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
|
#' Progression Handler: Progress Reported in the RStudio Console
#'
#' @inheritParams make_progression_handler
#'
#' @param title (character or a function) The "name" of the progressor, which
#' is displayed in front of the progress bar. If a function, then the name
#' is created dynamically by calling the function when the progressor is
#' created.
#'
#' @param \ldots Additional arguments passed to [make_progression_handler()].
#'
#' @section Requirements:
#' This progression handler works only in the RStudio Console.
#'
#' @section Use this progression handler by default:
#' To use this handler by default whenever using the RStudio Console, add
#' the following to your \file{~/.Rprofile} startup file:
#'
#' ```r
#' if (requireNamespace("progressr", quietly = TRUE)) {
#' if (Sys.getenv("RSTUDIO") == "1" && !nzchar(Sys.getenv("RSTUDIO_TERM"))) {
#' options(progressr.handlers = progressr::handler_rstudio)
#' }
#' }
#' ```
#'
#' @example incl/handler_rstudio.R
#'
#' @export
handler_rstudio <- function(intrusiveness = getOption("progressr.intrusiveness.gui", 1), target = "gui", title = function() format(Sys.time(), "Console %X"), ...) {
reporter <- local({
job_id <- NULL
list(
initiate = function(config, state, ...) {
if (!state$enabled || config$times <= 2L) return()
name <- state$message
if (length(name) == 0L) {
if (is.null(title)) {
name <- "Console"
} else if (is.character(title)) {
name <- title
} else if (is.function(title)) {
name <- title()
}
}
stop_if_not(
is.null(job_id),
is.character(name),
length(name) == 1L
)
job_id <<- rstudioapi::jobAdd(
name = name,
progressUnits = as.integer(config$max_steps),
status = "running",
autoRemove = FALSE,
show = FALSE
)
},
update = function(config, state, progression, ...) {
if (!state$enabled || config$times <= 2L) return()
## The RStudio Job progress bar cannot go backwards
if (state$delta < 0) return()
## The RStudio Job progress bar does not have a "spinner"
if (state$delta == 0) return()
stop_if_not(!is.null(job_id))
rstudioapi::jobSetProgress(job_id, units = state$step)
},
finish = function(...) {
if (!is.null(job_id)) rstudioapi::jobRemove(job_id)
job_id <<- NULL
}
)
})
make_progression_handler("rstudio", reporter, intrusiveness = intrusiveness, target = target, ...)
}
|
