From 64c114cde86865782c510ac51008ef7012dbc175 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Tue, 18 Jun 2024 13:28:23 +0100 Subject: [PATCH] Make watcher more simpler and more self-contained And only call it once, rather than once per evaluate call. --- DESCRIPTION | 2 +- R/eval.R | 28 +++++++++------------ R/utils.R | 4 +++ R/watcher.R | 67 ++++++++++++++++++++++++++----------------------- man/watchout.Rd | 6 ++++- 5 files changed, 57 insertions(+), 50 deletions(-) create mode 100644 R/utils.R diff --git a/DESCRIPTION b/DESCRIPTION index a85039c..365518c 100644 --- a/DESCRIPTION +++ b/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 diff --git a/R/eval.R b/R/eval.R index 8d2b84f..1277eea 100644 --- a/R/eval.R +++ b/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)) { diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..c46dda2 --- /dev/null +++ b/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) +} diff --git a/R/watcher.R b/R/watcher.R index 1864f62..e7767a5 100644 --- a/R/watcher.R +++ b/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) { diff --git a/man/watchout.Rd b/man/watchout.Rd index d5afa1a..75dab40 100644 --- a/man/watchout.Rd +++ b/man/watchout.Rd @@ -4,11 +4,15 @@ \alias{watchout} \title{Watch for changes in output, text and graphics} \usage{ -watchout(debug = FALSE) +watchout(handler = new_output_handler(), debug = FALSE, frame = parent.frame()) } \arguments{ +\item{handler}{An ouptut handler object.} + \item{debug}{activate debug mode where output will be both printed to screen and captured.} + +\item{frame}{When this frame terminates, the watcher will automatically close.`} } \value{ list containing four functions: \code{get_new}, \code{pause},