Partial fix of debugger breakage

There are two problems I'm trying to solve here.

1) Somewhere along the way, exprToFunction gained a hardcoded
   assumption that two stack frames up is a variable "expr",
   meaning anything that called installExprFunction had to have
   the first argument be exactly "expr". I think I got this
   fixed, now the only assumption made by both installExprFunc
   and exprToFunc is if they are called with quoted = FALSE,
   then the caller is merely passing through code that originated
   exactly one more level up the stack frame. If the code is
   less than one level up, i.e. an end user is directly passing
   code into installExprFunction or exprToFunction, then it won't
   work; and if the code is more than one level up (someone is
   passing code into function A which passes through to function
   B which calls installExprFunction, with quoted = FALSE) then
   it also won't work.

2) registerDebugHook calls were broken in various places by the
   name/envir registered with the hook being different than the
   name/envir through which the function was actually called.
   This generally seems fixable by moving the registerDebugHook
   call closer to the name/envir that will ultimately be called
   (e.g. call registerDebugHook directly from wrapFunctionLabel).

There still seems to be a problem here in that breakpoints in
RStudio are hit but then the IDE automatically runs "n" multiple
times. Also the unit tests don't currently pass, I haven't
investigated that yet.

R/reactives.R

@@ -505,7 +505,6 @@ reactive <- function(x, env = parent.frame(), quoted = FALSE, label = NULL,
   if (length(srcref) >= 2) attr(label, "srcref") <- srcref[[2]]
   attr(label, "srcfile") <- srcFileOfRef(srcref[[1]])
   o <- Observable$new(fun, label, domain, ..stacktraceon = ..stacktraceon)
-  registerDebugHook(".func", o, "Reactive")
   structure(o$getValue, observable = o, class = "reactive")
 }
 
@@ -596,7 +595,7 @@ Observer <- R6Class(
       if (length(formals(observerFunc)) > 0)
         stop("Can't make an observer from a function that takes parameters; ",
              "only functions without parameters can be reactive.")
-
+registerDebugHook("observerFunc", environment(), label)
       .func <<- function() {
         tryCatch(
           if (..stacktraceon)
@@ -831,7 +830,6 @@ observe <- function(x, env=parent.frame(), quoted=FALSE, label=NULL,
   o <- Observer$new(fun, label=label, suspended=suspended, priority=priority,
                     domain=domain, autoDestroy=autoDestroy,
                     ..stacktraceon=..stacktraceon)
-  registerDebugHook(".func", o, "Observer")
   invisible(o)
 }
 

R/render-plot.R

@@ -39,11 +39,11 @@
 #'   instead).
 #'
 #' @export
-renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
+renderPlot <- function(plotExpr, width='auto', height='auto', res=72, ...,
                        env=parent.frame(), quoted=FALSE, func=NULL) {
   # This ..stacktraceon is matched by a ..stacktraceoff.. when plotFunc
   # is called
-  installExprFunction(expr, "func", env, quoted, ..stacktraceon = TRUE)
+  installExprFunction(plotExpr, "func", env, quoted, ..stacktraceon = TRUE)
 
   args <- list(...)
 

R/utils.R

@@ -380,33 +380,13 @@ makeFunction <- function(args = pairlist(), body, env = parent.frame()) {
 #' # "text, text, text"
 #'
 #' @export
-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(caller_offset))
-
-  # Check if expr is a function, making sure not to evaluate expr, in case it
-  # is actually an unquoted expression.
-  # If expr is a single token, then indexing with [[ will error; if it has multiple
-  # tokens, then [[ works. In the former case it will be a name object; in the
-  # latter, it will be a language object.
-  if (!is.null(expr_sub) && !is.name(expr_sub) && expr_sub[[1]] == as.name('function')) {
-    # Get name of function that called this function
-    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=""))
-    return(expr)
+exprToFunction <- function(expr, env=parent.frame(), quoted=FALSE) {
+  if (!quoted) {
+    expr <- eval(substitute(substitute(expr)), sys.parent(1))
   }
 
-  if (quoted) {
-    # expr is a quoted expression
-    makeFunction(body=expr, env=env)
-  } else {
-    # expr is an unquoted expression
-    makeFunction(body=expr_sub, env=env)
-  }
+  # expr is a quoted expression
+  makeFunction(body=expr, env=env)
 }
 
 #' Install an expression as a function
@@ -440,7 +420,13 @@ installExprFunction <- function(expr, name, eval.env = parent.frame(2),
                                 label = deparse(sys.call(-1)[[1]]),
                                 wrappedWithLabel = TRUE,
                                 ..stacktraceon = FALSE) {
-  func <- exprToFunction(expr, eval.env, quoted, 2)
+  if (!quoted) {
+    quoted <- TRUE
+    expr <- eval(substitute(substitute(expr)), sys.frame(-1))
+    print(expr)
+  }
+
+  func <- exprToFunction(expr, eval.env, quoted)
   if (length(label) > 1) {
     # Just in case the deparsed code is more complicated than we imagine. If we
     # have a label with length > 1 it causes warnings in wrapFunctionLabel.
@@ -448,9 +434,10 @@ installExprFunction <- function(expr, name, eval.env = parent.frame(2),
   }
   if (wrappedWithLabel) {
     func <- wrapFunctionLabel(func, label, ..stacktraceon = ..stacktraceon)
+  } else {
+    registerDebugHook(name, assign.env, label)
   }
   assign(name, func, envir = assign.env)
-  registerDebugHook(name, assign.env, label)
 }
 
 #' Parse a GET query string from a URL
@@ -1253,6 +1240,7 @@ wrapFunctionLabel <- function(func, name, ..stacktraceon = FALSE) {
     stop("Invalid name for wrapFunctionLabel: ", name)
   }
   assign(name, func, environment())
+  registerDebugHook(name, environment(), name)
 
   relabelWrapper <- eval(substitute(
     function(...) {