r-lib / cli
1

2
defer <- function(expr, envir = parent.frame(),
3
                  priority = c("first", "last")) {
4 1
  if (identical(envir, .GlobalEnv)) {
5 0
    stop("attempt to defer event on global environment")
6
  }
7 1
  priority <- match.arg(priority)
8 1
  front <- priority == "first"
9 1
  invisible(add_handler(
10 1
    envir, list(expr = substitute(expr), envir = parent.frame()), front))
11
}
12

13
# Handlers used for 'defer' calls. Attached as a list of expressions for the
14
# 'handlers' attribute on the environment, with 'on.exit' called to ensure
15
# those handlers get executed on exit.
16

17
get_handlers <- function(envir) {
18 1
  as.list(attr(envir, "handlers"))
19
}
20

21
set_handlers <- function(envir, handlers) {
22 1
  has_handlers <- "handlers" %in% names(attributes(envir))
23 1
  attr(envir, "handlers") <- handlers
24 1
  if (!has_handlers) {
25 1
    call <- as.call(list(execute_handlers, envir))
26

27
    # We have to use do.call here instead of eval because of the way on.exit
28
    # determines its evaluation context
29
    # (https://stat.ethz.ch/pipermail/r-devel/2013-November/067867.html)
30 1
    do.call(base::on.exit, list(substitute(call), TRUE), envir = envir)
31
  }
32
}
33

34
execute_handlers <- function(envir) {
35 1
  handlers <- get_handlers(envir)
36 1
  for (handler in handlers) {
37 1
    tryCatch(eval(handler$expr, handler$envir), error = identity)
38
  }
39
}
40

41
add_handler <- function(envir, handler, front) {
42

43 1
  handlers <- if (front) {
44 1
    c(list(handler), get_handlers(envir))
45
  } else {
46 0
    c(get_handlers(envir), list(handler))
47
  }
48

49 1
  set_handlers(envir, handlers)
50 1
  handler
51
}

Read our documentation on viewing source code .

Loading