invoke debug hook function if present after instantiating app functions

R/reactives.R

@@ -415,6 +415,7 @@ reactive <- function(x, env = parent.frame(), quoted = FALSE, label = NULL) {
     label <- sprintf('reactive(%s)', paste(deparse(body(fun)), collapse='\n'))
 
   o <- Observable$new(fun, label)
+  registerDebugHook(".func", o, "Reactive")
   structure(o$getValue@.Data, observable = o, class = "reactive")
 }
 
@@ -620,8 +621,9 @@ observe <- function(x, env=parent.frame(), quoted=FALSE, label=NULL,
   if (is.null(label))
     label <- sprintf('observe(%s)', paste(deparse(body(fun)), collapse='\n'))
 
-  invisible(Observer$new(
-    fun, label=label, suspended=suspended, priority=priority))
+  o <- Observer$new(fun, label=label, suspended=suspended, priority=priority)
+  registerDebugHook(".func", o, "Observer")
+  invisible(o)
 }
 
 # ---------------------------------------------------------------------------

R/shinywrappers.R

@@ -43,6 +43,7 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
     shinyDeprecated(msg="renderPlot: argument 'func' is deprecated. Please use 'expr' instead.")
   } else {
     func <- exprToFunction(expr, env, quoted)
+    registerDebugHook("func", environment(), "Render Plot")
   }
 
 
@@ -221,7 +222,8 @@ 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")
+
   return(function(shinysession, name, ...) {
     imageinfo <- func()
     # Should the file be deleted after being sent? If .deleteFile not set or if
@@ -271,6 +273,7 @@ renderTable <- function(expr, ..., env=parent.frame(), quoted=FALSE, func=NULL)
     shinyDeprecated(msg="renderTable: argument 'func' is deprecated. Please use 'expr' instead.")
   } else {
     func <- exprToFunction(expr, env, quoted)
+    registerDebugHook("func", environment(), "Render Table")
   }
 
   function() {
@@ -328,6 +331,7 @@ renderPrint <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
     shinyDeprecated(msg="renderPrint: argument 'func' is deprecated. Please use 'expr' instead.")
   } else {
     func <- exprToFunction(expr, env, quoted)
+    registerDebugHook("func", environment(), "Render Print")
   }
 
   function() {
@@ -371,6 +375,7 @@ renderText <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
     shinyDeprecated(msg="renderText: argument 'func' is deprecated. Please use 'expr' instead.")
   } else {
     func <- exprToFunction(expr, env, quoted)
+    registerDebugHook("func", environment(), "Render Text")
   }
 
   function() {
@@ -411,6 +416,7 @@ renderUI <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
     shinyDeprecated(msg="renderUI: argument 'func' is deprecated. Please use 'expr' instead.")
   } else {
     func <- exprToFunction(expr, env, quoted)
+    registerDebugHook("func", environment(), "Render UI")
   }
 
   function() {

R/utils.R

@@ -272,6 +272,26 @@ shinyDeprecated <- function(new=NULL, msg=NULL,
   message(msg)
 }
 
+#' Register a function with the debugger (if one is active). 
+#' 
+#' Call this function after exprToFunction to give any active debugger a hook
+#' to set and clear breakpoints in the function. A debugger may implement
+#' registerShinyDebugHook to receive callbacks when Shiny functions are 
+#' instantiated at runtime. 
+#'
+#' @param name Name of the field or object containing the function. 
+#' @param where The reference object or environment containing the function.
+#' @param label A label to display on the function in the debugger.
+registerDebugHook <- function(name, where, label) {
+  if (exists("registerShinyDebugHook", mode = "function")) {
+    params <- new.env(parent = emptyenv())
+    params$name <- name
+    params$where <- where
+    params$label <- label
+    registerShinyDebugHook(params)
+  }
+}
+
 Callbacks <- setRefClass(
   'Callbacks',
   fields = list(