version 1.0.0

DESCRIPTION

@@ -0,0 +1,33 @@
+Encoding: UTF-8
+Package: withr
+Title: Run Code 'With' Temporarily Modified Global State
+Version: 1.0.0
+Authors@R: c(
+    person("Jim", "Hester", , "james.f.hester@gmail.com", role = c("aut", "cre")),
+    person("Kirill", "Müller", , "krlmlr+r@mailbox.org", role = "aut"),
+    person("Hadley", "Wickham", , "hadley@rstudio.com", role = "aut"),
+    person("Winston", "Chang", role = "aut"),
+    person("RStudio", role = "cph"))
+Description: A set of functions to run code 'with' safely and temporarily
+    modified global state. Many of these functions were originally a part of the
+    devtools package, this provides a simple package with limited dependencies
+    to provide access to these functions.
+URL: http://github.com/jimhester/withr
+BugReports: http://github.com/jimhester/withr/issues
+Depends: R (>= 3.2.0)
+License: GPL (>= 2)
+LazyData: true
+Imports: stats, graphics
+Suggests: testthat
+Collate: 'with_.R' 'collate.R' 'dir.R' 'env.R' 'libpaths.R' 'locale.R'
+        'makevars.R' 'options.R' 'par.R' 'path.R' 'with.R'
+NeedsCompilation: no
+Packaged: 2015-09-22 14:09:44 UTC; jhester
+Author: Jim Hester [aut, cre],
+  Kirill Müller [aut],
+  Hadley Wickham [aut],
+  Winston Chang [aut],
+  RStudio [cph]
+Maintainer: Jim Hester <james.f.hester@gmail.com>
+Repository: CRAN
+Date/Publication: 2015-09-23 02:58:41

MD5

@@ -0,0 +1,28 @@
+3e3e49bd6b3810dff3d147f59b55319e *DESCRIPTION
+8a8866237a58a71109bffd5e804cd22f *NAMESPACE
+b3ec11ee76b339c4d2ae9e409721039c *R/collate.R
+13ed0fd71ee35cae21d9da32ef81d00b *R/dir.R
+e202b586b599ebd825c856567615b8c7 *R/env.R
+a5ea25ec83c131d9f364d44be7ebe997 *R/libpaths.R
+d5e3df31efc160218e5e41f47d70f00a *R/locale.R
+90f1ff1cf6f20ac6d9cd6a96b678aeca *R/makevars.R
+3a7ad0bd8fc47af29778f0dcde2d8551 *R/options.R
+7ae96d23abe7df158000f77a73aa1580 *R/par.R
+a02e5528c7efb2d98360ecd6e19bb488 *R/path.R
+854311eab2a12fd10875eada311fe13d *R/with.R
+3d3bf7e65f26dc616bc20d93b1b92ec9 *R/with_.R
+18c40f182effc974e243c3de3ec95913 *README.md
+067657b82299b89e25e53ca495971039 *man/with_.Rd
+aaf62288d27e94453cfce2d13307d410 *man/with_collate.Rd
+b47a0dc1a4ac3d73f847fb59630bc9c6 *man/with_dir.Rd
+ff8dce05b6ca94365958b6103b231d4b *man/with_envvar.Rd
+af3e16397a72f524a2744904e1ff4f90 *man/with_libpaths.Rd
+0494ea90dd564c5c71bbe67ed7e1182a *man/with_locale.Rd
+f4dfe6bebf345bcff907ccc37199ce0f *man/with_makevars.Rd
+cafcfa50789f3a406dcc0f6eac7bafe1 *man/with_options.Rd
+7b70bf28ebfd6e1ddf3816c1a7903583 *man/with_par.Rd
+1ccc9b2e2416b0bd240e095b69cabaea *man/with_path.Rd
+2c5715d993e51361c602f84ea900a03f *man/with_temp_libpaths.Rd
+5e00c27bc53e265f5a40d4ce4811888f *man/withr.Rd
+70c4d334a0974e15d0309c48ca52ca08 *tests/testthat.R
+ea54ff80af0d3d21359aa5127aa25378 *tests/testthat/test-with.R

NAMESPACE

@@ -0,0 +1,13 @@
+# Generated by roxygen2 (4.1.1): do not edit by hand
+
+export(with_)
+export(with_collate)
+export(with_dir)
+export(with_envvar)
+export(with_libpaths)
+export(with_locale)
+export(with_makevars)
+export(with_options)
+export(with_par)
+export(with_path)
+export(with_temp_libpaths)

R/collate.R

@@ -0,0 +1,15 @@
+#' @include with_.R
+
+# collate --------------------------------------------------------------------
+
+set_collate <- function(locale) set_locale(c(LC_COLLATE = locale))[[1]]
+
+#' Collation Order
+#'
+#' Temporarily change collation order by changing the value of the
+#' \code{LC_COLLATE} locale.
+#'
+#' @template with
+#' @param new \code{[character(1)]}\cr New collation order
+#' @export
+with_collate <- with_(set_collate)

R/dir.R

@@ -0,0 +1,14 @@
+#' @include with_.R
+NULL
+
+# working directory ----------------------------------------------------------
+
+#' Working directory
+#'
+#' Temorarily change the current working directory.
+#'
+#' @template with
+#' @param new \code{[character(1)]}\cr New working directory
+#' @seealso \code{\link{setwd}}
+#' @export
+with_dir <- with_(setwd)

R/env.R

@@ -0,0 +1,43 @@
+# env ------------------------------------------------------------------------
+
+set_envvar <- function(envs, action = "replace") {
+  if (length(envs) == 0) return()
+
+  stopifnot(is.named(envs))
+  stopifnot(is.character(action), length(action) == 1)
+  action <- match.arg(action, c("replace", "prefix", "suffix"))
+
+  # if there are duplicated entries keep only the last one
+  envs <- envs[!duplicated(names(envs), fromLast = TRUE)]
+
+  old <- Sys.getenv(names(envs), names = TRUE, unset = NA)
+  set <- !is.na(envs)
+
+  both_set <- set & !is.na(old)
+  if (any(both_set)) {
+    if (action == "prefix") {
+      envs[both_set] <- paste(envs[both_set], old[both_set])
+    } else if (action == "suffix") {
+      envs[both_set] <- paste(old[both_set], envs[both_set])
+    }
+  }
+
+  if (any(set))  do.call("Sys.setenv", as.list(envs[set]))
+  if (any(!set)) Sys.unsetenv(names(envs)[!set])
+
+  invisible(old)
+}
+
+#' Environment variables
+#'
+#' Temporarily change system environment variables.
+#'
+#' @template with
+#' @param new \code{[named character]}\cr New environment variables
+#' @param action should new values \code{"replace"}, \code{"prefix"} or
+#'   \code{"suffix"} existing variables with the same name.
+#' @details if \code{NA} is used those environment variables will be unset.
+#' If there are any duplicated variable names only the last one is used.
+#' @seealso \code{\link{Sys.setenv}}
+#' @export
+with_envvar <- with_(set_envvar)

R/libpaths.R

@@ -0,0 +1,42 @@
+#' @include with_.R
+
+# lib ------------------------------------------------------------------------
+
+set_libpaths <- function(paths, action = "replace") {
+  paths <- normalizePath(paths, mustWork = TRUE)
+
+  old <- .libPaths()
+  paths <- merge_new(old, paths, action)
+
+  .libPaths(paths)
+  invisible(old)
+}
+
+set_temp_libpath <- function() {
+  paths <- tempfile("temp_libpath")
+  dir.create(paths)
+  set_libpaths(paths, action = "prefix")
+}
+
+#' Library paths
+#'
+#' Temporarily change library paths.
+#'
+#' @template with
+#' @param new \code{[character]}\cr New library paths
+#' @param action \code{[character(1)]}\cr should new values \code{"replace"}, \code{"prefix"} or
+#'   \code{"suffix"} existing paths.
+#' @seealso \code{\link{.libPaths}}
+#' @family libpaths
+#' @export
+with_libpaths <- with_(set_libpaths, .libPaths)
+
+#' Library paths
+#'
+#' Temporarily prepend a new temporary directory to the library paths.
+#'
+#' @template with
+#' @seealso \code{\link{.libPaths}}
+#' @family libpaths
+#' @export
+with_temp_libpaths <- with_(set_temp_libpath, .libPaths)

R/locale.R

@@ -0,0 +1,26 @@
+# locale ---------------------------------------------------------------------
+
+set_locale <- function(cats) {
+  stopifnot(is.named(cats), is.character(cats))
+
+  if ("LC_ALL" %in% names(cats)) {
+    stop("Setting LC_ALL category not implemented.", call. = FALSE)
+  }
+
+  old <- vapply(names(cats), Sys.getlocale, character(1))
+
+  mapply(Sys.setlocale, names(cats), cats)
+  invisible(old)
+}
+
+#' Locale settings
+#'
+#' Temporarily change locale settings.
+#'
+#' Setting the \code{LC_ALL} category is currently not implemented.
+#'
+#' @template with
+#' @param new \code{[named character]}\cr New locale settings
+#' @seealso \code{\link{Sys.setlocale}}
+#' @export
+with_locale <- with_(set_locale)

R/makevars.R

@@ -0,0 +1,59 @@
+#' @include with_.R
+
+# Makevars --------------------------------------------------------------------
+
+set_makevars <- function(variables,
+                         old_path = file.path("~", ".R", "Makevars"),
+                         new_path = tempfile()) {
+  if (length(variables) == 0) {
+    return()
+  }
+  stopifnot(is.named(variables))
+
+  old <- NULL
+  if (file.exists(old_path)) {
+    lines <- readLines(old_path)
+    old <- lines
+    for (var in names(variables)) {
+      loc <- grep(paste(c("^[[:space:]]*", var, "[[:space:]]*", "="), collapse = ""), lines)
+      if (length(loc) == 0) {
+        lines <- append(lines, paste(sep = "=", var, variables[var]))
+      } else if(length(loc) == 1) {
+        lines[loc] <- paste(sep = "=", var, variables[var])
+      } else {
+        stop("Multiple results for ", var, " found, something is wrong.", .call = FALSE)
+      }
+    }
+  } else {
+    lines <- paste(names(variables), variables, sep = "=")
+  }
+
+  if (!identical(old, lines)) {
+    writeLines(con = new_path, lines)
+  }
+
+  old
+}
+
+#' Makevars variables
+#'
+#' Temporarily change contents of an existing \code{Makevars} file.
+#'
+#' @details If no \code{Makevars} file exists or the fields in \code{new} do
+#' not exist in the existing \code{Makevars} file then the fields are added to
+#' the new file.  Existing fields which are not included in \code{new} are
+#' appended unchanged.  Fields which exist in \code{Makevars} and in \code{new}
+#' are modified to use the value in \code{new}.
+#'
+#' @template with
+#' @param new \code{[named character]}\cr New variables and their values
+#' @param path \code{[character(1)]}\cr location of existing \code{Makevars} file to modify.
+#' @export
+with_makevars <- function(new, code, path = file.path("~", ".R", "Makevars")) {
+  makevars_file <- tempfile()
+  on.exit(unlink(makevars_file), add = TRUE)
+  with_envvar(c(R_MAKEVARS_USER = makevars_file), {
+    set_makevars(new, path, makevars_file)
+    force(code)
+  })
+}

R/options.R

@@ -0,0 +1,17 @@
+#' @include with_.R
+
+# options --------------------------------------------------------------------
+
+set_options <- function(new_options) {
+  do.call(options, as.list(new_options))
+}
+
+#' Options
+#'
+#' Temporarily change global options.
+#'
+#' @template with
+#' @param new \code{[named list]}\cr New options and their values
+#' @seealso \code{\link{options}}
+#' @export
+with_options <- with_(set_options)

R/par.R

@@ -0,0 +1,15 @@
+#' @include with_.R
+NULL
+
+# par ------------------------------------------------------------------------
+
+#' Graphics parameters
+#'
+#' Temporarily change graphics parameters.
+#'
+#' @template with
+#' @param new \code{[named list]}\cr New graphics parameters and their values
+#' @param no.readonly \code{[logical(1)]}\cr see \code{\link{par}} documentation.
+#' @seealso \code{\link{par}}
+#' @export
+with_par <- with_(graphics::par)

R/path.R

@@ -0,0 +1,28 @@
+# path -----------------------------------------------------------------------
+
+get_path <- function() {
+  strsplit(Sys.getenv("PATH"), .Platform$path.sep)[[1]]
+}
+
+set_path <- function(path, action = "prefix") {
+  path <- normalizePath(path, mustWork = FALSE)
+
+  old <- get_path()
+  path <- merge_new(old, path, action)
+
+  path <- paste(path, collapse = .Platform$path.sep)
+  Sys.setenv(PATH = path)
+  invisible(old)
+}
+
+#' PATH environment variable
+#'
+#' Temporarily change the system search path.
+#'
+#' @template with
+#' @param new \code{[character]}\cr New \code{PATH} entries
+#' @param action \code{[character(1)]}\cr Should new values \code{"replace"}, \code{"prefix"} or
+#'   \code{"suffix"} existing paths
+#' @seealso \code{\link{Sys.setenv}}
+#' @export
+with_path <- with_(set_path, function(old) set_path(old, "replace"))

R/with.R

@@ -0,0 +1,51 @@
+#' Execute code in temporarily altered environment
+#'
+#' All functions prefixed by \code{with_} work as follows. First, a particular
+#' aspect of the global environment is modified (see below for a list).
+#' Then, custom code (passed via the \code{code} argument) is executed.
+#' Upon completion or error, the global environment is restored to the previous
+#' state.
+#'
+#' @section Arguments pattern:
+#' \tabular{lll}{
+#'   \code{new} \tab \code{[various]} \tab Values for setting \cr
+#'   \code{code} \tab \code{[any]} \tab Code to execute in the temporary environment \cr
+#'   \code{...} \tab \tab Further arguments \cr
+#' }
+#' @section Usage pattern:
+#' \code{with_...(new, code, ...)}
+#' @name withr
+#' @docType package
+#' @section withr functions:
+#' \itemize{
+#' \item \code{\link{with_collate}}: collation order
+#' \item \code{\link{with_dir}}: working directory
+#' \item \code{\link{with_envvar}}: environment variables
+#' \item \code{\link{with_libpaths}}: library paths, replacing current libpaths
+#' \item \code{\link{with_locale}}: any locale setting
+#' \item \code{\link{with_makevars}}: Makevars variables
+#' \item \code{\link{with_options}}: options
+#' \item \code{\link{with_par}}: graphics parameters
+#' \item \code{\link{with_path}}: PATH environment variable
+#' }
+#' @section Creating new "with" functions:
+#' All \code{with_} functions are created by a helper function,
+#' \code{\link{with_}}.  This functions accepts two arguments:
+#' a setter function and an optional resetter function.  The setter function is
+#' expected to change the global state and return an "undo instruction".
+#' This undo instruction is then passed to the resetter function, which changes
+#' back the global state. In many cases, the setter function can be used
+#' naturally as resetter.
+#' @examples
+#' getwd()
+#' with_dir(tempdir(), getwd())
+#' getwd()
+#'
+#' Sys.getenv("HADLEY")
+#' with_envvar(c("HADLEY" = 2), Sys.getenv("HADLEY"))
+#' Sys.getenv("HADLEY")
+#'
+#' with_envvar(c("A" = 1),
+#'   with_envvar(c("A" = 2), action = "suffix", Sys.getenv("A"))
+#' )
+NULL