@@ -3,7 +3,6 @@
Loading
3 3
#' `with_seed()` runs code with a specific random seed and resets it afterwards.
4 4
#'
5 5
#' @template with
6 -
#' @inheritParams with_collate
7 6
#' @param seed `[integer(1)]`\cr The random seed to use to evaluate the code.
8 7
#' @param .local_envir `[environment]`\cr The environment to use for scoping.
9 8
#' @examples

@@ -55,5 +55,5 @@
Loading
55 55
    defer(unlink(path, recursive = TRUE), envir = .local_envir)
56 56
  }
57 57
58 -
  invisible(path)
58 +
  path
59 59
}

@@ -15,7 +15,8 @@
Loading
15 15
#' Temporarily change global options.
16 16
#'
17 17
#' @template with
18 -
#' @param new `[named list]`\cr New options and their values
18 +
#' @param new,.new `[named list]`\cr New options and their values
19 +
#' @param ... Additional options and their values
19 20
#' @inheritParams with_collate
20 21
#' @seealso [options()]
21 22
#' @examples
@@ -50,4 +51,4 @@
Loading
50 51
51 52
#' @rdname with_options
52 53
#' @export
53 -
local_options <- local_(set_options, reset_options)
54 +
local_options <- local_(set_options, reset_options, dots = TRUE)

