Make watcher more simpler and more self-contained

R/eval.R

@@ -89,8 +89,15 @@
   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)
@@ -99,8 +106,8 @@
     out[[i]] <- evaluate_top_level_expression(
       exprs = parsed$expr[[i]],
       src = parsed$src[[i]],
+      watcher = watcher,
       envir = envir,
-      debug = debug,
       last = i == length(out),
       use_try = stop_on_error != 2L,
       keep_warning = keep_warning,
@@ -127,9 +134,9 @@
 }
 
 evaluate_top_level_expression <- function(exprs,
-                                          src = NULL,
+                                          src,
+                                          watcher,
                                           envir = parent.frame(),
-                                          debug = FALSE,
                                           last = FALSE,
                                           use_try = FALSE,
                                           keep_warning = TRUE,
@@ -139,15 +146,6 @@
                                           output_handler = new_output_handler(),
                                           include_timing = FALSE) {
   stopifnot(is.expression(exprs))
-  if (debug) message(src)
-
-  # 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())
@@ -160,8 +158,7 @@
   handle_output <- function(plot = TRUE, 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)
   }
 
@@ -221,7 +218,7 @@
   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}
   }
 
   user_handlers <- output_handler$calling_handlers

R/utils.R

@@ -14,3 +14,7 @@ defer <- function(expr, frame = parent.frame(), after = FALSE) {
 }
 
 `%||%` <- function(a, b) if (is.null(a)) b else a
+
+compact <- function(x) {
+  x[!vapply(x, is.null, logical(1))]
+}

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) {
-  output <- character()
-  prev   <- character()
-
-  con <- textConnection("output", "wr", local = TRUE)
+watchout <- function(handler = new_output_handler(),
+                     debug = FALSE,
+                     frame = parent.frame()) {
+  con <- file("", "w+b")
+  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")
-
-      out <- list()
-
-      if (plot) {
-        out$graphics <- plot_snapshot(incomplete_plots)
-        if (!is.null(out$graphics)) graphics_callback(out$graphics)
-      }
-
-      n0 <- length(prev)
-      n1 <- length(output)
-      if (n1 > n0) {
-        new <- output[n0 + seq_len(n1 - n0)]
-        prev <<- output
-
-        out$text <- paste0(new, collapse = "\n")
-        if (!incomplete) out$text <- paste0(out$text, "\n")
-
-        text_callback(out$text)
-      }
+  # try() defaults to using stderr() so we need to explicitly override(#88)
+  old <- options(try.outFile = con)
+  defer(options(old), frame = frame)
+
+  function(plot = TRUE, incomplete_plots = FALSE) {
+    out <- list(
+      if (plot) plot_snapshot(incomplete_plots),
+      read_con(con)
+    )
+    if (!is.null(out[[1]])) {
+      handler$graphics(out[[1]])
+    }
+    if (!is.null(out[[2]])) {
+      handler$text(out[[2]])
+    }
+
+    compact(out)
+  }
+}
 
-      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
-  )
+read_con <- function(con, buffer = 32 * 1024) {
+  bytes <- raw()
+  repeat {
+    new <- readBin(con, "raw", n = buffer)
+    if (length(new) == 0) break
+    bytes <- c(bytes, new)
+  }
+  if (length(bytes) == 0) {
+    NULL
+  } else {
+    rawToChar(bytes)
+  }
 }
 
 test_con = function(con, test) {