1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
#' Execute code with a modified search path
#'
#' `with_package()` attaches a package to the search path, executes the code, then
#' removes the package from the search path. The package namespace is _not_
#' unloaded however. `with_namespace()` does the same thing, but attaches the
#' package namespace to the search path, so all objects (even unexported ones) are also
#' available on the search path.
#' @param package \code{[character(1)]}\cr package name to load.
#' @param env \code{[environment()]}\cr Environment to attach.
#' @param .local_envir `[environment]`\cr The environment to use for scoping.
#' @inheritParams defer
#' @inheritParams base::library
#' @template with
#' @examples
#' \dontrun{
#' with_package("ggplot2", {
#' ggplot(mtcars) + geom_point(aes(wt, hp))
#' })
#' }
#' @export
with_package <- function(package, code, pos = 2, lib.loc = NULL,
character.only = TRUE, logical.return = FALSE, warn.conflicts = FALSE,
quietly = TRUE, verbose = getOption("verbose")) {
# Only try to attach (and detach) the package if it is not already attached.
if (!(package %in% .packages())) {
suppressPackageStartupMessages(
(get("library"))(package, pos = pos, lib.loc = lib.loc,
character.only = character.only, logical.return = logical.return,
warn.conflicts = warn.conflicts, quietly = quietly, verbose = verbose))
on.exit(detach(paste0("package:", package), character.only = TRUE))
}
force(code)
}
#' @rdname with_package
#' @export
local_package <- function(package, pos = 2, lib.loc = NULL,
character.only = TRUE, logical.return = FALSE, warn.conflicts = FALSE,
quietly = TRUE, verbose = getOption("verbose"),
.local_envir = parent.frame()) {
suppressPackageStartupMessages(
(get("library"))(package, pos = pos, lib.loc = lib.loc,
character.only = character.only, logical.return = logical.return,
warn.conflicts = warn.conflicts, quietly = quietly, verbose = verbose))
defer(detach(paste0("package:", package), character.only = TRUE), envir = .local_envir)
}
#' @rdname with_package
#' @export
with_namespace <- function(package, code, warn.conflicts = FALSE) {
ns <- asNamespace(package)
name <- format(ns)
(get("attach"))(ns, name = name, warn.conflicts = warn.conflicts)
on.exit(detach(name, character.only = TRUE))
force(code)
}
#' @rdname with_package
#' @export
local_namespace <- function(package, .local_envir = parent.frame(), warn.conflicts = FALSE) {
ns <- asNamespace(package)
name <- format(ns)
(get("attach"))(ns, name = name, warn.conflicts = warn.conflicts)
defer(detach(name, character.only = TRUE), envir = .local_envir)
}
#' @rdname with_package
#' @inheritParams base::attach
#' @export
with_environment <- function(env, code, pos = 2L, name = format(env), warn.conflicts = FALSE) {
(get("attach"))(env, name = name, pos = pos, warn.conflicts = warn.conflicts)
on.exit(detach(name, character.only = TRUE))
force(code)
}
#' @rdname with_package
#' @export
local_environment <- function(env, pos = 2L, name = format(env),
warn.conflicts = FALSE, .local_envir = parent.frame()) {
(get("attach"))(env, name = name, pos = pos, warn.conflicts = warn.conflicts)
defer(detach(name, character.only = TRUE), envir = .local_envir)
}
|
