Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix WS/indentation #215

Merged
merged 2 commits into from
Aug 21, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@

# evaluate 0.24.0

* The `source` output handler can now take two arguments (the unparsed `src`
* The `source` output handler can now take two arguments (the unparsed `src`
and the parsed `call`) and choose to affect the displayed source.
* The package now depends on R 4.0.0 in order to decrease our maintenance burden.

Expand All @@ -36,7 +36,7 @@
# Version 0.21

- `evaluate()` gains `log_echo` and `log_warning` arguments. When set to `TRUE`
these cause code and warnings (respectively) to be immediately emitted to
these cause code and warnings (respectively) to be immediately emitted to
`stderr()`. This is useful for logging in unattended environments (#118).

- Improved the error message when users accidentally called `closeAllConnections()` (thanks, @guslipkin, quarto-dev/quarto-cli#5214).
Expand Down
12 changes: 6 additions & 6 deletions R/conditions.R
Original file line number Diff line number Diff line change
Expand Up @@ -2,19 +2,19 @@ condition_handlers <- function(watcher, on_error, on_warning, on_message) {
list(
message = function(cnd) {
watcher$capture_plot_and_output()

if (on_message$capture) {
watcher$push(cnd)
}
if (on_message$silence) {
invokeRestart("muffleMessage")
}
},
warning = function(cnd) {
warning = function(cnd) {
# do not handle warnings that shortly become errors or have been silenced
if (getOption("warn") >= 2 || getOption("warn") < 0) {
return()
}
}

watcher$capture_plot_and_output()
if (on_warning$capture) {
Expand All @@ -27,10 +27,10 @@ condition_handlers <- function(watcher, on_error, on_warning, on_message) {
},
error = function(cnd) {
watcher$capture_plot_and_output()

cnd <- sanitize_call(cnd)
watcher$push(cnd)

switch(on_error,
continue = invokeRestart("eval_continue"),
stop = invokeRestart("eval_stop"),
Expand All @@ -57,6 +57,6 @@ sanitize_call <- function(cnd) {
if (identical(cnd$call, quote(eval(as.call(list(context)), envir)))) {
cnd$call <- NULL
}

cnd
}
47 changes: 23 additions & 24 deletions R/evaluate.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,28 +17,28 @@
#' including all output that evaluate captures.
#' @param stop_on_error A number between 0 and 2 that controls what happens
#' when the code errors:
#'
#'
#' * If `0`, the default, will continue running all code, just as if you'd
#' pasted the code into the command line.
#' * If `1`, evaluation will stop on first error without signaling the error,
#' and you will get back all results up to that point.
#' * If `2`, evaluation will halt on first error and you will get back no
#' * If `1`, evaluation will stop on first error without signaling the error,
#' and you will get back all results up to that point.
#' * If `2`, evaluation will halt on first error and you will get back no
#' results.
#' @param keep_warning,keep_message A single logical value that controls what
#' happens to warnings and messages.
#'
#'
#' * If `TRUE`, the default, warnings and messages will be captured in the
#' output.
#' * If `NA`, warnings and messages will not be captured and bubble up to
#' the calling environment of `evaluate()`.
#' * If `FALSE`, warnings and messages will be completed supressed and
#' not shown anywhere.
#'
#' Note that setting the envvar `R_EVALUATE_BYPASS_MESSAGES` to `true` will
#'
#' Note that setting the envvar `R_EVALUATE_BYPASS_MESSAGES` to `true` will
#' force these arguments to be set to `NA`.
#' @param log_echo,log_warning If `TRUE`, will immediately log code and
#' warnings (respectively) to `stderr`.
#'
#'
#' This will be force to `TRUE` if env var `ACTIONS_STEP_DEBUG` is
#' `true`, as when debugging a failing GitHub Actions workflow.
#' @param new_device if `TRUE`, will open a new graphics device and
Expand All @@ -48,19 +48,19 @@
#' processes the output from the evaluation. The default simply prints the
#' visible return values.
#' @param filename string overrriding the [base::srcfile()] filename.
#' @param include_timing Deprecated.
#' @param include_timing Deprecated.
#' @import graphics grDevices utils
#' @examples
#' evaluate(c(
#' "1 + 1",
#' "1 + 1",
#' "2 + 2"
#' ))
#'
#' # Not that's there's a difference in output between putting multiple
#'
#' # Not that's there's a difference in output between putting multiple
#' # expressions on one line vs spreading them across multiple lines
#' evaluate("1;2;3")
#' evaluate(c("1", "2", "3"))
#'
#'
#' # This also affects how errors propagate, matching the behaviour
#' # of the R console
#' evaluate("1;stop(2);3")
Expand All @@ -78,12 +78,11 @@ evaluate <- function(input,
output_handler = NULL,
filename = NULL,
include_timing = FALSE) {

on_error <- check_stop_on_error(stop_on_error)

# if this env var is set to true, always bypass messages
if (env_var_is_true('R_EVALUATE_BYPASS_MESSAGES')) {
keep_message <- NA
if (env_var_is_true("R_EVALUATE_BYPASS_MESSAGES")) {
keep_message <- NA
keep_warning <- NA
}
if (env_var_is_true("ACTIONS_STEP_DEBUG")) {
Expand All @@ -104,12 +103,12 @@ evaluate <- function(input,
watcher <- watchout(output_handler, new_device = new_device, debug = debug)

if (on_error != "error" && !can_parse(input)) {
err <- tryCatch(parse(text = input), error = function(cnd) cnd)
err <- tryCatch(parse(text = input), error = function(cnd) cnd)
watcher$push_source(input, expression())
watcher$push(err)
return(watcher$get())
}

parsed <- parse_all(input, filename = filename)
# "Transpose" parsed so we get a list that's easier to iterate over
tles <- Map(
Expand All @@ -121,7 +120,7 @@ evaluate <- function(input,
envir <- list2env(envir, parent = enclos %||% parent.frame())
}
local_inject_funs(envir)

# Handlers for warnings, errors and messages
user_handlers <- output_handler$calling_handlers
evaluate_handlers <- condition_handlers(
Expand All @@ -132,7 +131,7 @@ evaluate <- function(input,
)
# The user's condition handlers have priority over ours
handlers <- c(user_handlers, evaluate_handlers)

context <- function() {
do <- NULL # silence R CMD check note

Expand All @@ -141,7 +140,7 @@ evaluate <- function(input,
if (debug || log_echo) {
cat_line(tle$src, file = stderr())
}

continue <- withRestarts(
with_handlers(
{
Expand All @@ -150,7 +149,7 @@ evaluate <- function(input,
# `Rf_eval()`. Unlike the R-level `eval()`, this doesn't create
# an unwinding scope.
eval(bquote(delayedAssign("do", .(expr), eval.env = envir)))

ev <- withVisible(do)
watcher$capture_plot_and_output()
watcher$print_value(ev$value, ev$visible, envir)
Expand All @@ -164,15 +163,15 @@ evaluate <- function(input,
eval_error = function(cnd) stop(cnd)
)
watcher$check_devices()

if (!continue) {
break
}
}
}

# Here we use `eval()` to create an unwinding scope for `envir`.
# We call ourselves back immediately once the scope is created.
# We call ourselves back immediately once the scope is created.
eval(as.call(list(context)), envir)
watcher$capture_output()

Expand Down
3 changes: 2 additions & 1 deletion R/evaluation.R
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,8 @@ print.evaluate_evaluation <- function(x, ...) {
}
} else {
cat_line("Other: ")
cat(" "); str(component, indent.str = " ")
cat(" ")
str(component, indent.str = " ")
}
}

Expand Down
6 changes: 3 additions & 3 deletions R/flush-console.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,11 +8,11 @@
#' (specified in the `output_handler` argument of `evaluate()`) will
#' be called, which makes it possible for users to know it when the code
#' produces text output using the handler.
#'
#'
#' This function is supposed to be called inside `evaluate()` (e.g.
#' either a direct `evaluate()` call or in \pkg{knitr} code chunks).
#' @export
flush_console = function() {
flush_console <- function() {
if (!is.null(the$console_flusher)) {
the$console_flusher()
}
Expand All @@ -31,4 +31,4 @@ set_console_flusher <- function(flusher) {
old <- the$console_flusher
the$console_flusher <- flusher
invisible(old)
}
}
18 changes: 9 additions & 9 deletions R/graphics.R
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ looks_different <- function(old_dl, new_dl) {
if (length(new_dl) < length(old_dl)) {
return(TRUE)
}

# If the initial calls are different, it must be a visual change
if (!identical(old_dl[], new_dl[seq_along(old_dl)])) {
return(TRUE)
Expand Down Expand Up @@ -49,21 +49,21 @@ makes_visual_change <- function(plot) {
}

non_visual_calls <- c(
"C_clip",
"C_layout",
"C_par",
"C_plot_window",
"C_strHeight", "C_strWidth",
"C_clip",
"C_layout",
"C_par",
"C_plot_window",
"C_strHeight", "C_strWidth",
"palette", "palette2"
)

# plot trimming ----------------------------------------------------------

#' Trim away intermediate plots
#'
#'
#' Trim off plots that are modified by subsequent lines to only show
#' the "final" plot.
#'
#'
#' @param x An evaluation object produced by [evaluate()].
#' @return A modified evaluation object.
#' @export
Expand All @@ -73,7 +73,7 @@ non_visual_calls <- c(
#' "text(1, 1, 'x')",
#' "text(1, 1, 'y')"
#' ))
#'
#'
#' # All intermediate plots are captured
#' ev
#' # Only the final plot is shown
Expand Down
12 changes: 6 additions & 6 deletions R/inject-funs.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,17 +16,17 @@
#'
#' # replace the system() function
#' old <- inject_funs(system = function(...) {
#' cat(base::system(..., intern = TRUE), sep = '\n')
#' cat(base::system(..., intern = TRUE), sep = "\n")
#' })
#'
#' evaluate("system('R --version')")
#'
#' # restore previously injected functions
#' inject_funs(old)
#' inject_funs(old)
#' @export
inject_funs <- function(...) {
funs <- list(...)
funs <- funs[names(funs) != '']
funs <- funs[names(funs) != ""]
old <- the$inject_funs
the$inject_funs <- Filter(is.function, funs)

Expand All @@ -43,12 +43,12 @@ local_inject_funs <- function(envir, frame = parent.frame()) {
funs_new <- !vapply(funs_names, exists, logical(1), envir, inherits = FALSE)
funs_names <- funs_names[funs_new]
funs <- funs[funs_new]

defer(rm(list = funs_names, envir = envir), frame = frame)

for (i in seq_along(funs_names)) {
assign(funs_names[i], funs[[i]], envir)
}

invisible()
}
34 changes: 23 additions & 11 deletions R/output-handler.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,19 +18,19 @@
#' @param source Function to handle the echoed source code under evaluation.
#' This function should take two arguments (`src` and `expr`), and return
#' an object that will be inserted into the evaluate outputs. `src` is the
#' unparsed text of the source code, and `expr` is the complete input
#' unparsed text of the source code, and `expr` is the complete input
#' expression (which may have 0, 1, 2, or more components; see [parse_all()]
#' for details).
#'
#' Return `src` for the default evaluate behaviour. Return `NULL` to
#'
#' Return `src` for the default evaluate behaviour. Return `NULL` to
#' drop the source from the output.
#' @param text Function to handle any textual console output.
#' @param graphics Function to handle graphics, as returned by
#' [recordPlot()].
#' @param message Function to handle [message()] output.
#' @param warning Function to handle [warning()] output.
#' @param error Function to handle [stop()] output.
#' @param value Function to handle the values returned from evaluation.
#' @param value Function to handle the values returned from evaluation.
#' * If it has one argument, it called on visible values.
#' * If it has two arguments, it handles all values, with the second
#' argument indicating whether or not the value is visible.
Expand All @@ -44,9 +44,12 @@
#' @aliases output_handler
#' @export
new_output_handler <- function(source = identity,
text = identity, graphics = identity,
message = identity, warning = identity,
error = identity, value = render,
text = identity,
graphics = identity,
message = identity,
warning = identity,
error = identity,
value = render,
calling_handlers = list()) {
source <- match.fun(source)
stopifnot(length(formals(source)) >= 1)
Expand All @@ -65,10 +68,19 @@ new_output_handler <- function(source = identity,

check_handlers(calling_handlers)

structure(list(source = source, text = text, graphics = graphics,
message = message, warning = warning, error = error,
value = value, calling_handlers = calling_handlers),
class = "output_handler")
structure(
list(
source = source,
text = text,
graphics = graphics,
message = message,
warning = warning,
error = error,
value = value,
calling_handlers = calling_handlers
),
class = "output_handler"
)
}

check_handlers <- function(x) {
Expand Down
Loading
Loading