@@ -5,6 +5,7 @@
Loading
5 5
}
6 6
7 7
set_path <- function(path, action = "prefix") {
8 +
  path <- as_character(path)
8 9
  path <- normalizePath(path, mustWork = FALSE)
9 10
10 11
  old <- get_path()

@@ -1,7 +1,8 @@
Loading
1 1
# locale ---------------------------------------------------------------------
2 2
3 3
set_locale <- function(cats) {
4 -
  stopifnot(is.named(cats), is.character(cats))
4 +
  cats <- as_character(cats)
5 +
  stopifnot(is.named(cats))
5 6
6 7
  if ("LC_ALL" %in% names(cats)) {
7 8
    stop("Setting LC_ALL category not implemented.", call. = FALSE)
@@ -20,7 +21,8 @@
Loading
20 21
#' Setting the `LC_ALL` category is currently not implemented.
21 22
#'
22 23
#' @template with
23 -
#' @param new `[named character]`\cr New locale settings
24 +
#' @param new,.new `[named character]`\cr New locale settings
25 +
#' @param ... Additional arguments with locale settings.
24 26
#' @inheritParams with_collate
25 27
#' @seealso [Sys.setlocale()]
26 28
#' @examples
@@ -53,4 +55,4 @@
Loading
53 55
54 56
#' @rdname with_locale
55 57
#' @export
56 -
local_locale <- local_(set_locale)
58 +
local_locale <- local_(set_locale, dots = TRUE)

@@ -3,6 +3,7 @@
Loading
3 3
# lib ------------------------------------------------------------------------
4 4
5 5
set_libpaths <- function(paths, action = "replace") {
6 +
  paths <- as_character(paths)
6 7
  paths <- normalizePath(paths, mustWork = TRUE)
7 8
8 9
  old <- .libPaths()

@@ -33,7 +33,8 @@
Loading
33 33
#' Temporarily change system environment variables.
34 34
#'
35 35
#' @template with
36 -
#' @param new `[named character]`\cr New environment variables
36 +
#' @param new,.new `[named character]`\cr New environment variables
37 +
#' @param ... Named arguments with new environment variables.
37 38
#' @param action should new values `"replace"`, `"prefix"` or
38 39
#'   `"suffix"` existing variables with the same name.
39 40
#' @inheritParams with_collate
@@ -52,4 +53,4 @@
Loading
52 53
53 54
#' @rdname with_envvar
54 55
#' @export
55 -
local_envvar <- local_(set_envvar)
56 +
local_envvar <- local_(set_envvar, dots = TRUE)

@@ -2,7 +2,8 @@
Loading
2 2
#'
3 3
#' Create files, which are then automatically removed afterwards.
4 4
#' @template with
5 -
#' @param file `[named list]`\cr Files to create.
5 +
#' @param file,.file `[named list]`\cr Files to create.
6 +
#' @param ... Additional (possibly named) arguments of files to create.
6 7
#' @param .local_envir `[environment]`\cr The environment to use for scoping.
7 8
#' @examples
8 9
#' with_file("file1", {
@@ -27,11 +28,14 @@
Loading
27 28
28 29
#' @rdname with_file
29 30
#' @export
30 -
local_file <- function(file, .local_envir = parent.frame()) {
31 -
  file_nms <- names2(file)
31 +
local_file <- function(.file, ..., .local_envir = parent.frame()) {
32 +
  .file <- utils::modifyList(as.list(.file), list(...))
33 +
  .file <- as_character(.file)
34 +
35 +
  file_nms <- names2(.file)
32 36
  unnamed <- file_nms == ""
33 -
  file_nms[unnamed] <- as.character(file[unnamed])
37 +
  file_nms[unnamed] <- as.character(.file[unnamed])
34 38
  defer(unlink(file_nms, recursive = TRUE), envir = .local_envir)
35 39
36 -
  invisible(file)
40 +
  invisible(.file)
37 41
}

@@ -50,3 +50,10 @@
Loading
50 50
  }
51 51
  m
52 52
}
53 +
54 +
as_character <- function(x) {
55 +
  nms <- names(x)
56 +
  res <- as.character(x)
57 +
  names(res) <- nms
58 +
  res
59 +
}

@@ -65,9 +65,10 @@
Loading
65 65
#' are modified to use the value in `new`.
66 66
#'
67 67
#' @template with
68 -
#' @param new `[named character]`\cr New variables and their values
69 -
#' @param path `[character(1)]`\cr location of existing `Makevars` file to modify.
70 -
#' @param assignment `[character(1)]`\cr assignment type to use.
68 +
#' @param new,.new `[named character]`\cr New variables and their values
69 +
#' @param path,.path `[character(1)]`\cr location of existing `Makevars` file to modify.
70 +
#' @param ... Additional new variables and their values.
71 +
#' @param assignment,.assignment `[character(1)]`\cr assignment type to use.
71 72
#' @inheritParams with_collate
72 73
#' @examples
73 74
#' writeLines("void foo(int* bar) { *bar = 1; }\n", "foo.c")
@@ -87,10 +88,13 @@
Loading
87 88
88 89
#' @rdname with_makevars
89 90
#' @export
90 -
local_makevars <- function(new, path = makevars_user(), assignment = c("=", ":=", "?=", "+="), .local_envir = parent.frame()) {
91 -
  assignment <- match.arg(assignment)
91 +
local_makevars <- function(.new = list(), ..., .path = makevars_user(), .assignment = c("=", ":=", "?=", "+="), .local_envir = parent.frame()) {
92 +
  .new <- utils::modifyList(as.list(.new), list(...))
93 +
  .new <- as_character(.new)
94 +
95 +
  .assignment <- match.arg(.assignment)
92 96
  makevars_file <- tempfile()
93 97
  defer(unlink(makevars_file), envir = .local_envir)
94 98
  local_envvar(c(R_MAKEVARS_USER = makevars_file), .local_envir = .local_envir)
95 -
  set_makevars(new, path, makevars_file, assignment = assignment)
99 +
  invisible(set_makevars(.new, .path, makevars_file, assignment = .assignment))
96 100
}

@@ -73,12 +73,14 @@
Loading
73 73
74 74
  set_call <- as.call(c(substitute(set), called_fmls))
75 75
76 +
  reset <-  if (missing(reset)) substitute(set) else substitute(reset)
77 +
76 78
  fun <- eval(bquote(function(args) {
77 79
    old <- .(set_call)
78 80
    on.exit(.(reset)(old))
79 81
    force(code)
80 -
  }, as.environment(list(set_call = set_call,
81 -
          reset = if (missing(reset)) substitute(set) else substitute(reset)))))
82 +
    }
83 +
  ))
82 84
83 85
  # substitute does not work on arguments, so we need to fix them manually
84 86
  formals(fun) <- fun_args

@@ -1,6 +1,6 @@
Loading
1 1
#' @rdname with_
2 2
#' @export
3 -
local_ <- function(set, reset = set, envir = parent.frame(), new = TRUE) {
3 +
local_ <- function(set, reset = set, envir = parent.frame(), new = TRUE, dots = FALSE) {
4 4
5 5
  fmls <- formals(set)
6 6
@@ -9,10 +9,13 @@
Loading
9 9
    called_fmls <- stats::setNames(lapply(names(fmls), as.symbol), names(fmls))
10 10
11 11
    if (new) {
12 -
      # rename first formal to new
13 -
      called_fmls[[1]] <- as.symbol("new")
14 -
15 -
      fun_args <- c(alist(new =), fmls[-1L])
12 +
      if (dots) {
13 +
        called_fmls[[1]] <- as.symbol(".new")
14 +
        fun_args <- c(alist(.new = list(), ... = ), fmls[-1L])
15 +
      } else {
16 +
        called_fmls[[1]] <- as.symbol("new")
17 +
        fun_args <- c(alist(new = list()), fmls[-1L])
18 +
      }
16 19
    } else {
17 20
      fun_args <- fmls
18 21
    }
@@ -25,12 +28,26 @@
Loading
25 28
26 29
  set_call <- as.call(c(substitute(set), called_fmls))
27 30
28 -
  fun <- eval(bquote(function(args) {
29 -
    old <- .(set_call)
30 -
    defer(.(reset)(old), envir = .local_envir)
31 -
    invisible(old)
32 -
  }, as.environment(list(set_call = set_call,
33 -
                         reset = if (missing(reset)) substitute(set) else substitute(reset)))))
31 +
  reset <- if (missing(reset)) substitute(set) else substitute(reset)
32 +
33 +
  if (dots) {
34 +
    modify_call <- quote(.new <- utils::modifyList(as.list(.new), list(...)))
35 +
36 +
    fun <- eval(bquote(function(args) {
37 +
        .(modify_call)
38 +
        old <- .(set_call)
39 +
        defer(.(reset)(old), envir = .local_envir)
40 +
        invisible(old)
41 +
      }
42 +
    ))
43 +
  } else {
44 +
    fun <- eval(bquote(function(args) {
45 +
        old <- .(set_call)
46 +
        defer(.(reset)(old), envir = .local_envir)
47 +
        invisible(old)
48 +
      }
49 +
    ))
50 +
  }
34 51
35 52
  # substitute does not work on arguments, so we need to fix them manually
36 53
  formals(fun) <- c(fun_args, alist(.local_envir = parent.frame()))
Files Coverage
R 84.97%
Project Totals (23 files) 84.97%
1
comment: false
2

3
coverage:
4
  status:
5
    project:
6
      default:
7
        target: auto
8
        threshold: 1%
9
        informational: true
10
    patch:
11
      default:
12
        target: auto
13
        threshold: 1%
14
        informational: true
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading