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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
#' Control How Progress is Reported
#'
#' @param \dots One or more progression handlers. Alternatively, this
#' functions accepts also a single vector of progression handlers as input.
#' If this vector is empty, then an empty set of progression handlers will
#' be set.
#'
#' @param append (logical) If FALSE, the specified progression handlers
#' replace the current ones, otherwise appended to them.
#'
#' @param on_missing (character) If `"error"`, an error is thrown if one of
#' the progression handlers does not exists. If `"warning"`, a warning
#' is produces and the missing handlers is ignored. If `"ignore"`, the
#' missing handlers is ignored.
#'
#' @param default The default progression calling handler to use if none
#' are set.
#'
#' @param global If TRUE, then the global progression handler is enabled.
#' If FALSE, it is disabled. If NA, then TRUE is returned if it is enabled,
#' otherwise FALSE. Argument `global` must not used with other arguments.
#'
#' @return (invisibly) the previous list of progression handlers set.
#' If no arguments are specified, then the current set of progression
#' handlers is returned.
#' If `global` is specified, then TRUE is returned if the global progression
#' handlers is enabled, otherwise false.
#'
#' @details
#' This function provides a convenient alternative for getting and setting
#' option \option{progressr.handlers}.
#'
#' @section For package developers:
#' **IMPORTANT: Setting progression handlers is a privilege that should be
#' left to the end user. It should not be used by R packages, which only task
#' is to _signal_ progress updates, not to decide if, when, and how progress
#' should be reported.**
#'
#' If you have to set or modify the progression handlers inside a function,
#' please make sure to undo the settings afterward. If not, you will break
#' whatever progression settings the user already has for other purposes
#' used elsewhere. To undo you settings, you can do:
#'
#' ```r
#' old_handlers <- handlers(c("beepr", "progress"))
#' on.exit(handlers(old_handlers), add = TRUE)
#' ```
#'
#' @section Configuring progression handling during R startup:
#' A convenient place to configure the default progression handler and to
#' enable global progression reporting by default is in the \file{~/.Rprofile}
#' startup file. For example, the following will (i) cause your interactive
#' R session to use global progression handler by default, and (ii) report
#' progress via the \pkg{progress} package when in the terminal and via the
#' RStudio Jobs progress bar when in the RStudio Console.
#' [handler_txtprogressbar],
#' other whenever using the RStudio Console, add
#' the following to your \file{~/.Rprofile} startup file:
#'
#' ```r
#' if (interactive() && requireNamespace("progressr", quietly = TRUE)) {
#' ## Enable global progression updates
#' if (getRversion() >= 4) progressr::handlers(global = TRUE)
#'
#' ## In RStudio Console, or not?
#' if (Sys.getenv("RSTUDIO") == "1" && !nzchar(Sys.getenv("RSTUDIO_TERM"))) {
#' options(progressr.handlers = progressr::handler_rstudio)
#' } else {
#' options(progressr.handlers = progressr::handler_progress)
#' }
#' }
#' ```
#'
#' @example incl/handlers.R
#'
#' @export
handlers <- function(..., append = FALSE, on_missing = c("error", "warning", "ignore"), default = handler_txtprogressbar, global = NULL) {
stop_if_not(
is.null(global) ||
( is.logical(global) && length(global) == 1L )
)
args <- list(...)
nargs <- length(args)
if (nargs == 0L) {
## Get the current set of progression handlers?
if (is.null(global)) {
if (!is.list(default) && !is.null(default)) default <- list(default)
return(getOption("progressr.handlers", default))
}
## Check, register, or reset global calling handlers?
if (is.na(global)) {
return(register_global_progression_handler(action = "query"))
}
action <- if (isTRUE(global)) "add" else "remove"
return(invisible(register_global_progression_handler(action = action)))
}
if (!is.null(global)) {
stop("Argument 'global' must not be specified when also registering progress handlers")
}
on_missing <- match.arg(on_missing)
## Was a list specified?
if (nargs == 1L && is.vector(args[[1]])) {
args <- args[[1]]
}
handlers <- list()
names <- names(args)
for (kk in seq_along(args)) {
handler <- args[[kk]]
stop_if_not(length(handler) == 1L)
if (is.character(handler)) {
name <- handler
name2 <- sprintf("handler_%s", name)
handler <- NULL
if (exists(name2, mode = "function")) {
handler <- get(name2, mode = "function")
}
if (is.null(handler)) {
if (exists(name, mode = "function")) {
handler <- get(name, mode = "function")
}
}
if (is.null(handler)) {
if (on_missing == "error") {
stop("No such progression handler found: ", sQuote(name))
} else if (on_missing == "warning") {
warning("Ignoring non-existing progression handler: ", sQuote(name))
}
next
}
} else {
name <- NULL
}
stop_if_not(is.function(handler), length(formals(handler)) >= 1L)
## Validate?
validator <- attr(handler, "validator")
if (is.function(validator)) {
is_valid <- validator()
if (!is_valid) next
}
if (!is.null(name)) names[kk] <- name
handlers[[kk]] <- handler
}
stop_if_not(is.list(handlers))
names(handlers) <- names
## Drop non-existing handlers
keep <- vapply(handlers, FUN.VALUE = FALSE, FUN = is.function)
handlers <- handlers[keep]
if (append) {
current <- getOption("progressr.handlers", list())
if (length(current) > 0L) handlers <- c(current, handlers)
}
old_handlers <- options(progressr.handlers = handlers)[[1]]
if (is.null(old_handlers)) old_handlers <- list()
invisible(old_handlers)
}
|
