Merge pull request #264 from rstudio/feature/debug-hooks

Export installExprFunction and add supporting documentation

NAMESPACE

@@ -57,6 +57,7 @@ export(includeHTML)
 export(includeMarkdown)
 export(includeScript)
 export(includeText)
+export(installExprFunction)
 export(invalidateLater)
 export(is.reactive)
 export(is.reactivevalues)

R/shinywrappers.R

@@ -2,6 +2,7 @@ suppressPackageStartupMessages({
   library(caTools)
   library(xtable)
 })
+globalVariables('func')
 
 #' Plot Output
 #' 
@@ -42,11 +43,9 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
   if (!is.null(func)) {
     shinyDeprecated(msg="renderPlot: argument 'func' is deprecated. Please use 'expr' instead.")
   } else {
-    func <- exprToFunction(expr, env, quoted)
-    registerDebugHook("func", environment(), "Render Plot")
+    installExprFunction(expr, "func", env, quoted)
   }
 
-
   args <- list(...)
   
   if (is.function(width))
@@ -221,8 +220,7 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
 #' }
 renderImage <- function(expr, env=parent.frame(), quoted=FALSE,
                         deleteFile=TRUE) {
-  func <- exprToFunction(expr, env, quoted)
-  registerDebugHook("func", environment(), "Render Image")
+  installExprFunction(expr, "func", env, quoted)
   
   return(function(shinysession, name, ...) {
     imageinfo <- func()
@@ -272,8 +270,7 @@ renderTable <- function(expr, ..., env=parent.frame(), quoted=FALSE, func=NULL)
   if (!is.null(func)) {
     shinyDeprecated(msg="renderTable: argument 'func' is deprecated. Please use 'expr' instead.")
   } else {
-    func <- exprToFunction(expr, env, quoted)
-    registerDebugHook("func", environment(), "Render Table")
+    installExprFunction(expr, "func", env, quoted)
   }
 
   function() {
@@ -330,8 +327,7 @@ renderPrint <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
   if (!is.null(func)) {
     shinyDeprecated(msg="renderPrint: argument 'func' is deprecated. Please use 'expr' instead.")
   } else {
-    func <- exprToFunction(expr, env, quoted)
-    registerDebugHook("func", environment(), "Render Print")
+    installExprFunction(expr, "func", env, quoted)
   }
 
   function() {
@@ -374,8 +370,7 @@ renderText <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
   if (!is.null(func)) {
     shinyDeprecated(msg="renderText: argument 'func' is deprecated. Please use 'expr' instead.")
   } else {
-    func <- exprToFunction(expr, env, quoted)
-    registerDebugHook("func", environment(), "Render Text")
+    installExprFunction(expr, "func", env, quoted)
   }
 
   function() {
@@ -415,8 +410,7 @@ renderUI <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
   if (!is.null(func)) {
     shinyDeprecated(msg="renderUI: argument 'func' is deprecated. Please use 'expr' instead.")
   } else {
-    func <- exprToFunction(expr, env, quoted)
-    registerDebugHook("func", environment(), "Render UI")
+    installExprFunction(expr, "func", env, quoted)
   }
 
   function() {

R/utils.R

@@ -130,6 +130,8 @@ makeFunction <- function(args = pairlist(), body, env = parent.frame()) {
 #' @param env The desired environment for the function. Defaults to the
 #'   calling environment two steps back.
 #' @param quoted Is the expression quoted?
+#' @param caller_offset If specified, the offset in the callstack of the 
+#'   functiont to be treated as the caller. 
 #'
 #' @examples
 #' # Example of a new renderer, similar to renderText
@@ -165,9 +167,10 @@ makeFunction <- function(args = pairlist(), body, env = parent.frame()) {
 #' # "text, text, text"
 #'
 #' @export
-exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE) {
+exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE, 
+                           caller_offset=1) {
   # Get the quoted expr from two calls back
-  expr_sub <- eval(substitute(substitute(expr)), parent.frame())
+  expr_sub <- eval(substitute(substitute(expr)), parent.frame(caller_offset))
 
   # Check if expr is a function, making sure not to evaluate expr, in case it
   # is actually an unquoted expression.
@@ -176,8 +179,8 @@ exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE) {
   # latter, it will be a language object.
   if (!is.name(expr_sub) && expr_sub[[1]] == as.name('function')) {
     # Get name of function that called this function
-    called_fun <- sys.call(-1)[[1]]
-
+    called_fun <- sys.call(-1 * caller_offset)[[1]]
+    
     shinyDeprecated(msg = paste("Passing functions to '", called_fun,
       "' is deprecated. Please use expressions instead. See ?", called_fun,
       " for more information.", sep=""))
@@ -193,6 +196,37 @@ exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE) {
   }
 }
 
+#' Installs an expression in the given environment as a function, and registers
+#' debug hooks so that breakpoints may be set in the function.
+#' 
+#' Can replace \code{exprToFunction} as follows:
+#' 
+#' Before: \code{func <- exprToFunction(expr)}
+#' 
+#' After: \code{installExprFunction(expr, "func")}
+#' 
+#' @seealso Wraps \code{exprToFunction}; see that method's documentation for 
+#'   more documentation and examples.
+#'   
+#' @param expr A quoted or unquoted expression
+#' @param name The name the function should be given 
+#' @param eval.env The desired environment for the function. Defaults to the
+#'   calling environment two steps back. 
+#' @param quoted Is the expression quoted?
+#' @param assign.env The environment in which the function should be assigned.
+#' @param label A label for the object to be shown in the debugger. Defaults
+#'   to the name of the calling function. 
+#' 
+#' @export
+installExprFunction <- function(expr, name, eval.env = parent.frame(2), 
+                                quoted = FALSE, 
+                                assign.env = parent.frame(1),
+                                label = as.character(sys.call(-1)[[1]])) {
+  func <- exprToFunction(expr, eval.env, quoted, 2)
+  assign(name, func, envir = assign.env)
+  registerDebugHook(name, assign.env, label)
+}
+
 #' Parse a GET query string from a URL
 #'
 #' Returns a named character vector of key-value pairs.

man/exprToFunction.Rd

@@ -3,7 +3,7 @@
 \title{Convert an expression or quoted expression to a function}
 \usage{
   exprToFunction(expr, env = parent.frame(2),
-    quoted = FALSE)
+    quoted = FALSE, caller_offset = 1)
 }
 \arguments{
   \item{expr}{A quoted or unquoted expression, or a
@@ -13,6 +13,9 @@
   Defaults to the calling environment two steps back.}
 
   \item{quoted}{Is the expression quoted?}
+
+  \item{caller_offset}{The offset in the callstack of the function to be
+  considered the caller. Defaults to the direct caller.}
 }
 \description{
   This is to be called from another function, because it
@@ -27,6 +30,12 @@
   this will quote the original expression and convert it to
   a function.
 }
+\note{
+exprToFunction does not set debug hooks in the function it creates, so it is
+not possible to set breakpoints in the original expressions and hit them during
+Shiny application runtime. Use \code{\link{installExprFunction}} instead if you
+need debug support.
+}
 \examples{
 # Example of a new renderer, similar to renderText
 # This is something that toolkit authors will do

man/installExprFunction.Rd

@@ -0,0 +1,70 @@
+\name{installExprFunction}
+\alias{installExprFunction}
+\title{Convert an expression to a function and place it in an environment}
+\description{This is to be called from another function, because it will attempt
+to get an unquoted expression from two calls back.}
+\usage{
+  installExprFunction(expr, name, eval.env = parent.frame(2), 
+    quoted = FALSE, assign.env = parent.frame(1), 
+    label = as.character(sys.call(-1)[[1]]))
+}
+\arguments{
+  \item{expr}{A quoted or unquoted expression.}
+
+  \item{name}{The name of the function object to create.}
+
+  \item{eval.env}{The desired environment for the function. Defaults to the 
+  calling environment two steps back.}
+
+  \item{quoted}{Is the expression quoted?}
+   
+  \item{assign.env}{The environment in which to place the function object.
+  Defaults to the calling environment.}
+  
+  \item{label}{A descriptive label for the function to be shown in the 
+  debugger, if active. Defaults to the name of the calling function.}
+}
+\details{
+  Converts expr to a function, using the semantics described in 
+  \code{\link{exprToFunction}}. Installs the newly created function into an
+  environment (the environment of the caller unless otherwise specified), and 
+  registers debug hooks on the function object if a debugger is active so that 
+  breakpoints may be set in it.
+}
+\seealso{
+\code{link{exprToFunction}}
+}
+\examples{
+# Example of a new renderer, similar to renderText
+# This is something that toolkit authors will do
+renderTriple <- function(expr, env=parent.frame(), quoted=FALSE) {
+  # Create a function named "func" from the expression
+  shiny::installExprFunction(expr, "func", env, quoted)
+
+  function() {
+    # Call the function just created
+    value <- func()
+    paste(rep(value, 3), collapse=", ")
+  }
+}
+
+# Example of using the renderer.
+# This is something that app authors will do.
+values <- reactiveValues(A="text")
+
+\dontrun{
+# Create an output object
+output$tripleA <- renderTriple({
+  values$A
+})
+}
+
+# At the R console, you can experiment with the renderer using isolate()
+tripleA <- renderTriple({
+  values$A
+})
+
+isolate(tripleA())
+# "text, text, text"
+}
+