improve progress outputs (#2)

.lintr

@@ -1,3 +1,5 @@
-linters: linters_with_defaults() # see vignette("lintr")
+linters: linters_with_defaults(
+  indentation_linter = NULL
+  )
 encoding: "UTF-8"
 exclusions: list("tests/spelling.R")

R/echo-classes.R

@@ -1,11 +1,17 @@
 
-echo_echo <- function(x, level = "NUL") {
+echo_echo <- function(x, level = "NUL", p = NULL) {
   if (echo_get_level() > level) {
     return(invisible())
   }
 
+  if (inherits(p, "echo_progress")) {
+    p$flush()
+    on.exit(p$show(), add = TRUE)
+  }
+
   op <- options(width = getOption("echo.width", getOption("width", 80L)))
   on.exit(options(op), add = TRUE)
+
   print(x)
 }
 
@@ -38,32 +44,32 @@ print.echo_err <- function(x, ...) {
   catln(paste0(time(), "[ERR] #> ", x))
 }
 
-echo_exp <- function(x) {
-  echo_class("exp", x)
+echo_exp <- function(x, p = NULL) {
+  echo_class("exp", x, p = p)
 }
 
-echo_out <- function(x) {
-  echo_class("out", x)
+echo_out <- function(x, p = NULL) {
+  echo_class("out", x, p = p)
 }
 
-echo_msg <- function(x) {
-  echo_class("msg", x)
+echo_msg <- function(x, p = NULL) {
+  echo_class("msg", x, p = p)
 }
 
-echo_wrn <- function(x) {
-  echo_class("wrn", x)
+echo_wrn <- function(x, p = NULL) {
+  echo_class("wrn", x, p = p)
 }
 
-echo_err <- function(x) {
-  echo_class("err", x)
+echo_err <- function(x, p = NULL) {
+  echo_class("err", x, p = p)
 }
 
-echo_class <- function(class, text) {
+echo_class <- function(class, text, p = NULL) {
   stopifnot(toupper(class) %in% level_levels())
   x <- structure(
     text,
     class = c("echo_echo", paste0("echo_", class), "list")
   )
 
-  echo_echo(x, level = toupper(class))
+  echo_echo(x, level = toupper(class), p = p)
 }

R/echo.R

@@ -111,31 +111,31 @@ echo <- function(
 
 evaluate <- function(expr, env = env, progress = echo_null) {
   dep <- deparse1(expr)
+  progress$flush()
   echo_exp(dep)
+  progress$show()
 
+  # FIXME include progress$flush(), $show() in echo_echo()
   output <- utils::capture.output(value <- tryCatch(
     eval(as.expression(expr), envir = env),
     message = function(e) {
-      echo_msg(conditionMessage(e))
+      echo_msg(conditionMessage(e), p = progress)
       tryInvokeRestart("muffleMessage")
     },
     warning = function(e) {
-      echo_wrn(conditionMessage(e))
+      echo_wrn(conditionMessage(e), p = progress)
       tryInvokeRestart("muffleWarning")
     },
     error = function(e) {
-      echo_err(conditionMessage(e))
       progress$flush()
+      echo_err(conditionMessage(e), p = progress)
       progress$show()
       stop("Error in ", dep, "\n  ", conditionMessage(e), call. = FALSE)
     }
   ))
 
-  progress$flush()
-
-  if (is.null(value) && identical(output, character())) {
-    utils::flush.console()
-  } else {
+  if (!(is.null(value) && identical(output, character()))) {
+    progress$flush()
     echo_out(output)
   }
 

R/progress.R

@@ -121,13 +121,11 @@ local(envir = echo_progress, {
     if (self$at == 0L) {
       return(invisible())
     }
-
     w <- getOption("width")
     bs <- strrep("\b", w)
     cat(bs)
-    cat(strrep(" ", w))
+    cat("\r", strrep(" ", w), sep = "")
     cat(bs)
-    cat("\r")
   }
 
   # 'internal' methods
@@ -148,6 +146,7 @@ local(envir = echo_progress, {
     self$.width() - self$.progress()
   }
 })
+class(echo_progress) <- c("echo_progress", "environment")
 lockBinding("self", echo_progress)
 lockBinding("reset", echo_progress)
 lockBinding("set", echo_progress)
@@ -173,6 +172,7 @@ local(envir = echo_null, {
   flush <- function(...) invisible()
 })
 
+class(echo_null) <- c("echo_null", "environment")
 lockBinding("self", echo_null)
 lockBinding("reset", echo_null)
 lockBinding("set", echo_null)