evaluate/0000755000176200001440000000000012222360554012061 5ustar liggesusersevaluate/inst/0000755000176200001440000000000012142655645013047 5ustar liggesusersevaluate/inst/tests/0000755000176200001440000000000012220503247014174 5ustar liggesusersevaluate/inst/tests/test-graphics.r0000644000176200001440000000743312214665607017157 0ustar liggesusersop <- options(device = function(...) { pdf(file = NULL) dev.control("enable") }) context("Evaluation: graphics") test_that("single plot is captured", { ev <- evaluate(file("plot.r")) expect_that(length(ev), equals(2)) expect_that(classes(ev), equals(c("source", "recordedplot"))) }) test_that("ggplot is captured", { if (require("ggplot2")) { ev <- evaluate(file("ggplot.r")) expect_that(length(ev), equals(3)) expect_that(classes(ev), equals(c("source", "source", "recordedplot"))) } }) test_that("plot additions are captured", { ev <- evaluate(file("plot-additions.r")) expect_that(length(ev), equals(4)) expect_that(classes(ev), equals(c("source", "recordedplot", "source", "recordedplot"))) }) test_that("blank plots by plot.new() are preserved", { ev <- evaluate(file("plot-new.r")) expect_that(length(ev), equals(10)) expect_that(classes(ev), equals(rep(c("source", "recordedplot"), 5))) }) test_that("base plots in a single expression are captured", { ev <- evaluate(file("plot-loop.r")) expect_that(length(ev), equals(4)) expect_that(classes(ev), equals(c("source", rep("recordedplot", 3)))) }) test_that("ggplot2 plots in a single expression are captured", { if (require("ggplot2")) { ev <- evaluate(file("ggplot-loop.r")) expect_that(length(ev), equals(4)) expect_that(classes(ev), equals(c(rep("source", 2), rep("recordedplot", 2)))) } }) test_that("multirow graphics are captured only when complete", { ev <- evaluate(file("plot-multi.r")) expect_that(classes(ev), equals(c(rep("source", 5), "recordedplot"))) }) test_that("multirow graphics are captured on close", { ev <- evaluate(file("plot-multi-missing.r")) expect_that(classes(ev), equals(c(rep("source", 4), "recordedplot"))) }) test_that("plots are captured in a non-rectangular layout", { ev <- evaluate(file("plot-multi-layout.r")) expect_that(classes(ev), equals(rep(c("source", "recordedplot"), c(1, 3)))) ev <- evaluate(file("plot-multi-layout2.r")) expect_that(classes(ev), equals(rep(c("source", "recordedplot"), c(4, 2)))) }) test_that("changes in parameters don't generate new plots", { ev <- evaluate(file("plot-par.r")) expect_that(classes(ev), equals(c("source", "recordedplot", "source", "source", "recordedplot"))) }) test_that("plots in a loop are captured even the changes seem to be from par only", { ev <- evaluate(file("plot-par2.r")) expect_that(classes(ev), equals(c("source", "recordedplot")[c(1, 2, 1, 1, 2, 2, 2)])) }) test_that("strwidth()/strheight() should not produce new plots", { ev <- evaluate(file("plot-strwidth.r")) expect_that(classes(ev), equals(rep(c("source", "recordedplot"), c(4, 1)))) }) test_that("clip() does not produce new plots", { ev <- evaluate(file("plot-clip.r")) expect_that(classes(ev), equals(c("source", "recordedplot")[c(1, 2, 1, 1, 2)])) }) test_that("perspective plots are captured", { ev <- evaluate(file("plot-persp.r")) expect_that(classes(ev), equals(rep(c("source", "recordedplot"), c(6, 3)))) }) test_that("an incomplete plot with a comment in the end is also captured", { ev <- evaluate(file("plot-last-comment.r")) expect_that(classes(ev), equals(rep(c("source", "recordedplot"), c(3, 1)))) }) # test_that("no plot windows open", { # graphics.off() # expect_that(length(dev.list()), equals(0)) # evaluate(file("plot.r")) # expect_that(length(dev.list()), equals(0)) # }) options(op) test_that("by default, evaluate() always records plots regardless of the device", { op <- options(device = pdf) ev <- evaluate("plot(1)") options(op) expect_that(length(ev), equals(2)) }) evaluate/inst/tests/plot-multi-layout.r0000644000176200001440000000022312200313462017771 0ustar liggesusersfor (j in 1:3) { layout(matrix(c(1, 2, 1, 3, 4, 4), 3, 2, byrow=TRUE)) plot(rnorm(10)) plot(rnorm(10)) plot(rnorm(10)) plot(rnorm(10)) } evaluate/inst/tests/interleave-2.r0000644000176200001440000000004512164221503016652 0ustar liggesusersfor(i in 1:2) { plot(i) cat(i) } evaluate/inst/tests/test-evaluate.r0000644000176200001440000000446512220503247017153 0ustar liggesuserscontext("Evaluation") test_that("file with only comments runs", { ev <- evaluate(file("comment.r")) expect_that(length(ev), equals(2)) expect_that(classes(ev), equals(c("source", "source"))) }) test_that("data sets loaded", { ev <- evaluate(file("data.r")) expect_that(length(ev), equals(3)) }) # # Don't know how to implement this # test_that("newlines escaped correctly", { # ev <- evaluate("cat('foo\n')") # expect_that(ev[[1]]$src, equals("cat('foo\\n'))")) # }) test_that("terminal newline not needed", { ev <- evaluate("cat('foo')") expect_that(length(ev), equals(2)) expect_that(ev[[2]], equals("foo")) }) test_that("S4 methods are displayed with show, not print", { setClass("A", contains = "function") setMethod("show", "A", function(object) cat("B")) a <- new('A', function() b) ev <- evaluate("a") expect_equal(ev[[2]], "B") }) test_that("errors during printing visible values are captured", { setClass("A", contains = "function") setMethod("show", "A", function(object) stop("B")) a <- new('A', function() b) ev <- evaluate("a") stopifnot("error" %in% class(ev[[2]])) }) test_that("options(warn = -1) suppresses warnings", { ev <- evaluate("op = options(warn = -1); warning('hi'); options(op)") expect_that(classes(ev), equals("source")) }) op <- options(device = function(...) { pdf(file = NULL) dev.control("enable") }) test_that("output and plots interleaved correctly", { ev <- evaluate(file("interleave-1.r")) expect_equal(classes(ev), c("source", "character", "recordedplot", "character", "recordedplot")) ev <- evaluate(file("interleave-2.r")) expect_equal(classes(ev), c("source", "recordedplot", "character", "recordedplot", "character")) }) test_that("return value of value handler inserted directly in output list", { ev <- evaluate(file("raw-output.r"), output_handler = new_output_handler(value = identity)) expect_equal(classes(ev), c("source", "numeric", "source", "source", "source", "gg")) }) test_that("invisible values can also be saved if value handler has two arguments", { handler <- new_output_handler(value = function(x, visible) { x # always returns a visible value }) ev <- evaluate("x<-1:10", output_handler = handler) expect_equal(classes(ev), c("source", "integer")) }) options(op) evaluate/inst/tests/test-errors.r0000644000176200001440000000171312164221503016651 0ustar liggesuserscontext("Errors") test_that("all code run, even after error", { ev <- evaluate(file("error.r")) expect_that(length(ev), equals(4)) }) test_that("code aborts on error if stop_on_error == 1L", { ev <- evaluate(file("error.r"), stop_on_error = 1L) expect_that(length(ev), equals(2)) }) test_that("code errors if stop_on_error == 2L", { expect_error(evaluate(file("error.r"), stop_on_error = 2L), "1") }) test_that("traceback useful if stop_on_error == 2L", { expect_error(evaluate(file("error-complex.r"), stop_on_error = 2L), "h()") ## Doesn't work because .Traceback not create when code run ## inside try or tryCatch. Can't figure out how to work around. ## tryCatch(..., error = function(e) {}) doesn't have enough info ## in e, or in the call stack. options(error = function() {}) doesn't ## stop error propagation # expect_match(.Traceback[[2]], "h()") # expect_match(.Traceback[[3]], "g()") # expect_match(.Traceback[[4]], "f()") }) evaluate/inst/tests/plot-new.r0000644000176200001440000000006712164221503016126 0ustar liggesusersplot.new() plot(1:10) plot.new() plot(1:10) plot.new() evaluate/inst/tests/plot.r0000644000176200001440000000001312164221503015326 0ustar liggesusersplot(1:10) evaluate/inst/tests/interleave-1.r0000644000176200001440000000004512164221503016651 0ustar liggesusersfor(i in 1:2) { cat(i) plot(i) } evaluate/inst/tests/error-complex.r0000644000176200001440000000011312164221503017147 0ustar liggesusersf <- function() g() g <- function() h() h <- function() stop("Error") f() evaluate/inst/tests/plot-additions.r0000644000176200001440000000002712164221503017307 0ustar liggesusersplot(1:10) lines(1:10) evaluate/inst/tests/plot-clip.r0000644000176200001440000000013412211770444016265 0ustar liggesusersplot(rnorm(100), rnorm(100)) clip(-1, 1, -1, 1) points(rnorm(100), rnorm(100), col = 'red') evaluate/inst/tests/plot-par2.r0000644000176200001440000000032012200552421016166 0ustar liggesusersbarplot(table(mtcars$mpg), main="All") # should capture all plots in this loop for (numcyl in levels(as.factor(mtcars$cyl))) { barplot(table(mtcars$mpg[mtcars$cyl==numcyl]), main=paste("cyl = ", numcyl)) } evaluate/inst/tests/comment.r0000644000176200001440000000011712164221503016017 0ustar liggesusers# This test case contains no executable code # but it shouldn't throw an error evaluate/inst/tests/plot-last-comment.r0000644000176200001440000000007612214665437017756 0ustar liggesuserspar(mfrow = c(3, 3)) for(i in 1:7) image(volcano) # comment evaluate/inst/tests/plot-multi-layout2.r0000644000176200001440000000031212200315726020057 0ustar liggesuserslayout(matrix(c(1, 2, 1, 3, 4, 4), 3, 2, byrow=TRUE)) # another expression before drawing the plots x <- 1 + 1 for (j in 1:2) { plot(rnorm(10)) plot(rnorm(10)) plot(rnorm(10)) plot(rnorm(10)) } evaluate/inst/tests/error.r0000644000176200001440000000001412164221503015502 0ustar liggesusersstop("1") 2 evaluate/inst/tests/raw-output.r0000644000176200001440000000016212220503247016505 0ustar liggesusersrnorm(10) x <- list("I'm a list!") suppressPackageStartupMessages(library(ggplot2)) qplot(mpg, wt, data = mtcars) evaluate/inst/tests/order.r0000644000176200001440000000026212164221503015471 0ustar liggesuserscat("1\n") print("2") warning("3") print("4") message("5") stop("6") stop("7", call. = FALSE) f <- function(x) { print("8") message("9") warning("10") stop("11") } f() evaluate/inst/tests/plot-multi.r0000644000176200001440000000006512200313437016464 0ustar liggesuserspar(mfrow = c(2, 2)) plot(1) plot(2) plot(3) plot(4) evaluate/inst/tests/plot-loop.r0000644000176200001440000000004712164221503016304 0ustar liggesusersfor (i in 1:3) { plot(rnorm(100)) } evaluate/inst/tests/parse.r0000644000176200001440000000012412164221503015465 0ustar liggesusersf <- function() { for(i in 1:3){ plot(rnorm(100)) lines(rnorm(100)) } } evaluate/inst/tests/plot-par.r0000644000176200001440000000004512164221503016113 0ustar liggesusersplot(1) par(mar = rep(0, 4)) plot(2) evaluate/inst/tests/test-output.r0000644000176200001440000000024512164221503016674 0ustar liggesuserscontext("Output") test_that("open plot windows maintained", { n <- length(dev.list()) evaluate(file("plot.r")) expect_that(length(dev.list()), equals(n)) }) evaluate/inst/tests/ggplot-loop.r0000644000176200001440000000022112164221503016614 0ustar liggesuserssuppressPackageStartupMessages(library(ggplot2)) for (j in 1:2) { # ggplot2 has been loaded previously print(qplot(rnorm(30), runif(30))) } evaluate/inst/tests/plot-strwidth.r0000644000176200001440000000013512211770642017207 0ustar liggesusersx <- strwidth('foo', 'inches') y <- strheight('foo', 'inches') par(mar = c(4,4,1,1)) plot(1) evaluate/inst/tests/data.r0000644000176200001440000000005112164221503015263 0ustar liggesusersdata(barley, package = "lattice") barley evaluate/inst/tests/plot-persp.r0000644000176200001440000000030612164221503016462 0ustar liggesusersx <- seq(-10, 10, length= 30) y <- x ff <- function(x,y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r } z <- outer(x, y, ff) z[is.na(z)] <- 1 for (i in 1:3) { persp(x, y, z, phi = 30 + i*10, theta = 30) } evaluate/inst/tests/plot-multi-missing.r0000644000176200001440000000005512164221503020133 0ustar liggesuserspar(mfrow = c(2, 2)) plot(1) plot(2) plot(3) evaluate/inst/tests/ggplot.r0000644000176200001440000000011712164221503015651 0ustar liggesuserssuppressPackageStartupMessages(library(ggplot2)) qplot(mpg, wt, data = mtcars) evaluate/inst/tests/example-1.r0000644000176200001440000000042012164221503016143 0ustar liggesusers# These test cases check that interweave # works for a variety of situations a <- 1 # Comment after an expression b <- 2 { a b } # Here is a comment which should be followed # by two new lines { print(a) # comment in a block print(b) } a; b a; b # Comment evaluate/inst/tests/test-parse.r0000644000176200001440000000076112164221503016451 0ustar liggesuserscontext("Parsing") test_that("{ not removed", { f <- function() { for(i in 1:3){ plot(rnorm(100)) lines(rnorm(100)) } } expect_that(nrow(parse_all(f)), equals(1)) }) test_that("double quotes in Chinese characters not destroyed", { loc <- Sys.getlocale("LC_ALL") if (.Platform$OS.type == "windows" && grepl("Chinese (Simplified)_People's Republic of China.936", loc, fixed = TRUE)) { expect_identical(parse_all(c('1+1', '"你好"'))[2, 1], '"你好"') } }) evaluate/tests/0000755000176200001440000000000012142655645013234 5ustar liggesusersevaluate/tests/test-all.R0000644000176200001440000000007611736113424015077 0ustar liggesuserslibrary(testthat) library(evaluate) test_package("evaluate") evaluate/NAMESPACE0000644000176200001440000000112312055465036013302 0ustar liggesusersS3method(parse_all,"function") S3method(parse_all,character) S3method(parse_all,connection) S3method(parse_all,default) S3method(replay,character) S3method(replay,error) S3method(replay,list) S3method(replay,message) S3method(replay,recordedplot) S3method(replay,source) S3method(replay,value) S3method(replay,warning) export(create_traceback) export(evaluate) export(is.error) export(is.message) export(is.recordedplot) export(is.source) export(is.value) export(is.warning) export(new_output_handler) export(parse_all) export(replay) export(set_hooks) export(try_capture_stack) import(stringr) evaluate/NEWS0000644000176200001440000001205312222105463012555 0ustar liggesusersVersion 0.5.1 ------------------------------------------------------------------------------ BUG FIXES * under R 2.15.x, evaluate() was unable to filter out the plots triggered by clip() (thanks, Uwe Ligges) Version 0.5 ------------------------------------------------------------------------------ NEW FEATURES * evaluate() is better at telling if a new plot should render a new page due to the new par('page') in R 3.0.2 BUG FIXES * fixed yihui/knitr#600: when the last expression in the code is a comment, the previous incomplete plot was not captured * the empty plots produced by strwidth(), strheight(), and clip() are no longer recorded MAJOR CHANGES * evaluate() no longer records warnings in case of options(warn = -1); see yihui/knitr#610 * for 'output_handler' in evaluate(), visible values from the 'value' handler will be saved to the output list; this makes it possible for users to save the original values instead of their printed side effects; this change will not affect those who use the default output handlers (#40, thanks, Gabriel Becker) * the 'value' handler in new_output_handler() may take an additional argument that means if the value is visible or not; this makes it possible to save the invisible values as well (#41, thanks, Joroen Ooms) Version 0.4.7 ------------------------------------------------------------------------------ NEW FEATURES * added two arguments keep_warning and keep_message in evaluate() so that it is possible not to capture warnings or messages now BUG FIXES * fixed #25: plots can be correctly recorded under a complex layout now (#25, thanks, Jack Tanner and Andy Barbour) * fixed yihui/knitr#582: evaluate() misclassified some plot changes as "par changes" and removed some plots when it should not; now it is better at identifying plot changes dur to par() (thanks, Keith Twombley) Version 0.4.4 ------------------------------------------------------------------------------ BUG FIXES * Perspective plots from `persp()` are captured now (thanks to Harvey Lime and Yihui Xie) * If an error occurs during printing a visible value, evaluate will halt on a cryptic error "operator is invalid for atomic vectors" (#26, fixed by Yihui Xie) * If the internal connection was accidentally closed by the user, a more informative message will show up (#23) * Now the graphical device will always try to record graphics by default (when new_device = TRUE) (#34) * Some empty and incomplete plots caused by par() or layout() will be filtered out correctly for R 3.0 (#35) MAINTAINENCE * Yihui Xie is the new maintainer of this package now Version 0.4.3 ------------------------------------------------------------------------------ NEW FEATURES * Added `output_handler` argument to `evaluate`. Should be a `output_handler` object, which is a list of functions for handling each type of result, prior to printing of visible return values. This allows clients to override the console-like printing of values, while still processing them in the correct temporal context. The other handlers are necessary to convey the correct ordering of the output. This essentially provides stream-based processing, as an alternative to the existing deferred processing. * New option, `stop_on_error` which controls behaviour when errors occur. The default value, `0`, acts like you've copied and pasted the code into the console, and continues to execute all code. `1` will stop the code execution and return the results of evaluation up to that point, and `2` will raise an error. BUG FIXES * Compound expressions like `x <- 10; x` are now evaluated completely. * Chinese characters on windows now work correctly (thanks to Yihui Xie) * Graphics and output interleaved correctly when generated from a loop or other compound statements * By default, `evaluate` will now open a new graphics device and clean it up afterwards. To suppress that behaviour use `new_device = FALSE` * use `show` to display S4 objects. Version 0.4.2 ------------------------------------------------------------------------------ * replace deprecated `.Internal(eval.with.vis)` with correct `withVisible` * `evaluate` gains `debug` argument Version 0.4.1 ------------------------------------------------------------------------------ * use `test_package` to avoid problems with latest version of `testthat` evaluate 0.4 (2011-11-03) ========================= * Use plot hooks to capture multiple plots created in a loop or within a function. (Contributed by Yihui Xie) evaluate 0.3 ============ * Import `stringr` instead of depending on it. * Test plot recording only in the presence of interactive devices. evaluate 0.2 ============ * try_capture_stack and create_traceback do a much better job of removing infrastructure calls from the captured traceback * visible results are automatically evaluated and their outputs are captured. This is particularly important for lattice and ggplot graphics, which otherwise require special handling. It also correctly captures warnings, errors and messages raised by the print method. evaluate/R/0000755000176200001440000000000012220503247012256 5ustar liggesusersevaluate/R/graphics.r0000644000176200001440000000604712222106016014243 0ustar liggesusers#" 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[grDevices]{recordPlot}}. plot_snapshot <- local({ last_plot <- NULL # help decide whether to keep plots when multiple plots on one screen mfg_init <- NULL mfg_changed <- FALSE function(incomplete = FALSE) { if (is.null(dev.list())) return(NULL) # is page in par()? feature of R 3.0.2 if ("page" %in% getFromNamespace('.Pars', 'graphics')) { if (!incomplete && !par('page')) return(NULL) # current page not complete } else { # a hack for R < 3.0.2 mfg <- par("mfg") if (identical(mfg, rep(1L, 4)) || incomplete) { mfg_init <<- NULL mfg_changed <<- FALSE } else { # now there is a multi-col/row layout if (is.null(mfg_init)) { mfg_init <<- mfg } else { if (identical(mfg_init, mfg)) { if (!mfg_changed) return(NULL) } else { mfg_changed <<- TRUE return(NULL) } } } } plot <- recordPlot() if (is_par_change(last_plot, plot) || identical(last_plot, plot)) { return(NULL) } if (is.empty(plot)) return(NULL) last_plot <<- plot plot } }) is_par_change <- function(p1, p2) { calls1 <- plot_calls(p1) calls2 <- plot_calls(p2) n1 <- length(calls1) n2 <- length(calls2) if (n2 <= n1) return(FALSE) i1 <- seq_len(n1) if (!identical(calls1, calls2[i1])) return(FALSE) # also check if the content of the display list is still the same (note we # need p1[[1]][] as well because [] turns a dotted pair list into a list) if (!identical(p1[[1]][i1], p2[[1]][i1])) return(FALSE) last <- calls2[(n1 + 1):n2] all(last %in% empty_calls) } # R 3.0 has significant changes in display lists isR3 <- getRversion() >= "3.0.0" # if all calls are in these elements, the plot is basically empty empty_calls <- if (isR3) { c("C_par", "C_layout", "palette", "palette2", "C_strWidth", "C_strHeight", "C_clip") } else c("layout", "par", "clip") is.empty <- function(x) { if(is.null(x)) return(TRUE) pc <- plot_calls(x) if (length(pc) == 0) return(TRUE) if (isR3) all(pc %in% empty_calls) else { !identical(pc, "recordGraphics") && !identical(pc, "persp") && !identical(pc, "plot.new") && (length(pc) <= 1L || all(pc %in% empty_calls)) } } plot_calls <- if (isR3) { function(plot) { el <- lapply(plot[[1]], "[[", 2) if (length(el) == 0) return() sapply(el, function(x) { x <- x[[1]] # grid graphics do not have x$name if (is.null(x[["name"]])) deparse(x) else x[["name"]] }) } } else function(plot) { prims <- lapply(plot[[1]], "[[", 1) if (length(prims) == 0) return() chars <- sapply(prims, deparse) str_replace_all(chars, ".Primitive\\(\"|\"\\)", "") } evaluate/R/traceback.r0000644000176200001440000000235012220477051014363 0ustar liggesusers#' Generate a traceback from a list of calls. #' #' @param callstack stack of calls, as generated by (e.g.) #' \code{\link[base]{sys.calls}} #' @keywords internal #' @export create_traceback <- function(callstack) { if (length(callstack) == 0) return() # Convert to text calls <- lapply(callstack, deparse, width = 500) calls <- sapply(calls, str_c, collapse = "\n") # Number and indent calls <- str_c(seq_along(calls), ": ", calls) calls <- str_replace(calls, "\n", "\n ") calls } #' Try, capturing stack on error. #' #' This is a variant of \code{\link{tryCatch}} that also captures the call #' stack if an error occurs. #' #' @param quoted_code code to evaluate, in quoted form #' @param env environment in which to execute code #' @keywords internal #' @export try_capture_stack <- function(quoted_code, env) { capture_calls <- function(e) { # Capture call stack, removing last two calls from end (added by # withCallingHandlers), and first frame + 7 calls from start (added by # tryCatch etc) e$calls <- head(sys.calls()[-seq_len(frame + 7)], -2) signalCondition(e) } frame <- sys.nframe() tryCatch( withCallingHandlers(eval(quoted_code, env), error = capture_calls), error = identity ) } evaluate/R/replay.r0000644000176200001440000000350612220477051013744 0ustar liggesusers#' Replay a list of evaluated results. #' #' Replay a list of evaluated results, as if you'd run them in an R #' terminal. #' #' @param x result from \code{\link{evaluate}} #' @export #' @examples #' samples <- system.file("tests", package = "evaluate") #' replay(evaluate(file(file.path(samples, "order.r")))) #' replay(evaluate(file(file.path(samples, "plot.r")))) #' replay(evaluate(file(file.path(samples, "data.r")))) #' @S3method replay list #' @S3method replay character #' @S3method replay source #' @S3method replay warning #' @S3method replay message #' @S3method replay error #' @S3method replay value #' @S3method replay recordedplot replay <- function(x) UseMethod("replay", x) replay.list <- function(x) { invisible(lapply(x, replay)) } replay.character <- function(x) { cat(x) } replay.source <- function(x) { cat(line_prompt(x$src)) } replay.warning <- function(x) { message("Warning message:\n", x$message) } replay.message <- function(x) { message(str_replace(x$message, "\n$", "")) } replay.error <- function(x) { if (is.null(x$call)) { message("Error: ", x$message) } else { call <- deparse(x$call) message("Error in ", call, ": ", x$message) } } replay.value <- function(x) { if (x$visible) print(x$value) } replay.recordedplot <- function(x) { print(x) } #' Line prompt. #' #' Format a single expression as if it had been entered at the command prompt. #' #' @param x string representing a single expression #' @param prompt prompt for first line #' @param continue prompt for subsequent lines #' @return a string line_prompt <- function(x, prompt = getOption("prompt"), continue = getOption("continue")) { lines <- strsplit(x, "\n")[[1]] n <- length(lines) lines[1] <- str_c(prompt, lines[1]) if (n > 1) lines[2:n] <- str_c(continue, lines[2:n]) str_c(lines, "\n", collapse = "") } evaluate/R/eval.r0000644000176200001440000001350212220503247013371 0ustar liggesusers#' Evaluate input and return all details of evaluation. #' #' Compare to \code{\link{eval}}, \code{evaluate} captures all of the #' information necessary to recreate the output as if you had copied and #' pasted the code into a R terminal. It captures messages, warnings, errors #' and output, all correctly interleaved in the order in which they occured. #' It stores the final result, whether or not it should be visible, and the #' contents of the current graphics device. #' #' @export #' @param input input object to be parsed an evaluated. Maybe a string, #' file connection or function. #' @param envir environment in which to evaluate expressions #' @param enclos when \code{envir} is a list or data frame, this is treated #' as the parent environment to \code{envir}. #' @param debug if \code{TRUE}, displays information useful for debugging, #' including all output that evaluate captures #' @param stop_on_error if \code{2}, evaluation will stop on first error and you #' will get no results back. If \code{1}, evaluation will stop on first error, #' but you will get back all results up to that point. If \code{0} will #' continue running all code, just as if you'd pasted the code into the #' command line. #' @param keep_warning,keep_message whether to record warnings and messages #' @param new_device if \code{TRUE}, will open a new graphics device and #' automatically close it after completion. This prevents evaluation from #' interfering with your existing graphics environment. #' @param output_handler an instance of \code{\link{output_handler}} #' that processes the output from the evaluation. The default simply #' prints the visible return values. #' @import stringr evaluate <- function(input, envir = parent.frame(), enclos = NULL, debug = FALSE, stop_on_error = 0L, keep_warning = TRUE, keep_message = TRUE, new_device = TRUE, output_handler = default_output_handler) { parsed <- parse_all(input) stop_on_error <- as.integer(stop_on_error) stopifnot(length(stop_on_error) == 1) if (is.null(enclos)) { enclos <- if (is.list(envir) || is.pairlist(envir)) parent.frame() else baseenv() } if (new_device) { # Start new graphics device and clean up afterwards dev.new() dev.control(displaylist = "enable") dev <- dev.cur() on.exit(dev.off(dev)) } out <- vector("list", nrow(parsed)) for (i in seq_along(out)) { expr <- parsed$expr[[i]] if (!is.null(expr)) expr <- as.expression(expr) out[[i]] <- evaluate_call( expr, parsed$src[[i]], envir = envir, enclos = enclos, debug = debug, last = i == length(out), use_try = stop_on_error != 2L, keep_warning = keep_warning, keep_message = keep_message, output_handler = output_handler) if (stop_on_error > 0L) { errs <- vapply(out[[i]], is.error, logical(1)) if (!any(errs)) next if (stop_on_error == 1L) break } } unlist(out, recursive = FALSE, use.names = FALSE) } evaluate_call <- function(call, src = NULL, envir = parent.frame(), enclos = NULL, debug = FALSE, last = FALSE, use_try = FALSE, keep_warning = TRUE, keep_message = TRUE, output_handler = new_output_handler()) { if (debug) message(src) if (is.null(call) && !last) { return(list(new_source(src))) } stopifnot(is.call(call) || is.language(call) || is.atomic(call)) # Capture output w <- watchout(debug) on.exit(w$close()) source <- new_source(src) output_handler$source(source) output <- list(source) handle_output <- function(plot = FALSE, incomplete_plots = FALSE) { out <- w$get_new(plot, incomplete_plots) if (!is.null(out$text)) output_handler$text(out$text) if (!is.null(out$graphics)) output_handler$graphics(out$graphics) output <<- c(output, out) } # Hooks to capture plot creation capture_plot <- function() { handle_output(TRUE) } old_hooks <- set_hooks(list( persp = capture_plot, before.plot.new = capture_plot, before.grid.newpage = capture_plot)) on.exit(set_hooks(old_hooks, "replace"), add = TRUE) handle_condition <- function(cond) { handle_output() output <<- c(output, list(cond)) } # Handlers for warnings, errors and messages wHandler <- if (keep_warning) function(wn) { if (getOption("warn") >= 0) { handle_condition(wn) output_handler$warning(wn) } invokeRestart("muffleWarning") } else identity eHandler <- if (use_try) function(e) { handle_condition(e) output_handler$error(e) } else identity mHandler <- if (keep_message) function(m) { handle_condition(m) output_handler$message(m) invokeRestart("muffleMessage") } else identity ev <- list(value = NULL, visible = FALSE) if (use_try) { handle <- function(f) try(f, silent = TRUE) } else { handle <- force } if (!is.null(call)) { handle(ev <- withCallingHandlers( withVisible(eval(call, envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)) handle_output(TRUE) } value_handler <- output_handler$value multi_args <- length(formals(value_handler)) > 1 # If visible or the value handler has multi args, process and capture output if (ev$visible || multi_args) { pv <- list(value = NULL, visible = FALSE) value_fun <- if (multi_args) value_handler else { function(x, visible) value_handler(x) } handle(pv <- withCallingHandlers(withVisible(value_fun(ev$value, ev$visible)), warning = wHandler, error = eHandler, message = mHandler)) handle_output(TRUE) # If the return value is visible, save the value to the output if (pv$visible) output <- c(output, list(pv$value)) } # Always capture last plot, even if incomplete if (last) { handle_output(TRUE, TRUE) } output } evaluate/R/hooks.r0000644000176200001440000000146012220477051013570 0ustar liggesusers#' Set hooks. #' #' This wraps the base \code{\link{setHook}} function to provide a return #' value that makes it easy to undo. #' #' @param hooks a named list of hooks - each hook can either be a function or #' a list of functions. #' @param action \code{"replace"}, \code{"append"} or \code{"prepend"} #' @keywords internal #' @export #' @examples #' new <- list(before.plot.new = function() print("Plotted!")) #' hooks <- set_hooks(new) #' plot(1) #' set_hooks(hooks, "replace") #' plot(1) set_hooks <- function(hooks, action = "append") { stopifnot(is.list(hooks)) stopifnot(!is.null(names(hooks)) && all(names(hooks) != "")) old <- list() for (hook_name in names(hooks)) { old[[hook_name]] <- getHook(hook_name) setHook(hook_name, hooks[[hook_name]], action = action) } invisible(old) } evaluate/R/watcher.r0000644000176200001440000000232012220477051014076 0ustar liggesusers#' Watch for changes in output, text and graphical. #' #' @param debug activate debug mode where output will be both printed to #' screen and captured. #' @return list containing four functions: \code{get_new}, \code{pause}, #' \code{unpause}, \code{close}. watchout <- function(debug = FALSE) { output <- vector("character") prev <- vector("character") con <- textConnection("output", "wr", local=TRUE) sink(con, split = debug) list( get_new = function(plot = FALSE, incomplete_plots = FALSE) { incomplete <- isIncomplete(con) if (incomplete) cat("\n") out <- list() if (plot) { out$graphics <- plot_snapshot(incomplete_plots) } if (length(output) != length(prev)) { new <- output[setdiff(seq_along(output), seq_along(prev))] prev <<- output out$text <- str_c(new, collapse = "\n") if (!incomplete) out$text <- str_c(out$text, "\n") } unname(out) }, pause = function() sink(), unpause = function() sink(con, split = debug), close = function() { if (!isOpen(con)) stop("something bad happened... did you use closeAllConnections()?") sink() close(con) output } ) } evaluate/R/output.r0000644000176200001440000000666112220503247014012 0ustar liggesusers#' Object class tests #' @export is.message is.warning is.error is.value is.source is.recordedplot #' @aliases is.message is.warning is.error is.value is.source is.recordedplot #' @keywords internal #' @rdname is.message is.message <- function(x) inherits(x, "message") #' @rdname is.message is.warning <- function(x) inherits(x, "warning") #' @rdname is.message is.error <- function(x) inherits(x, "error") #' @rdname is.message is.value <- function(x) inherits(x, "value") #' @rdname is.message is.source <- function(x) inherits(x, "source") #' @rdname is.message is.recordedplot <- function(x) inherits(x, "recordedplot") new_value <- function(value, visible = TRUE) { structure(list(value = value, visible = visible), class = "value") } new_source <- function(src) { structure(list(src = src), class = "source") } classes <- function(x) vapply(x, function(x) class(x)[1], character(1)) render <- function(x) if (isS4(x)) show(x) else print(x) #' Custom output handlers. #' #' An \code{output_handler} handles the results of \code{\link{evaluate}}, #' including the values, graphics, conditions. Each type of output is handled by #' a particular function in the handler object. #' #' The handler functions should accept an output object as their first argument. #' The return value of the handlers is ignored, except in the case of the #' \code{value} handler, where a visible return value is saved in the output #' list. #' #' Calling the constructor with no arguments results in the default handler, #' which mimics the behavior of the console by printing visible values. #' #' Note that recursion is common: for example, if \code{value} does any #' printing, then the \code{text} or \code{graphics} handlers may be called. #' #' @param source Function to handle the echoed source code under evaluation. #' @param text Function to handle any textual console output. #' @param graphics Function to handle graphics, as returned by #' \code{\link{recordPlot}}. #' @param message Function to handle \code{\link{message}} output. #' @param warning Function to handle \code{\link{warning}} output. #' @param error Function to handle \code{\link{stop}} output. #' @param value Function to handle the values returned from evaluation. If it #' only has one argument, only visible values are handled; if it has more #' arguments, the second argument indicates whether the value is visible. #' @return A new \code{output_handler} object #' @aliases output_handler #' @export new_output_handler <- function(source = identity, text = identity, graphics = identity, message = identity, warning = identity, error = identity, value = render) { source <- match.fun(source) stopifnot(length(formals(source)) >= 1) text <- match.fun(text) stopifnot(length(formals(text)) >= 1) graphics <- match.fun(graphics) stopifnot(length(formals(graphics)) >= 1) message <- match.fun(message) stopifnot(length(formals(message)) >= 1) warning <- match.fun(warning) stopifnot(length(formals(warning)) >= 1) error <- match.fun(error) stopifnot(length(formals(error)) >= 1) value <- match.fun(value) stopifnot(length(formals(value)) >= 1) structure(list(source = source, text = text, graphics = graphics, message = message, warning = warning, error = error, value = value), class = "output_handler") } default_output_handler <- new_output_handler() evaluate/R/parse.r0000644000176200001440000000750412220477051013564 0ustar liggesusers#' Parse, retaining comments. #' #' Works very similarly to parse, but also keeps original formatting and #' comments. #' #' @param x object to parse. Can be a string, a file connection, or a #' function #' @return a data.frame with columns \code{src}, the source code, and #' \code{eval} #' @export #' @S3method parse_all character #' @S3method parse_all "function" #' @S3method parse_all connection #' @S3method parse_all default parse_all <- function(x) UseMethod("parse_all") parse_all.character <- function(x) { x <- unlist(str_split(x, "\n"), recursive = FALSE, use.names = FALSE) src <- srcfilecopy("", x) expr <- parse(text = x, srcfile = src) # No code, all comments if (length(expr) == 0) { n <- length(x) return(data.frame( x1 = seq_along(x), x2 = seq_along(x), y1 = rep(0, n), y2 = nchar(x), src = x, text = rep(TRUE, n), expr = I(rep(list(NULL), n)), visible = rep(FALSE, n), stringsAsFactors = FALSE )) } srcref <- attr(expr, "srcref") srcfile <- attr(srcref[[1]], "srcfile") # Create data frame containing each expression and its # location in the original source src <- sapply(srcref, function(src) str_c(as.character(src), collapse="\n")) pos <- t(sapply(srcref, unclass))[, 1:4, drop = FALSE] colnames(pos) <- c("x1", "y1", "x2", "y2") pos <- as.data.frame(pos)[c("x1","y1","x2","y2")] parsed <- data.frame( pos, src=src, expr=I(as.list(expr)), text = FALSE, stringsAsFactors = FALSE ) # Extract unparsed text ---------------------------------------------------- # Unparsed text includes: # * text before first expression # * text between expressions # * text after last expression # # Unparsed text does not contain any expressions, so can # be split into individual lines get_region <- function(x1, y1, x2, y2) { string <- getSrcRegion(srcfile, x1, x2, y1, y2) lines <- strsplit(string, "(?<=\n)", perl=TRUE)[[1]] n <- length(lines) if (n == 0) { lines <- "" n <- 1 } data.frame( x1 = x1 + seq_len(n) - 1, y1 = c(y1, rep(1, n - 1)), x2 = x1 + seq_len(n), y2 = rep(1, n), src = lines, expr = I(rep(list(NULL), n)), stringsAsFactors=FALSE ) } breaks <- data.frame( x1 = c(1, parsed[, "x2"]), y1 = c(1, parsed[, "y2"] + 1), x2 = c(parsed[1, "x1"], parsed[-1, "x1"], Inf), y2 = c(parsed[, "y1"], Inf) ) unparsed <- do.call("rbind", apply(breaks, 1, function(row) do.call("get_region", as.list(row))) ) unparsed <- subset(unparsed, src != "") if (nrow(unparsed) > 0) { unparsed$text <- TRUE all <- rbind(parsed, unparsed) } else { all <- parsed } all <- all[do.call("order", all[,c("x1","y1", "x2","y2")]), ] all$eol <- FALSE all$eol[grep("\n$", all$src)] <- TRUE # Join lines --------------------------------------------------------------- # Expressions need to be combined to create a complete line # Some expressions already span multiple lines, and these should be # left alone join_pieces <- function(df) { clean_expr <- Filter(Negate(is.null), as.list(df$expr)) if (length(clean_expr) == 0) { clean_expr <- list(NULL) } else { clean_expr <- list(clean_expr) } with(df, data.frame( src = str_c(src, collapse = ""), expr = I(clean_expr), stringsAsFactors = FALSE )) } block <- c(0, cumsum(all$eol)[-nrow(all)]) lines <- split(all, block) do.call("rbind", lapply(lines, join_pieces)) } parse_all.connection <- function(x) { if (!isOpen(x, "r")) { open(x, "r") on.exit(close(x)) } text <- readLines(x) parse_all(text) } parse_all.function <- function(x) { src <- attr(x, "source") # Remove first, function() {, and last lines, } n <- length(src) parse_all(src[-c(1, n)]) } parse_all.default <- function(x) { parse_all(deparse(x)) } evaluate/R/src-region.r0000644000176200001440000000111412220477051014511 0ustar liggesusers#' Extract a rectangular region of a srcfile #' #' @param srcfile string #' @param x1 start line #' @param x2 end line #' @param y1 start col #' @param y2 end col #' @return a string getSrcRegion <- function(srcfile, x1, x2, y1, y2) { if (is.infinite(x2)) x2 <- 1e6 if (is.infinite(y2)) y2 <- 1e6 lines <- getSrcLines(srcfile, x1, x2) text <- if (length(lines) == 1) { str_sub(lines[1], y1, y2 - 1) } else { c( str_sub(lines[1], y1, 1e6), lines[-c(1, length(lines))], str_sub(lines[length(lines)], 0, y2 - 1) ) } str_c(text, collapse="\n") } evaluate/MD50000644000176200001440000000565212222360554012401 0ustar liggesusers365c46f626f9a322fc539585c3612896 *DESCRIPTION b089c0a6e9685038a9590b2f3a42957a *NAMESPACE 9698f0112ea749cbada842a72de797a1 *NEWS db4fbe66d1d112a55da6f472ff8ee5b2 *R/eval.r 7efecddcb9acb49cc7849549a9e91b61 *R/graphics.r 92ff4620dde1944914335f47d5d71b1f *R/hooks.r e8e15e7f645a48f4c517f38f42c0d6d1 *R/output.r 43d5efa8e2530772fa8d3d93a16d4a56 *R/parse.r 0821f3076a126b14b5ec9ea18524597f *R/replay.r 1f18fee05e024575d6ff1b147739cf23 *R/src-region.r 97f0d9e1b50256566a00cc6041282e35 *R/traceback.r 49179fa81d61aef613e93a49cb626ccf *R/watcher.r 446d67f5fc9a97626f757fae3fefcee7 *inst/tests/comment.r 94750480cbfd8455ba433ab42828023e *inst/tests/data.r 38a0bd49c764aefce15f4844036ccf02 *inst/tests/error-complex.r fea574ba53709e7b38a294d855011323 *inst/tests/error.r 24e9ae27434864fdef5901807e66ea98 *inst/tests/example-1.r 19234a68f3630d7690a8232714fa5d04 *inst/tests/ggplot-loop.r 9792e29336dfe5fe654b91a231d4bd1e *inst/tests/ggplot.r ca3241b977d18d52ff5664cf9c228db2 *inst/tests/interleave-1.r c2a3b01bdd0873e435d9f376c9112ed3 *inst/tests/interleave-2.r c887105bd174693b5ab37f3c1e92ec10 *inst/tests/order.r cfaf5bebb5ba464bc95d311ee37fb0ee *inst/tests/parse.r ea5f897a7a8a861dffbfb4a97f4ba666 *inst/tests/plot-additions.r 9cf8a8768e36e0e4b9f33c7dae3e2a29 *inst/tests/plot-clip.r 2c1349feb6b38c8521a1bc8e8c046012 *inst/tests/plot-last-comment.r 396ff3413370398b3be86fa9a27ae235 *inst/tests/plot-loop.r d848b820afa7870196da03b30e14678a *inst/tests/plot-multi-layout.r 88f9535f005b899f7f52c7f91cc4a0f8 *inst/tests/plot-multi-layout2.r 2f5434a4a5a4a9fa0164c21ee9ec52f4 *inst/tests/plot-multi-missing.r 4b9fd50ee21d4f3da6332ffed48746cb *inst/tests/plot-multi.r b4952448dc702d1ce95cb57b8d2660f5 *inst/tests/plot-new.r 6013de5aae712457dedf5a949395a7b4 *inst/tests/plot-par.r c0f8dc8e852767d2d020b2bfb54bd856 *inst/tests/plot-par2.r 69410ac0ba507aa703d3f16802e27b89 *inst/tests/plot-persp.r 43c3eebe13c4fc96e7f3b08844babe89 *inst/tests/plot-strwidth.r 4cbfd1ffe04ab0562a2514f22a2e049d *inst/tests/plot.r 7df061829daeba528956cfd392bac1e7 *inst/tests/raw-output.r 8f7ec82910b852ddff26db703fa1881b *inst/tests/test-errors.r 5e3806656b8a3d4fb0bf5fd34c71b34f *inst/tests/test-evaluate.r 47387818255f470461d4923a08b711b0 *inst/tests/test-graphics.r f0dfe4d4709355498c1d03d06a149a7a *inst/tests/test-output.r cd8df2f4b726150b47a3b9c9d31f946d *inst/tests/test-parse.r e4c7eea5cb30720c8a3730e9ba56e9c3 *man/create_traceback.Rd 86b6af39b850d1a7578ecbda41285e16 *man/evaluate.Rd 99ef05350751084503d7388efb294860 *man/getSrcRegion.Rd 2500f383c00c22581b213cce5e60f94b *man/is.message.Rd deb609815e87e0e2400f0d4f15c506a9 *man/line_prompt.Rd 99d231e6feb42e9b89c398cf322154e7 *man/new_output_handler.Rd 40bf0b45b0a543a7647f453d0ad6f494 *man/parse_all.Rd 464b99a3c6a34c8ae58d919a36da0a3f *man/replay.Rd 3f535eb296e05a900d39497c0b1f3775 *man/set_hooks.Rd 9da72d52dbe4a2a6da857704c35dab13 *man/try_capture_stack.Rd ddb201de0f474b6eec22d00ddf0f50cf *man/watchout.Rd e894059a96d5dfc09bbaf3a527123390 *tests/test-all.R evaluate/DESCRIPTION0000644000176200001440000000157312222360554013575 0ustar liggesusersPackage: evaluate Type: Package Title: Parsing and evaluation tools that provide more details than the default. Version: 0.5.1 Date: 2013-09-30 Authors@R: c(person("Hadley", "Wickham", role = "aut"), person("Yihui", "Xie", role = c("cre", "ctb"), email = "xie@yihui.name"), person("Barret", "Schloerke", role = "ctb")) Description: Parsing and evaluation tools that make it easy to recreate the command line behaviour of R. License: GPL Depends: R (>= 2.14.0) Imports: stringr (>= 0.4) Suggests: testthat, ggplot2 Collate: 'eval.r' 'hooks.r' 'graphics.r' 'output.r' 'parse.r' 'replay.r' 'src-region.r' 'traceback.r' 'watcher.r' Packaged: 2013-09-30 20:22:45 UTC; yihui Author: Hadley Wickham [aut], Yihui Xie [cre, ctb], Barret Schloerke [ctb] Maintainer: Yihui Xie NeedsCompilation: no Repository: CRAN Date/Publication: 2013-09-30 22:39:08 evaluate/man/0000755000176200001440000000000012220503247012630 5ustar liggesusersevaluate/man/line_prompt.Rd0000644000176200001440000000064412222356625015463 0ustar liggesusers\name{line_prompt} \alias{line_prompt} \title{Line prompt.} \usage{ line_prompt(x, prompt = getOption("prompt"), continue = getOption("continue")) } \arguments{ \item{x}{string representing a single expression} \item{prompt}{prompt for first line} \item{continue}{prompt for subsequent lines} } \value{ a string } \description{ Format a single expression as if it had been entered at the command prompt. } evaluate/man/create_traceback.Rd0000644000176200001440000000050312222356624016366 0ustar liggesusers\name{create_traceback} \alias{create_traceback} \title{Generate a traceback from a list of calls.} \usage{ create_traceback(callstack) } \arguments{ \item{callstack}{stack of calls, as generated by (e.g.) \code{\link[base]{sys.calls}}} } \description{ Generate a traceback from a list of calls. } \keyword{internal} evaluate/man/evaluate.Rd0000644000176200001440000000363112222356625014740 0ustar liggesusers\name{evaluate} \alias{evaluate} \title{Evaluate input and return all details of evaluation.} \usage{ evaluate(input, envir = parent.frame(), enclos = NULL, debug = FALSE, stop_on_error = 0L, keep_warning = TRUE, keep_message = TRUE, new_device = TRUE, output_handler = default_output_handler) } \arguments{ \item{input}{input object to be parsed an evaluated. Maybe a string, file connection or function.} \item{envir}{environment in which to evaluate expressions} \item{enclos}{when \code{envir} is a list or data frame, this is treated as the parent environment to \code{envir}.} \item{debug}{if \code{TRUE}, displays information useful for debugging, including all output that evaluate captures} \item{stop_on_error}{if \code{2}, evaluation will stop on first error and you will get no results back. If \code{1}, evaluation will stop on first error, but you will get back all results up to that point. If \code{0} will continue running all code, just as if you'd pasted the code into the command line.} \item{keep_warning,keep_message}{whether to record warnings and messages} \item{new_device}{if \code{TRUE}, will open a new graphics device and automatically close it after completion. This prevents evaluation from interfering with your existing graphics environment.} \item{output_handler}{an instance of \code{\link{output_handler}} that processes the output from the evaluation. The default simply prints the visible return values.} } \description{ Compare to \code{\link{eval}}, \code{evaluate} captures all of the information necessary to recreate the output as if you had copied and pasted the code into a R terminal. It captures messages, warnings, errors and output, all correctly interleaved in the order in which they occured. It stores the final result, whether or not it should be visible, and the contents of the current graphics device. } evaluate/man/replay.Rd0000644000176200001440000000073412222356625014427 0ustar liggesusers\name{replay} \alias{replay} \title{Replay a list of evaluated results.} \usage{ replay(x) } \arguments{ \item{x}{result from \code{\link{evaluate}}} } \description{ Replay a list of evaluated results, as if you'd run them in an R terminal. } \examples{ samples <- system.file("tests", package = "evaluate") replay(evaluate(file(file.path(samples, "order.r")))) replay(evaluate(file(file.path(samples, "plot.r")))) replay(evaluate(file(file.path(samples, "data.r")))) } evaluate/man/getSrcRegion.Rd0000644000176200001440000000054112222356625015522 0ustar liggesusers\name{getSrcRegion} \alias{getSrcRegion} \title{Extract a rectangular region of a srcfile} \usage{ getSrcRegion(srcfile, x1, x2, y1, y2) } \arguments{ \item{srcfile}{string} \item{x1}{start line} \item{x2}{end line} \item{y1}{start col} \item{y2}{end col} } \value{ a string } \description{ Extract a rectangular region of a srcfile } evaluate/man/parse_all.Rd0000644000176200001440000000056612222356625015100 0ustar liggesusers\name{parse_all} \alias{parse_all} \title{Parse, retaining comments.} \usage{ parse_all(x) } \arguments{ \item{x}{object to parse. Can be a string, a file connection, or a function} } \value{ a data.frame with columns \code{src}, the source code, and \code{eval} } \description{ Works very similarly to parse, but also keeps original formatting and comments. } evaluate/man/set_hooks.Rd0000644000176200001440000000107612222356625015131 0ustar liggesusers\name{set_hooks} \alias{set_hooks} \title{Set hooks.} \usage{ set_hooks(hooks, action = "append") } \arguments{ \item{hooks}{a named list of hooks - each hook can either be a function or a list of functions.} \item{action}{\code{"replace"}, \code{"append"} or \code{"prepend"}} } \description{ This wraps the base \code{\link{setHook}} function to provide a return value that makes it easy to undo. } \examples{ new <- list(before.plot.new = function() print("Plotted!")) hooks <- set_hooks(new) plot(1) set_hooks(hooks, "replace") plot(1) } \keyword{internal} evaluate/man/try_capture_stack.Rd0000644000176200001440000000061212222356625016654 0ustar liggesusers\name{try_capture_stack} \alias{try_capture_stack} \title{Try, capturing stack on error.} \usage{ try_capture_stack(quoted_code, env) } \arguments{ \item{quoted_code}{code to evaluate, in quoted form} \item{env}{environment in which to execute code} } \description{ This is a variant of \code{\link{tryCatch}} that also captures the call stack if an error occurs. } \keyword{internal} evaluate/man/watchout.Rd0000644000176200001440000000062712222356625014772 0ustar liggesusers\name{watchout} \alias{watchout} \title{Watch for changes in output, text and graphical.} \usage{ watchout(debug = FALSE) } \arguments{ \item{debug}{activate debug mode where output will be both printed to screen and captured.} } \value{ list containing four functions: \code{get_new}, \code{pause}, \code{unpause}, \code{close}. } \description{ Watch for changes in output, text and graphical. } evaluate/man/new_output_handler.Rd0000644000176200001440000000335212222356625017040 0ustar liggesusers\name{new_output_handler} \alias{new_output_handler} \alias{output_handler} \title{Custom output handlers.} \usage{ new_output_handler(source = identity, text = identity, graphics = identity, message = identity, warning = identity, error = identity, value = render) } \arguments{ \item{source}{Function to handle the echoed source code under evaluation.} \item{text}{Function to handle any textual console output.} \item{graphics}{Function to handle graphics, as returned by \code{\link{recordPlot}}.} \item{message}{Function to handle \code{\link{message}} output.} \item{warning}{Function to handle \code{\link{warning}} output.} \item{error}{Function to handle \code{\link{stop}} output.} \item{value}{Function to handle the values returned from evaluation. If it only has one argument, only visible values are handled; if it has more arguments, the second argument indicates whether the value is visible.} } \value{ A new \code{output_handler} object } \description{ An \code{output_handler} handles the results of \code{\link{evaluate}}, including the values, graphics, conditions. Each type of output is handled by a particular function in the handler object. } \details{ The handler functions should accept an output object as their first argument. The return value of the handlers is ignored, except in the case of the \code{value} handler, where a visible return value is saved in the output list. Calling the constructor with no arguments results in the default handler, which mimics the behavior of the console by printing visible values. Note that recursion is common: for example, if \code{value} does any printing, then the \code{text} or \code{graphics} handlers may be called. } evaluate/man/is.message.Rd0000644000176200001440000000047212222356625015170 0ustar liggesusers\name{is.message} \alias{is.error} \alias{is.message} \alias{is.recordedplot} \alias{is.source} \alias{is.value} \alias{is.warning} \title{Object class tests} \usage{ is.message(x) is.warning(x) is.error(x) is.value(x) is.source(x) is.recordedplot(x) } \description{ Object class tests } \keyword{internal}