Merge branch 'master' of github.com:trestletech/shiny into input-regi…

…stry

R/imageutils.R

@@ -47,7 +47,7 @@ plotPNG <- function(func, filename=tempfile(fileext='.png'),
     pngfun <- png
   }
 
-  do.call(pngfun, c(filename=filename, width=width, height=height, res=res, list(...)))
+  pngfun(filename=filename, width=width, height=height, res=res, ...)
   tryCatch(
     func(),
     finally=dev.off())

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/run-url.R

@@ -7,7 +7,7 @@
 #'   \code{'3239667'}, and \code{'https://gist.github.com/jcheng5/3239667'}
 #'   are all valid values.
 #' @param port The TCP port that the application should listen on. Defaults to
-#'   port 8100.
+#'   choosing a random port.
 #' @param launch.browser If true, the system's default web browser will be
 #'   launched automatically after the app is started. Defaults to true in
 #'   interactive sessions only.
@@ -23,7 +23,7 @@
 #'
 #' @export
 runGist <- function(gist,
-                    port=8100L,
+                    port=NULL,
                     launch.browser=getOption('shiny.launch.browser',
                                              interactive())) {
 
@@ -52,7 +52,7 @@ runGist <- function(gist,
 #'   default, this function will run an app from the top level of the repo, but
 #'   you can use a path such as `\code{"inst/shinyapp"}.
 #' @param port The TCP port that the application should listen on. Defaults to
-#'   port 8100.
+#'   choosing a random port.
 #' @param launch.browser If true, the system's default web browser will be
 #'   launched automatically after the app is started. Defaults to true in
 #'   interactive sessions only.
@@ -67,7 +67,7 @@ runGist <- function(gist,
 #'
 #' @export
 runGitHub <- function(repo, username = getOption("github.user"),
-  ref = "master", subdir = NULL, port = 8100,
+  ref = "master", subdir = NULL, port = NULL,
   launch.browser = getOption('shiny.launch.browser', interactive())) {
 
   if (is.null(ref)) {
@@ -102,7 +102,7 @@ runGitHub <- function(repo, username = getOption("github.user"),
 #'   default, this function will run an app from the top level of the repo, but
 #'   you can use a path such as `\code{"inst/shinyapp"}.
 #' @param port The TCP port that the application should listen on. Defaults to
-#'   port 8100.
+#'   choosing a random port.
 #' @param launch.browser If true, the system's default web browser will be
 #'   launched automatically after the app is started. Defaults to true in
 #'   interactive sessions only.
@@ -117,7 +117,7 @@ runGitHub <- function(repo, username = getOption("github.user"),
 #' }
 #'
 #' @export
-runUrl <- function(url, filetype = NULL, subdir = NULL, port = 8100,
+runUrl <- function(url, filetype = NULL, subdir = NULL, port = NULL,
   launch.browser = getOption('shiny.launch.browser', interactive())) {
 
   if (!is.null(subdir) && ".." %in% strsplit(subdir, '/')[[1]])

R/shiny.R

@@ -223,7 +223,7 @@ ShinySession <- setRefClass(
     },
     dispatch = function(msg) {
       method <- paste('@', msg$method, sep='')
-      func <- try(do.call(`$`, list(.self, method)), silent=TRUE)
+      func <- try(.self[[method]], silent=TRUE)
       if (inherits(func, 'try-error')) {
         .sendErrorResponse(msg, paste('Unknown method', msg$method))
       }
@@ -1016,6 +1016,13 @@ resourcePathHandler <- function(req) {
 #' @export
 shinyServer <- function(func) {
   .globals$server <- func
+  if (!is.null(func))
+  {
+    # Tag this function as the Shiny server function. A debugger may use this
+    # tag to give this function special treatment.
+    attr(.globals$server, "shinyServerFunction") <- TRUE
+    registerDebugHook("server", .globals, "Server Function")
+  }
   invisible()
 }
 
@@ -1333,7 +1340,7 @@ serviceApp <- function(ws_env) {
 #'   \code{server.R}, plus, either \code{ui.R} or a \code{www} directory that
 #'   contains the file \code{index.html}. Defaults to the working directory.
 #' @param port The TCP port that the application should listen on. Defaults to 
-#'   port 8100.
+#'   choosing a random port.
 #' @param launch.browser If true, the system's default web browser will be 
 #'   launched automatically after the app is started. Defaults to true in 
 #'   interactive sessions only.
@@ -1362,7 +1369,7 @@ serviceApp <- function(ws_env) {
 #' }
 #' @export
 runApp <- function(appDir=getwd(),
-                   port=8100L,
+                   port=NULL,
                    launch.browser=getOption('shiny.launch.browser',
                                             interactive()), 
                    workerId="") {
@@ -1385,6 +1392,17 @@ runApp <- function(appDir=getwd(),
 
   require(shiny)
 
+  # determine port if we need to
+  if (is.null(port)) {
+    if (!is.null(.globals$lastPort))
+      port <- .globals$lastPort
+    else
+      port <- sample(3000:8000, 1)
+  }
+
+  # set lastPort to NULL so that we don't re-use it if startApp fails
+  .globals$lastPort <- NULL
+
   if (is.character(appDir)) {
     orig.wd <- getwd()
     setwd(appDir)
@@ -1394,6 +1412,9 @@ runApp <- function(appDir=getwd(),
     server <- startAppObj(appDir$ui, appDir$server, port=port, workerId)
   }
 
+  # record port
+  .globals$lastPort <- port
+
   on.exit({
     stopServer(server)
   }, add = TRUE)
@@ -1440,7 +1461,7 @@ stopApp <- function(returnValue = NULL) {
 #' @param example The name of the example to run, or \code{NA} (the default) to
 #'   list the available examples.
 #' @param port The TCP port that the application should listen on. Defaults to 
-#'   port 8100.
+#'   choosing a random port.
 #' @param launch.browser If true, the system's default web browser will be 
 #'   launched automatically after the app is started. Defaults to true in 
 #'   interactive sessions only.
@@ -1458,7 +1479,7 @@ stopApp <- function(returnValue = NULL) {
 #' }
 #' @export
 runExample <- function(example=NA,
-                       port=8100L,
+                       port=NULL,
                        launch.browser=getOption('shiny.launch.browser',
                                                 interactive())) {
   examplesDir <- system.file('examples', package='shiny')

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

@@ -36,7 +36,7 @@ repeatable <- function(rngfunc, seed = runif(1, 0, .Machine$integer.max)) {
 
     set.seed(seed)
 
-    do.call(rngfunc, list(...))
+    rngfunc(...)
   }
 }
 
@@ -122,7 +122,7 @@ makeFunction <- function(args = pairlist(), body, env = parent.frame()) {
 #'
 #' If expr is a quoted expression, then this just converts it to a function.
 #' If expr is a function, then this simply returns expr (and prints a
-#'   deprecation message.
+#'   deprecation message).
 #' If expr was a non-quoted expression from two calls back, then this will
 #'   quote the original expression and convert it to a function.
 #
@@ -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(
@@ -292,19 +312,15 @@ Callbacks <- setRefClass(
     },
     invoke = function(..., onError=NULL) {
       for (callback in .callbacks$values()) {
-        tryCatch(
-          do.call(callback, list(...)),
-          error = function(e) {
-            if (is.null(onError))
-              stop(e)
-            else
-              onError(e)
-          }
-        )
+        if (is.null(onError)) {
+          callback(...)
+        } else {
+          tryCatch(callback(...), error = onError)
+        }
       }
     },
     count = function() {
       .callbacks$size()
     }
   )
-)
+)

inst/www/shared/shiny.js

@@ -461,7 +461,16 @@
       var self = this;
 
       var createSocketFunc = exports.createSocket || function() {
-        var ws = new WebSocket('ws://' + window.location.host + '/websocket/');
+        var protocol = 'ws:';
+        if (window.location.protocol === 'https:')
+          protocol = 'wss:';
+
+        var defaultPath = window.location.pathname;
+        if (!/\/$/.test(defaultPath))
+          defaultPath += '/';
+        defaultPath += 'websocket/';
+
+        var ws = new WebSocket(protocol + '//' + window.location.host + defaultPath);
         ws.binaryType = 'arraybuffer';
         return ws;
       };
@@ -634,7 +643,18 @@
     };
 
     this.$updateConditionals = function() {
-      var scope = {input: this.$inputValues, output: this.$values};
+      var inputs = {};
+
+      // Input keys use "name:type" format; we don't want the user to
+      // have to know about the type suffix when referring to inputs.
+      for (var name in this.$inputValues) {
+        if (this.$inputValues.hasOwnProperty(name)) {
+          var shortName = name.replace(/:.*/, '');
+          inputs[shortName] = this.$inputValues[name];
+        }
+      }
+
+      var scope = {input: inputs, output: this.$values};
 
       var triggerShown  = function() { $(this).trigger('shown'); };
       var triggerHidden = function() { $(this).trigger('hidden'); };
@@ -1006,13 +1026,13 @@
       var $el = $(el);
       // Load the image before emptying, to minimize flicker
       var img = null;
-      var coordmap, clickId, hoverId;
+      var clickId, hoverId;
 
       if (data) {
         clickId = $el.data('click-id');
         hoverId = $el.data('hover-id');
 
-        coordmap = data.coordmap;
+        $el.data('coordmap', data.coordmap);
         delete data.coordmap;
 
         img = document.createElement('img');
@@ -1047,6 +1067,7 @@
 
             // TODO: Account for scrolling within the image??
 
+            var coordmap = $el.data('coordmap');
             function devToUsrX(deviceX) {
               var x = deviceX - coordmap.bounds.left;
               var factor = (coordmap.usr.right - coordmap.usr.left) /

man/exprToFunction.Rd

@@ -22,7 +22,7 @@
 \details{
   If expr is a quoted expression, then this just converts
   it to a function. If expr is a function, then this simply
-  returns expr (and prints a deprecation message. If expr
+  returns expr (and prints a deprecation message). If expr
   was a non-quoted expression from two calls back, then
   this will quote the original expression and convert it to
   a function.