Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Trim trailing whitespace

  • Loading branch information...
commit 3f91451e79c7624417655bd68e51e526d7666301 1 parent ac1ff7d
@hadley authored
Showing with 273 additions and 273 deletions.
  1. +1 −1  R/bash.r
  2. +17 −17 R/check-cran.r
  3. +4 −4 R/check.r
  4. +4 −4 R/common-mistakes.r
  5. +3 −3 R/create.r
  6. +3 −3 R/decompress.r
  7. +4 −4 R/dev-example.r
  8. +12 −12 R/dev-help.r
  9. +15 −15 R/devel-mode.r
  10. +10 −10 R/document.r
  11. +1 −1  R/env-utils.r
  12. +5 −5 R/file-cache.r
  13. +1 −1  R/install-bitbucket.r
  14. +7 −7 R/install-github.r
  15. +6 −6 R/install-gitorious.r
  16. +9 −9 R/install-url.r
  17. +5 −5 R/install-version.r
  18. +16 −16 R/install.r
  19. +9 −9 R/load-code.r
  20. +5 −5 R/load-data.r
  21. +4 −4 R/load.r
  22. +1 −1  R/namespace-env.r
  23. +4 −4 R/news.r
  24. +1 −1  R/package-env.r
  25. +11 −11 R/package.r
  26. +3 −3 R/path.r
  27. +14 −14 R/release.r
  28. +4 −4 R/reload.r
  29. +14 −14 R/run-example.r
  30. +5 −5 R/run-examples.r
  31. +4 −4 R/source.r
  32. +5 −5 R/system.r
  33. +2 −2 R/test.r
  34. +13 −13 R/topic-index.r
  35. +12 −12 R/vignettes.r
  36. +2 −2 R/wd.r
  37. +10 −10 R/with.r
  38. +15 −15 R/zzz.r
  39. +1 −1  inst/templates/packagename-package.r
  40. +1 −1  inst/tests/test-description.r
  41. +7 −7 inst/tests/test-load-collate.r
  42. +2 −2 inst/tests/test-vignettes.r
  43. +1 −1  tests/test-all.R
