evaluate/0000755000176000001440000000000012330003277012105 5ustar ripleyusersevaluate/tests/0000755000176000001440000000000012327375203013256 5ustar ripleyusersevaluate/tests/testthat/0000755000176000001440000000000012327377643015130 5ustar ripleyusersevaluate/tests/testthat/test-graphics.r0000644000176000001440000001004712316673446020070 0ustar ripleyuserscontext("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)))) }) # 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("no plot windows open", { # graphics.off() # expect_that(length(dev.list()), equals(0)) # evaluate(file("plot.r")) # expect_that(length(dev.list()), equals(0)) # }) test_that("by default, evaluate() always records plots regardless of the device", { op <- options(device = pdf) on.exit(options(op)) ev <- evaluate("plot(1)") expect_that(length(ev), equals(2)) }) test_that("Rplots.pdf files are not created", { op <- options(device = pdf) on.exit(options(op)) evaluate(file("plot.r")) expect_false(file.exists("Rplots.pdf")) }) evaluate/tests/testthat/plot-multi-layout.r0000644000176000001440000000022312235534635020723 0ustar ripleyusersfor (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/tests/testthat/interleave-2.r0000644000176000001440000000004512235534634017600 0ustar ripleyusersfor(i in 1:2) { plot(i) cat(i) } evaluate/tests/testthat/test-evaluate.r0000644000176000001440000000512612316673446020100 0ustar ripleyuserscontext("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", where = environment()) 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", where = environment()) 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")) }) 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")) }) test_that("multiple expressions on one line can get printed as expected", { ev <- evaluate("x <- 1; y <- 2; x; y") expect_equal(classes(ev), c("source", "character", "character")) }) test_that("multiple lines of comments do not lose the terminating \\n", { ev <- evaluate("# foo\n#bar") expect_equal(ev[[1]][["src"]], "# foo\n") }) evaluate/tests/testthat/test-errors.r0000644000176000001440000000171312235534635017600 0ustar ripleyuserscontext("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/tests/testthat/plot-new.r0000644000176000001440000000006712235534635017055 0ustar ripleyusersplot.new() plot(1:10) plot.new() plot(1:10) plot.new() evaluate/tests/testthat/plot.r0000644000176000001440000000001312235534635016255 0ustar ripleyusersplot(1:10) evaluate/tests/testthat/interleave-1.r0000644000176000001440000000004512235534636017601 0ustar ripleyusersfor(i in 1:2) { cat(i) plot(i) } evaluate/tests/testthat/error-complex.r0000644000176000001440000000011312235534636020077 0ustar ripleyusersf <- function() g() g <- function() h() h <- function() stop("Error") f() evaluate/tests/testthat/plot-additions.r0000644000176000001440000000002712235534636020237 0ustar ripleyusersplot(1:10) lines(1:10) evaluate/tests/testthat/plot-clip.r0000644000176000001440000000013412235534636017207 0ustar ripleyusersplot(rnorm(100), rnorm(100)) clip(-1, 1, -1, 1) points(rnorm(100), rnorm(100), col = 'red') evaluate/tests/testthat/plot-par2.r0000644000176000001440000000032012235534636017121 0ustar ripleyusersbarplot(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/tests/testthat/comment.r0000644000176000001440000000011712235534636016747 0ustar ripleyusers# This test case contains no executable code # but it shouldn't throw an error evaluate/tests/testthat/plot-last-comment.r0000644000176000001440000000007612235534636020670 0ustar ripleyuserspar(mfrow = c(3, 3)) for(i in 1:7) image(volcano) # comment evaluate/tests/testthat/plot-multi-layout2.r0000644000176000001440000000031212235534635021004 0ustar ripleyuserslayout(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/tests/testthat/error.r0000644000176000001440000000001412235534635016431 0ustar ripleyusersstop("1") 2 evaluate/tests/testthat/raw-output.r0000644000176000001440000000016212235534635017433 0ustar ripleyusersrnorm(10) x <- list("I'm a list!") suppressPackageStartupMessages(library(ggplot2)) qplot(mpg, wt, data = mtcars) evaluate/tests/testthat/order.r0000644000176000001440000000026212235534635016420 0ustar ripleyuserscat("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/tests/testthat/plot-multi.r0000644000176000001440000000006512235534635017414 0ustar ripleyuserspar(mfrow = c(2, 2)) plot(1) plot(2) plot(3) plot(4) evaluate/tests/testthat/plot-loop.r0000644000176000001440000000004712235534635017233 0ustar ripleyusersfor (i in 1:3) { plot(rnorm(100)) } evaluate/tests/testthat/parse.r0000644000176000001440000000012412235534636016415 0ustar ripleyusersf <- function() { for(i in 1:3){ plot(rnorm(100)) lines(rnorm(100)) } } evaluate/tests/testthat/plot-par.r0000644000176000001440000000004512235534634017041 0ustar ripleyusersplot(1) par(mar = rep(0, 4)) plot(2) evaluate/tests/testthat/test-output.r0000644000176000001440000000024512235534635017623 0ustar ripleyuserscontext("Output") test_that("open plot windows maintained", { n <- length(dev.list()) evaluate(file("plot.r")) expect_that(length(dev.list()), equals(n)) }) evaluate/tests/testthat/test-output-handler.R0000644000176000001440000000074112316662535021200 0ustar ripleyuserscontext("Output handlers") test_that("text output handler is called with text", { text <- NULL oh <- new_output_handler(text = function(o) text <<- o) evaluate("print('abc')", output_handler = oh) expect_equal(text, "[1] \"abc\"\n") }) test_that("graphic output handler not called with no graphics", { graphics <- NULL oh <- new_output_handler(graphics = function(o) graphics <<- 1) evaluate("print('abc')", output_handler = oh) expect_equal(graphics, NULL) }) evaluate/tests/testthat/ggplot-loop.r0000644000176000001440000000022112235534635017543 0ustar ripleyuserssuppressPackageStartupMessages(library(ggplot2)) for (j in 1:2) { # ggplot2 has been loaded previously print(qplot(rnorm(30), runif(30))) } evaluate/tests/testthat/plot-strwidth.r0000644000176000001440000000013512235534635020130 0ustar ripleyusersx <- strwidth('foo', 'inches') y <- strheight('foo', 'inches') par(mar = c(4,4,1,1)) plot(1) evaluate/tests/testthat/data.r0000644000176000001440000000005112235534635016212 0ustar ripleyusersdata(barley, package = "lattice") barley evaluate/tests/testthat/plot-persp.r0000644000176000001440000000030612235534636017412 0ustar ripleyusersx <- 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/tests/testthat/plot-multi-missing.r0000644000176000001440000000005512235534636021063 0ustar ripleyuserspar(mfrow = c(2, 2)) plot(1) plot(2) plot(3) evaluate/tests/testthat/ggplot.r0000644000176000001440000000011712235534635016600 0ustar ripleyuserssuppressPackageStartupMessages(library(ggplot2)) qplot(mpg, wt, data = mtcars) evaluate/tests/testthat/example-1.r0000644000176000001440000000042012235534635017072 0ustar ripleyusers# 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/tests/testthat/test-parse.r0000644000176000001440000000076112235534636017401 0ustar ripleyuserscontext("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/test-all.R0000644000176000001440000000007412315454541015127 0ustar ripleyuserslibrary(testthat) library(evaluate) test_check("evaluate") evaluate/NAMESPACE0000644000176000001440000000112312316667625013342 0ustar ripleyusersS3method(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/NEWS0000644000176000001440000001335412316673531012624 0ustar ripleyusersVersion 0.5.5 ------------------------------------------------------------------------------ * Actually use the `text` and `graphics` in `new_output_handler` * Multiple expressions separated by `;` on the same line can be printed as expected when the result returned is visible, e.g. both `x` and `y` will be printed when the source code is `x; y`. In previous versions, only `y` is printed. (thanks, Bill Venables) Version 0.5.3 ------------------------------------------------------------------------------ BUG FIXES * fixed the bug reported at https://github.com/yihui/knitr/issues/722 (repeatedly knitting the same code results in plots being omitted randomly) (thanks, Simon Urbanek) Version 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/0000755000176000001440000000000012327374773012330 5ustar ripleyusersevaluate/R/graphics.r0000644000176000001440000000604712315445474014314 0ustar ripleyusers#" 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 (identical(last_plot, plot) || is_par_change(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.r0000644000176000001440000000235012235534714014421 0ustar ripleyusers#' 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.r0000644000176000001440000000336312305420356013775 0ustar ripleyusers#' 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", "testthat", package = "evaluate") #' if (file_test("-d", samples)) { #' replay(evaluate(file(file.path(samples, "order.r")))) #' replay(evaluate(file(file.path(samples, "plot.r")))) #' replay(evaluate(file(file.path(samples, "data.r")))) #' } replay <- function(x) UseMethod("replay", x) #' @export replay.list <- function(x) { invisible(lapply(x, replay)) } #' @export replay.character <- function(x) { cat(x) } #' @export replay.source <- function(x) { cat(line_prompt(x$src)) } #' @export replay.warning <- function(x) { message("Warning message:\n", x$message) } #' @export replay.message <- function(x) { message(str_replace(x$message, "\n$", "")) } #' @export replay.error <- function(x) { if (is.null(x$call)) { message("Error: ", x$message) } else { call <- deparse(x$call) message("Error in ", call, ": ", x$message) } } #' @export replay.value <- function(x) { if (x$visible) print(x$value) } #' @export 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.r0000644000176000001440000001401212316673446013435 0ustar ripleyusers#' 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 if (identical(grDevices::pdf, getOption("device"))) { dev.new(file = NULL) } else dev.new() dev.control(displaylist = "enable") dev <- dev.cur() on.exit(dev.off(dev)) } # 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) 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, output_handler$text, output_handler$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 } value_handler <- output_handler$value multi_args <- length(formals(value_handler)) > 1 for (expr in call) { handle(ev <- withCallingHandlers( withVisible(eval(expr, envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)) handle_output(TRUE) # 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.r0000644000176000001440000000146012235534714013626 0ustar ripleyusers#' 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.r0000644000176000001440000000260412316662535014144 0ustar ripleyusers#' 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, text_callback = identity, graphics_callback = identity) { incomplete <- isIncomplete(con) if (incomplete) cat("\n") out <- list() if (plot) { out$graphics <- plot_snapshot(incomplete_plots) if (!is.null(out$graphics)) graphics_callback(out$graphics) } 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") text_callback(out$text) } 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.r0000644000176000001440000000666112235534714014053 0ustar ripleyusers#' 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.r0000644000176000001440000000746112316673446013632 0ustar ripleyusers#' 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 parse_all <- function(x) UseMethod("parse_all") #' @export 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) if (n > 1) x <- paste(x, rep(c("\n", ""), c(n - 1, 1)), sep = "") 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)) } #' @export parse_all.connection <- function(x) { if (!isOpen(x, "r")) { open(x, "r") on.exit(close(x)) } text <- readLines(x) parse_all(text) } #' @export parse_all.function <- function(x) { src <- attr(x, "source") # Remove first, function() {, and last lines, } n <- length(src) parse_all(src[-c(1, n)]) } #' @export parse_all.default <- function(x) { parse_all(deparse(x)) } evaluate/R/src-region.r0000644000176000001440000000111412235534714014547 0ustar ripleyusers#' 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/MD50000644000176000001440000000615512330003277012424 0ustar ripleyusersa71384aa89ade17a4ddd541145bd0ace *DESCRIPTION b089c0a6e9685038a9590b2f3a42957a *NAMESPACE 40754e4c3d8263ffc429c404291bcf85 *NEWS f8bd3b94b3091f5e0d4d428503134afb *R/eval.r 62a745dd2a17d47703e9f7edf08f027d *R/graphics.r 92ff4620dde1944914335f47d5d71b1f *R/hooks.r e8e15e7f645a48f4c517f38f42c0d6d1 *R/output.r 71f34c955c8194ab1a8c2f23767d1e93 *R/parse.r 5df5a5fa5a9bc48450e1024532cd7ba8 *R/replay.r 1f18fee05e024575d6ff1b147739cf23 *R/src-region.r 97f0d9e1b50256566a00cc6041282e35 *R/traceback.r cbe5c542bd6e296af621cd5decc48cc6 *R/watcher.r abea68c98cfc26071f74df095433e98a *man/create_traceback.Rd 447c656ee9cfe56ae30a1a9d44d5c9c4 *man/evaluate.Rd 724c624d24845580b2a60e6f8dab79f3 *man/getSrcRegion.Rd 3f9f05786462b144cc804a180199d4f6 *man/is.message.Rd 2313780f6ff2e9d760d0386b76c0abef *man/line_prompt.Rd 6a17d91d4be068bdaad9c32878fc7437 *man/new_output_handler.Rd 6c59de3f472153ff1c64d794395a6bfb *man/parse_all.Rd 9722949419423a426e34d939d9ecbe51 *man/replay.Rd 8600cf8c57cdd0081e8e65fc2bd08205 *man/set_hooks.Rd 966070f53534aec19ea03c66e8d61506 *man/try_capture_stack.Rd f5caaec8fde7f3b23b6c10d2b9e36fb4 *man/watchout.Rd ec7450e60a6afd59071c526d1fa2ecdf *tests/test-all.R 446d67f5fc9a97626f757fae3fefcee7 *tests/testthat/comment.r 94750480cbfd8455ba433ab42828023e *tests/testthat/data.r 38a0bd49c764aefce15f4844036ccf02 *tests/testthat/error-complex.r fea574ba53709e7b38a294d855011323 *tests/testthat/error.r 24e9ae27434864fdef5901807e66ea98 *tests/testthat/example-1.r 19234a68f3630d7690a8232714fa5d04 *tests/testthat/ggplot-loop.r 9792e29336dfe5fe654b91a231d4bd1e *tests/testthat/ggplot.r ca3241b977d18d52ff5664cf9c228db2 *tests/testthat/interleave-1.r c2a3b01bdd0873e435d9f376c9112ed3 *tests/testthat/interleave-2.r c887105bd174693b5ab37f3c1e92ec10 *tests/testthat/order.r cfaf5bebb5ba464bc95d311ee37fb0ee *tests/testthat/parse.r ea5f897a7a8a861dffbfb4a97f4ba666 *tests/testthat/plot-additions.r 9cf8a8768e36e0e4b9f33c7dae3e2a29 *tests/testthat/plot-clip.r 2c1349feb6b38c8521a1bc8e8c046012 *tests/testthat/plot-last-comment.r 396ff3413370398b3be86fa9a27ae235 *tests/testthat/plot-loop.r d848b820afa7870196da03b30e14678a *tests/testthat/plot-multi-layout.r 88f9535f005b899f7f52c7f91cc4a0f8 *tests/testthat/plot-multi-layout2.r 2f5434a4a5a4a9fa0164c21ee9ec52f4 *tests/testthat/plot-multi-missing.r 4b9fd50ee21d4f3da6332ffed48746cb *tests/testthat/plot-multi.r b4952448dc702d1ce95cb57b8d2660f5 *tests/testthat/plot-new.r 6013de5aae712457dedf5a949395a7b4 *tests/testthat/plot-par.r c0f8dc8e852767d2d020b2bfb54bd856 *tests/testthat/plot-par2.r 69410ac0ba507aa703d3f16802e27b89 *tests/testthat/plot-persp.r 43c3eebe13c4fc96e7f3b08844babe89 *tests/testthat/plot-strwidth.r 4cbfd1ffe04ab0562a2514f22a2e049d *tests/testthat/plot.r 7df061829daeba528956cfd392bac1e7 *tests/testthat/raw-output.r 8f7ec82910b852ddff26db703fa1881b *tests/testthat/test-errors.r b7766244e5e462b6403d0e8ee21dffa7 *tests/testthat/test-evaluate.r 9cc709519be1a4c57f0343f0a4527d4a *tests/testthat/test-graphics.r f558fc2fc0f097cdf455ad5cc1467240 *tests/testthat/test-output-handler.R f0dfe4d4709355498c1d03d06a149a7a *tests/testthat/test-output.r cd8df2f4b726150b47a3b9c9d31f946d *tests/testthat/test-parse.r evaluate/DESCRIPTION0000644000176000001440000000141412330003277013613 0ustar ripleyusersPackage: evaluate Type: Package Title: Parsing and evaluation tools that provide more details than the default. Version: 0.5.5 Date: 2014-04-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.6.2) Suggests: testthat, lattice, ggplot2 Packaged: 2014-04-29 19:01:11 UTC; yihui Author: Hadley Wickham [aut], Yihui Xie [cre, ctb], Barret Schloerke [ctb] Maintainer: Yihui Xie NeedsCompilation: no Repository: CRAN Date/Publication: 2014-04-29 22:08:31 evaluate/man/0000755000176000001440000000000012327376456012702 5ustar ripleyusersevaluate/man/line_prompt.Rd0000644000176000001440000000063012316667625015517 0ustar ripleyusers\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.Rd0000644000176000001440000000047512316667625016440 0ustar ripleyusers\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.Rd0000644000176000001440000000352612316667625015004 0ustar ripleyusers\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.Rd0000644000176000001440000000102012316667625014455 0ustar ripleyusers\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", "testthat", package = "evaluate") if (file_test("-d", samples)) { 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.Rd0000644000176000001440000000052312316667625015563 0ustar ripleyusers\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.Rd0000644000176000001440000000055412316667625015136 0ustar ripleyusers\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.Rd0000644000176000001440000000106212316667625015165 0ustar ripleyusers\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.Rd0000644000176000001440000000060212316667625016714 0ustar ripleyusers\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.Rd0000644000176000001440000000061612316667625015031 0ustar ripleyusers\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.Rd0000644000176000001440000000325412316667625017102 0ustar ripleyusers\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.Rd0000644000176000001440000000047012316667625015227 0ustar ripleyusers\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}