Make watcher more simpler and more self-contained

And only call it once, rather than once per evaluate call.

DESCRIPTION

@@ -37,4 +37,4 @@ Config/Needs/website: tidyverse/tidytemplate
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

R/eval.R

@@ -89,8 +89,15 @@ evaluate <- function(input,
   if (tolower(Sys.getenv('R_EVALUATE_BYPASS_MESSAGES')) == 'true')
     keep_message = keep_warning = NA
 
+  # Capture output
+  watcher <- watchout(output_handler, debug = debug)
+
   out <- vector("list", nrow(parsed))
   for (i in seq_along(out)) {
+    if (debug) {
+      message(parsed$src[[i]])
+    }
+
     # if dev.off() was called, make sure to restore device to the one opened by
     # evaluate() or existed before evaluate()
     if (length(dev.list()) < devn) dev.set(dev)
@@ -102,9 +109,9 @@ evaluate <- function(input,
     out[[i]] <- evaluate_call(
       expr,
       parsed$src[[i]],
+      watcher = watcher,
       envir = envir,
       enclos = enclos,
-      debug = debug,
       last = i == length(out),
       use_try = stop_on_error != 2L,
       keep_warning = keep_warning,
@@ -130,10 +137,10 @@ evaluate <- function(input,
 }
 
 evaluate_call <- function(call,
-                          src = NULL,
+                          src,
+                          watcher,
                           envir = parent.frame(),
                           enclos = NULL,
-                          debug = FALSE,
                           last = FALSE,
                           use_try = FALSE,
                           keep_warning = TRUE,
@@ -142,22 +149,12 @@ evaluate_call <- function(call,
                           log_warning = FALSE,
                           output_handler = new_output_handler(),
                           include_timing = FALSE) {
-  if (debug) message(src)
-
   if (is.null(call) && !last) {
     source <- new_source(src, call[[1]], output_handler$source)
     return(list(source))
   }
   stopifnot(is.call(call) || is.language(call) || is.atomic(call) || is.null(call))
 
-  # Capture output
-  w <- watchout(debug)
-  on.exit(w$close())
-
-  # Capture error output from try() (#88)
-  old_try_outfile <- options(try.outFile = w$get_con())
-  on.exit(options(old_try_outfile), add = TRUE)
-
   if (log_echo && !is.null(src)) {
     cat(src, "\n", sep = "", file = stderr())
   }
@@ -169,8 +166,7 @@ evaluate_call <- function(call,
   handle_output <- function(plot = FALSE, incomplete_plots = FALSE) {
     # if dev.cur() has changed, we should not record plots any more
     plot <- plot && identical(dev, dev.cur())
-    out <- w$get_new(plot, incomplete_plots,
-      output_handler$text, output_handler$graphics)
+    out <- watcher(plot, incomplete_plots)
     output <<- c(output, out)
   }
 
@@ -235,7 +231,7 @@ evaluate_call <- function(call,
   if (include_timing) {
     timing_fn <- function(x) system.time(x)[1:3]
   } else {
-    timing_fn <- function(x) {x; NULL};
+    timing_fn <- function(x) {x; NULL}
   }
 
   if (length(funs <- .env$inject_funs)) {

R/utils.R

@@ -0,0 +1,4 @@
+defer <- function(expr, frame = parent.frame(), after = FALSE) {
+  thunk <- as.call(list(function() expr))
+  do.call(on.exit, list(thunk, TRUE, after), envir = frame)
+}

R/watcher.R

@@ -2,53 +2,56 @@
 #'
 #' @param debug activate debug mode where output will be both printed to
 #'   screen and captured.
+#' @param handler An ouptut handler object.
+#' @param frame When this frame terminates, the watcher will automatically close.` 
 #' @return list containing four functions: `get_new`, `pause`,
 #'  `unpause`, `close`.
 #' @keywords internal
-watchout <- function(debug = FALSE) {
+watchout <- function(handler = new_output_handler(),
+                     debug = FALSE,
+                     frame = parent.frame()) {
   output <- character()
   prev   <- character()
 
   con <- textConnection("output", "wr", local = TRUE)
+  defer(frame = frame, {
+    if (!test_con(con, isOpen)) {
+      con_error('The connection has been closed')
+    }
+    sink()
+    close(con)
+  })
   sink(con, split = debug)
 
-  list(
-    get_new = function(plot = FALSE, incomplete_plots = FALSE,
-                       text_callback = identity, graphics_callback = identity) {
-      incomplete <- test_con(con, isIncomplete)
-      if (incomplete) cat("\n")
+  # try() defaults to using stderr() so we need to explicitly override(#88)
+  old <- options(try.outFile = con)
+  defer(options(old), frame = frame)
 
-      out <- list()
+  function(plot = FALSE, incomplete_plots = FALSE) {
+    incomplete <- test_con(con, isIncomplete)
+    if (incomplete) cat("\n")
 
-      if (plot) {
-        out$graphics <- plot_snapshot(incomplete_plots)
-        if (!is.null(out$graphics)) graphics_callback(out$graphics)
-      }
+    out <- list()
 
-      n0 <- length(prev)
-      n1 <- length(output)
-      if (n1 > n0) {
-        new <- output[n0 + seq_len(n1 - n0)]
-        prev <<- output
+    if (plot) {
+      out$graphics <- plot_snapshot(incomplete_plots)
+      if (!is.null(out$graphics)) handler$graphics(out$graphics)
+    }
 
-        out$text <- paste0(new, collapse = "\n")
-        if (!incomplete) out$text <- paste0(out$text, "\n")
+    n0 <- length(prev)
+    n1 <- length(output)
+    if (n1 > n0) {
+      new <- output[n0 + seq_len(n1 - n0)]
+      prev <<- output
 
-        text_callback(out$text)
-      }
+      out$text <- paste0(new, collapse = "\n")
+      if (!incomplete) out$text <- paste0(out$text, "\n")
 
-      unname(out)
-    },
-    pause = function() sink(),
-    unpause = function() sink(con, split = debug),
-    close = function() {
-      if (!test_con(con, isOpen)) con_error('The connection has been closed')
-      sink()
-      close(con)
-      output
-    },
-    get_con = function() con
-  )
+      handler$text(out$text)
+    }
+
+    unname(out)
+  }
 }
 
 test_con = function(con, test) {