Move all plot watching logic into watchout (#151)

NEWS.md

@@ -1,5 +1,6 @@
 # evaluate (development version)
 
+* `watchout()` is no longer exported; it's really an implementation detail that should never have been leaked to the public interface.
 * `evaluate()` gains an output class (`evaluate_evaluation`/`list`) and a basic print method.
 * `evaluate()` now correctly captures plots created before messages/warnings/errors (#28).
 

R/eval.R

@@ -69,40 +69,18 @@ evaluate <- function(input,
   }
   local_inject_funs(envir)
 
-  if (new_device) {
-    # Ensure we have a graphics device available for recording, but choose
-    # one that's available on all platforms and doesn't write to disk
-    pdf(file = NULL)
-    dev.control(displaylist = "enable")
-    dev <- dev.cur()
-    on.exit(dev.off(dev))
-  }
-  # record the list of current devices
-  devs <- .env$dev_list; on.exit(.env$dev_list <- devs, add = TRUE)
-  devn <- length(.env$dev_list <- dev.list())
-  dev <- dev.cur()
-
-  # clean up the last_plot object after an evaluate() call (cf yihui/knitr#722)
-  on.exit(assign("last_plot", NULL, envir = environment(plot_snapshot)), add = TRUE)
-
   # if this env var is set to true, always bypass messages
   if (tolower(Sys.getenv('R_EVALUATE_BYPASS_MESSAGES')) == 'true')
     keep_message = keep_warning = NA
 
   # Capture output
-  watcher <- watchout(output_handler, debug = debug)
+  watcher <- watchout(output_handler, new_device = new_device, debug = debug)
 
   out <- vector("list", nrow(parsed))
   for (i in seq_along(out)) {
     if (log_echo || debug) {
       cat_line(parsed$src[[i]], file = stderr())
     }
-
-    # 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)
-    devn <- length(dev.list())
-
     out[[i]] <- evaluate_top_level_expression(
       exprs = parsed$expr[[i]],
       src = parsed$src[[i]],
@@ -116,6 +94,7 @@ evaluate <- function(input,
       output_handler = output_handler,
       include_timing = include_timing
     )
+    watcher$check_devices()
 
     if (stop_on_error > 0L) {
       errs <- vapply(out[[i]], is.error, logical(1))
@@ -148,12 +127,12 @@ evaluate_top_level_expression <- function(exprs,
   source <- new_source(src, exprs[[1]], output_handler$source)
   output <- list(source)
 
-  dev <- dev.cur()
   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 <- watcher(plot, incomplete_plots)
-    output <<- c(output, out)
+    out <- list(
+      if (plot) watcher$capture_plot(incomplete_plots),
+      watcher$capture_output()
+    )
+    output <<- c(output, compact(out))
   }
 
   local_output_handler(function() handle_output(FALSE))

R/graphics.R

@@ -1,45 +1,3 @@
-#" Capture snapshot of current device.
-#"
-#" There's currently no way to capture when a graphics device changes,
-#" except to check its contents after the evaluation of every expression.
-#" This means that only the last plot of a series will be captured.
-#"
-#" @return \code{NULL} if plot is blank or unchanged, otherwise the output of
-#"   \code{\link{recordPlot}}.
-plot_snapshot <- local({
-  last_plot <- NULL
-
-  function(incomplete = FALSE) {
-    devs <- dev.list()
-    # No graphics devices 
-    if (is.null(devs)) {
-      return()
-    }
-
-    # Current graphics device changed since evaluate started
-    if (!identical(devs, .env$dev_list)) {
-      return()
-    }
-
-    # current page is incomplete
-    if (!par("page") && !incomplete) {
-      return()
-    }
-
-    plot <- recordPlot()
-    if (!makes_visual_change(plot[[1]])) {
-      return()
-    }
-
-    if (!looks_different(last_plot[[1]], plot[[1]])) {
-      return()
-    }
-
-    last_plot <<- plot
-    plot
-  }
-})
-
 looks_different <- function(old_dl, new_dl) {
   if (identical(old_dl, new_dl)) {
     return(FALSE)

R/watcher.R

@@ -1,15 +1,23 @@
-#' Watch for changes in output, text and graphics
-#'
-#' @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(handler = new_output_handler(),
+                     new_device = TRUE,
                      debug = FALSE,
                      frame = parent.frame()) {
+  last_plot <- NULL
+
+  if (new_device) {
+    # Ensure we have a graphics device available for recording, but choose
+    # one that's available on all platforms and doesn't write to disk
+    pdf(file = NULL)
+    dev.control(displaylist = "enable")
+    dev <- dev.cur()
+    defer(dev.off(dev), frame)
+  }
+
+  # record current devices
+  devs <- dev.list()
+  devn <- length(devs)
+  dev <- dev.cur()
+
   con <- file("", "w+b")
   defer(frame = frame, {
     if (!test_con(con, isOpen)) {
@@ -24,20 +32,54 @@ watchout <- function(handler = new_output_handler(),
   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]])
+  capture_plot <- function(incomplete = FALSE) {
+    # only record plots for our graphics device
+    if (!identical(dev.cur(), dev)) {
+      return()
+    }
+
+    # current page is incomplete
+    if (!par("page") && !incomplete) {
+      return()
+    }
+
+    plot <- recordPlot()
+    if (!makes_visual_change(plot[[1]])) {
+      return()
     }
-    if (!is.null(out[[2]])) {
-      handler$text(out[[2]])
+
+    if (!looks_different(last_plot[[1]], plot[[1]])) {
+      return()
+    }
+
+    last_plot <<- plot
+    handler$graphics(plot)
+    plot
+  }
+
+  capture_output <- function() {
+    out <- read_con(con)
+    if (!is.null(out)) {
+      handler$text(out)
+    }
+    out
+  }
+
+  check_devices <- function() {
+    # if dev.off() was called, make sure to restore device to the one opened 
+    # when watchout() was called
+    if (length(dev.list()) < devn) {
+      dev.set(dev)
     }
-
-    compact(out)
+    devn <<- length(dev.list())
+    invisible()
   }
+
+  list(
+    capture_plot = capture_plot,
+    capture_output = capture_output,
+    check_devices = check_devices
+  )
 }
 
 read_con <- function(con, buffer = 32 * 1024) {

tests/testthat/test-graphics.R

@@ -174,8 +174,10 @@ test_that("perspective plots are captured", {
 })
 
 # a bug report yihui/knitr#722
-test_that("repeatedly drawing the same plot does not omit plots randomly", {
-  expect_true(all(replicate(100, length(evaluate("plot(1:10)"))) == 2))
+test_that("plot state doesn't persist over evaluate calls", {
+  expect_output_types(evaluate("plot(1)"), c("source", "plot"))
+  expect_output_types(evaluate("plot(1)"), c("source", "plot"))
+  expect_output_types(evaluate("plot(1)"), c("source", "plot"))
 })
 
 test_that("evaluate() doesn't depend on device option", {