Duncan Murdoch wrote: [...] > I've just added this function to R-devel (to become 2.5.0 next spring): > > withVisible <- function(x) { > x <- substitute(x) > v <- .Internal(eval.with.vis(x, parent.frame(), baseenv())) > v > } > > Luke Tierney suggested simplifying the interface (no need to duplicate > the 3 parameter eval interface, you can just wrap this in evalq() if you > need that flexibility); the name "with.vis" was suggested, but it looks > like an S3 method for the with() generic, so I renamed it. > > Duncan Murdoch
Excellent, many thanks... but I am afraid I cannot use this function because you force evaluation on parent.frame(), where I need to evaluate it in .GlobalEnv (which is NOT equal to parent.frame() in my context). Would it be possible to change it to: withVisible <- function(x, env = parent.frame()) { x <- substitute(x) v <- .Internal(eval.with.vis(x, env, baseenv())) v } ...so that we got additional flexibility? This is one good example of problems we encounter if we want to make R GUIs that emulate the very, very complex mechanism used by R to evaluate a command send at the prompt. Since we are on this topic, here is a copy of the function I am working on. It emulates most of the mechanism (Is the code line complete or not? Do we issue one or several warnings? When? Correct error message in case of a stop condition or other errors? Return of results with visibility? Etc.). As you can see, it is incredibly complex. So, do I make a mistake somewhere, or are we really forced to make all these computations to emulate the way R works at the command line (to put in a context, this is part of a R socket server to be used, for instance, in Tinn-R to fork output of R in the Tinn-R console, without blocking the original R console, or R terminal). Best, Philippe Grosjean processSocket <- function(msg) { # This is the default R function that processes a command send # by a socket client # 'msg' is assumed to be R code contained in a string # First parse code msgcon <- textConnection(msg) expr <- try(parse(msgcon), silent = TRUE) close(msgcon) # Determine if this code is correctly parsed if (inherits(expr, "try-error")) { results <- expr # Determine if it is incorrect code, or incomplete line! if (length(grep("\n2:", results)) == 1) { ### TODO: use the continue prompt from options! results <- "\n+ " # Send just the continue prompt # The client must manage the rest! } else { # Rework error message toReplace <- "^([^ ]* )[^:]*(:.*)$" Replace <- "\\1\\2" results <- sub(toReplace, Replace, results) # Add the prompt at the end to show that R is ready # to process new commands results <- paste(results, "> ", sep = "\n") } } else { # Code is correctly parsed, # evaluate generated expression(s) # capture.all() is inspired from capture.output(), # but it captures both the output and the message streams capture.all <- function(expr) { file <- textConnection("rval", "w", local = TRUE) sink(file, type = "output") sink(file, type = "message") on.exit({ sink(type = "output") sink(type = "message") close(file) }) ### TODO: do not erase 'last.warning', # otherwise warnings(), etc. do not work! evalVis <- function(Expr) { if (getOption("warn") == 0) { # We need to install our own warning handling # and also, we use a customized interrupt handler owarn <- getOption("warning.expression") # Inactivate current warning handler options(warning.expression = expression()) # ... and make sure it is restored at the end on.exit({ # Check that the warning.expression # was not changed nwarn <- getOption("warning.expression") if (!is.null(nwarn) && length(as.character(nwarn)) == 0) options(warning.expression = owarn) # If the evaluation did not generated warnings, # restore old "last.warning" if (!exists("last.warning", envir = .GlobalEnv) && !is.null(save.last.warning)) last.warning <<- save.last.warning }) # Save the current content of "last.warning" # From .GlobalEnv if (exists("last.warning", envir = .GlobalEnv)) { save.last.warning <- get("last.warning", envir = .GlobalEnv) # ... and delete it rm(last.warning, envir = .GlobalEnv) } else { save.last.warning <- NULL } myEvalEnv.. <- .GlobalEnv res <- try(withCallingHandlers(.Internal( eval.with.vis(Expr, myEvalEnv.., baseenv())), # Our custom warning handler ### TODO: how to deal with immediate warnings! # (currently, all warnings are differed!) warning = function(w) { if (exists("last.warning", envir =.GlobalEnv)) { lwarn <- get("last.warning", envir = .GlobalEnv) } else lwarn <- list() # Do not add more than 50 warnings if (length(lwarn) >= 50) return() # Add the warning to this list nwarn <- length(lwarn) names.warn <- names(lwarn) Call <- conditionCall(w) # If warning generated in eval environment, # put it as character(0) if (Call == "eval.with.vis(Expr, myEvalEnv.., baseenv())") Call <- character(0) # I don't use NULL, # because it doesn't add to a list! lwarn[[nwarn + 1]] <- Call names(lwarn) <- c(names.warn, conditionMessage(w)) # Save the modified version in .GlobalEnv last.warning <<- lwarn return() }, interrupt = function(i) cat("<INTERRUPTED!>\n")), silent = TRUE) # Possibly add 'last.warning' as attribute to res if (exists("last.warning", envir = .GlobalEnv)) attr(res, "last.warning") <- get("last.warning", envir = .GlobalEnv) } else { # We have a simpler warning handler owarn <- getOption("warning.expression") # Inactivate current warning handler options(warning.expression = expression()) # ... and make sure it is restored at the end on.exit({ # Check that the warning.expression was #not changed nwarn <- getOption("warning.expression") if (!is.null(nwarn) && length(as.character(nwarn)) == 0) options(warning.expression = owarn) }) myEvalEnv.. <- .GlobalEnv res <- try(withCallingHandlers(.Internal( eval.with.vis(Expr, myEvalEnv.., baseenv())), warning = function(w) { Mes <- conditionMessage(w) Call <- conditionCall(w) # Result depends upon 'warn' Warn <- getOption("warn") if (Warn < 0) { # Do nothing! return() } else if (Warn > 1) { # Generate an error! Mes <- paste("(converted from warning)", Mes) stop(simpleError(Mes, call = Call)) } else { # Print the warning message # Format the warning message ### TODO: translate this! # If warning generated in eval # environment, do not print call if (Call == "eval.with.vis(Expr, myEvalEnv.., baseenv())") { cat("Warning message:\n", Mes, "\n", sep = "") } else { cat("Warning message:\n", Mes, " in: ", as.character(Call), "\n", sep = "") } } }, interrupt = function(i) cat("<INTERRUPTED!>\n")), silent = TRUE) } return(res) } tmp <- list() for (i in 1:length(expr)) { tmp[[i]] <- evalVis(expr[[i]]) if (inherits(tmp[[i]], "try-error")) break } #tmp <- lapply(expr, evalVis) # This one does not stop #on error!? # This is my function to display delayed warnings WarningMessage <- function(last.warning) { n.warn <- length(last.warning) if (n.warn < 11) { # If less than 11 warnings, # print them if (exists("last.warning", envir = .GlobalEnv)) { owarn <- get("last.warning", envir = .GlobalEnv) } else owarn <- NULL last.warning <<- last.warning invisible(warnings()) if (is.null(owarn)) { rm("last.warning", envir = .GlobalEnv) } else last.warning <<- owarn } else { # Generate a message similar to the one we got # at the command line ### TODO: translation of this message! if (n.warn >= 50) { cat("There were 50 or more warnings (use warnings() to see the first 50)\n") } else { cat("There were", n.warn, "warnings (use warnings() to see them)\n", sep = " ") } } return(invisible(n.warn)) } # Process all generated items for (item in tmp) { if (inherits(item, "try-error")) { # Rework the error message if it occurs in the # calling environment toReplace <- "^([^ ]*) .*eval\.with\.vis[(]Expr, myEvalEnv\.\., baseenv[(][)][)].*:.*\n\t(.*)$" Replace <- "\\1 : \\2" cat(sub(toReplace, Replace, unclass(item))) # Do we have to print 'last.warning'? last.warning <- attr(item, "last.warning") if (!is.null(last.warning)) { # Add "In addition: " before warning, like at # the command line cat("In addition: ") WarningMessage(last.warning) } } else { # No error if (item$visible) { print(item$value) } # Do we have to print 'last.warning'? last.warning <- attr(item, "last.warning") if (!is.null(last.warning)) WarningMessage(last.warning) } } return(rval) } results <- capture.all(expr) if (inherits(results, "list")) results <- paste(results, collapse = "\n") # Add the prompt at the end to show that R is ready to process # new commands results <- paste(paste(results, collapse = "\n"), "> ", sep = "\n") # Note: we don't use options()$prompt here... we always use a # fixed string! It is the client that must manage # possible change } return(results) } ______________________________________________ R-devel@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-devel