handlers() gained argument 'default'

Author: HenrikBengtsson

NEWS

@@ -1,9 +1,12 @@
 Package: progressr
 ==================
 
-Version: 0.1.5-9000 [2019-10-26]
+Version: 0.1.5-9000 [2019-11-02]
 
- * ...
+NEW FEATURES:
+
+ * handlers() gained argument 'default' specifying a progression handler to
+   be returned if none is set.
 
 
 Version: 0.1.5 [2019-10-26]

R/handlers.R

@@ -10,6 +10,9 @@
 #' 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.
+#'
 #' @return (invisibly) the previous list of progression handlers set.
 #' If no arguments are specified, then the current set of progression
 #' handlers is returned.
@@ -21,11 +24,11 @@
 #' @example incl/handlers.R
 #'
 #' @export
-handlers <- function(..., on_missing = c("error", "warning", "ignore")) {
+handlers <- function(..., on_missing = c("error", "warning", "ignore"), default = txtprogressbar_handler) {
   args <- list(...)
 
   ## Get the current set of progression handlers?
-  if (length(args) == 0L) return(getOption("progressr.handlers"))
+  if (length(args) == 0L) return(getOption("progressr.handlers", default))
 
   on_missing <- match.arg(on_missing)
 

R/progression_handler.R

@@ -29,14 +29,17 @@
 #' @param clear (logical) If TRUE, any output, typically visual, produced
 #'   by a reporter will be cleared/removed upon completion, if possible.
 #'
+#' @param target (character vector) Specifies where progression updates are
+#'   rendered.
+#'
 #' @return A function of class `progression_handler` that takes a
 #' [progression] condition as its first and only argument.
 #'
 #' @seealso
 #' [base::withCallingHandlers()].
 #'
 #' @export
-make_progression_handler <- function(name, reporter = list(), handler = NULL, enable = getOption("progressr.enable", interactive()), enable_after = getOption("progressr.enable_after", 0.0), times = getOption("progressr.times", +Inf), interval = getOption("progressr.interval", 0.0), intrusiveness = 1.0, clear = getOption("progressr.clear", TRUE)) {
+make_progression_handler <- function(name, reporter = list(), handler = NULL, enable = getOption("progressr.enable", interactive()), enable_after = getOption("progressr.enable_after", 0.0), times = getOption("progressr.times", +Inf), interval = getOption("progressr.interval", 0.0), intrusiveness = 1.0, clear = getOption("progressr.clear", TRUE), target = "terminal") {
   if (!enable) times <- 0
   name <- as.character(name)
   stop_if_not(length(name) == 1L, !is.na(name), nzchar(name))
@@ -50,7 +53,8 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en
               times >= 0)
   stop_if_not(length(interval) == 1L, is.numeric(interval),
               !is.na(interval), interval >= 0)
-
+  stop_if_not(is.character(target))
+  
   ## Disable progress updates?
   if (times == 0 || is.infinite(interval) || is.infinite(intrusiveness)) {
     handler <- function(p) NULL
@@ -101,7 +105,8 @@ make_progression_handler <- function(name, reporter = list(), handler = NULL, en
       interval = interval,
       enable_after = enable_after,
       auto_finish = auto_finish,
-      clear = clear
+      clear = clear,
+      target = target
     )
 
     state <- list(
@@ -348,6 +353,7 @@ print.progression_handler <- function(x, ...) {
   s <- c(s, sprintf("   - intrusiveness: %g", env$intrusiveness))
   s <- c(s, sprintf("   - auto_finish: %s", env$auto_finish))
   s <- c(s, sprintf("   - clear: %s", env$clear))
+  s <- c(s, sprintf("   - target: %s", paste(sQuote(env$target), collapse = ", ")))
   s <- c(s, sprintf("   - milestones: %s", hpaste(env$milestones %||% "<NULL>")))
   s <- c(s, sprintf("   - owner: %s", hpaste(env$owner %||% "<NULL>")))
 

R/progression_handlers.R

@@ -14,7 +14,7 @@
 #' @example incl/ascii_alert_handler.R
 #'
 #' @export
-ascii_alert_handler <- function(symbol = "\a", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.auditory", 5.0), ...) {
+ascii_alert_handler <- function(symbol = "\a", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.auditory", 5.0), target = c("terminal", "audio"), ...) {
   reporter <- local({
     list(
       update = function(config, state, progression, ...) {
@@ -44,7 +44,7 @@ ascii_alert_handler <- function(symbol = "\a", file = stderr(), intrusiveness =
 #'
 #' @importFrom utils file_test flush.console txtProgressBar setTxtProgressBar
 #' @export
-txtprogressbar_handler <- function(style = 3L, file = stderr(), intrusiveness = getOption("progressr.intrusiveness.terminal", 1), ...) {
+txtprogressbar_handler <- function(style = 3L, file = stderr(), intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) {
   reporter <- local({
     ## Import functions
     eraseTxtProgressBar <- function(pb) {
@@ -123,7 +123,7 @@ txtprogressbar_handler <- function(style = 3L, file = stderr(), intrusiveness =
 #' @example incl/tkprogressbar_handler.R
 #'
 #' @export
-tkprogressbar_handler <- function(intrusiveness = getOption("progressr.intrusiveness.gui", 1), ...) {
+tkprogressbar_handler <- function(intrusiveness = getOption("progressr.intrusiveness.gui", 1), target = "terminal", ...) {
   ## Used for package testing purposes only when we want to perform
   ## everything except the last part where the backend is called
   if (!is_fake("tkprogressbar_handler")) {
@@ -190,7 +190,7 @@ tkprogressbar_handler <- function(intrusiveness = getOption("progressr.intrusive
 #' @param \ldots Additional arguments passed to [make_progression_handler()].
 #'
 #' @export
-winprogressbar_handler <- function(intrusiveness = getOption("progressr.intrusiveness.gui", 1), ...) {
+winprogressbar_handler <- function(intrusiveness = getOption("progressr.intrusiveness.gui", 1), target = "gui", ...) {
   ## Used for package testing purposes only when we want to perform
   ## everything except the last part where the backend is called
   if (!is_fake("winprogressbar_handler")) {
@@ -268,7 +268,7 @@ winprogressbar_handler <- function(intrusiveness = getOption("progressr.intrusiv
 #'
 #' @importFrom utils file_test flush.console txtProgressBar setTxtProgressBar
 #' @export
-pbmcapply_handler <- function(substyle = 3L, style = "ETA", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.terminal", 1), ...) {
+pbmcapply_handler <- function(substyle = 3L, style = "ETA", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) {
   if (!is_fake("pbmcapply_handler")) {
     progressBar <- pbmcapply::progressBar
     eraseTxtProgressBar <- function(pb) {
@@ -366,7 +366,7 @@ pbmcapply_handler <- function(substyle = 3L, style = "ETA", file = stderr(), int
 #' @example incl/progress_handler.R
 #'
 #' @export
-progress_handler <- function(format = "[:bar] :percent :message", show_after = 0.0, intrusiveness = getOption("progressr.intrusiveness.terminal", 1), ...) {
+progress_handler <- function(format = "[:bar] :percent :message", show_after = 0.0, intrusiveness = getOption("progressr.intrusiveness.terminal", 1), target = "terminal", ...) {
   if (!is_fake("progress_handler")) {
     progress_bar <- progress::progress_bar
   } else {
@@ -440,7 +440,7 @@ progress_handler <- function(format = "[:bar] :percent :message", show_after = 0
 #' @example incl/beepr_handler.R
 #'
 #' @export
-beepr_handler <- function(initiate = 2L, update = 10L,  finish = 11L, intrusiveness = getOption("progressr.intrusiveness.auditory", 5.0), ...) {
+beepr_handler <- function(initiate = 2L, update = 10L,  finish = 11L, intrusiveness = getOption("progressr.intrusiveness.auditory", 5.0), target = "audio", ...) {
   ## Used for package testing purposes only when we want to perform
   ## everything except the last part where the backend is called
   if (!is_fake("beepr_handler")) {
@@ -491,7 +491,7 @@ beepr_handler <- function(initiate = 2L, update = 10L,  finish = 11L, intrusiven
 #' @example incl/notifier_handler.R
 #'
 #' @export
-notifier_handler <- function(intrusiveness = getOption("progressr.intrusiveness.notifier", 10), ...) {
+notifier_handler <- function(intrusiveness = getOption("progressr.intrusiveness.notifier", 10), target = "gui", ...) {
   ## Used for package testing purposes only when we want to perform
   ## everything except the last part where the backend is called
   if (!is_fake("notifier_handler")) {
@@ -548,7 +548,7 @@ notifier_handler <- function(intrusiveness = getOption("progressr.intrusiveness.
 #' @example incl/debug_handler.R
 #'
 #' @export
-debug_handler <- function(interval = getOption("progressr.interval", 0), intrusiveness = getOption("progressr.intrusiveness.debug", 0), ...) {
+debug_handler <- function(interval = getOption("progressr.interval", 0), intrusiveness = getOption("progressr.intrusiveness.debug", 0), target = "terminal", ...) {
   reporter <- local({
     t_init <- NULL
 
@@ -599,7 +599,7 @@ debug_handler <- function(interval = getOption("progressr.interval", 0), intrusi
 #' @param \ldots Additional arguments passed to [make_progression_handler()].
 #'
 #' @export
-newline_handler <- function(symbol = "\n", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.debug", 0), ...) {
+newline_handler <- function(symbol = "\n", file = stderr(), intrusiveness = getOption("progressr.intrusiveness.debug", 0), target = "terminal", ...) {
   reporter <- local({
     list(
       initiate = function(...) cat(file = file, symbol),
@@ -630,7 +630,7 @@ newline_handler <- function(symbol = "\n", file = stderr(), intrusiveness = getO
 #'
 #' @importFrom utils file_test
 #' @export
-filesize_handler <- function(file = "default.progress", intrusiveness = getOption("progressr.intrusiveness.file", 5), ...) {
+filesize_handler <- function(file = "default.progress", intrusiveness = getOption("progressr.intrusiveness.file", 5), target = "file", ...) {
   reporter <- local({
     set_file_size <- function(config, state, progression) {
       ratio <- state$step / config$max_steps
@@ -696,7 +696,7 @@ filesize_handler <- function(file = "default.progress", intrusiveness = getOptio
 #' }}
 #'
 #' @export
-shiny_handler <- function(intrusiveness = getOption("progressr.intrusiveness.gui", 1), ...) {
+shiny_handler <- function(intrusiveness = getOption("progressr.intrusiveness.gui", 1), target = "gui", ...) {
   reporter <- local({
     list(
       update = function(config, state, progression, ...) {

R/withProgress2.R

@@ -9,7 +9,7 @@
 #' @example incl/shiny-withProgress.R
 #'
 #' @export
-withProgress2 <- function(expr, ..., env = parent.frame(), quoted = FALSE, handlers = c(shiny = shiny_handler, getOption("progressr.handlers"))) {
+withProgress2 <- function(expr, ..., env = parent.frame(), quoted = FALSE, handlers = c(shiny = shiny_handler, progressr::handlers(default = NULL))) {
   if (!quoted) expr <- substitute(expr)
   expr <- bquote(progressr::with_progress({.(expr)}, handlers = .(handlers)))
   res <- withVisible(shiny::withProgress(expr, ..., env = env, quoted = TRUE))

R/with_progress.R

@@ -25,7 +25,7 @@
 #' @example incl/with_progress.R
 #'
 #' @export
-with_progress <- function(expr, handlers = getOption("progressr.handlers", txtprogressbar_handler), cleanup = TRUE, delay_stdout = getOption("progressr.delay_stdout", interactive()), delay_conditions = getOption("progressr.delay_conditions", if (interactive()) c("condition") else character(0L)), interval = NULL, enable = NULL) {
+with_progress <- function(expr, handlers = progressr::handlers(), cleanup = TRUE, delay_stdout = getOption("progressr.delay_stdout", interactive()), delay_conditions = getOption("progressr.delay_conditions", if (interactive()) c("condition") else character(0L)), interval = NULL, enable = NULL) {
   stop_if_not(is.logical(cleanup), length(cleanup) == 1L, !is.na(cleanup))
 
   ## FIXME: With zero handlers, progression conditions will be