Added print() for 'progression_handler' objects.

Author: HenrikBengtsson

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(print,progression)
+S3method(print,progression_handler)
 S3method(print,progressor)
 export(ascii_alert_handler)
 export(beepr_handler)

NEWS

@@ -9,6 +9,8 @@ NEW FEATURES:
    to setting corresponding options progressr.*.
 
  * Now option 'progressr.interval' defaults to 0.0 (was 0.5 seconds).
+
+ * Added print() for 'progression_handler' objects.
 
 
 Version: 0.1.1 [2019-06-08]

R/progression_handler.R

@@ -279,3 +279,35 @@ progression_handler <- function(name, reporter = list(), handler = NULL, enable
 
   handler
 }
+
+
+#' @export
+print.progression_handler <- function(x, ...) {
+  print(sys.calls())
+  s <- sprintf("Progression handler of class %s:", sQuote(class(x)[1]))
+  
+  env <- environment(x)
+  s <- c(s, " * configuration:")
+  s <- c(s, sprintf("   - name: %s", sQuote(env$name %||% "<NULL>")))
+  s <- c(s, sprintf("   - max_steps: %s", env$max_steps %||% "<NULL>"))
+  s <- c(s, sprintf("   - enable: %g", env$enable))
+  s <- c(s, sprintf("   - enable_after: %g seconds", env$enable_after))
+  s <- c(s, sprintf("   - times: %g", env$times))
+  s <- c(s, sprintf("   - interval: %g seconds", env$interval))
+  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("   - milestones: %s", hpaste(env$milestones %||% "<NULL>")))
+  s <- c(s, sprintf("   - owner: %s", hpaste(env$owner %||% "<NULL>")))
+
+  s <- c(s, " * state:")
+  s <- c(s, sprintf("   - enabled: %s", env$enabled))
+  s <- c(s, sprintf("   - finished: %s", env$finished))
+  s <- c(s, sprintf("   - step: %s", env$step %||% "<NULL>"))
+  s <- c(s, sprintf("   - prev_milestone: %s", env$prev_milestone %||% "<NULL>"))
+  s <- c(s, sprintf("   - delta: %g", (env$step - env$prev_milestone) %||% 0L))
+  s <- c(s, sprintf("   - timestamps: %s", hpaste(env$timestamps %||% "<NULL>")))
+
+  s <- paste(s, collapse = "\n")
+  cat(s, "\n", sep = "")
+}

R/utils.R

@@ -1,3 +1,35 @@
+## From R.utils 2.0.2 (2015-05-23)
+hpaste <- function(..., sep = "", collapse = ", ", lastCollapse = NULL, maxHead = if (missing(lastCollapse)) 3 else Inf, maxTail = if (is.finite(maxHead)) 1 else Inf, abbreviate = "...") {
+  if (is.null(lastCollapse)) lastCollapse <- collapse
+
+  # Build vector 'x'
+  x <- paste(..., sep = sep)
+  n <- length(x)
+
+  # Nothing todo?
+  if (n == 0) return(x)
+  if (is.null(collapse)) return(x)
+
+  # Abbreviate?
+  if (n > maxHead + maxTail + 1) {
+    head <- x[seq_len(maxHead)]
+    tail <- rev(rev(x)[seq_len(maxTail)])
+    x <- c(head, abbreviate, tail)
+    n <- length(x)
+  }
+
+  if (!is.null(collapse) && n > 1) {
+    if (lastCollapse == collapse) {
+      x <- paste(x, collapse = collapse)
+    } else {
+      xT <- paste(x[1:(n-1)], collapse = collapse)
+      x <- paste(xT, x[n], sep = lastCollapse)
+    }
+  }
+
+  x
+} # hpaste()
+
 # More efficient than the default utils::capture.output()
 #' @importFrom utils capture.output
 capture_output <- function(expr, envir = parent.frame(), ...) {
@@ -70,6 +102,12 @@ is_fake <- local({
 known_progression_handlers <- function() {
   ns <- asNamespace(.packageName)
   handlers <- ls(envir = ns, pattern = "_handler$")
-  handlers <- setdiff(handlers, "progression_handler")
-  mget(handlers, envir = ns, inherits = FALSE)
+  handlers <- setdiff(handlers, c("progression_handler", "print.progression_handler"))
+  handlers <- mget(handlers, envir = ns, inherits = FALSE)
+  handlers
+}
+
+
+`%||%` <- function(lhs, rhs) {
+  if (is.null(lhs)) rhs else lhs
 }