Bump version to 0.14.2

* Add list2env wrapper, for R <3.2.0

* Update NEWS

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 0.14.1
+Version: 0.14.2
 Authors@R: c(
     person("Winston", "Chang", role = c("aut", "cre"), email = "winston@rstudio.com"),
     person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"),
@@ -142,6 +142,7 @@ Collate:
     'shinywrappers.R'
     'showcase.R'
     'tar.R'
+    'test-export.R'
     'timer.R'
     'update-input.R'
 RoxygenNote: 5.0.1

NAMESPACE

@@ -69,6 +69,7 @@ export(downloadLink)
 export(em)
 export(enableBookmarking)
 export(eventReactive)
+export(exportTestValues)
 export(exprToFunction)
 export(extractStackTrace)
 export(fileInput)

NEWS.md

@@ -1,3 +1,32 @@
+shiny 0.14.2
+============
+
+This is a maintenance release of Shiny, with some bug fixes and minor new features.
+
+## Full changelog
+
+### Minor new features and improvements
+
+* Added a `fade` argument to `modalDialog()` -- setting it to `FALSE` will remove the usual fade-in animation for that modal window. ([#1414](https://github.com/rstudio/shiny/pull/1414))
+
+* Fixed a "duplicate binding" error that occurred in some edge cases involving `insertUI` and nested `uiOutput`. ([#1402](https://github.com/rstudio/shiny/pull/1402))
+
+* Fixed [#1422](https://github.com/rstudio/shiny/issues/1422): When using the `shiny.trace` option, allow specifying to only log SEND or RECV messages, or both. (PR [#1428](https://github.com/rstudio/shiny/pull/1428))
+
+* Fixed [#1419](https://github.com/rstudio/shiny/issues/1419): Allow overriding a JS custom message handler. (PR [#1445](https://github.com/rstudio/shiny/pull/1445))
+
+* Added `exportTestValues()` function, which allows a test driver to query the session for values internal to an application's server function. This only has an effect if the `shiny.testmode` option is set to `TRUE`. ([#1436](https://github.com/rstudio/shiny/pull/1436))
+
+### Bug fixes
+
+* Fixed [#1427](https://github.com/rstudio/shiny/issues/1427): make sure that modals do not close incorrectly when an element inside them is triggered as hidden. ([#1430](https://github.com/rstudio/shiny/pull/1430))
+
+* Fixed [#1404](https://github.com/rstudio/shiny/issues/1404): stack trace tests were not compatible with the byte-code compiler in R-devel, which now tracks source references.
+
+* `sliderInputBinding.setValue()` now sends a slider's value immediately, instead of waiting for the usual 250ms debounce delay. ([#1429](https://github.com/rstudio/shiny/pull/1429))
+
+* Fixed a bug where, in versions of R before 3.2, Shiny applications could crash due to a bug in R's implementation of `list2env()`. ([#1446](https://github.com/rstudio/shiny/pull/1446))
+
 shiny 0.14.1
 ============
 

R/app.R

@@ -231,13 +231,13 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
 # ignored when checking extensions. If any changes are detected, all connected
 # Shiny sessions are reloaded.
 #
-# Use option(shiny.autoreload = TRUE) to enable this behavior. Since monitoring
+# Use options(shiny.autoreload = TRUE) to enable this behavior. Since monitoring
 # for changes is expensive (we are polling for mtimes here, nothing fancy) this
 # feature is intended only for development.
 #
 # You can customize the file patterns Shiny will monitor by setting the
 # shiny.autoreload.pattern option. For example, to monitor only ui.R:
-# option(shiny.autoreload.pattern = glob2rx("ui.R"))
+# options(shiny.autoreload.pattern = glob2rx("ui.R"))
 #
 # The return value is a function that halts monitoring when called.
 initAutoReloadMonitor <- function(dir) {

R/bookmark-state.R

@@ -362,7 +362,7 @@ RestoreContext <- R6Class("RestoreContext",
       self$input <- RestoreInputSet$new(inputs)
 
       values <- valuesFromJSON(values)
-      self$values <- list2env(values, self$values)
+      self$values <- list2env2(values, self$values)
     }
   )
 )
@@ -385,7 +385,7 @@ RestoreInputSet <- R6Class("RestoreInputSet",
 
   public = list(
     initialize = function(values) {
-      private$values <- list2env(values, parent = emptyenv())
+      private$values <- list2env2(values, parent = emptyenv())
     },
 
     exists = function(name) {

R/conditions.R

@@ -76,7 +76,7 @@ getCallNames <- function(calls) {
 }
 
 getLocs <- function(calls) {
-  sapply(calls, function(call) {
+  vapply(calls, function(call) {
     srcref <- attr(call, "srcref", exact = TRUE)
     if (!is.null(srcref)) {
       srcfile <- attr(srcref, "srcfile", exact = TRUE)
@@ -86,7 +86,7 @@ getLocs <- function(calls) {
       }
     }
     return("")
-  })
+  }, character(1))
 }
 
 #' @details \code{captureStackTraces} runs the given \code{expr} and if any

R/modal.R

@@ -43,6 +43,8 @@ removeModal <- function(session = getDefaultReactiveDomain()) {
 #'   \code{FALSE} (the default), the modal dialog can't be dismissed in those
 #'   ways; instead it must be dismissed by clicking on the dismiss button, or
 #'   from a call to \code{\link{removeModal}} on the server.
+#' @param fade If \code{FALSE}, the modal dialog will have no fade-in animation
+#'   (it will simply appear rather than fade in to view).
 #'
 #' @examples
 #' if (interactive()) {
@@ -143,11 +145,12 @@ removeModal <- function(session = getDefaultReactiveDomain()) {
 #' }
 #' @export
 modalDialog <- function(..., title = NULL, footer = modalButton("Dismiss"),
-  size = c("m", "s", "l"), easyClose = FALSE) {
+  size = c("m", "s", "l"), easyClose = FALSE, fade = TRUE) {
 
   size <- match.arg(size)
 
-  div(id = "shiny-modal", class = "modal fade", tabindex = "-1",
+  cls <- if (fade) "modal fade" else "modal"
+  div(id = "shiny-modal", class = cls, tabindex = "-1",
     `data-backdrop` = if (!easyClose) "static",
     `data-keyboard` = if (!easyClose) "false",
 

R/server-input-handlers.R

@@ -71,6 +71,63 @@ removeInputHandler <- function(type){
   inputHandlers$remove(type)
 }
 
+
+# Apply input handler to a single input value
+applyInputHandler <- function(name, val, shinysession) {
+  splitName <- strsplit(name, ':')[[1]]
+  if (length(splitName) > 1) {
+    if (!inputHandlers$containsKey(splitName[[2]])) {
+      # No input handler registered for this type
+      stop("No handler registered for type ", name)
+    }
+
+    inputName <- splitName[[1]]
+
+    # Get the function for processing this type of input
+    inputHandler <- inputHandlers$get(splitName[[2]])
+
+    return(inputHandler(val, shinysession, inputName))
+
+  } else if (is.list(val) && is.null(names(val))) {
+    return(unlist(val, recursive = TRUE))
+  } else {
+    return(val)
+  }
+}
+
+#' Apply input handlers to raw input values
+#'
+#' The purpose of this function is to make it possible for external packages to
+#' test Shiny inputs. It takes a named list of raw input values, applies input
+#' handlers to those values, and then returns a named list of the processed
+#' values.
+#'
+#' The raw input values should be in a named list. Some values may have names
+#' like \code{"x:shiny.date"}. This function would apply the \code{"shiny.date"}
+#' input handler to the value, and then rename the result to \code{"x"}, in the
+#' output.
+#'
+#' @param inputs A named list of input values.
+#' @param shinysession A Shiny session object.
+#'
+#' @seealso registerInputHandler
+#' @keywords internal
+applyInputHandlers <- function(inputs, shinysession = getDefaultReactiveDomain()) {
+  inputs <- mapply(applyInputHandler, names(inputs), inputs,
+                   MoreArgs = list(shinysession = shinysession),
+                   SIMPLIFY = FALSE)
+
+  # Convert names like "button1:shiny.action" to "button1"
+  names(inputs) <- vapply(
+    names(inputs),
+    function(name) { strsplit(name, ":")[[1]][1] },
+    FUN.VALUE = character(1)
+  )
+
+  inputs
+}
+
+
 # Takes a list-of-lists and returns a matrix. The lists
 # must all be the same length. NULL is replaced by NA.
 registerInputHandler("shiny.matrix", function(data, ...) {

R/server.R

@@ -218,7 +218,8 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
           if (is.character(msg))
             msg <- charToRaw(msg)
 
-          if (isTRUE(getOption('shiny.trace'))) {
+          traceOption <- getOption('shiny.trace', FALSE)
+          if (isTRUE(traceOption) || traceOption == "recv") {
             if (binary)
               message("RECV ", '$$binary data$$')
             else
@@ -247,38 +248,7 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
 
           withRestoreContext(shinysession$restoreContext, {
 
-            unpackInput <- function(name, val) {
-              splitName <- strsplit(name, ':')[[1]]
-              if (length(splitName) > 1) {
-                if (!inputHandlers$containsKey(splitName[[2]])) {
-                  # No input handler registered for this type
-                  stop("No handler registered for type ", name)
-                }
-
-                inputName <- splitName[[1]]
-
-                # Get the function for processing this type of input
-                inputHandler <- inputHandlers$get(splitName[[2]])
-
-                return(inputHandler(val, shinysession, inputName))
-
-              } else if (is.list(val) && is.null(names(val))) {
-                return(unlist(val, recursive = TRUE))
-              } else {
-                return(val)
-              }
-            }
-
-            msg$data <- mapply(unpackInput, names(msg$data), msg$data,
-                               SIMPLIFY = FALSE)
-
-            # Convert names like "button1:shiny.action" to "button1"
-            names(msg$data) <- vapply(
-              names(msg$data),
-              function(name) { strsplit(name, ":")[[1]][1] },
-              FUN.VALUE = character(1)
-            )
-
+            msg$data <- applyInputHandlers(msg$data)
 
             switch(
               msg$method,

R/shiny.R

@@ -39,9 +39,12 @@ NULL
 #'     when an app is run. See \code{\link{runApp}} for more information.}
 #'   \item{shiny.port}{A port number that Shiny will listen on. See
 #'     \code{\link{runApp}} for more information.}
-#'   \item{shiny.trace}{If \code{TRUE}, all of the messages sent between the R
-#'     server and the web browser client will be printed on the console. This
-#'     is useful for debugging.}
+#'   \item{shiny.trace}{Print messages sent between the R server and the web
+#'     browser client to the R console. This is useful for debugging. Possible
+#'     values are \code{"send"} (only print messages sent to the client),
+#'     \code{"recv"} (only print messages received by the server), \code{TRUE}
+#'     (print all messages), or \code{FALSE} (default; don't print any of these
+#'     messages).}
 #'   \item{shiny.autoreload}{If \code{TRUE} when a Shiny app is launched, the
 #'     app directory will be continually monitored for changes to files that
 #'     have the extensions: r, htm, html, js, css, png, jpg, jpeg, gif. If any
@@ -53,10 +56,10 @@ NULL
 #'
 #'     You can customize the file patterns Shiny will monitor by setting the
 #'     shiny.autoreload.pattern option. For example, to monitor only ui.R:
-#'     \code{option(shiny.autoreload.pattern = glob2rx("ui.R"))}
+#'     \code{options(shiny.autoreload.pattern = glob2rx("ui.R"))}
 #'
 #'     The default polling interval is 500 milliseconds. You can change this
-#'     by setting e.g. \code{option(shiny.autoreload.interval = 2000)} (every
+#'     by setting e.g. \code{options(shiny.autoreload.interval = 2000)} (every
 #'     two seconds).}
 #'   \item{shiny.reactlog}{If \code{TRUE}, enable logging of reactive events,
 #'     which can be viewed later with the \code{\link{showReactLog}} function.
@@ -104,6 +107,9 @@ NULL
 #'     particular error \code{e} to get displayed to the user, then set this option
 #'     to \code{TRUE} and use \code{stop(safeError(e))} for errors you want the
 #'     user to see.}
+#'   \item{shiny.testmode}{If \code{TRUE}, then enable features for testing Shiny
+#'     applications. If \code{FALSE} (the default), do not enable those features.
+#'   }
 #' }
 #' @name shiny-options
 NULL
@@ -323,6 +329,19 @@ workerId <- local({
 #' \item{doBookmark()}{
 #'   Do bookmarking and invoke the onBookmark and onBookmarked callback functions.
 #' }
+#' \item{exportTestValues()}{
+#'   Registers expressions for export in test mode, available at the test
+#'   endpoint URL.
+#' }
+#' \item{getTestEndpointUrl(inputs=TRUE, outputs=TRUE, exports=TRUE,
+#'   format="rds")}{
+#'   Returns a URL for the test endpoint. Only has an effect when the
+#'   \code{shiny.testmode} option is set to TRUE. For the inputs, outputs, and
+#'   exports arguments, TRUE means to return all of these values. It is also
+#'   possible to specify by name which values to return by providing a
+#'   character vector, as in \code{inputs=c("x", "y")}. The format can be
+#'   "rds" or "json".
+#' }
 #'
 #' @name session
 NULL
@@ -393,6 +412,10 @@ ShinySession <- R6Class(
     restoredCallbacks = 'Callbacks',
     bookmarkExclude = character(0),  # Names of inputs to exclude from bookmarking
 
+    testValueExprs = list(),
+    outputValues = list(),           # Saved output values (for testing mode)
+    testEndpointUrl = character(0),
+
     sendResponse = function(requestMsg, value) {
       if (is.null(requestMsg$tag)) {
         warning("Tried to send response for untagged message; method: ",
@@ -414,7 +437,8 @@ ShinySession <- R6Class(
       if (self$closed){
         return()
       }
-      if (isTRUE(getOption('shiny.trace')))
+      traceOption <- getOption('shiny.trace', FALSE)
+      if (isTRUE(traceOption) || traceOption == "send")
         message('SEND ',
            gsub('(?m)base64,[a-zA-Z0-9+/=]+','[base64 data]',json,perl=TRUE))
       private$websocket$send(json)
@@ -548,6 +572,98 @@ ShinySession <- R6Class(
         })
 
       }) # withReactiveDomain
+    },
+
+    # Save output values and errors. This is only used for testing mode.
+    storeOutputValues = function(values = NULL) {
+      private$outputValues <- mergeVectors(private$outputValues, values)
+    },
+
+    enableTestEndpoint = function() {
+      private$testEndpointUrl <- self$registerDataObj("shinytest", NULL,
+        function(data, req) {
+          if (!isTRUE(getOption("shiny.testmode"))) {
+            return()
+          }
+
+          params <- parseQueryString(req$QUERY_STRING)
+          # The format of the response that will be sent back. Default to "rds"
+          # unless requested otherwise. The only other valid value is "json".
+          format <- params$format %OR% "rds"
+
+          values <- list()
+
+          if (!is.null(params$inputs)) {
+
+            allInputs <- isolate(
+              reactiveValuesToList(self$input, all.names = TRUE)
+            )
+
+            # If params$inputs is "1", return all; otherwise return just the
+            # inputs that are named in params$inputs, like "x,y,z".
+            if (params$inputs == "1") {
+              values$inputs <- allInputs
+            } else {
+              items <- strsplit(params$inputs, ",")[[1]]
+              items <- intersect(items, names(allInputs))
+              values$inputs <- allInputs[items]
+            }
+          }
+
+          if (!is.null(params$outputs)) {
+
+            if (params$outputs == "1") {
+              values$outputs <- private$outputValues
+            } else {
+              items <- strsplit(params$outputs, ",")[[1]]
+              items <- intersect(items, names(private$outputValues))
+              values$outputs <- private$outputValues[items]
+            }
+          }
+
+          if (!is.null(params$exports)) {
+
+            testValueExprs <- private$testValueExprs
+            if (params$exports == "1") {
+              values$exports <- isolate(
+                lapply(private$testValueExprs, function(item) {
+                  eval(item$expr, envir = item$env)
+                })
+              )
+            } else {
+              items <- strsplit(params$exports, ",")[[1]]
+              items <- intersect(items, names(private$testValueExprs))
+              values$exports <- isolate(
+                lapply(private$testValueExprs[items], function(item) {
+                  eval(item$expr, envir = item$env)
+                })
+              )
+            }
+          }
+
+          if (length(values) == 0) {
+            return(httpResponse(400, "text/plain",
+              "No exports, inputs, or outputs requested."
+            ))
+          }
+
+          if (identical(format, "json")) {
+            content <- toJSON(values, pretty = TRUE)
+            httpResponse(200, "application/json", content)
+
+          } else if (identical(format, "rds")) {
+            tmpfile <- tempfile("shinytest", fileext = ".rds")
+            saveRDS(values, tmpfile)
+            on.exit(unlink(tmpfile))
+
+            content <- readBin(tmpfile, "raw", n = file.info(tmpfile)$size)
+            httpResponse(200, "application/octet-stream", content)
+
+          } else {
+            httpResponse(400, "text/plain", paste("Invalid format requested:", format))
+          }
+        }
+      )
     }
   ),
   public = list(
@@ -600,6 +716,8 @@ ShinySession <- R6Class(
       private$restoredCallbacks <- Callbacks$new()
       private$createBookmarkObservers()
 
+      private$enableTestEndpoint()
+
       private$registerSessionEndCallbacks()
 
       if (!is.null(websocket$request$HTTP_SHINY_SERVER_CREDENTIALS)) {
@@ -675,6 +793,24 @@ ShinySession <- R6Class(
             stop("`fun` must be a function that takes one argument")
           }
           restoredCallbacks$register(fun)
+        },
+        exportTestValues = function(..., quoted_ = FALSE, env_ = parent.frame()) {
+          if (quoted_) {
+            dots <- list(...)
+          } else {
+            dots <- eval(substitute(alist(...)))
+          }
+
+          if (anyUnnamed(dots))
+            stop("exportTestValues: all arguments must be named.")
+
+          names(dots) <- vapply(names(dots), ns, character(1))
+
+          do.call(
+            .subset2(self, "exportTestValues"),
+            c(dots, quoted_ = TRUE, env_ = env_),
+            quote = TRUE
+          )
         }
       )
 
@@ -992,16 +1128,20 @@ ShinySession <- R6Class(
       }
 
       private$progressKeys <- character(0)
-      values <- private$invalidatedOutputValues
+      values <- as.list(private$invalidatedOutputValues)
       private$invalidatedOutputValues <- Map$new()
-      errors <- private$invalidatedOutputErrors
+      errors <- as.list(private$invalidatedOutputErrors)
       private$invalidatedOutputErrors <- Map$new()
       inputMessages <- private$inputMessageQueue
       private$inputMessageQueue <- list()
 
+      if (isTRUE(getOption("shiny.testmode"))) {
+        private$storeOutputValues(mergeVectors(values, errors))
+      }
+
       private$sendMessage(
-        errors = as.list(errors),
-        values = as.list(values),
+        errors = errors,
+        values = values,
         inputMessages = inputMessages
       )
     },
@@ -1174,6 +1314,45 @@ ShinySession <- R6Class(
       )
     },
 
+    exportTestValues = function(..., quoted_ = FALSE, env_ = parent.frame()) {
+      # Get a named list of unevaluated expressions.
+      if (quoted_) {
+        dots <- list(...)
+      } else {
+        dots <- eval(substitute(alist(...)))
+      }
+
+      if (anyUnnamed(dots))
+        stop("exportTestValues: all arguments must be named.")
+
+      # Create a named list where each item is a list with an expression and
+      # environment in which to eval the expression.
+      items <- lapply(dots, function(expr) {
+        list(expr = expr, env = env_)
+      })
+
+      private$testValueExprs <- mergeVectors(private$testValueExprs, items)
+    },
+
+    getTestEndpointUrl = function(inputs = TRUE, outputs = TRUE, exports = TRUE,
+                                  format = "rds") {
+      reqString <- function(group, value) {
+        if (isTRUE(value))
+          paste0(group, "=1")
+        else if (is.character(value))
+          paste0(group, "=", paste(value, collapse = ","))
+        else
+          ""
+      }
+      paste(
+        private$testEndpointUrl,
+        reqString("inputs", inputs),
+        reqString("outputs", outputs),
+        reqString("exports", exports),
+        paste0("format=", format),
+        sep = "&"
+      )
+    },
 
     reactlog = function(logEntry) {
       # Use sendCustomMessage instead of sendMessage, because the handler in

R/test-export.R

@@ -0,0 +1,60 @@
+#' Register expressions for export in test mode
+#'
+#' This function registers expressions that will be evaluated when a test export
+#' event occurs. These events are triggered by accessing an API endpoint URL.
+#'
+#' This function only has an effect if the global option \code{shiny.testmode}
+#' is set to \code{TRUE}.
+#'
+#' @param quoted_ Are the expression quoted? Default is \code{FALSE}.
+#' @param env_ The environment in which the expression should be evaluated.
+#' @param session_ A Shiny session object.
+#' @param ... Named arguments that are quoted or unquoted expressions that will
+#'   be captured and evaluated when API endpoint is visited.
+#' @examples
+#' ## Only run this example in interactive R sessions
+#' if (interactive()) {
+#'
+#' options(shiny.testmode = TRUE)
+#'
+#' # This application shows the test endpoint URL; clicking on it will
+#' # fetch the input, output, and exported values in JSON format.
+#' shinyApp(
+#'   ui = basicPage(
+#'     h4("Snapshot URL: "),
+#'     uiOutput("url"),
+#'     h4("Current values:"),
+#'     verbatimTextOutput("values"),
+#'     actionButton("inc", "Increment x")
+#'   ),
+#'
+#'   server = function(input, output, session) {
+#'     vals <- reactiveValues(x = 1)
+#'     y <- reactive({ vals$x + 1 })
+#'
+#'     observeEvent(input$inc, {
+#'       vals$x <<- vals$x + 1
+#'     })
+#'
+#'     exportTestValues(
+#'       x = vals$x,
+#'       y = y()
+#'     )
+#'
+#'     output$url <- renderUI({
+#'       url <- session$getTestEndpointUrl(format="json")
+#'       a(href = url, url)
+#'     })
+#'
+#'     output$values <- renderText({
+#'       paste0("vals$x: ", vals$x, "\ny: ", y())
+#'     })
+#'   }
+#' )
+#' }
+#' @export
+exportTestValues <- function(..., quoted_ = FALSE, env_ = parent.frame(),
+  session_ = getDefaultReactiveDomain())
+{
+  session_$exportTestValues(..., quoted_ = quoted_, env_ = env_)
+}

R/update-input.R

@@ -622,7 +622,7 @@ updateSelectizeInput <- function(session, inputId, label = NULL, choices = NULL,
     res <- checkAsIs(options)
     cfg <- tags$script(
       type = 'application/json',
-      `data-for` = inputId,
+      `data-for` = session$ns(inputId),
       `data-eval` = if (length(res$eval)) HTML(toJSON(res$eval)),
       HTML(toJSON(res$options))
     )

R/utils.R

@@ -196,6 +196,16 @@ mergeVectors <- function(a, b) {
   x[!drop_idx]
 }
 
+# Wrapper around list2env with a NULL check. In R <3.2.0, if an empty unnamed
+# list is passed to list2env(), it errors. But an empty named list is OK. For
+# R >=3.2.0, this wrapper is not necessary.
+list2env2 <- function(x, ...) {
+  # Ensure that zero-length lists have a name attribute
+   if (length(x) == 0)
+    attr(x, "names") <- character(0)
+
+  list2env(x, ...)
+}
 
 # Combine dir and (file)name into a file path. If a file already exists with a
 # name differing only by case, then use it instead.

inst/staticdocs/index.r

@@ -184,10 +184,12 @@ sd_section("Utility functions",
     "safeError",
     "onFlush",
     "restoreInput",
+    "applyInputHandlers",
     "exprToFunction",
     "installExprFunction",
     "parseQueryString",
     "plotPNG",
+    "exportTestValues",
     "repeatable",
     "shinyDeprecated",
     "serverInfo",

inst/www/shared/shiny.js

@@ -1,6 +1,6 @@
 'use strict';
 
-var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol" ? function (obj) { return typeof obj; } : function (obj) { return obj && typeof Symbol === "function" && obj.constructor === Symbol ? "symbol" : typeof obj; };
+var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol" ? function (obj) { return typeof obj; } : function (obj) { return obj && typeof Symbol === "function" && obj.constructor === Symbol && obj !== Symbol.prototype ? "symbol" : typeof obj; };
 
 //---------------------------------------------------------------------
 // Source file: ../srcjs/_start.js
@@ -675,7 +675,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
       // function to normalize hostnames
       var normalize = function normalize(hostname) {
-        if (hostname == "127.0.0.1") return "localhost";else return hostname;
+        if (hostname === "127.0.0.1") return "localhost";else return hostname;
       };
 
       // Send a 'disconnected' message to parent if we are on the same domin
@@ -686,7 +686,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
         a.href = parentUrl;
 
         // post the disconnected message if the hostnames are the same
-        if (normalize(a.hostname) == normalize(window.location.hostname)) {
+        if (normalize(a.hostname) === normalize(window.location.hostname)) {
           var protocol = a.protocol.replace(':', ''); // browser compatability
           var origin = protocol + '://' + a.hostname;
           if (a.port) origin = origin + ':' + a.port;
@@ -971,8 +971,14 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
     // Adds custom message handler - this one is exposed to the user
     function addCustomMessageHandler(type, handler) {
+      // Remove any previously defined handlers so that only the most recent one
+      // will be called
       if (customMessageHandlers[type]) {
-        throw 'handler for message of type "' + type + '" already added.';
+        var typeIdx = customMessageHandlerOrder.indexOf(type);
+        if (typeIdx !== -1) {
+          customMessageHandlerOrder.splice(typeIdx, 1);
+          delete customMessageHandlers[type];
+        }
       }
       if (typeof handler !== 'function') {
         throw 'handler must be a function.';
@@ -1305,6 +1311,12 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     };
 
     exports.progressHandlers = progressHandlers;
+
+    // Returns a URL which can be queried to get values from inside the server
+    // function. This is enabled with `options(shiny.testmode=TRUE)`.
+    this.getTestEndpointUrl = function () {
+      return "session/" + encodeURIComponent(this.config.sessionId) + "/dataobj/shinytest?w=" + encodeURIComponent(this.config.workerId) + "&nonce=" + randomId();
+    };
   }).call(ShinyApp.prototype);
 
   exports.showReconnectDialog = function () {
@@ -1361,7 +1373,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     var fadeDuration = 250;
 
     function show() {
-      var _ref = arguments.length <= 0 || arguments[0] === undefined ? {} : arguments[0];
+      var _ref = arguments.length > 0 && arguments[0] !== undefined ? arguments[0] : {};
 
       var _ref$html = _ref.html;
       var html = _ref$html === undefined ? '' : _ref$html;
@@ -1520,7 +1532,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     // content is non-Bootstrap. Bootstrap modals require some special handling,
     // which is coded in here.
     show: function show() {
-      var _ref2 = arguments.length <= 0 || arguments[0] === undefined ? {} : arguments[0];
+      var _ref2 = arguments.length > 0 && arguments[0] !== undefined ? arguments[0] : {};
 
       var _ref2$html = _ref2.html;
       var html = _ref2$html === undefined ? '' : _ref2$html;
@@ -1529,7 +1541,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
 
       // If there was an existing Bootstrap modal, then there will be a modal-
-      // backdrop div that was added outside of the modal wrapper, and it must be 
+      // backdrop div that was added outside of the modal wrapper, and it must be
       // removed; otherwise there can be multiple of these divs.
       $('.modal-backdrop').remove();
 
@@ -1541,9 +1553,11 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
         // If the wrapper's content is a Bootstrap modal, then when the inner
         // modal is hidden, remove the entire thing, including wrapper.
-        $modal.on('hidden.bs.modal', function () {
-          exports.unbindAll($modal);
-          $modal.remove();
+        $modal.on('hidden.bs.modal', function (e) {
+          if (e.target === $("#shiny-modal")[0]) {
+            exports.unbindAll($modal);
+            $modal.remove();
+          }
         });
       }
 
@@ -2675,7 +2689,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
         var aProps = Object.getOwnPropertyNames(a);
         var bProps = Object.getOwnPropertyNames(b);
 
-        if (aProps.length != bProps.length) return false;
+        if (aProps.length !== bProps.length) return false;
 
         for (var i = 0; i < aProps.length; i++) {
           var propName = aProps[i];
@@ -3075,7 +3089,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
   // inputs/outputs. `content` can be null, a string, or an object with
   // properties 'html' and 'deps'.
   exports.renderContent = function (el, content) {
-    var where = arguments.length <= 2 || arguments[2] === undefined ? "replace" : arguments[2];
+    var where = arguments.length > 2 && arguments[2] !== undefined ? arguments[2] : "replace";
 
     exports.unbindAll(el);
 
@@ -3112,7 +3126,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
   // Render HTML in a DOM element, inserting singletons into head as needed
   exports.renderHtml = function (html, el, dependencies) {
-    var where = arguments.length <= 3 || arguments[3] === undefined ? 'replace' : arguments[3];
+    var where = arguments.length > 3 && arguments[3] !== undefined ? arguments[3] : 'replace';
 
     renderDependencies(dependencies);
     return singletons.renderHtml(html, el, where);
@@ -3414,6 +3428,10 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     this.getValue = function (el) {
       throw "Not implemented";
     };
+
+    // The callback method takes one argument, whose value is boolean. If true,
+    // allow deferred (debounce or throttle) sending depending on the value of
+    // getRatePolicy. If false, send value immediately.
     this.subscribe = function (el, callback) {};
     this.unsubscribe = function (el) {};
 
@@ -3639,25 +3657,32 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
         };
       }
 
-      if (this._numValues(el) == 2) {
+      if (this._numValues(el) === 2) {
         return [convert(result.from), convert(result.to)];
       } else {
         return convert(result.from);
       }
     },
     setValue: function setValue(el, value) {
-      var slider = $(el).data('ionRangeSlider');
+      var $el = $(el);
+      var slider = $el.data('ionRangeSlider');
 
-      if (this._numValues(el) == 2 && value instanceof Array) {
-        slider.update({ from: value[0], to: value[1] });
-      } else {
-        slider.update({ from: value });
+      $el.data('immediate', true);
+      try {
+        if (this._numValues(el) === 2 && value instanceof Array) {
+          slider.update({ from: value[0], to: value[1] });
+        } else {
+          slider.update({ from: value });
+        }
+
+        forceIonSliderUpdate(slider);
+      } finally {
+        $el.data('immediate', false);
       }
-      forceIonSliderUpdate(slider);
     },
     subscribe: function subscribe(el, callback) {
       $(el).on('change.sliderInputBinding', function (event) {
-        callback(!$(el).data('updating') && !$(el).data('animating'));
+        callback(!$(el).data('immediate') && !$(el).data('animating'));
       });
     },
     unsubscribe: function unsubscribe(el) {
@@ -3669,7 +3694,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
       var msg = {};
 
       if (data.hasOwnProperty('value')) {
-        if (this._numValues(el) == 2 && data.value instanceof Array) {
+        if (this._numValues(el) === 2 && data.value instanceof Array) {
           msg.from = data.value[0];
           msg.to = data.value[1];
         } else {
@@ -3682,12 +3707,12 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
       if (data.hasOwnProperty('label')) $el.parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
 
-      $el.data('updating', true);
+      $el.data('immediate', true);
       try {
         slider.update(msg);
         forceIonSliderUpdate(slider);
       } finally {
-        $el.data('updating', false);
+        $el.data('immediate', false);
       }
     },
     getRatePolicy: function getRatePolicy() {
@@ -4031,8 +4056,8 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
       return [formatDateUTC(start), formatDateUTC(end)];
     },
-    // value must be an array of unambiguous strings like '2001-01-01', or
-    // Date objects.
+    // value must be an object, with optional fields `start` and `end`. These
+    // should be unambiguous strings like '2001-01-01', or Date objects.
     setValue: function setValue(el, value) {
       if (!(value instanceof Object)) {
         return;
@@ -4523,7 +4548,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
       // from being mistakenly selected)
       if ($el.find('i[class]').length > 0) {
         var icon_html = $el.find('i[class]')[0];
-        if (icon_html == $el.children()[0]) {
+        if (icon_html === $el.children()[0]) {
           // another check for robustness
           icon = $(icon_html).prop('outerHTML');
         }
@@ -4848,7 +4873,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     var shinyapp = exports.shinyapp = new ShinyApp();
 
     function bindOutputs() {
-      var scope = arguments.length <= 0 || arguments[0] === undefined ? document : arguments[0];
+      var scope = arguments.length > 0 && arguments[0] !== undefined ? arguments[0] : document;
 
       scope = $(scope);
 
@@ -4864,6 +4889,11 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
           // Check if ID is falsy
           if (!id) continue;
 
+          // In some uncommon cases, elements that are later in the
+          // matches array can be removed from the document by earlier
+          // iterations. See https://github.com/rstudio/shiny/issues/1399
+          if (!$.contains(document, el)) continue;
+
           var $el = $(el);
           if ($el.hasClass('shiny-bound-output')) {
             // Already bound; can happen with nested uiOutput (bindAll
@@ -4889,8 +4919,8 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     }
 
     function unbindOutputs() {
-      var scope = arguments.length <= 0 || arguments[0] === undefined ? document : arguments[0];
-      var includeSelf = arguments.length <= 1 || arguments[1] === undefined ? false : arguments[1];
+      var scope = arguments.length > 0 && arguments[0] !== undefined ? arguments[0] : document;
+      var includeSelf = arguments.length > 1 && arguments[1] !== undefined ? arguments[1] : false;
 
       var outputs = $(scope).find('.shiny-bound-output');
 
@@ -4952,7 +4982,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     }
 
     function bindInputs() {
-      var scope = arguments.length <= 0 || arguments[0] === undefined ? document : arguments[0];
+      var scope = arguments.length > 0 && arguments[0] !== undefined ? arguments[0] : document;
 
       var bindings = inputBindings.getBindings();
 
@@ -5010,8 +5040,8 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     }
 
     function unbindInputs() {
-      var scope = arguments.length <= 0 || arguments[0] === undefined ? document : arguments[0];
-      var includeSelf = arguments.length <= 1 || arguments[1] === undefined ? false : arguments[1];
+      var scope = arguments.length > 0 && arguments[0] !== undefined ? arguments[0] : document;
+      var includeSelf = arguments.length > 1 && arguments[1] !== undefined ? arguments[1] : false;
 
       var inputs = $(scope).find('.shiny-bound-input');
 
@@ -5040,7 +5070,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
       return bindInputs(scope);
     }
     function unbindAll(scope) {
-      var includeSelf = arguments.length <= 1 || arguments[1] === undefined ? false : arguments[1];
+      var includeSelf = arguments.length > 1 && arguments[1] !== undefined ? arguments[1] : false;
 
       unbindInputs(scope, includeSelf);
       unbindOutputs(scope, includeSelf);
@@ -5065,7 +5095,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     // Calls .initialize() for all of the input objects in all input bindings,
     // in the given scope.
     function initializeInputs() {
-      var scope = arguments.length <= 0 || arguments[0] === undefined ? document : arguments[0];
+      var scope = arguments.length > 0 && arguments[0] !== undefined ? arguments[0] : document;
 
       var bindings = inputBindings.getBindings();
 

man/applyInputHandlers.Rd

@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/server-input-handlers.R
+\name{applyInputHandlers}
+\alias{applyInputHandlers}
+\title{Apply input handlers to raw input values}
+\usage{
+applyInputHandlers(inputs, shinysession = getDefaultReactiveDomain())
+}
+\arguments{
+\item{inputs}{A named list of input values.}
+
+\item{shinysession}{A Shiny session object.}
+}
+\description{
+The purpose of this function is to make it possible for external packages to
+test Shiny inputs. It takes a named list of raw input values, applies input
+handlers to those values, and then returns a named list of the processed
+values.
+}
+\details{
+The raw input values should be in a named list. Some values may have names
+like \code{"x:shiny.date"}. This function would apply the \code{"shiny.date"}
+input handler to the value, and then rename the result to \code{"x"}, in the
+output.
+}
+\seealso{
+registerInputHandler
+}
+\keyword{internal}
+

man/exportTestValues.Rd

@@ -0,0 +1,70 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/test-export.R
+\name{exportTestValues}
+\alias{exportTestValues}
+\title{Register expressions for export in test mode}
+\usage{
+exportTestValues(..., quoted_ = FALSE, env_ = parent.frame(),
+  session_ = getDefaultReactiveDomain())
+}
+\arguments{
+\item{...}{Named arguments that are quoted or unquoted expressions that will
+be captured and evaluated when API endpoint is visited.}
+
+\item{quoted_}{Are the expression quoted? Default is \code{FALSE}.}
+
+\item{env_}{The environment in which the expression should be evaluated.}
+
+\item{session_}{A Shiny session object.}
+}
+\description{
+This function registers expressions that will be evaluated when a test export
+event occurs. These events are triggered by accessing an API endpoint URL.
+}
+\details{
+This function only has an effect if the global option \code{shiny.testmode}
+is set to \code{TRUE}.
+}
+\examples{
+## Only run this example in interactive R sessions
+if (interactive()) {
+
+options(shiny.testmode = TRUE)
+
+# This application shows the test endpoint URL; clicking on it will
+# fetch the input, output, and exported values in JSON format.
+shinyApp(
+  ui = basicPage(
+    h4("Snapshot URL: "),
+    uiOutput("url"),
+    h4("Current values:"),
+    verbatimTextOutput("values"),
+    actionButton("inc", "Increment x")
+  ),
+
+  server = function(input, output, session) {
+    vals <- reactiveValues(x = 1)
+    y <- reactive({ vals$x + 1 })
+
+    observeEvent(input$inc, {
+      vals$x <<- vals$x + 1
+    })
+
+    exportTestValues(
+      x = vals$x,
+      y = y()
+    )
+
+    output$url <- renderUI({
+      url <- session$getTestEndpointUrl(format="json")
+      a(href = url, url)
+    })
+
+    output$values <- renderText({
+      paste0("vals$x: ", vals$x, "\\ny: ", y())
+    })
+  }
+)
+}
+}
+

man/modalDialog.Rd

@@ -5,7 +5,7 @@
 \title{Create a modal dialog UI}
 \usage{
 modalDialog(..., title = NULL, footer = modalButton("Dismiss"),
-  size = c("m", "s", "l"), easyClose = FALSE)
+  size = c("m", "s", "l"), easyClose = FALSE, fade = TRUE)
 }
 \arguments{
 \item{...}{UI elements for the body of the modal dialog box.}
@@ -22,6 +22,9 @@ clicking outside the dialog box, or be pressing the Escape key. If
 \code{FALSE} (the default), the modal dialog can't be dismissed in those
 ways; instead it must be dismissed by clicking on the dismiss button, or
 from a call to \code{\link{removeModal}} on the server.}
+
+\item{fade}{If \code{FALSE}, the modal dialog will have no fade-in animation
+(it will simply appear rather than fade in to view).}
 }
 \description{
 This creates the UI for a modal dialog, using Bootstrap's modal class. Modals

man/session.Rd

@@ -155,6 +155,19 @@
 \item{doBookmark()}{
   Do bookmarking and invoke the onBookmark and onBookmarked callback functions.
 }
+\item{exportTestValues()}{
+  Registers expressions for export in test mode, available at the test
+  endpoint URL.
+}
+\item{getTestEndpointUrl(inputs=TRUE, outputs=TRUE, exports=TRUE,
+  format="rds")}{
+  Returns a URL for the test endpoint. Only has an effect when the
+  \code{shiny.testmode} option is set to TRUE. For the inputs, outputs, and
+  exports arguments, TRUE means to return all of these values. It is also
+  possible to specify by name which values to return by providing a
+  character vector, as in \code{inputs=c("x", "y")}. The format can be
+  "rds" or "json".
+}
 }
 \description{
 Shiny server functions can optionally include \code{session} as a parameter

man/shiny-options.Rd

@@ -13,9 +13,12 @@ be set with (for example) \code{options(shiny.trace=TRUE)}.
     when an app is run. See \code{\link{runApp}} for more information.}
   \item{shiny.port}{A port number that Shiny will listen on. See
     \code{\link{runApp}} for more information.}
-  \item{shiny.trace}{If \code{TRUE}, all of the messages sent between the R
-    server and the web browser client will be printed on the console. This
-    is useful for debugging.}
+  \item{shiny.trace}{Print messages sent between the R server and the web
+    browser client to the R console. This is useful for debugging. Possible
+    values are \code{"send"} (only print messages sent to the client),
+    \code{"recv"} (only print messages received by the server), \code{TRUE}
+    (print all messages), or \code{FALSE} (default; don't print any of these
+    messages).}
   \item{shiny.autoreload}{If \code{TRUE} when a Shiny app is launched, the
     app directory will be continually monitored for changes to files that
     have the extensions: r, htm, html, js, css, png, jpg, jpeg, gif. If any
@@ -27,10 +30,10 @@ Since monitoring for changes is expensive (we simply poll for last
 
 You can customize the file patterns Shiny will monitor by setting the
     shiny.autoreload.pattern option. For example, to monitor only ui.R:
-    \code{option(shiny.autoreload.pattern = glob2rx("ui.R"))}
+    \code{options(shiny.autoreload.pattern = glob2rx("ui.R"))}
 
 The default polling interval is 500 milliseconds. You can change this
-    by setting e.g. \code{option(shiny.autoreload.interval = 2000)} (every
+    by setting e.g. \code{options(shiny.autoreload.interval = 2000)} (every
     two seconds).}
   \item{shiny.reactlog}{If \code{TRUE}, enable logging of reactive events,
     which can be viewed later with the \code{\link{showReactLog}} function.
@@ -78,6 +81,9 @@ The default polling interval is 500 milliseconds. You can change this
     particular error \code{e} to get displayed to the user, then set this option
     to \code{TRUE} and use \code{stop(safeError(e))} for errors you want the
     user to see.}
+  \item{shiny.testmode}{If \code{TRUE}, then enable features for testing Shiny
+    applications. If \code{FALSE} (the default), do not enable those features.
+  }
 }
 }
 

srcjs/init_shiny.js

@@ -18,6 +18,12 @@ function initShiny() {
         if (!id)
           continue;
 
+        // In some uncommon cases, elements that are later in the
+        // matches array can be removed from the document by earlier
+        // iterations. See https://github.com/rstudio/shiny/issues/1399
+        if (!$.contains(document, el))
+          continue;
+
         var $el = $(el);
         if ($el.hasClass('shiny-bound-output')) {
           // Already bound; can happen with nested uiOutput (bindAll

srcjs/input_binding.js

@@ -14,6 +14,10 @@ this.getId = function(el) {
 // to deserialize the JSON correctly
 this.getType = function() { return false; };
 this.getValue = function(el) { throw "Not implemented"; };
+
+// The callback method takes one argument, whose value is boolean. If true,
+// allow deferred (debounce or throttle) sending depending on the value of
+// getRatePolicy. If false, send value immediately.
 this.subscribe = function(el, callback) { };
 this.unsubscribe = function(el) { };
 

srcjs/input_binding_actionbutton.js

@@ -37,7 +37,7 @@ $.extend(actionButtonInputBinding, {
     // from being mistakenly selected)
     if ($el.find('i[class]').length > 0) {
       var icon_html = $el.find('i[class]')[0];
-      if (icon_html == $el.children()[0]) {     // another check for robustness
+      if (icon_html === $el.children()[0]) {     // another check for robustness
         icon = $(icon_html).prop('outerHTML');
       }
     }

srcjs/input_binding_daterange.js

@@ -12,8 +12,8 @@ $.extend(dateRangeInputBinding, dateInputBinding, {
 
     return [formatDateUTC(start), formatDateUTC(end)];
   },
-  // value must be an array of unambiguous strings like '2001-01-01', or
-  // Date objects.
+  // value must be an object, with optional fields `start` and `end`. These
+  // should be unambiguous strings like '2001-01-01', or Date objects.
   setValue: function(el, value) {
     if (!(value instanceof Object)) {
       return;

srcjs/input_binding_slider.js

@@ -44,7 +44,7 @@ $.extend(sliderInputBinding, textInputBinding, {
       convert = function(val) { return +val; };
     }
 
-    if (this._numValues(el) == 2) {
+    if (this._numValues(el) === 2) {
       return [convert(result.from), convert(result.to)];
     }
     else {
@@ -53,18 +53,25 @@ $.extend(sliderInputBinding, textInputBinding, {
 
   },
   setValue: function(el, value) {
-    var slider = $(el).data('ionRangeSlider');
+    var $el = $(el);
+    var slider = $el.data('ionRangeSlider');
 
-    if (this._numValues(el) == 2 && value instanceof Array) {
-      slider.update({ from: value[0], to: value[1] });
-    } else {
-      slider.update({ from: value });
+    $el.data('immediate', true);
+    try {
+      if (this._numValues(el) === 2 && value instanceof Array) {
+        slider.update({ from: value[0], to: value[1] });
+      } else {
+        slider.update({ from: value });
+      }
+
+      forceIonSliderUpdate(slider);
+    } finally {
+      $el.data('immediate', false);
     }
-    forceIonSliderUpdate(slider);
   },
   subscribe: function(el, callback) {
     $(el).on('change.sliderInputBinding', function(event) {
-      callback(!$(el).data('updating') && !$(el).data('animating'));
+      callback(!$(el).data('immediate') && !$(el).data('animating'));
     });
   },
   unsubscribe: function(el) {
@@ -76,7 +83,7 @@ $.extend(sliderInputBinding, textInputBinding, {
     var msg = {};
 
     if (data.hasOwnProperty('value')) {
-      if (this._numValues(el) == 2 && data.value instanceof Array) {
+      if (this._numValues(el) === 2 && data.value instanceof Array) {
         msg.from = data.value[0];
         msg.to = data.value[1];
       } else {
@@ -90,12 +97,12 @@ $.extend(sliderInputBinding, textInputBinding, {
     if (data.hasOwnProperty('label'))
       $el.parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
 
-    $el.data('updating', true);
+    $el.data('immediate', true);
     try {
       slider.update(msg);
       forceIonSliderUpdate(slider);
     } finally {
-      $el.data('updating', false);
+      $el.data('immediate', false);
     }
   },
   getRatePolicy: function() {

srcjs/modal.js

@@ -7,7 +7,7 @@ exports.modal = {
   show: function({ html='', deps=[] } = {}) {
 
     // If there was an existing Bootstrap modal, then there will be a modal-
-    // backdrop div that was added outside of the modal wrapper, and it must be 
+    // backdrop div that was added outside of the modal wrapper, and it must be
     // removed; otherwise there can be multiple of these divs.
     $('.modal-backdrop').remove();
 
@@ -19,9 +19,11 @@ exports.modal = {
 
       // If the wrapper's content is a Bootstrap modal, then when the inner
       // modal is hidden, remove the entire thing, including wrapper.
-      $modal.on('hidden.bs.modal', function() {
-        exports.unbindAll($modal);
-        $modal.remove();
+      $modal.on('hidden.bs.modal', function(e) {
+        if (e.target === $("#shiny-modal")[0]) {
+          exports.unbindAll($modal);
+          $modal.remove();
+        }
       });
     }
 

srcjs/output_binding_image.js

@@ -983,7 +983,7 @@ imageutils.createBrush = function($el, opts, coordmap, expandPixels) {
       var aProps = Object.getOwnPropertyNames(a);
       var bProps = Object.getOwnPropertyNames(b);
 
-      if (aProps.length != bProps.length)
+      if (aProps.length !== bProps.length)
         return false;
 
       for (var i=0; i<aProps.length; i++) {

srcjs/shinyapp.js

@@ -146,7 +146,7 @@ var ShinyApp = function() {
 
     // function to normalize hostnames
     var normalize = function(hostname) {
-      if (hostname == "127.0.0.1")
+      if (hostname === "127.0.0.1")
         return "localhost";
       else
         return hostname;
@@ -160,7 +160,7 @@ var ShinyApp = function() {
       a.href = parentUrl;
 
       // post the disconnected message if the hostnames are the same
-      if (normalize(a.hostname) == normalize(window.location.hostname)) {
+      if (normalize(a.hostname) === normalize(window.location.hostname)) {
         var protocol = a.protocol.replace(':',''); // browser compatability
         var origin = protocol + '://' + a.hostname;
         if (a.port)
@@ -456,8 +456,14 @@ var ShinyApp = function() {
 
   // Adds custom message handler - this one is exposed to the user
   function addCustomMessageHandler(type, handler) {
+    // Remove any previously defined handlers so that only the most recent one
+    // will be called
     if (customMessageHandlers[type]) {
-      throw('handler for message of type "' + type + '" already added.');
+      var typeIdx = customMessageHandlerOrder.indexOf(type);
+      if (typeIdx !== -1) {
+        customMessageHandlerOrder.splice(typeIdx, 1);
+        delete customMessageHandlers[type];
+      }
     }
     if (typeof(handler) !== 'function') {
       throw('handler must be a function.');
@@ -832,6 +838,15 @@ var ShinyApp = function() {
 
   exports.progressHandlers = progressHandlers;
 
+  // Returns a URL which can be queried to get values from inside the server
+  // function. This is enabled with `options(shiny.testmode=TRUE)`.
+  this.getTestEndpointUrl = function() {
+    return "session/" +
+      encodeURIComponent(this.config.sessionId) +
+      "/dataobj/shinytest?w=" +
+      encodeURIComponent(this.config.workerId) +
+      "&nonce=" + randomId();
+  };
 
 }).call(ShinyApp.prototype);
 

tests/testthat/test-stacks.R

@@ -13,7 +13,15 @@ causeError <- function(full) {
     B()
   })
 
-  res <- try(captureStackTraces(isolate(renderTable({C()}, server = FALSE)())),
+  res <- try({
+      captureStackTraces({
+        isolate({
+          renderTable({
+            C()
+          }, server = FALSE)()
+        })
+      })
+    },
     silent = TRUE)
   cond <- attr(res, "condition", exact = TRUE)
 
@@ -50,7 +58,7 @@ test_that("integration tests", {
     "isolate", "withCallingHandlers", "captureStackTraces", "doTryCatch",
     "tryCatchOne", "tryCatchList", "tryCatch", "try"))
   expect_equal(nzchar(df$loc), c(TRUE, TRUE, TRUE, FALSE, TRUE,
-    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+    FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, FALSE, FALSE,
     FALSE, FALSE))
 
   df <- causeError(full = TRUE)
@@ -72,8 +80,8 @@ test_that("integration tests", {
     "tryCatch", "try"))
   expect_equal(nzchar(df$loc), c(FALSE, FALSE, FALSE, TRUE,
     TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
-    FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE,
-    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+    FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE,
+    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, TRUE,
     FALSE, FALSE, FALSE, FALSE))
 })
 

tools/Gruntfile.js

@@ -94,6 +94,7 @@ module.exports = function(grunt) {
         rules: {
           "consistent-return": 1,
           "dot-location": [1, "property"],
+          "eqeqeq": 1,
           // "no-shadow": 1,
           "no-undef": 1,
           "no-unused-vars": [1, {"args": "none"}],

tools/README.md

@@ -1,30 +1,49 @@
 This directory contains build tools for Shiny.
 
 
-## Grunt
+## JavaScript build tools
 
-Grunt is a build tool that runs on node.js. In Shiny, it is used for concatenating, minifying, and linting Javascript code.
 
-### Installing Grunt
+### First-time setup
 
-Grunt requires Node.js and npm (the Node.js package manager). Installation of these programs differs across platforms and is generally pretty easy, so I won't include instructions here.
+Shiny's JavaScript build tools use Node.js, along with [yarn](https://yarnpkg.com/) to manage the JavaScript packages.
 
-Once node and npm are installed, install grunt:
+Installation of Node.js differs across platforms and is generally pretty easy, so I won't include instructions here.
+
+There are a number of ways to [install yarn](https://yarnpkg.com/en/docs/install), but if you already have npm installed, you can simply run:
+
+```
+sudo npm install --global yarn
+```
+
+Then, in this directory (tools/), run the following to install the packages:
+
+```
+yarn
+```
+
+If in the future you want to upgrade or add a package, run:
+
+```
+yarn add --dev [packagename]
+```
+
+If someone else updates the package.json and/or yarn.lock files, simply run `yarn` to update your packages.
+
+For information about upgrading or installing new packages, see the [yarn workflow documentation](https://yarnpkg.com/en/docs/yarn-workflow).
+
+
+### Grunt
+
+Grunt is a build tool that runs on node.js and will be installed. In Shiny, it is used for concatenating, minifying, and linting Javascript code.
+
+#### Installing Grunt
 
 ```
 # Install grunt command line tool globally
-sudo npm install -g grunt-cli
-
-# Install grunt plus modules for this project
-npm install
-
-# To update modules in the future
-npm update
+sudo yarn global add grunt-cli
 ```
 
-Note: The `package.json` file contains a reference to `estraverse-fb`. This is needed only because the current version of ESLint has a [bug](https://github.com/eslint/eslint/issues/5476). At some point in the future, it can be removed.
-
-
 ### Using Grunt
 
 To run all default grunt tasks (concatenation, minification, and jshint), simply go into the `tools` directory and run:
@@ -58,7 +77,7 @@ Updating web libraries
 
 To update the version of babel-polyfill:
 
-* Check if there is a newer version available by running `npm outdated babel-polyfill`. (If there's no output, then you have the latest version.)
-* Run `npm install babel-polyfill --save-dev --save-exact`.
+* Check if there is a newer version available by running `yarn outdated babel-polyfill`. (If there's no output, then you have the latest version.)
+* Run `yarn add --dev babel-polyfill --exact`.
 * Edit R/shinyui.R. The `renderPage` function has an `htmlDependency` for
   `babel-polyfill`. Update this to the new version number.

tools/package.json

@@ -4,7 +4,6 @@
     "babel-polyfill": "6.7.2",
     "babel-preset-es2015": "^6.6.0",
     "eslint-stylish-mapped": "^1.0.0",
-    "estraverse-fb": "^1.3.1",
     "grunt": "~1.0.0",
     "grunt-babel": "^6.0.0",
     "grunt-contrib-clean": "^1.0.0",