View
2  R/bash.r
@@ -5,6 +5,6 @@
#' @export
bash <- function(pkg = ".") {
pkg <- as.package(pkg)
-
+
in_dir(pkg$path, system("bash"))
}
View
34 R/check-cran.r
@@ -1,6 +1,6 @@
#' Check a package from CRAN.
#'
-#' This is useful for automatically checking that dependencies of your
+#' This is useful for automatically checking that dependencies of your
#' packages work.
#'
#' The downloaded package and check directory are only removed if the check is
@@ -63,16 +63,16 @@ check_cran <- function(pkgs, libpath = file.path(tempdir(), "R-lib"),
on.exit(.libPaths(setdiff(.libPaths(), libpath)))
# Make sure existing dependencies are up to date ---------------------------
- old <- old.packages(libpath, repos = repos, type = type,
+ old <- old.packages(libpath, repos = repos, type = type,
available = available_bin)
if (!is.null(old)) {
message("Updating ", nrow(old), " existing dependencies")
install.packages(old[, "Package"], libpath, repos = repos, type = type,
Ncpus = threads)
}
-
+
# Install missing dependencies
- deps <- unique(unlist(package_dependencies(pkgs, packages(),
+ deps <- unique(unlist(package_dependencies(pkgs, packages(),
which = "all")))
to_install <- setdiff(deps, installed.packages()[, 1])
known <- intersect(to_install, rownames(available_bin))
@@ -84,31 +84,31 @@ check_cran <- function(pkgs, libpath = file.path(tempdir(), "R-lib"),
Ncpus = threads)
}
if (length(unknown) > 0) {
- message("No binary packages available for dependenices: ",
+ message("No binary packages available for dependenices: ",
paste(unknown, collapse = ", "))
}
-
+
# Download and check each package, parsing output as we go.
tmp <- tempdir()
check <- function(i) {
url <- package_url(pkgs[i], repos, available = available_src)
-
+
if (length(url$url) == 0) {
message("Can't find package source. Skipping...")
return(NULL)
}
local <- file.path(srcpath, url$name)
-
+
if (!file.exists(local)) {
message("Downloading ", pkgs[i])
download.file(url$url, local, quiet = TRUE)
}
-
+
message("Checking ", i , ": ", pkgs[i])
cmd <- paste("CMD check --as-cran --no-multiarch --no-manual --no-codoc ",
local, sep = "")
try(R(cmd, tmp, stdout = NULL), silent = TRUE)
-
+
check_path <- file.path(tmp, gsub("_.*?$", ".Rcheck", url$name))
results <- parse_check_results(check_path)
if (length(results) > 0) cat(results, "\n")
@@ -118,7 +118,7 @@ check_cran <- function(pkgs, libpath = file.path(tempdir(), "R-lib"),
mc.cores = threads)
names(results) <- pkgs
-
+
n_problems <- sum(vapply(results, length, integer(1)))
if (n_problems > 0) {
warning("Found ", n_problems, call. = FALSE)
@@ -126,7 +126,7 @@ check_cran <- function(pkgs, libpath = file.path(tempdir(), "R-lib"),
# Collect the output
collect_check_results(tmp)
-
+
invisible(results)
}
@@ -135,24 +135,24 @@ available_packages <- memoise(function(repos, type) {
})
package_url <- function(package, repos, available = available.packages(contrib.url(repos, "source"))) {
-
+
ok <- (available[, "Package"] == package)
ok <- ok & !is.na(ok)
-
+
vers <- package_version(available[ok, "Version"])
keep <- vers == max(vers)
keep[duplicated(keep)] <- FALSE
ok[ok][!keep] <- FALSE
-
+
name <- paste(package, "_", available[ok, "Version"], ".tar.gz", sep = "")
url <- file.path(available[ok, "Repository"], name)
-
+
list(name = name, url = url)
}
parse_check_results <- function(path) {
check_path <- file.path(path, "00check.log")
-
+
check_log <- paste(readLines(check_path), collapse = "\n")
pieces <- strsplit(check_log, "\n\\* ")[[1]]
problems <- grepl("... (WARN|ERROR)", pieces)
View
8 R/check.r
@@ -2,7 +2,7 @@
#'
#' \code{check} automatically builds a package before using \code{R CMD check}
#' as this is the recommended way to check packages. Note that this process
-#' runs in an independent realisation of R, so nothing in your current
+#' runs in an independent realisation of R, so nothing in your current
#' workspace will affect the process.
#'
#' After the \code{R CMD check}, this will run checks that are specific
@@ -22,18 +22,18 @@
check <- function(pkg = ".", document = TRUE, cleanup = TRUE,
cran = TRUE, args = NULL) {
pkg <- as.package(pkg)
-
+
if (document) {
document(pkg, clean = TRUE)
}
- built_path <- build(pkg, tempdir())
+ built_path <- build(pkg, tempdir())
on.exit(unlink(built_path))
r_cmd_check_path <- check_r_cmd(pkg, built_path, cran, args)
check_devtools(pkg, built_path)
-
+
if (cleanup) {
unlink(r_cmd_check_path, recursive = TRUE)
View
8 R/common-mistakes.r
@@ -4,11 +4,11 @@
# @examples
# \dontrun{
# trace_all(
-# functions_with_arg("na.rm", "package:base"),
+# functions_with_arg("na.rm", "package:base"),
# quote(if (!na.rm) warning("na.rm = FALSE"))
# )
# trace_all(
-# functions_with_arg("drop", "package:base"),
+# functions_with_arg("drop", "package:base"),
# quote(if (drop) warning("drop = TRUE"))
# )
# }
@@ -27,11 +27,11 @@ trace_all <- function(fs, tracer) {
# }
functions_with_arg <- function(arg, pos) {
fs <- ls(pos=pos)
-
+
has_arg <- function(f) {
(is.function(f) || is.primitive(f)) && !is.null(formals(f)[[arg]])
}
-
+
Filter(function(x) has_arg(get(x)), fs)
}
View
6 R/create.r
@@ -1,7 +1,7 @@
#' Creates a new package, following all devtools package conventions.
#'
#' Similar to \code{\link{package.skeleton}}, except that it only creates
-#' the standard devtools directory structures, it doesn't try and create
+#' the standard devtools directory structures, it doesn't try and create
#' source code and data files by inspecting the global environment.
#'
#' @param path location to create new package. The last component of the path
@@ -18,7 +18,7 @@
#'
#' # Override a description attribute.
#' path <- file.path(tempdir(), "myCustomPackage")
-#' my_description <- list("Maintainer" =
+#' my_description <- list("Maintainer" =
#' "'Yoni Ben-Meshulam' <yoni@@opower.com>")
#' create(path, my_description)
#' }
@@ -47,7 +47,7 @@ create <- function(path, description = list()) {
)
description <- modifyList(defaults, description)
write.dcf(description, file.path(path, 'DESCRIPTION'))
-
+
dir.create(file.path(path, "R"))
dir.create(file.path(path, "man"))
create_package_doc(path, name)
View
6 R/decompress.r
@@ -1,5 +1,5 @@
decompress <- function(src, target = tempdir()) {
-
+
if (grepl("\\.zip$", src)) {
unzip(src, exdir = target)
outdir <- getdir(as.character(unzip(src, list = TRUE)$Name[1]))
@@ -14,10 +14,10 @@ decompress <- function(src, target = tempdir()) {
} else {
ext <- gsub("^[^.]*\\.", "", src)
- stop("Don't know how to decompress files with extension ", ext,
+ stop("Don't know how to decompress files with extension ", ext,
call. = FALSE)
}
-
+
file.path(target, outdir)
}
View
8 R/dev-example.r
@@ -1,6 +1,6 @@
#' Run a examples for an in-development function.
#'
-#' @inheritParams run_examples
+#' @inheritParams run_examples
#' @param topic Name or topic (or name of Rd) file to run examples for
#' @export
#' @family example functions
@@ -16,13 +16,13 @@
#' }
dev_example <- function(topic) {
path <- find_topic(topic)
-
+
if (is.null(path)) {
stop("Can't find development example for topic ", topic, call. = FALSE)
}
-
+
pkg <- as.package(names(path)[[1]])
load_all(pkg)
-
+
run_example(path)
}
View
24 R/dev-help.r
@@ -2,7 +2,7 @@
#'
#' Note that this only renders a single documentation file, so that links
#' to other files within the package won't work.
-#'
+#'
#' @param topic name of help to search for.
#' @param stage at which stage ("build", "install", or "render") should
#' \\Sexpr macros be executed? This is only important if you're using
@@ -14,7 +14,7 @@
#' \dontrun{
#' library("ggplot2")
#' help("ggplot") # loads installed documentation for ggplot
-#'
+#'
#' load_all("ggplot2")
#' dev_help("ggplot") # loads development documentation for ggplot
#' }
@@ -24,16 +24,16 @@ dev_help <- function(topic, stage = "render", type = getOption("help_type")) {
dev <- paste(dev_packages(), collapse = ", ")
stop("Could not find topic ", topic, " in: ", dev)
}
-
+
pkg <- basename(names(path)[1])
view_rd(path, pkg, stage = stage, type = type)
-}
+}
#' Show an Rd file in a package.
#'
#' @param pkg package description, can be path or package name. See
#' \code{\link{as.package}} for more information
-#' @param file topic or name Rd file to open.
+#' @param file topic or name Rd file to open.
#' @param ... additional arguments passed onto \code{\link[tools]{Rd2txt}}.
#' This is particular useful if you're checking macros and want to simulate
#' what happens when the package is built (\code{stage = "build"})
@@ -43,13 +43,13 @@ dev_help <- function(topic, stage = "render", type = getOption("help_type")) {
show_rd <- function(pkg = ".", file, ...) {
.Deprecated("dev_help")
pkg <- as.package(pkg)
-
+
rd <- find_pkg_topic(pkg, file)
if (is.null(rd)) {
stop("Could not find topic or Rd file ", file, call. = FALSE)
}
- path <- file.path(pkg$path, "man", rd)
+ path <- file.path(pkg$path, "man", rd)
view_rd(path, pkg, ...)
}
@@ -57,21 +57,21 @@ show_rd <- function(pkg = ".", file, ...) {
view_rd <- function(path, package, stage = "render", type = getOption("help_type")) {
if (is.null(type)) type <- "text"
type <- match.arg(type, c("text", "html"))
-
+
out_path <- paste(tempfile("Rtxt"), type, sep = ".")
-
+
if (type == "text") {
Rd2txt(path, out = out_path, package = package, stages = stage)
file.show(out_path, title = paste(package, basename(path), sep = ":"))
} else if (type == "html") {
- Rd2HTML(path, out = out_path, package = package, stages = stage,
+ Rd2HTML(path, out = out_path, package = package, stages = stage,
no_links = TRUE)
-
+
css_path <- file.path(tempdir(), "R.css")
if (!file.exists(css_path)) {
file.copy(file.path(R.home("doc"), "html", "R.css"), css_path)
}
-
+
browseURL(out_path)
}
}
View
30 R/devel-mode.r
@@ -1,7 +1,7 @@
#' Activate and deactivate development mode.
#'
#' When activated, \code{dev_mode} creates a new library for storing installed
-#' packages. This new library is automatically created when \code{dev_mode} is
+#' packages. This new library is automatically created when \code{dev_mode} is
#' activated if it does not already exist.
#' This allows you to test development packages in a sandbox, without
#' interfering with the other packages you have installed.
@@ -18,15 +18,15 @@
#' }
dev_mode <- local({
.prompt <- NULL
-
+
function(on = NULL, path = getOption("devtools.path")) {
lib_paths <- .libPaths()
-
+
path <- normalizePath(path, winslash = "/", mustWork = FALSE)
if (is.null(on)) {
on <- !(path %in% lib_paths)
}
-
+
if (on) {
if (!file.exists(path)) {
dir.create(path, recursive = TRUE, showWarnings = FALSE)
@@ -34,27 +34,27 @@ dev_mode <- local({
if (!file.exists(path)) {
stop("Failed to create ", path, call. = FALSE)
}
-
+
if (!is_library(path)) {
- warning(path, " does not appear to be a library. ",
+ warning(path, " does not appear to be a library. ",
"Are sure you specified the correct directory?", call. = FALSE)
}
-
+
message("Dev mode: ON")
options(dev_path = path)
-
+
if (is.null(.prompt)) .prompt <<- getOption("prompt")
options(prompt = paste("d> "))
-
+
.libPaths(c(path, lib_paths))
} else {
-
+
message("Dev mode: OFF")
options(dev_path = NULL)
-
+
if (!is.null(.prompt)) options(prompt = .prompt)
.prompt <<- NULL
-
+
.libPaths(setdiff(lib_paths, path))
}
}
@@ -63,14 +63,14 @@ dev_mode <- local({
is_library <- function(path) {
# empty directories can be libraries
if (length(dir(path)) == 0) return (TRUE)
-
+
# otherwise check that the directories are compiled R directories -
# i.e. that they contain a Meta directory
dirs <- dir(path, full.names = TRUE)
dirs <- dirs[file_test("-d", dirs)]
-
+
has_pkg_dir <- function(path) length(dir(path, pattern = "Meta")) > 0
help_dirs <- vapply(dirs, has_pkg_dir, logical(1))
-
+
all(help_dirs)
}
View
20 R/document.r
@@ -19,32 +19,32 @@ document <- function(pkg = ".", clean = FALSE, roclets = c("collate", "namespace
man_path <- file.path(pkg$path, "man")
if (!file.exists(pkg$path)) dir.create(man_path)
-
+
if (clean) {
roxygen2:::clear_caches()
file.remove(dir(man_path, full.names = TRUE))
}
-
+
if (reload) {
load_all(pkg, reset = clean)
}
-
+
# Integrate source and evaluated code
env <- ns_env(pkg)
env_hash <- suppressWarnings(digest(env))
r_files <- find_code(pkg)
- parsed <- unlist(lapply(r_files, parse.file, env = env,
+ parsed <- unlist(lapply(r_files, parse.file, env = env,
env_hash = env_hash), recursive = FALSE)
-
+
roclets <- paste(roclets, "_roclet", sep = "")
for (roclet in roclets) {
roc <- match.fun(roclet)()
with_collate("C", {
results <- roxygen2:::roc_process(roc, parsed, pkg$path)
- roxygen2:::roc_output(roc, results, pkg$path)
+ roxygen2:::roc_output(roc, results, pkg$path)
})
}
-
+
clear_topic_index(pkg)
invisible()
}
@@ -52,7 +52,7 @@ document <- function(pkg = ".", clean = FALSE, roclets = c("collate", "namespace
#' Check documentation, as \code{R CMD check} does.
#'
#' Currently runs these checks: package parseRd, Rd metadata, Rd xrefs, and
-#' Rd contents.
+#' Rd contents.
#'
#' @param pkg package description, can be path or package name. See
#' \code{\link{as.package}} for more information
@@ -61,12 +61,12 @@ check_doc <- function(pkg = ".") {
pkg <- as.package(pkg)
old <- options(warn = -1)
on.exit(options(old))
-
+
print(tools:::.check_package_parseRd(dir = pkg$path))
print(tools:::.check_Rd_metadata(dir = pkg$path))
print(tools:::.check_Rd_xrefs(dir = pkg$path))
print(tools:::.check_Rd_contents(dir = pkg$path))
-
+
print(tools::checkDocFiles(dir = pkg$path))
# print(tools::checkDocStyle(dir = pkg$path))
# print(tools::undoc(dir = pkg$path))
View
2  R/env-utils.r
@@ -11,6 +11,6 @@ copy_env <- function(src, dest = new.env(parent = emptyenv()),
srclist <- as.list(src, all.names = TRUE)
srclist <- srclist[ !(names(srclist) %in% ignore) ]
list2env(srclist, envir = dest)
-
+
dest
}
View
10 R/file-cache.r
@@ -11,17 +11,17 @@ make_cache <- function() {
paths <- path.expand(paths)
new_hash <- md5(paths)
old_hash <- .file_cache[paths]
-
+
changed <- is.na(old_hash) | new_hash != old_hash
.file_cache[paths[changed]] <<- new_hash[changed]
-
+
paths[changed]
}
-
- clear <- function() {
+
+ clear <- function() {
.file_cache <<- character()
}
-
+
list(make = make, clear = clear)
}
.cache <- make_cache()
View
2  R/install-bitbucket.r
@@ -24,7 +24,7 @@ install_bitbucket <- function(repo, username, ref = "master", branch = NULL, ...
" from ",
paste(username, collapse = ", "))
- url <- paste("https://bitbucket.org/", username, "/", repo, "/get/",
+ url <- paste("https://bitbucket.org/", username, "/", repo, "/get/",
ref, ".zip", sep = "")
install_url(url, paste(ref, ".zip", sep = ""), ...)
}
View
14 R/install-github.r
@@ -1,6 +1,6 @@
#' Attempts to install a package directly from github.
#'
-#' This function is vectorised so you can install multiple packages in
+#' This function is vectorised so you can install multiple packages in
#' a single command.
#'
#' @param username Github username
@@ -40,7 +40,7 @@ install_github <- function(repo, username = getOption("github.user"),
username <- pullinfo$username
ref <- pullinfo$ref
}
-
+
if (!is.null(password)) {
auth <- authenticate(
user = auth_user %||% username,
@@ -49,17 +49,17 @@ install_github <- function(repo, username = getOption("github.user"),
} else {
auth <- list()
}
-
- message("Installing github repo(s) ",
+
+ message("Installing github repo(s) ",
paste(repo, ref, sep = "/", collapse = ", "),
- " from ",
+ " from ",
paste(username, collapse = ", "))
name <- paste(username, "-", repo, sep = "")
-
+
url <- paste("https://api.github.com/repos/", username, "/", repo,
"/zipball/", ref, sep = "")
- install_url(url, paste(repo, ".zip", sep = ""), subdir = subdir,
+ install_url(url, paste(repo, ".zip", sep = ""), subdir = subdir,
config = auth, ...)
}
View
12 R/install-gitorious.r
@@ -1,6 +1,6 @@
#' Attempts to install a package directly from gitorious.
#'
-#' This function is vectorised so you can install multiple packages in
+#' This function is vectorised so you can install multiple packages in
#' a single command.
#'
#' @param project Gitorious project name
@@ -22,16 +22,16 @@ install_gitorious <- function(repo, project = repo, ref = "master",
warning("'branch' is deprecated. In the future, please use 'ref' instead.")
ref <- branch
}
- message("Installing gitorious repo(s) ",
- paste(repo, collapse = ", "),
- " from ",
+ message("Installing gitorious repo(s) ",
+ paste(repo, collapse = ", "),
+ " from ",
paste(project, collapse = ", "))
repo <- tolower(repo)
- project <- tolower(project)
+ project <- tolower(project)
url <- paste("https://gitorious.org/", project, "/", repo,
"/archive-tarball/", ref, sep = "")
-
+
install_url(url, paste(repo, ".tar.gz", sep = ""), subdir = subdir, ...)
}
View
18 R/install-url.r
@@ -1,9 +1,9 @@
#' Install a package from a url
#'
-#' This function is vectorised so you can install multiple packages in
+#' This function is vectorised so you can install multiple packages in
#' a single command.
#'
-#' @param url location of package on internet. The url should point to a
+#' @param url location of package on internet. The url should point to a
#' zip file, a tar file or a bzipped/gzipped tar file.
#' @param name optional package name, used to provide more informative
#' messages
@@ -17,8 +17,8 @@ install_url <- function(url, name = NULL, subdir = NULL, config = list(), ...) {
if (is.null(name)) {
name <- rep(list(NULL), length(url))
}
-
- invisible(mapply(install_url_single, url, name,
+
+ invisible(mapply(install_url_single, url, name,
MoreArgs = list(subdir = subdir, config = config, ...)))
}
@@ -30,18 +30,18 @@ install_url_single <- function(url, name = NULL, subdir = NULL, config = list(),
message("Installing ", name, " from ", url)
bundle <- file.path(tempdir(), name)
-
+
# Download package file
request <- GET(url, config)
stop_for_status(request)
writeBin(content(request), bundle)
on.exit(unlink(bundle), add = TRUE)
-
+
unbundle <- decompress(bundle)
on.exit(unlink(unbundle), add = TRUE)
-
+
pkg_path <- if (is.null(subdir)) unbundle else file.path(unbundle, subdir)
-
+
# Check it's an R package
if (!file.exists(file.path(pkg_path, "DESCRIPTION"))) {
stop("Does not appear to be an R package", call. = FALSE)
@@ -51,7 +51,7 @@ install_url_single <- function(url, name = NULL, subdir = NULL, config = list(),
if (file.exists(config_path)) {
Sys.chmod(config_path, "777")
}
-
+
# Install
install(pkg_path, ...)
}
View
10 R/install-version.r
@@ -1,6 +1,6 @@
#' Install specified version of a CRAN package.
#'
-#' If you are installing an package that contains compiled code, you will
+#' If you are installing an package that contains compiled code, you will
#' need to have an R development environment installed. You can check
#' if you do by running \code{\link{has_devel}}.
#'
@@ -15,14 +15,14 @@
#' @inheritParams utils::install.packages
#' @author Jeremy Stephens
install_version <- function(package, version = NULL, repos = getOption("repos"), type = getOption("pkgType"), ...) {
-
+
contriburl <- contrib.url(repos, type)
available <- available.packages(contriburl)
-
+
if (!is.null(version)) {
version <- numeric_version(version)
}
-
+
if (package %in% row.names(available)) {
current.version <- available[package, 'Version']
if (is.null(version) || version == current.version) {
@@ -52,6 +52,6 @@ install_version <- function(package, version = NULL, repos = getOption("repos"),
}
}
- url <- paste(repos, "/src/contrib/Archive/", package.path, sep = "")
+ url <- paste(repos, "/src/contrib/Archive/", package.path, sep = "")
install_url(url, ...)
}
View
32 R/install.r
@@ -3,12 +3,12 @@
#' Uses \code{R CMD INSTALL} to install the package. Will also try to install
#' dependencies of the package from CRAN, if they're not already installed.
#'
-#' Installation takes place on a copy of the package produced by
+#' Installation takes place on a copy of the package produced by
#' \code{R CMD build} to avoid modifying the local directory in any way.
#'
#' @param pkg package description, can be path or package name. See
#' \code{\link{as.package}} for more information
-#' @param reload if \code{TRUE} (the default), will automatically reload the
+#' @param reload if \code{TRUE} (the default), will automatically reload the
#' package after installing.
#' @param quick if \code{TRUE} skips docs, multiple-architectures,
#' and demos to make installation as fast as possible.
@@ -22,11 +22,11 @@
install <- function(pkg = ".", reload = TRUE, quick = FALSE, args = NULL) {
pkg <- as.package(pkg)
message("Installing ", pkg$package)
- install_deps(pkg)
-
+ install_deps(pkg)
+
built_path <- build(pkg, tempdir())
- on.exit(unlink(built_path))
-
+ on.exit(unlink(built_path))
+
opts <- c(
paste("--library=", shQuote(.libPaths()[1]), sep = ""),
"--with-keep.source")
@@ -34,7 +34,7 @@ install <- function(pkg = ".", reload = TRUE, quick = FALSE, args = NULL) {
opts <- c(opts, "--no-docs", "--no-multiarch", "--no-demo")
}
opts <- paste(paste(opts, collapse = " "), paste(args, collapse = " "))
-
+
R(paste("CMD INSTALL ", shQuote(built_path), " ", opts, sep = ""))
if (reload) reload(pkg)
@@ -43,16 +43,16 @@ install <- function(pkg = ".", reload = TRUE, quick = FALSE, args = NULL) {
install_deps <- function(pkg = ".") {
pkg <- as.package(pkg)
- deps <- c(parse_deps(pkg$depends)$name, parse_deps(pkg$imports)$name,
+ deps <- c(parse_deps(pkg$depends)$name, parse_deps(pkg$imports)$name,
parse_deps(pkg$linkingto)$name)
-
+
# Remove packages that are already installed
not.installed <- function(x) length(find.package(x, quiet = TRUE)) == 0
deps <- Filter(not.installed, deps)
-
+
if (length(deps) == 0) return(invisible())
-
- message("Installing dependencies for ", pkg$package, ":\n",
+
+ message("Installing dependencies for ", pkg$package, ":\n",
paste(deps, collapse = ", "))
install.packages(deps)
invisible(deps)
@@ -64,7 +64,7 @@ install_deps <- function(pkg = ".") {
#' @param PKG_CFLAGS flags for compiling C code
#' @param PKG_CXXFLAGS flags for compiling C++ code
#' @param PKG_FFLAGS flags for compiling Fortran code.
-#' @param PKG_FCFLAGS flags for Fortran 9x code.
+#' @param PKG_FCFLAGS flags for Fortran 9x code.
#' @export
#' @examples
#' \dontrun{
@@ -73,13 +73,13 @@ install_deps <- function(pkg = ".") {
#' }
with_debug <- function(code,
PKG_CFLAGS = "-UNDEBUG -Wall -pedantic -g -O0",
- PKG_CXXFLAGS = "-UNDEBUG -Wall -pedantic -g -O0",
- PKG_FFLAGS = "-g -O0",
+ PKG_CXXFLAGS = "-UNDEBUG -Wall -pedantic -g -O0",
+ PKG_FFLAGS = "-g -O0",
PKG_FCFLAGS = "-g -O0") {
flags <- c(
PKG_CFLAGS = PKG_CFLAGS, PKG_CXXFLAGS = PKG_CXXFLAGS,
PKG_FFLAGS = PKG_FFLAGS, PKG_FCFLAGS = PKG_FCFLAGS)
-
+
with_env(flags, code)
}
View
18 R/load-code.r
@@ -1,6 +1,6 @@
#' Load R code.
#'
-#' Load all R code in the \code{R} directory. The first time the code is
+#' Load all R code in the \code{R} directory. The first time the code is
#' loaded, \code{.onLoad} will be run if it exists.
#'
#' @param pkg package description, can be path or package name. See
@@ -15,15 +15,15 @@ load_code <- function(pkg = ".") {
paths <- changed_files(r_files)
tryCatch(
- lapply(paths, sys.source, envir = env, chdir = TRUE,
- keep.source = TRUE),
+ lapply(paths, sys.source, envir = env, chdir = TRUE,
+ keep.source = TRUE),
error = function(e) {
clear_cache()
unload(pkg)
stop(e)
}
)
-
+
invisible(r_files)
}
@@ -39,13 +39,13 @@ parse_collate <- function(string) {
#' @keywords internal
find_code <- function(pkg = ".") {
path_r <- file.path(pkg$path, "R")
-
- code_paths <- dir(path_r, "\\.[Rrq]$", full.names = TRUE)
+
+ code_paths <- dir(path_r, "\\.[Rrq]$", full.names = TRUE)
r_files <- with_collate("C", sort(code_paths))
-
+
if (!is.null(pkg$collate)) {
collate <- file.path(path_r, parse_collate(pkg$collate))
-
+
missing <- setdiff(collate, r_files)
files <- function(x) paste(basename(x), collapse = ", ")
if (length(missing) > 0) {
@@ -57,7 +57,7 @@ find_code <- function(pkg = ".") {
if (length(extra) > 0) {
message("Adding files missing in collate: ", files(extra))
}
-
+
r_files <- union(collate, r_files)
}
r_files
View
10 R/load-data.r
@@ -10,23 +10,23 @@ load_data <- function(pkg = ".") {
pkg <- as.package(pkg)
env <- ns_env(pkg)
objs <- character()
-
+
sysdata <- file.path(pkg$path, "R", "sysdata.rda")
if (file.exists(sysdata)) {
objs <- c(objs, load(sysdata, envir = env))
}
-
+
path_data <- file.path(pkg$path, "data")
if (file.exists(path_data)) {
paths <- dir(path_data, "\\.[rR][dD]a(ta)?$", full.names = TRUE)
paths <- changed_files(paths)
objs <- c(objs, unlist(lapply(paths, load, envir = env)))
-
+
paths <- dir(path_data, "\\.[rR]$", full.names = TRUE)
paths <- changed_files(paths)
- objs <- c(objs, unlist(lapply(paths, sys.source, envir = env,
+ objs <- c(objs, unlist(lapply(paths, sys.source, envir = env,
chdir = TRUE, keep.source = TRUE)))
}
-
+
invisible(objs)
}
View
8 R/load.r
@@ -83,7 +83,7 @@ load_all <- function(pkg = ".", reset = FALSE, recompile = FALSE,
msg <- capture.output(tools:::print.check_package_description(check))
message("Invalid DESCRIPTION:\n", paste(msg, collapse = "\n"))
}
-
+
# If installed version of package loaded, unload it
if (is_loaded(pkg) && is.null(dev_meta(pkg$package))) {
unload(pkg)
@@ -91,7 +91,7 @@ load_all <- function(pkg = ".", reset = FALSE, recompile = FALSE,
# Unload dlls
unload_dll(pkg)
-
+
if (reset) {
clear_cache()
if (is_loaded(pkg)) unload(pkg)
@@ -127,11 +127,11 @@ load_all <- function(pkg = ".", reset = FALSE, recompile = FALSE,
# Set up the package environment ------------------------------------
# Create the package environment if needed
if (!is_attached(pkg)) attach_ns(pkg)
-
+
# Copy over objects from the namespace environment
export_ns(pkg)
run_onattach(pkg)
- invisible(out)
+ invisible(out)
}
View
2  R/namespace-env.r
@@ -1,7 +1,7 @@
#' Return the namespace environment for a package.
#'
#' Contains all (exported and non-exported) objects, and is a descendent of
-#' \code{R_GlobalEnv}. The hieararchy is \code{<namespace:pkg>},
+#' \code{R_GlobalEnv}. The hieararchy is \code{<namespace:pkg>},
#' \code{<imports:pkg>}, \code{<namespace:base>}, and then
#' \code{R_GlobalEnv}.
#'
View
8 R/news.r
@@ -1,19 +1,19 @@
#' Show package news
-#'
+#'
#' @param pkg package description, can be path or package name. See
#' \code{\link{as.package}} for more information
-#' @param latest if \code{TRUE}, only show the news for the most recent
+#' @param latest if \code{TRUE}, only show the news for the most recent
#' version.
#' @param ... other arguments passed on to \code{news}
#' @export
show_news <- function(pkg = ".", latest = TRUE, ...) {
pkg <- as.package(pkg)
news_path <- file.path(pkg$path, "NEWS")
-
+
if (!file.exists(news_path)) {
stop("No NEWS found", call. = FALSE)
}
-
+
out <- news(..., db = tools:::.news_reader_default(news_path))
if (latest) {
ver <- numeric_version(out$Version)
View
2  R/package-env.r
@@ -49,7 +49,7 @@ export_ns <- function(pkg = ".") {
pkg_env <- function(pkg = ".") {
pkg <- as.package(pkg)
name <- pkg_env_name(pkg)
-
+
if (!is_attached(pkg)) return(NULL)
as.environment(name)
View
22 R/package.r
@@ -1,5 +1,5 @@
#' Coerce input to a package.
-#'
+#'
#' Possible specifications of package:
#' \itemize{
#' \item path
@@ -9,36 +9,36 @@
#' @export
as.package <- function(x = NULL) {
if (is.package(x)) return(x)
-
+
if (is.null(x)) {
stop("pkg must not be NULL", call. = FALSE)
}
-
+
path <- find_package(x)
-
+
pkg <- load_pkg_description(path)
}
find_package <- function(x) {
if (is.null(x)) return(FALSE)
-
+
# Strip trailing slashes (needed only for windows)
x <- normalizePath(x, mustWork = FALSE)
x <- gsub("\\\\$", "", x)
-
+
if (!file.exists(x)) {
stop("Can't find directory ", x, call. = FALSE)
}
if (!file.info(x)$isdir) {
stop(x, " is not a directory", call. = FALSE)
}
-
+
desc_path <- file.path(x, "DESCRIPTION")
if (!file.exists(desc_path)) {
stop("No DESCRIPTION file found in ", x, call. = FALSE)
}
-
+
x
}
@@ -47,15 +47,15 @@ find_package <- function(x) {
load_pkg_description <- function(path) {
path <- normalizePath(path)
path_desc <- file.path(path, "DESCRIPTION")
-
+
if (!file.exists(path_desc)) {
stop("No description at ", path_desc, call. = FALSE)
}
-
+
desc <- as.list(read.dcf(path_desc)[1, ])
names(desc) <- tolower(names(desc))
desc$path <- path
-
+
structure(desc, class = "package")
}
View
6 R/path.r
@@ -1,5 +1,5 @@
#' Get/set the PATH variable.
-#'
+#'
#' @param path character vector of paths
#' @return \code{set_path} invisibly returns the old path.
#' @name path
@@ -25,7 +25,7 @@ get_path <- function() {
#' @rdname path
set_path <- function(path) {
path <- normalizePath(path, mustWork = FALSE)
-
+
old <- get_path()
path <- paste(path, collapse = .Platform$path.sep)
Sys.setenv(PATH = path)
@@ -56,4 +56,4 @@ on_path <- function(...) {
commands <- c(...)
stopifnot(is.character(commands))
unname(Sys.which(commands) != "")
-}
+}
View
28 R/release.r
@@ -34,33 +34,33 @@ release <- function(pkg = ".", check = TRUE) {
if (check) {
check(pkg)
- if (yesno("Was package check successful?"))
+ if (yesno("Was package check successful?"))
return(invisible())
}
-
+
if (yesno("Have you checked on win-builder (with build_win)?"))
return(invisible())
-
+
try(print(show_news(pkg)))
- if (yesno("Is package news up-to-date?"))
+ if (yesno("Is package news up-to-date?"))
return(invisible())
-
+
cat(readLines(file.path(pkg$path, "DESCRIPTION")), sep = "\n")
- if (yesno("Is DESCRIPTION up-to-date?"))
+ if (yesno("Is DESCRIPTION up-to-date?"))
return(invisible())
if (yesno("Have you checked packages that depend on this package?"))
return(invisible())
-
- if (yesno("Ready to upload?"))
+
+ if (yesno("Ready to upload?"))
return(invisible())
-
+
message("Building and uploading")
built_path <- build(pkg, tempdir())
ftpUpload(built_path, paste("ftp://cran.R-project.org/incoming/",
basename(built_path), sep = ""))
-
+
message("Preparing email")
msg <- paste(
"Dear CRAN maintainers,\n",
@@ -71,17 +71,17 @@ release <- function(pkg = ".", check = TRUE) {
"INSERT YOUR NAME", "\n\n\n", sep = "")
subject <- paste("CRAN submission ", pkg$package, " ", pkg$version, sep = "")
create.post(msg, subject = subject, address = "cran@r-project.org")
-
+
invisible(TRUE)
-}
+}
yesno <- function(question) {
yeses <- c("Yes", "Definitely", "For sure", "Yup", "Yeah")
nos <- c("No way", "Not yet", "I forgot", "No", "Nope")
-
+
cat(question)
qs <- c(sample(yeses, 1), sample(nos, 2))
rand <- sample(length(qs))
-
+
menu(qs[rand]) != which(rand == 1)
}
View
8 R/reload.r
@@ -1,8 +1,8 @@
#' Unload and reload package.
-#'
+#'
#' If the package is not loaded already, this does nothing.
-#'
-#' See the caveats in \code{\link{detach}} for the many reasons why this
+#'
+#' See the caveats in \code{\link{detach}} for the many reasons why this
#' might not work. If in doubt, quit R and restart.
#'
#' @param pkg package description, can be path or package name. See
@@ -22,7 +22,7 @@
#' @export
reload <- function(pkg = ".") {
pkg <- as.package(pkg)
-
+
if (is_attached(pkg)) {
message("Reloading installed ", pkg$package)
unload(pkg)
View
28 R/run-example.r
@@ -1,13 +1,13 @@
#' @importFrom evaluate evaluate replay
#' @importFrom tools parse_Rd
-run_example <- function(path, show = TRUE, test = FALSE, run = TRUE, env = new.env(parent = globalenv())) {
+run_example <- function(path, show = TRUE, test = FALSE, run = TRUE, env = new.env(parent = globalenv())) {
rd <- parse_Rd(path)
ex <- rd[rd_tags(rd) == "examples"]
code <- process_ex(ex, show = show, test = test, run = run)
if (is.null(code)) return()
-
+
message("Running examples in ", basename(path))
- rule()
+ rule()
code <- paste(code, collapse = "")
results <- evaluate(code, env)
@@ -16,11 +16,11 @@ run_example <- function(path, show = TRUE, test = FALSE, run = TRUE, env = new.e
process_ex <- function(rd, show = TRUE, test = FALSE, run = TRUE) {
tag <- rd_tag(rd)
-
+
recurse <- function(rd) {
unlist(lapply(rd, process_ex, show = show, test = test, run = run))
}
-
+
if (is.null(tag) || tag == "examples") {
return(recurse(rd))
}
@@ -29,11 +29,11 @@ process_ex <- function(rd, show = TRUE, test = FALSE, run = TRUE) {
if (tag %in% c("RCODE", "COMMENT", "TEXT", "VERB")) {
return(rd[[1]])
}
-
+
# Conditional execution
if (tag %in% c("dontshow", "dontrun", "donttest", "testonly")) {
out <- recurse(rd)
-
+
if ((tag == "dontshow" && show) ||
(tag == "dontrun" && run) ||
(tag == "donttest" && test) ||
@@ -44,11 +44,11 @@ process_ex <- function(rd, show = TRUE, test = FALSE, run = TRUE) {
}
return(out)
}
-
+
if (tag %in% c("dots", "ldots")) {
return("...")
}
-
+
warning("Unknown tag ", tag, call. = FALSE)
tag
}
@@ -57,7 +57,7 @@ process_ex <- function(rd, show = TRUE, test = FALSE, run = TRUE) {
rd_tag <- function(x) {
tag <- attr(x, "Rd_tag")
if (is.null(tag)) return()
-
+
gsub("\\", "", tag, fixed = TRUE)
}
@@ -72,10 +72,10 @@ remove_tag <- function(x) {
replay.error <- function(x) {
if (is.null(x$call)) {
- message("Error: ", x$message)
+ message("Error: ", x$message)
} else {
call <- deparse(x$call)
- message("Error in ", call, ": ", x$message)
+ message("Error in ", call, ": ", x$message)
}
}
@@ -94,7 +94,7 @@ replay_stop.list <- function(x) {
}
quiet_error <- function(message, call = NULL) {
- structure(list(message = as.character(message), call = call),
+ structure(list(message = as.character(message), call = call),
class = c("quietError", "error", "condition"))
}
as.character.quietError <- function(x) {
@@ -104,4 +104,4 @@ as.character.quietError <- function(x) {
call <- deparse(x$call)
paste("Error in ", call, ": ", x$message, sep = "")
}
-}
+}
View
10 R/run-examples.r
@@ -26,28 +26,28 @@ run_examples <- function(pkg = ".", start = NULL, show = TRUE, test = FALSE, run
load_all(pkg, reset = TRUE, export_all = FALSE)
on.exit(load_all(pkg, reset = TRUE))
document(pkg, reload = FALSE)
-
+
path_man <- file.path(pkg$path, "man")
files <- dir(path_man, pattern = "\\.[Rr]d$", full.names = TRUE)
names(files) <- basename(files)
files <- with_collate("C", sort(files))
-
+
if (!is.null(start)) {
start_path <- find_pkg_topic(pkg, start)
if (is.null(start_path)) {
stop("Couldn't find start position ", start, call. = FALSE)
}
-
+
start_pos <- which(names(files) == start_path)
if (length(start_pos) == 1) {
files <- files[- seq(1, start_pos - 1)]
}
}
-
+
message("Running ", length(files), " example files in ", pkg$package)
rule()
lapply(files, run_example, show = show, test = test, run = run)
-
+
invisible()
}
# If an error occurs, should print out the suspect line of code, and offer
View
8 R/source.r
@@ -1,21 +1,21 @@
#' Sources an R file in a clean environment.
-#'
+#'
#' Opens up a fresh R environment and sources file, ensuring that it works
#' independently of the current working environment.
#'
#' @param path path to R script
-#' @param vanilla if \code{TRUE} tells R not to use any system specific
+#' @param vanilla if \code{TRUE} tells R not to use any system specific
#' settings.
#' @export
clean_source <- function(path, vanilla = FALSE) {
stopifnot(file.exists(path))
-
+
if (vanilla) {
opts <- c("--no-restore", "--no-save")
} else {
opts <- c("--vanilla")
}
-
+
opts <- c("--quiet", paste("--file=", shQuote(path), sep = ""))
R(opts, dirname(path))
}
View
10 R/system.r
@@ -3,7 +3,7 @@
system_check <- function(cmd, args = character(), env = character(), ...) {
full <- paste(cmd, " ", paste(args, collapse = ", "), sep = "")
message(wrap_command(full))
-
+
message()
with_env(env, {
res <- system2(cmd, args = args, ...)
@@ -11,16 +11,16 @@ system_check <- function(cmd, args = character(), env = character(), ...) {
if (res != 0) {
stop("Command failed (", res, ")", call. = FALSE)
}
-
+
invisible(TRUE)
}
R <- function(options, path = tempdir(), ...) {
options <- paste("--vanilla", options)
r_path <- file.path(R.home("bin"), "R")
-
+
env <- c(
- "LC_ALL" = "C",
+ "LC_ALL" = "C",
"R_LIBS" = paste(.libPaths(), collapse = .Platform$path.sep),
"CYGWIN" = "nodosfilewarning",
"R_TESTS" = "")
@@ -36,4 +36,4 @@ wrap_command <- function(x) {
lines <- strwrap(x, getOption("width") - 2, exdent = 2)
continue <- c(rep(" \\", length(lines) - 1), "")
paste(lines, continue, collapse = "\n")
-}
+}
View
4 R/test.r
@@ -12,10 +12,10 @@ test <- function(pkg = ".", filter = NULL) {
pkg <- as.package(pkg)
load_all(pkg)
message("Testing ", pkg$package)
-
+
path_test <- file.path(pkg$path, "inst", "tests")
if (!file.exists(path_test)) return()
-
+
require(testthat)
# Run tests in a child of the namespace environment, like testthat::test_package
env <- new.env(parent = ns_env(pkg))
View
26 R/topic-index.r
@@ -4,19 +4,19 @@
# @return path to rd file within package
find_pkg_topic <- function(pkg = ".", topic) {
pkg <- as.package(pkg)
-
+
# First see if a man file of that name exists
man <- file.path(pkg$path, "man", topic)
if (file.exists(man)) return(basename(man))
-
- # Next, look in index
+
+ # Next, look in index
index <- topic_index(pkg)
if (topic %in% names(index)) return(index[[topic]])
-
+
# Finally, try adding .Rd to name
man_rd <- file.path(pkg$path, "man", paste(topic, ".Rd"))
if (file.exists(man_rd)) return(basename(man_rd))
-
+
NULL
}
@@ -29,21 +29,21 @@ find_topic <- function(topic) {
pkgs <- pieces[1]
topic <- pieces[2]
}
-
+
for (pkg in pkgs) {
path <- getNamespaceInfo(pkg, "path")
rd <- find_pkg_topic(path, topic)
if (!is.null(rd)) return(setNames(file.path(path, "man", rd), path))
}
-
+
NULL
}
topic_indices <- new.env(parent = emptyenv())
topic_index <- function(pkg = ".") {
pkg <- as.package(pkg)
-
- if (!exists(pkg$package, topic_indices)) {
+
+ if (!exists(pkg$package, topic_indices)) {
topic_indices[[pkg$package]] <- build_topic_index(pkg)
}
topic_indices[[pkg$package]]
@@ -54,23 +54,23 @@ clear_topic_index <- function(pkg = ".") {
if (exists(pkg$package, topic_indices)) {
rm(list = pkg$package, envir = topic_indices)
}
-
+
invisible(TRUE)
}
#' @importFrom tools parse_Rd
build_topic_index <- function(pkg = ".") {
pkg <- as.package(pkg)
-
+
rds <- dir(file.path(pkg, "man"), full.names = TRUE)
names(rds) <- basename(rds)
-
+
aliases <- function(path) {
parsed <- parse_Rd(path)
tags <- vapply(parsed, function(x) attr(x, "Rd_tag")[[1]], character(1))
unlist(parsed[tags == "\\alias"])
}
-
+
invert(lapply(rds, aliases))
}
View
24 R/vignettes.r
@@ -13,13 +13,13 @@
build_vignettes <- function(pkg = ".") {
pkg <- as.package(pkg)
message("Building ", pkg$package, " vignettes")
-
+
vigs <- find_vignettes(pkg)
-
+
# First warn about vignettes in deprecated location
if (length(vigs$doc_files) > 0) {
files <- basename(vigs$doc_files)
- warning("The following vignettes were found (and ignored) in inst/doc:",
+ warning("The following vignettes were found (and ignored) in inst/doc:",
paste(files, collapse = ", "), ". Vignettes should now live in ",
"vignettes/")
}
@@ -32,17 +32,17 @@ build_vignettes <- function(pkg = ".") {
dir.create(temp)
dir.create(vigs$doc_path, recursive = TRUE, showWarnings = FALSE)
on.exit(unlink(temp, recursive = TRUE))
-
+
in_dir(temp, {
capture.output(lapply(vigs$vig_files, Sweave))
tex <- dir(pattern = "\\.tex$", full.names = FALSE)
lapply(tex, tools::texi2dvi, pdf = TRUE, quiet = TRUE)
-
+
pdfs <- dir(temp, "\\.pdf$")
message("Copying ", paste(pdfs, collapse = ", "), " to inst/doc/")
file.copy(pdfs, vigs$doc_path)
})
-
+
invisible(TRUE)
}
@@ -54,16 +54,16 @@ build_vignettes <- function(pkg = ".") {
clean_vignettes <- function(pkg = ".") {
pkg <- as.package(pkg)
message("Cleaning built vignettes from ", pkg$package)
-
+
vigs <- find_vignettes(pkg)
pdfs <- dir(vigs$doc_path, "\\.pdf$", full.names = TRUE)
to_remove <- file_name(pdfs) %in% file_name(vigs$vig_files)
if (any(to_remove)) {
message("Removing ", paste(basename(pdfs[to_remove]), collapse = ", "))
- file.remove(pdfs[to_remove])
+ file.remove(pdfs[to_remove])
}
-
+
invisible(TRUE)
}
@@ -76,7 +76,7 @@ file_name <- function(x) {
find_vignettes <- function(pkg = ".") {
pkg <- as.package(pkg)
vig_match <- "\\.(Rnw|Snw|Rtex|Stex)$"
-
+
doc_path <- file.path(pkg$path, "inst", "doc")
doc_files <- dir(doc_path, vig_match, full.names = TRUE)
names(doc_files) <- basename(doc_files)
@@ -84,9 +84,9 @@ find_vignettes <- function(pkg = ".") {
vig_path <- file.path(pkg$path, "vignettes")
vig_files <- dir(vig_path, vig_match, full.names = TRUE)
names(vig_files) <- basename(vig_files)
-
+
list(
- doc_path = doc_path, doc_files = doc_files,
+ doc_path = doc_path, doc_files = doc_files,
vig_path = vig_path, vig_files = vig_files
)
}
View
4 R/wd.r
@@ -8,11 +8,11 @@
wd <- function(pkg = ".", path = NULL) {
pkg <- as.package(pkg)
path <- file.path(pkg$path, path)
-
+
if (!file.exists(path)) {
stop(path, " does not exist", call. = FALSE)
}
-
+
message("Changing working directory to ", path)
setwd(path)
}
View
20 R/with.r
@@ -7,17 +7,17 @@
#' \item \code{with_libpaths}: library paths
#' \item \code{with_locale}: any locale setting
#' \item \code{with_options}: options
-#' \item \code{with_path}: PATH environment variable
+#' \item \code{with_path}: PATH environment variable
#' \item \code{with_par}: graphics parameters
#' }
#' @param new values for setting
-#' @param code code to execute in that environment
+#' @param code code to execute in that environment
#'
#' @name with_something
#' @examples
#' getwd()
#' in_dir(tempdir(), getwd())
-#' getwd()
+#' getwd()
#'
#' Sys.getenv("HADLEY")
#' with_env(c("HADLEY" = 2), Sys.getenv("HADLEY"))
@@ -25,11 +25,11 @@
NULL
with_something <- function(set) {
- function(new, code) {
+ function(new, code) {
old <- set(new)
on.exit(set(old))
force(code)
- }
+ }
}
is.named <- function(x) {
!is.null(names(x)) && all(names(x) != "")
@@ -52,7 +52,7 @@ with_env <- with_something(set_env)
set_locale <- function(cats) {
stopifnot(is.named(cats), is.character(cats))
-
+
old <- vapply(names(cats), Sys.getlocale, character(1))
mapply(Sys.setlocale, names(cats), cats)
@@ -80,7 +80,7 @@ in_dir <- with_something(setwd)
set_libpaths <- function(paths) {
libpath <- normalizePath(paths, mustWork = TRUE)
-
+
old <- .libPaths()
.libPaths(paths)
invisible(old)
@@ -107,9 +107,9 @@ with_par <- with_something(par)
#' @rdname with_something
#' @export
#' @param add Combine with existing values? Currently for
-#' \code{\link{with_path}} only. If \code{FALSE} all existing
-#' paths are ovewritten, which don't you usually want.
-with_path <- function(new, code, add = TRUE) {
+#' \code{\link{with_path}} only. If \code{FALSE} all existing
+#' paths are ovewritten, which don't you usually want.
+with_path <- function(new, code, add = TRUE) {
if (add) new <- c(get_path(), new)
old <- set_path(new)
on.exit(set_path(old))
View
30 R/zzz.r
@@ -1,14 +1,14 @@
.onAttach <- function(...) {
# Assume that non-windows users have paths set correctly
if (.Platform$OS.type != "windows") return()
-
+
# Check if Rtools is already set up
if (all(on_path("ls.exe", "gcc.exe"))) return()
-
+
# Look for rtools
rtools_path <- rtools()
if (is.null(rtools_path)) return()
-
+
# Look for gcc
if (current_ver() == "2.15") {
gcc_bin <- file.path(rtools_path, "gcc-4.6.3", "bin")
@@ -18,13 +18,13 @@
gcc_bin <- c(gcc_bin, file.path(rtools_path, "MinGW64", "bin"))
}
}
-
+
rtools_bin <- file.path(rtools_path, "bin")
paths <- normalizePath(c(rtools_bin, gcc_bin))
new_paths <- setdiff(paths, get_path())
-
+
if (length(new_paths) == 0) return()
-
+
packageStartupMessage("Rtools not in path, but I'm adding it automatically :)")
add_path(new_paths)
}
@@ -34,28 +34,28 @@ rtools_url <- "http://cran.r-project.org/bin/windows/Rtools/"
rtools <- function() {
# Look in registry
key <- NULL
- try(key <- utils::readRegistry("SOFTWARE\\R-core\\Rtools",
+ try(key <- utils::readRegistry("SOFTWARE\\R-core\\Rtools",
hive = "HLM", view = "32-bit"), silent = TRUE)
-
+
if (!is.null(key)) {
version_match <- key$`Current Version` == current_ver()
-
+
if (!version_match) {
- packageStartupMessage("Version of Rtools does not match R version :(. ",
+ packageStartupMessage("Version of Rtools does not match R version :(. ",
"Please reinstall Rtools from ", rtools_url, ".")
return()
}
-
+
return(key$InstallPath)
}
-
+
# Look in default location
default_path <- normalizePath("c:\\Rtools\\bin", mustWork = FALSE)
if (file.exists(default_path)) return(default_path)
-
+
# Give up
- packageStartupMessage("Rtools not installed :(. Please install from ",
- rtools_url, ".")
+ packageStartupMessage("Rtools not installed :(. Please install from ",
+ rtools_url, ".")
invisible(NULL)
}
View
2  inst/templates/packagename-package.r
@@ -1,5 +1,5 @@
#' {{{ name }}}
-#'
+#'
#' @name {{{ name }}}
#' @docType package
NULL
View
2  inst/tests/test-description.r
@@ -1,7 +1,7 @@
context("Documentation checks")
test_that("invalid DESCRIPTION gives warning", {
- expect_message(load_all("invalid-description"),
+ expect_message(load_all("invalid-description"),
c("invalid DESCRIPTION", "fields missing"))
})
View
14 inst/tests/test-load-collate.r
@@ -2,25 +2,25 @@ context("Load: collate")
test_that("If collate absent, load in alphabetical order", {
load_all("collate-absent")
-
+
expect_equal(a, 3)
-
+
unload("collate-absent")
})
test_that("Warned about files missing from collate, but they're still loaded", {
expect_message(load_all("collate-missing"), "a.r")
-
+
expect_equal(a, 1)
expect_equal(b, 2)
-
+
unload("collate-missing")
})
test_that("Extra files in collate don't error, but warn", {
expect_message(load_all("collate-extra"), "b.r")
-
+
expect_equal(a, 1)
-
+
unload("collate-extra")
-})
+})
View
4 inst/tests/test-vignettes.r
@@ -3,10 +3,10 @@ context("Vignettes")
test_that("Building process works", {
# Warn about vignette in wrong location
expect_warning(build_vignettes("vignettes"), "old.Rnw")
-
+
# Check inst/doc doesn't contain artefacts of complication
expect_equal(length(dir("vignettes/inst/doc")), 3)
-
+
clean_vignettes("vignettes")
# Check new.pdf gone
expect_equal(length(dir("vignettes/inst/doc")), 2)
View
2  tests/test-all.R
@@ -1,4 +1,4 @@
library(testthat)
library(devtools)
-test_package("devtools")
+test_package("devtools")
Please sign in to comment.
Something went wrong with that request. Please try again.