added convenience function: getCurrentObserver. The dig param is problematic (if it's FALSE -- this does not work for observeEvent, only observe)

* Fix #1013: flushReact should be called after app loads

* Add link to pull request

CONTRIBUTING.md

@@ -1,10 +1,38 @@
-
 We welcome contributions to the **shiny** package. To submit a contribution:
 
 1. [Fork](https://github.com/rstudio/shiny/fork) the repository and make your changes.
 
-2. Ensure that you have signed the [individual](http://www.rstudio.com/wp-content/uploads/2014/06/RStudioIndividualContributorAgreement.pdf) or [corporate](http://www.rstudio.com/wp-content/uploads/2014/06/RStudioCorporateContributorAgreement.pdf) contributor agreement as appropriate. You can send the signed copy to jj@rstudio.com.
+2. If the change is non-trivial, ensure that you have signed the [individual](http://www.rstudio.com/wp-content/uploads/2014/06/RStudioIndividualContributorAgreement.pdf) or [corporate](http://www.rstudio.com/wp-content/uploads/2014/06/RStudioCorporateContributorAgreement.pdf) contributor agreement as appropriate. You can send the signed copy to jj@rstudio.com. For trivial changes (like typo fixes), a contributor agreement is not needed.
 
 3. Submit a [pull request](https://help.github.com/articles/using-pull-requests).
 
-We'll try to be as responsive as possible in reviewing and accepting pull requests. We appreciate your contributions!
+We generally do not merge pull requests that update included web libraries (such as Bootstrap or jQuery) because it is difficult for us to verify that the update is done correctly; we prefer to update these libraries ourselves.
+
+
+## How to make changes
+
+Before you submit a pull request, please do the following:
+
+* Add an entry to NEWS.md concisely describing what you changed.
+
+* If appropriate, add unit tests in the tests/ directory.
+
+* If you made any changes to the JavaScript files in the srcjs/ directory, make sure you build the output JavaScript files. See tools/README.md file for information on using the build system.
+
+* Run Build->Check Package in the RStudio IDE, or `devtools::check()`, to make sure your change did not add any messages, warnings, or errors.
+
+Doing these things will make it easier for the Shiny development team to evaluate your pull request. Even so, we may still decide to modify your code or even not merge it at all. Factors that may prevent us from merging the pull request include:
+
+* breaking backward compatibility
+* adding a feature that we do not consider relevant for Shiny
+* is hard to understand
+* is hard to maintain in the future
+* is computationally expensive
+* is not intuitive for people to use
+
+We will try to be responsive and provide feedback in case we decide not to merge your pull request.
+
+
+## Filing issues
+
+If you find a bug in Shiny, you can also [file an issue](https://github.com/rstudio/shiny/issues/new). Please provide as much relevant information as you can, and include a minimal reproducible example if possible.

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 0.14.1
+Version: 0.14.2.9001
 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)
@@ -83,6 +84,7 @@ export(fluidPage)
 export(fluidRow)
 export(formatStackTrace)
 export(freezeReactiveValue)
+export(getCurrentObserver)
 export(getDefaultReactiveDomain)
 export(getShinyOption)
 export(h1)

NEWS.md

@@ -1,3 +1,65 @@
+shiny 0.14.2.9000
+============
+
+## Full changelog
+
+### Breaking changes
+
+* Added a new `placeholder` argument to `verbatimTextOutput()`. The default is `FALSE`, which means that, if there is no content for this output, no representation of this slot will be made in the UI. Previsouly, even if there was no content, you'd see an empty rectangle in the UI that served as a placeholder. You can set `placeholder = TRUE` to revert back to that look. ([#1480](https://github.com/rstudio/shiny/pull/1480))
+
+### Minor new features and improvements
+
+* Added a more descriptive JS warning for `insertUI()` when the selector argument does not match anything in DOM. ([#1488](https://github.com/rstudio/shiny/pull/1488))
+
+* Added support for injecting JavaScript code when the `shiny.testmode` option is set to `TRUE`. This makes it possible to record test events interactively. ([#1464]https://github.com/rstudio/shiny/pull/1464))
+
+* Added ability through arguments to the `a` tag function called inside `downloadButton()` and `downloadLink()`. Closes [#986](https://github.com/rstudio/shiny/issues/986). ([#1492](https://github.com/rstudio/shiny/pulls/1492))
+
+* Implemented [#1512](https://github.com/rstudio/shiny/issues/1512): added a `userData` environment to `session`, for storing arbitrary session-related variables. Generally, session-scoped variables are created just by declaring normal variables that are local to the Shiny server function, but `session$userData` may be more convenient for some advanced scenarios. ([#1513](https://github.com/rstudio/shiny/pull/1513))
+
+### Bug fixes
+
+* Fixed [#969](https://github.com/rstudio/shiny/issues/969): allow navbarPage's `fluid` param to control both containers. ([#1481](https://github.com/rstudio/shiny/pull/1481))
+
+* Fixed [#1438](https://github.com/rstudio/shiny/issues/1438): `unbindAll()` should not be called when inserting content with `insertUI()` ([#1449](https://github.com/rstudio/shiny/pull/1449))
+
+* Fixed bug causing `<meta>` tags associated with HTML dependencies of Shiny R Markdown files to be rendered incorrectly. ([#1463](https://github.com/rstudio/shiny/pull/1463))
+
+* Fixed [#1359](https://github.com/rstudio/shiny/issues/1359): `shinyApp()` options argument ignored when passed to `runApp()`. ([#1483](https://github.com/rstudio/shiny/pull/1483))
+
+* Fixed [#117](https://github.com/rstudio/shiny/issues/117): Reactive expressions now release references to cached values as soon as they are invalidated, potentially making those cached values eligible for garbage collection sooner. Previously, this would not occur until the next cached value was calculated and stored. ([#1504](https://github.com/rstudio/shiny/pull/1504/files))
+
+* Fixed [#1013](https://github.com/rstudio/shiny/issues/1013): `flushReact` should be called after app loads. Observers set up outside of server functions were not running until after the first user connects. ([#1503](https://github.com/rstudio/shiny/pull/1503))
+
+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

@@ -20,9 +20,11 @@
 #' @param onStart A function that will be called before the app is actually run.
 #'   This is only needed for \code{shinyAppObj}, since in the \code{shinyAppDir}
 #'   case, a \code{global.R} file can be used for this purpose.
-#' @param options Named options that should be passed to the `runApp` call. You
-#'   can also specify \code{width} and \code{height} parameters which provide a
-#'   hint to the embedding environment about the ideal height/width for the app.
+#' @param options Named options that should be passed to the \code{runApp} call
+#'   (these can be any of the following: "port", "launch.browser", "host", "quiet",
+#'   "display.mode" and "test.mode"). You can also specify \code{width} and
+#'   \code{height} parameters which provide a hint to the embedding environment
+#'   about the ideal height/width for the app.
 #' @param uiPattern A regular expression that will be applied to each \code{GET}
 #'   request to determine whether the \code{ui} should be used to handle the
 #'   request. Note that the entire request path must match the regular
@@ -231,13 +233,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) {
@@ -373,7 +375,8 @@ is.shiny.appobj <- function(x) {
 print.shiny.appobj <- function(x, ...) {
   opts <- x$options %OR% list()
   opts <- opts[names(opts) %in%
-      c("port", "launch.browser", "host", "quiet", "display.mode")]
+      c("port", "launch.browser", "host", "quiet",
+        "display.mode", "test.mode")]
 
   args <- c(list(x), opts)
 

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/bootstrap.R

@@ -342,10 +342,18 @@ navbarPage <- function(title,
   tabs <- list(...)
   tabset <- buildTabset(tabs, "nav navbar-nav", NULL, id, selected)
 
+  # function to return plain or fluid class name
+  className <- function(name) {
+    if (fluid)
+      paste(name, "-fluid", sep="")
+    else
+      name
+  }
+
   # built the container div dynamically to support optional collapsibility
   if (collapsible) {
     navId <- paste("navbar-collapse-", p_randomInt(1000, 10000), sep="")
-    containerDiv <- div(class="container",
+    containerDiv <- div(class=className("container"),
       div(class="navbar-header",
         tags$button(type="button", class="navbar-toggle collapsed",
           `data-toggle`="collapse", `data-target`=paste0("#", navId),
@@ -359,7 +367,7 @@ navbarPage <- function(title,
       div(class="navbar-collapse collapse", id=navId, tabset$navList)
     )
   } else {
-    containerDiv <- div(class="container",
+    containerDiv <- div(class=className("container"),
       div(class="navbar-header",
         span(class="navbar-brand", pageTitle)
       ),
@@ -367,14 +375,6 @@ navbarPage <- function(title,
     )
   }
 
-  # function to return plain or fluid class name
-  className <- function(name) {
-    if (fluid)
-      paste(name, "-fluid", sep="")
-    else
-      name
-  }
-
   # build the main tab content div
   contentDiv <- div(class=className("container"))
   if (!is.null(header))
@@ -935,21 +935,34 @@ textOutput <- function(outputId, container = if (inline) span else div, inline =
 #' Render a reactive output variable as verbatim text within an
 #' application page. The text will be included within an HTML \code{pre} tag.
 #' @param outputId output variable to read the value from
+#' @param placeholder if the output is empty or \code{NULL}, should an empty
+#'   rectangle be displayed to serve as a placeholder? (does not affect
+#'   behavior when the the output in nonempty)
 #' @return A verbatim text output element that can be included in a panel
 #' @details Text is HTML-escaped prior to rendering. This element is often used
-#' with the \link{renderPrint} function to preserve fixed-width formatting
-#' of printed objects.
+#'   with the \link{renderPrint} function to preserve fixed-width formatting
+#'   of printed objects.
 #' @examples
-#' mainPanel(
-#'   h4("Summary"),
-#'   verbatimTextOutput("summary"),
-#'
-#'   h4("Observations"),
-#'   tableOutput("view")
-#' )
+#' ## Only run this example in interactive R sessions
+#' if (interactive()) {
+#'   shinyApp(
+#'     ui = basicPage(
+#'       textInput("txt", "Enter the text to display below:"),
+#'       verbatimTextOutput("default"),
+#'       verbatimTextOutput("placeholder", placeholder = TRUE)
+#'     ),
+#'     server = function(input, output) {
+#'       output$default <- renderText({ input$txt })
+#'       output$placeholder <- renderText({ input$txt })
+#'     }
+#'   )
+#' }
 #' @export
-verbatimTextOutput <- function(outputId) {
-  textOutput(outputId, container = pre)
+verbatimTextOutput <- function(outputId, placeholder = FALSE) {
+  pre(id = outputId,
+      class = paste(c("shiny-text-output", if (!placeholder) "noplaceholder"),
+                    collapse = " ")
+      )
 }
 
 
@@ -1123,7 +1136,7 @@ imageOutput <- function(outputId, width = "100%", height="400px",
 #'   same \code{id} to disappear.
 #' @inheritParams textOutput
 #' @note The arguments \code{clickId} and \code{hoverId} only work for R base
-#'   graphics (see the \pkg{\link{graphics}} package). They do not work for
+#'   graphics (see the \pkg{\link[graphics:graphics-package]{graphics}} package). They do not work for
 #'   \pkg{\link[grid:grid-package]{grid}}-based graphics, such as \pkg{ggplot2},
 #'   \pkg{lattice}, and so on.
 #'
@@ -1421,6 +1434,7 @@ uiOutput <- htmlOutput
 #'   is assigned to.
 #' @param label The label that should appear on the button.
 #' @param class Additional CSS classes to apply to the tag, if any.
+#' @param ... Other arguments to pass to the container tag function.
 #'
 #' @examples
 #' \dontrun{
@@ -1443,23 +1457,25 @@ uiOutput <- htmlOutput
 #' @export
 downloadButton <- function(outputId,
                            label="Download",
-                           class=NULL) {
+                           class=NULL, ...) {
   aTag <- tags$a(id=outputId,
                  class=paste('btn btn-default shiny-download-link', class),
                  href='',
                  target='_blank',
+                 download=NA,
                  icon("download"),
-                 label)
+                 label, ...)
 }
 
 #' @rdname downloadButton
 #' @export
-downloadLink <- function(outputId, label="Download", class=NULL) {
+downloadLink <- function(outputId, label="Download", class=NULL, ...) {
   tags$a(id=outputId,
          class=paste(c('shiny-download-link', class), collapse=" "),
          href='',
          target='_blank',
-         label)
+         download=NA,
+         label, ...)
 }
 
 

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/imageutils.R

@@ -21,7 +21,7 @@
 #' @param width Width in pixels.
 #' @param height Height in pixels.
 #' @param res Resolution in pixels per inch. This value is passed to
-#'   \code{\link{png}}. Note that this affects the resolution of PNG rendering in
+#'   \code{\link[grDevices]{png}}. Note that this affects the resolution of PNG rendering in
 #'   R; it won't change the actual ppi of the browser.
 #' @param ... Arguments to be passed through to \code{\link[grDevices]{png}}.
 #'   These can be used to set the width, height, background color, etc.

R/input-date.R

@@ -10,7 +10,7 @@
 #'   \item \code{yy} Year without century (12)
 #'   \item \code{yyyy} Year with century (2012)
 #'   \item \code{mm} Month number, with leading zero (01-12)
-#'   \item \code{m} Month number, without leading zero (01-12)
+#'   \item \code{m} Month number, without leading zero (1-12)
 #'   \item \code{M} Abbreviated month name
 #'   \item \code{MM} Full month name
 #'   \item \code{dd} Day of month with leading zero

R/input-daterange.R

@@ -10,7 +10,7 @@
 #'   \item \code{yy} Year without century (12)
 #'   \item \code{yyyy} Year with century (2012)
 #'   \item \code{mm} Month number, with leading zero (01-12)
-#'   \item \code{m} Month number, without leading zero (01-12)
+#'   \item \code{m} Month number, without leading zero (1-12)
 #'   \item \code{M} Abbreviated month name
 #'   \item \code{MM} Full month name
 #'   \item \code{dd} Day of month with leading zero

R/input-select.R

@@ -15,7 +15,12 @@
 #'
 #' @inheritParams textInput
 #' @param choices List of values to select from. If elements of the list are
-#'   named then that name rather than the value is displayed to the user.
+#'   named, then that name rather than the value is displayed to the user.
+#'   This can also be a named list whose elements are (either named or
+#'   unnamed) lists or vectors. If this is the case, the outermost names
+#'   will be used as the "optgroup" label for the elements in the respective
+#'   sublist. This allows you to group and label similar choices. See the
+#'   example section for a small demo of this feature.
 #' @param selected The initially selected value (or multiple values if
 #'   \code{multiple = TRUE}). If not specified then defaults to the first value
 #'   for single-select lists and no values for multiple select lists.
@@ -34,21 +39,38 @@
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {
 #'
-#' ui <- fluidPage(
-#'   selectInput("variable", "Variable:",
-#'               c("Cylinders" = "cyl",
-#'                 "Transmission" = "am",
-#'                 "Gears" = "gear")),
-#'   tableOutput("data")
+#' # basic example
+#' shinyApp(
+#'   ui = fluidPage(
+#'     selectInput("variable", "Variable:",
+#'                 c("Cylinders" = "cyl",
+#'                   "Transmission" = "am",
+#'                   "Gears" = "gear")),
+#'     tableOutput("data")
+#'   ),
+#'   server = function(input, output) {
+#'     output$data <- renderTable({
+#'       mtcars[, c("mpg", input$variable), drop = FALSE]
+#'     }, rownames = TRUE)
+#'   }
 #' )
 #'
-#' server <- function(input, output) {
-#'   output$data <- renderTable({
-#'     mtcars[, c("mpg", input$variable), drop = FALSE]
-#'   }, rownames = TRUE)
-#' }
-#'
-#' shinyApp(ui, server)
+#' # demoing optgroup support in the `choices` arg
+#' shinyApp(
+#'   ui = fluidPage(
+#'     selectInput("state", "Choose a state:",
+#'       list(`East Coast` = c("NY", "NJ", "CT"),
+#'            `West Coast` = c("WA", "OR", "CA"),
+#'            `Midwest` = c("MN", "WI", "IA"))
+#'     ),
+#'     textOutput("result")
+#'   ),
+#'   server = function(input, output) {
+#'     output$result <- renderText({
+#'       paste("You chose", input$state)
+#'     })
+#'   }
+#' )
 #' }
 #' @export
 selectInput <- function(inputId, label, choices, selected = NULL,
@@ -133,7 +155,7 @@ needOptgroup <- function(choices) {
 #' @rdname selectInput
 #' @param ... Arguments passed to \code{selectInput()}.
 #' @param options A list of options. See the documentation of \pkg{selectize.js}
-#'   for possible options (character option values inside \code{\link{I}()} will
+#'   for possible options (character option values inside \code{\link[base]{I}()} will
 #'   be treated as literal JavaScript code; see \code{\link{renderDataTable}()}
 #'   for details).
 #' @param width The width of the input, e.g. \code{'400px'}, or \code{'100\%'};

R/input-slider.R

@@ -36,7 +36,7 @@
 #'   format string, to be passed to the Javascript strftime library. See
 #'   \url{https://github.com/samsonjs/strftime} for more details. The allowed
 #'   format specifications are very similar, but not identical, to those for R's
-#'   \code{\link{strftime}} function. For Dates, the default is \code{"\%F"}
+#'   \code{\link[base]{strftime}} function. For Dates, the default is \code{"\%F"}
 #'   (like \code{"2015-07-01"}), and for POSIXt, the default is \code{"\%F \%T"}
 #'   (like \code{"2015-07-01 15:32:10"}).
 #' @param timezone Only used if the values are POSIXt objects. A string

R/input-submit.R

@@ -1,8 +1,27 @@
 #' Create a submit button
 #'
-#' Create a submit button for an input form. Forms that include a submit
+#' Create a submit button for an app. Apps that include a submit
 #' button do not automatically update their outputs when inputs change,
 #' rather they wait until the user explicitly clicks the submit button.
+#' The use of \code{submitButton} is generally discouraged in favor of
+#' the more versatile \code{\link{actionButton}} (see details below).
+#'
+#' Submit buttons are unusual Shiny inputs, and we recommend using
+#' \code{\link{actionButton}} instead of \code{submitButton} when you
+#' want to delay a reaction.
+#' See \href{http://shiny.rstudio.com/articles/action-buttons.html}{this
+#' article} for more information (including a demo of how to "translate"
+#' code using a \code{submitButton} to code using an \code{actionButton}).
+#'
+#' In essence, the presence of a submit button stops all inputs from
+#' sending their values automatically to the server. This means, for
+#' instance, that if there are \emph{two} submit buttons in the same app,
+#' clicking either one will cause all inputs in the app to send their
+#' values to the server. This is probably not what you'd want, which is
+#' why submit button are unwieldy for all but the simplest apps. There
+#' are other problems with submit buttons: for example, dynamically
+#' created submit buttons (for example, with \code{\link{renderUI}}
+#' or \code{\link{insertUI}}) will not work.
 #'
 #' @param text Button caption
 #' @param icon Optional \code{\link{icon}} to appear on the button
@@ -13,8 +32,26 @@
 #' @family input elements
 #'
 #' @examples
-#' submitButton("Update View")
-#' submitButton("Update View", icon("refresh"))
+#' if (interactive()) {
+#'
+#' shinyApp(
+#'   ui = basicPage(
+#'     numericInput("num", label = "Make changes", value = 1),
+#'     submitButton("Update View", icon("refresh")),
+#'     helpText("When you click the button above, you should see",
+#'              "the output below update to reflect the value you",
+#'              "entered at the top:"),
+#'     verbatimTextOutput("value")
+#'   ),
+#'   server = function(input, output) {
+#'
+#'     # submit buttons do not have a value of their own,
+#'     # they control when the app accesses values of other widgets.
+#'     # input$num is the value of the number widget.
+#'     output$value <- renderPrint({ input$num })
+#'   }
+#' )
+#' }
 #' @export
 submitButton <- function(text = "Apply Changes", icon = NULL, width = NULL) {
   div(

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/reactives.R

@@ -344,7 +344,7 @@ as.list.reactivevalues <- function(x, all.names=FALSE, ...) {
 
 #' Convert a reactivevalues object to a list
 #'
-#' This function does something similar to what you might \code{\link{as.list}}
+#' This function does something similar to what you might \code{\link[base]{as.list}}
 #' to do. The difference is that the calling context will take dependencies on
 #' every object in the reactivevalues object. To avoid taking dependencies on
 #' all the objects, you can wrap the call with \code{\link{isolate}()}.
@@ -526,6 +526,7 @@ Observable <- R6Class(
       .mostRecentCtxId <<- ctx$id
       ctx$onInvalidate(function() {
         .invalidated <<- TRUE
+        .value <<- NULL # Value can be GC'd, it won't be read once invalidated
         .dependents$invalidate()
       })
       .execCount <<- .execCount + 1L
@@ -702,6 +703,10 @@ execCount <- function(x) {
 
 # Observer ------------------------------------------------------------------
 
+# The initial value of "current observer" is NULL (and will always be NULL,
+# except when within the scope of the observe or observeEvent)
+.globals$currentObserver <- NULL
+
 Observer <- R6Class(
   'Observer',
   portable = FALSE,
@@ -813,6 +818,8 @@ registerDebugHook("observerFunc", environment(), label)
     run = function() {
       ctx <- .createContext()
       .execCount <<- .execCount + 1L
+      .globals$currentObserver <- self
+      on.exit(.globals$currentObserver <- NULL) # On exit, set it back to NULL
       ctx$run(.func)
     },
     onInvalidate = function(callback) {
@@ -903,6 +910,125 @@ registerDebugHook("observerFunc", environment(), label)
   )
 )
 
+#' Return the current observer
+#'
+#' This function is useful when you want to access an observer's methods or
+#' variables directly. For example, you may have logic that destroys or
+#' suspends the observer (from within its own scope) on some condition.
+#'
+#' This function works by returning the observer that is currently being run
+#' when \code{getCurrentObserver()} is called. If there is no observer being
+#' run (for example, if you called it from outside of a reactive context),
+#' it will always return \code{NULL}. There are a few subtleties, however.
+#' Consider the following five situations:
+#'
+#' \enumerate{
+#'   \item \code{getCurrentObserver()   #outside of a reactive context}
+#'   \item \code{observe({              getCurrentObserver()      }) }
+#'   \item \code{observe({ (function(){ getCurrentObserver() })() )} }
+#'   \item \code{observe({ isolate({    getCurrentObserver() })   }) }
+#'   \item \code{observe({ reactive({   getCurrentObserver() })   }) }
+#' }
+#'
+#' In (1), since you're outside of a reactive context, we've already
+#' established that \code{getCurrentObserver()} will return \code{NULL}.
+#' In (2), we have the "vanilla" case, in which \code{getCurrentObserver()}
+#' is called directly from within the body of the \code{observe} call.
+#' This returns that observer. So far, so good. The problem comes with
+#' the last three cases -- should we be able to "retrieve" the outer
+#' observer if we're inside an inner function's scope, or inside of an
+#' \code{isolate} or a \code{reactive} block?
+#'
+#' Before we can even asnwer that, there is an important distinction to
+#' be made here: are function calls, \code{reactive} calls and
+#' \code{isolate} blocks the same \emph{type} of thing? As far as Shiny
+#' is concerned, the answer is no. Shiny-specific things (like observers,
+#' reactives and code inside of an \code{isolate} chunk) exist in what we
+#' call reactive contexts. Each run of an observer or a reactive is
+#' associated with a particular reactive context. But regular functions
+#' have no relation to reactive contexts. So, while calling a regular
+#' function inside of an observer does not change the reactive context,
+#' calling a \code{reactive} or \code{isolate} certainly does.
+#'
+#' With this distinction in mind, we can refine our definition of
+#' \code{getCurrentObserver()} as follows: it returns the observer (if any)
+#' that is currently running, as long as it is called from within the
+#' same reactive context that was created when the observer started
+#' running. If the reactive context changed (most likely because of a
+#' call to \code{reactive} or \code{isolate}), \code{getCurrentObserver}
+#' will return \code{NULL}. (There is another common way that the reactive
+#' context can change inside an observer, which is if there is a second,
+#' nested observer. In this case, \code{getCurrentObserver()} will return
+#' the second, nested observer, since that is the one that is actually
+#' running at that time.)
+#'
+#' So to recap, here's the return value for each of the five situations:
+#' \enumerate{
+#'   \item \code{NULL}
+#'   \item the observer
+#'   \item the observer
+#'   \item \code{NULL}
+#'   \item \code{NULL}
+#' }
+#'
+#' Now, you may be wondering why \code{getCurrentObserver()} should't be able
+#' to get the running observer even if the reactive context changes. This isn't
+#' technically impossible. In fact, if you want this behavior for some reason,
+#' you can set the argument \code{dig} to be \code{TRUE}, so that the function
+#' will "dig" through the reactive contexts until it retrieves the one for the
+#' observer and returns the observer.
+#'
+#' So, with \code{dig = TRUE}, here's the return value for each of the five
+#' situations:
+#' \enumerate{
+#'   \item \code{NULL}
+#'   \item the observer
+#'   \item the observer
+#'   \item the observer
+#'   \item the observer
+#' }
+#'
+#' The reason that this is not the default (or even encouraged) is because
+#' things can get messy quickly when you cross reactive contexts at will.
+#' For example, the return value of a \code{reactive} call is cached and that
+#' reactive is not re-run unless its reactive dependencies change. If that
+#' reactive has a call to \code{getCurrentObserver()}, this can produce
+#' undesirable and unintuitive results.
+#'
+#' @param dig If \code{FALSE} (default), \code{getCurrentObserver} will only
+#'   return the observer if it's invoked directly from within the observer's
+#'   body or from a regular function. If \code{TRUE}, it will always return
+#'   the observer (if it exists on the stack), even if it's invoked from
+#'   within a \code{reactive} or an \code{isolate} scope. See below for more
+#'   information.
+#'
+#' @return The observer (created with a call to either \code{observe} or to
+#' \code{observeEvent}) that is currently running.
+#'
+#' @seealso \code{\link{observe}}
+#'
+#' @examples
+#' ## Only run examples in interactive R sessions
+#' if (interactive()) {
+#' shinyApp(
+#'   ui = basicPage( actionButton("go", "Go")),
+#'   server = function(input, output, session) {
+#'     observeEvent(input$go, {
+#'       print(paste("This will only be printed once; all",
+#'             "subsequent button clicks won't do anything"))
+#'       getCurrentObserver()$destroy()
+#'     })
+#'   }
+#' )
+#' }
+#' @export
+getCurrentObserver <- function(dig = FALSE) {
+  o <- .globals$currentObserver
+  ctx <- getCurrentContext()
+  if (!dig && !is.null(o) && ctx$id != o$.ctx$id) o <- NULL
+  o
+}
+
 #' Create a reactive observer
 #'
 #' Creates an observer from the given expression.
@@ -1109,7 +1235,7 @@ setAutoflush <- local({
 #' @return A no-parameter function that can be called from a reactive context,
 #'   in order to cause that context to be invalidated the next time the timer
 #'   interval elapses. Calling the returned function also happens to yield the
-#'   current time (as in \code{\link{Sys.time}}).
+#'   current time (as in \code{\link[base]{Sys.time}}).
 #' @seealso \code{\link{invalidateLater}}
 #'
 #' @examples
@@ -1417,7 +1543,7 @@ reactiveFileReader <- function(intervalMillis, session, filePath, readFunc, ...)
 #' The expression given to \code{isolate()} is evaluated in the calling
 #' environment. This means that if you assign a variable inside the
 #' \code{isolate()}, its value will be visible outside of the \code{isolate()}.
-#' If you want to avoid this, you can use \code{\link{local}()} inside the
+#' If you want to avoid this, you can use \code{\link[base]{local}()} inside the
 #' \code{isolate()}.
 #'
 #' This function can also be useful for calling reactive expression at the

R/render-plot.R

@@ -28,7 +28,7 @@
 #'   inline plot, you must provide numeric values (in pixels) to both
 #'   \code{width} and \code{height}.
 #' @param res Resolution of resulting plot, in pixels per inch. This value is
-#'   passed to \code{\link{png}}. Note that this affects the resolution of PNG
+#'   passed to \code{\link[grDevices]{png}}. Note that this affects the resolution of PNG
 #'   rendering in R; it won't change the actual ppi of the browser.
 #' @param ... Arguments to be passed through to \code{\link[grDevices]{png}}.
 #'   These can be used to set the width, height, background color, etc.

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,
@@ -533,6 +503,9 @@ serviceApp <- function() {
 #'   application. If set to \code{"normal"}, displays the application normally.
 #'   Defaults to \code{"auto"}, which displays the application in the mode given
 #'   in its \code{DESCRIPTION} file, if any.
+#' @param test.mode Should the application be launched in test mode? This is
+#'   only used for recording or running automated tests. Defaults to the
+#'   \code{shiny.testmode} option, or FALSE if the option is not set.
 #'
 #' @examples
 #' \dontrun{
@@ -576,7 +549,8 @@ runApp <- function(appDir=getwd(),
                                             interactive()),
                    host=getOption('shiny.host', '127.0.0.1'),
                    workerId="", quiet=FALSE,
-                   display.mode=c("auto", "normal", "showcase")) {
+                   display.mode=c("auto", "normal", "showcase"),
+                   test.mode=getOption('shiny.testmode', FALSE)) {
   on.exit({
     handlerManager$clear()
   }, add = TRUE)
@@ -587,14 +561,52 @@ runApp <- function(appDir=getwd(),
     .globals$options <- oldOptionSet
   },add = TRUE)
 
-  if (is.null(host) || is.na(host))
-    host <- '0.0.0.0'
-
   # Make warnings print immediately
   # Set pool.scheduler to support pool package
   ops <- options(warn = 1, pool.scheduler = scheduleTask)
   on.exit(options(ops), add = TRUE)
 
+  appParts <- as.shiny.appobj(appDir)
+
+  # The lines below set some of the app's running options, which
+  # can be:
+  #   - left unspeficied (in which case the arguments' default
+  #     values from `runApp` kick in);
+  #   - passed through `shinyApp`
+  #   - passed through `runApp` (this function)
+  #   - passed through both `shinyApp` and `runApp` (the latter
+  #     takes precedence)
+  #
+  # Matrix of possibilities:
+  # | IN shinyApp | IN runApp | result       | check                                                                                                                                  |
+  # |-------------|-----------|--------------|----------------------------------------------------------------------------------------------------------------------------------------|
+  # | no          | no        | use defaults | exhaust all possibilities: if it's missing (runApp does not specify); THEN if it's not in shinyApp appParts$options; THEN use defaults |
+  # | yes         | no        | use shinyApp | if it's missing (runApp does not specify); THEN if it's in shinyApp appParts$options; THEN use shinyApp                                |
+  # | no          | yes       | use runApp   | if it's not missing (runApp specifies), use those                                                                                      |
+  # | yes         | yes       | use runApp   | if it's not missing (runApp specifies), use those                                                                                      |
+  #
+  # I tried to make this as compact and intuitive as possible,
+  # given that there are four distinct possibilities to check
+  appOps <- appParts$options
+  findVal <- function(arg, default) {
+    if (arg %in% names(appOps)) appOps[[arg]] else default
+  }
+
+  if (missing(port))
+    port <- findVal("port", port)
+  if (missing(launch.browser))
+    launch.browser <- findVal("launch.browser", launch.browser)
+  if (missing(host))
+    host <- findVal("host", host)
+  if (missing(quiet))
+    quiet <- findVal("quiet", quiet)
+  if (missing(display.mode))
+    display.mode <- findVal("display.mode", display.mode)
+  if (missing(test.mode))
+    test.mode <- findVal("test.mode", test.mode)
+
+  if (is.null(host) || is.na(host)) host <- '0.0.0.0'
+
   workerId(workerId)
 
   if (inShinyServer()) {
@@ -614,6 +626,11 @@ runApp <- function(appDir=getwd(),
   # the display.mode parameter. The latter takes precedence.
   setShowcaseDefault(0)
 
+  .globals$testMode <- test.mode
+  if (test.mode) {
+    message("Running application in test mode.")
+  }
+
   # If appDir specifies a path, and display mode is specified in the
   # DESCRIPTION file at that path, apply it here.
   if (is.character(appDir)) {
@@ -701,8 +718,6 @@ runApp <- function(appDir=getwd(),
     }
   }
 
-  appParts <- as.shiny.appobj(appDir)
-
   # Extract appOptions (which is a list) and store them as shinyOptions, for
   # this app. (This is the only place we have to store settings that are
   # accessible both the UI and server portion of the app.)
@@ -746,12 +761,16 @@ runApp <- function(appDir=getwd(),
   # Top-level ..stacktraceoff..; matches with ..stacktraceon in observe(),
   # reactive(), Callbacks$invoke(), and others
   ..stacktraceoff..(
-    captureStackTraces(
+    captureStackTraces({
+      # If any observers were created before runApp was called, this will make
+      # sure they run once the app starts. (Issue #1013)
+      scheduleFlush()
+
       while (!.globals$stopped) {
         serviceApp()
         Sys.sleep(0.001)
       }
-    )
+    })
   )
 
   if (isTRUE(.globals$reterror)) {

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
@@ -270,6 +276,10 @@ workerId <- local({
 #'   This is the request that was used to initiate the websocket connection
 #'   (as opposed to the request that downloaded the web page for the app).
 #' }
+#' \item{userData}{
+#'   An environment for app authors and module/package authors to store whatever
+#'   session-specific data they want.
+#' }
 #' \item{resetBrush(brushId)}{
 #'   Resets/clears the brush with the given \code{brushId}, if it exists on
 #'   any \code{imageOutput} or \code{plotOutput} in the app.
@@ -323,6 +333,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
+#'   snapshot URL.
+#' }
+#' \item{getTestSnapshotUrl(input=TRUE, output=TRUE, export=TRUE,
+#'   format="json")}{
+#'   Returns a URL for the test snapshots. Only has an effect when the
+#'   \code{shiny.testmode} option is set to TRUE. For the input, output, and
+#'   export 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{input=c("x", "y")}. The format can be
+#'   "rds" or "json".
+#' }
 #'
 #' @name session
 NULL
@@ -393,6 +416,11 @@ ShinySession <- R6Class(
     restoredCallbacks = 'Callbacks',
     bookmarkExclude = character(0),  # Names of inputs to exclude from bookmarking
 
+    testMode = FALSE,                # Are we running in test mode?
+    testExportExprs = list(),
+    outputValues = list(),           # Saved output values (for testing mode)
+    testSnapshotUrl = character(0),
+
     sendResponse = function(requestMsg, value) {
       if (is.null(requestMsg$tag)) {
         warning("Tried to send response for untagged message; method: ",
@@ -414,7 +442,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 +577,111 @@ 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)
+    },
+
+    enableTestSnapshot = function() {
+      private$testSnapshotUrl <- self$registerDataObj("shinytest", NULL,
+        function(data, req) {
+          if (!isTRUE(private$testMode)) {
+            return()
+          }
+
+          params <- parseQueryString(req$QUERY_STRING)
+          # The format of the response that will be sent back. Defaults to
+          # "json" unless requested otherwise. The only other valid value is
+          # "rds".
+          format <- params$format %OR% "json"
+
+          values <- list()
+
+          if (!is.null(params$input)) {
+
+            allInputs <- isolate(
+              reactiveValuesToList(self$input, all.names = TRUE)
+            )
+
+            # If params$input is "1", return all; otherwise return just the
+            # inputs that are named in params$input, like "x,y,z".
+            if (params$input == "1") {
+              values$input <- allInputs
+            } else {
+              items <- strsplit(params$input, ",")[[1]]
+              items <- intersect(items, names(allInputs))
+              values$input <- allInputs[items]
+            }
+
+            values$input <- sortByName(values$input)
+          }
+
+          if (!is.null(params$output)) {
+
+            if (params$output == "1") {
+              values$output <- private$outputValues
+            } else {
+              items <- strsplit(params$output, ",")[[1]]
+              items <- intersect(items, names(private$outputValues))
+              values$output <- private$outputValues[items]
+            }
+
+            values$output <- sortByName(values$output)
+          }
+
+          if (!is.null(params$export)) {
+
+            if (params$export == "1") {
+              values$export <- isolate(
+                lapply(private$testExportExprs, function(item) {
+                  eval(item$expr, envir = item$env)
+                })
+              )
+            } else {
+              items <- strsplit(params$export, ",")[[1]]
+              items <- intersect(items, names(private$testExportExprs))
+              values$export <- isolate(
+                lapply(private$testExportExprs[items], function(item) {
+                  eval(item$expr, envir = item$env)
+                })
+              )
+            }
+
+            values$export <- sortByName(values$export)
+          }
+
+          # Make sure input, output, and export are all named lists (at this
+          # point, they could be unnamed if they are empty lists). This is so
+          # that the resulting object is represented as an object in JSON
+          # instead of an array, and so that the RDS data structure is of a
+          # consistent type.
+          values <- lapply(values, asNamedVector)
+
+          if (length(values) == 0) {
+            return(httpResponse(400, "text/plain",
+              "None of export, input, or output 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(
@@ -562,6 +696,7 @@ ShinySession <- R6Class(
     closed = logical(0),
     request = 'ANY',      # Websocket request object
     singletons = character(0),  # Tracks singleton HTML fragments sent to the page
+    userData = 'environment',
     user = NULL,
     groups = NULL,
 
@@ -582,6 +717,7 @@ ShinySession <- R6Class(
       self$progressStack <- Stack$new()
       self$files <- Map$new()
       self$downloads <- Map$new()
+      self$userData <- new.env(parent = emptyenv())
 
       self$input <- .createReactiveValues(private$.input, readonly=TRUE)
       .setLabel(self$input, 'input')
@@ -600,6 +736,9 @@ ShinySession <- R6Class(
       private$restoredCallbacks <- Callbacks$new()
       private$createBookmarkObservers()
 
+      private$testMode <- .globals$testMode
+      private$enableTestSnapshot()
+
       private$registerSessionEndCallbacks()
 
       if (!is.null(websocket$request$HTTP_SHINY_SERVER_CREDENTIALS)) {
@@ -675,6 +814,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 +1149,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(private$testMode)) {
+        private$storeOutputValues(mergeVectors(values, errors))
+      }
+
       private$sendMessage(
-        errors = as.list(errors),
-        values = as.list(values),
+        errors = errors,
+        values = values,
         inputMessages = inputMessages
       )
     },
@@ -1174,6 +1335,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$testExportExprs <- mergeVectors(private$testExportExprs, items)
+    },
+
+    getTestSnapshotUrl = function(input = TRUE, output = TRUE, export = TRUE,
+                                  format = "json") {
+      reqString <- function(group, value) {
+        if (isTRUE(value))
+          paste0(group, "=1")
+        else if (is.character(value))
+          paste0(group, "=", paste(value, collapse = ","))
+        else
+          ""
+      }
+      paste(
+        private$testSnapshotUrl,
+        reqString("input", input),
+        reqString("output", output),
+        reqString("export", export),
+        paste0("format=", format),
+        sep = "&"
+      )
+    },
 
     reactlog = function(logEntry) {
       # Use sendCustomMessage instead of sendMessage, because the handler in

R/shinyui.R

@@ -24,7 +24,7 @@ withMathJax <- function(...) {
   )
 }
 
-renderPage <- function(ui, connection, showcase=0) {
+renderPage <- function(ui, connection, showcase=0, testMode=FALSE) {
   # If the ui is a NOT complete document (created by htmlTemplate()), then do some
   # preprocessing and make sure it's a complete document.
   if (!inherits(ui, "html_document")) {
@@ -50,6 +50,14 @@ renderPage <- function(ui, connection, showcase=0) {
       script = if (getOption("shiny.minified", TRUE)) "shiny.min.js" else "shiny.js",
       stylesheet = "shiny.css")
   )
+
+  if (testMode) {
+    # Add code injection listener if in test mode
+    shiny_deps[[length(shiny_deps) + 1]] <-
+      htmlDependency("shiny-testmode", utils::packageVersion("shiny"),
+        c(href="shared"), script = "shiny-testmode.js")
+  }
+
   html <- renderDocument(ui, shiny_deps, processDep = createWebDependency)
   writeUTF8(html, con = connection)
 }
@@ -91,6 +99,8 @@ uiHttpHandler <- function(ui, uiPattern = "^/$") {
         showcaseMode <- mode
     }
 
+    testMode <- .globals$testMode %OR% FALSE
+
     # Create a restore context using query string
     bookmarkStore <- getShinyOption("bookmarkStore", default = "disable")
     if (bookmarkStore == "disable") {
@@ -121,7 +131,7 @@ uiHttpHandler <- function(ui, uiPattern = "^/$") {
     if (is.null(uiValue))
       return(NULL)
 
-    renderPage(uiValue, textConn, showcaseMode)
+    renderPage(uiValue, textConn, showcaseMode, testMode)
     html <- paste(readLines(textConn, encoding = 'UTF-8'), collapse='\n')
     return(httpResponse(200, content=enc2utf8(html)))
   }

R/shinywrappers.R

@@ -220,7 +220,7 @@ renderImage <- function(expr, env=parent.frame(), quoted=FALSE,
 #'
 #' Makes a reactive version of the given function that captures any printed
 #' output, and also captures its printable result (unless
-#' \code{\link{invisible}}), into a string. The resulting function is suitable
+#' \code{\link[base]{invisible}}), into a string. The resulting function is suitable
 #' for assigning to an  \code{output} slot.
 #'
 #' The corresponding HTML output tag can be anything (though \code{pre} is
@@ -232,14 +232,14 @@ renderImage <- function(expr, env=parent.frame(), quoted=FALSE,
 #'
 #' Note that unlike most other Shiny output functions, if the given function
 #' returns \code{NULL} then \code{NULL} will actually be visible in the output.
-#' To display nothing, make your function return \code{\link{invisible}()}.
+#' To display nothing, make your function return \code{\link[base]{invisible}()}.
 #'
 #' @param expr An expression that may print output and/or return a printable R
 #'   object.
 #' @param env The environment in which to evaluate \code{expr}.
 #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
 #'   is useful if you want to save an expression in a variable.
-#' @param width The value for \code{\link{options}('width')}.
+#' @param width The value for \code{\link[base]{options}('width')}.
 #' @param outputArgs A list of arguments to be passed through to the implicit
 #'   call to \code{\link{verbatimTextOutput}} when \code{renderPrint} is used
 #'   in an interactive R Markdown document.
@@ -420,7 +420,7 @@ downloadHandler <- function(filename, content, contentType=NA, outputArgs=list()
 #' the server infrastructure.
 #'
 #' For the \code{options} argument, the character elements that have the class
-#' \code{"AsIs"} (usually returned from \code{\link{I}()}) will be evaluated in
+#' \code{"AsIs"} (usually returned from \code{\link[base]{I}()}) will be evaluated in
 #' JavaScript. This is useful when the type of the option value is not supported
 #' in JSON, e.g., a JavaScript function, which can be obtained by evaluating a
 #' character string. Note this only applies to the root-level elements of the

R/test-export.R

@@ -0,0 +1,61 @@
+#' 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 a snapshot URL.
+#'
+#' This function only has an effect if the app is launched in test mode. This is
+#' done by calling \code{runApp()} with \code{test.mode=TRUE}, or by setting the
+#' global option \code{shiny.testmode} 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 snapshot URL is visited.
+#' @examples
+#' ## Only run this example in interactive R sessions
+#' if (interactive()) {
+#'
+#' options(shiny.testmode = TRUE)
+#'
+#' # This application shows the test snapshot 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$getTestSnapshotUrl(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

@@ -182,6 +182,16 @@ anyUnnamed <- function(x) {
   any(!nzchar(nms))
 }
 
+
+# Given a vector/list, returns a named vector (the labels will be blank).
+asNamedVector <- function(x) {
+  if (!is.null(names(x)))
+    return(x)
+
+  names(x) <- rep.int("", length(x))
+  x
+}
+
 # Given two named vectors, join them together, and keep only the last element
 # with a given name in the resulting vector. If b has any elements with the same
 # name as elements in a, the element in a is dropped. Also, if there are any
@@ -196,6 +206,30 @@ mergeVectors <- function(a, b) {
   x[!drop_idx]
 }
 
+# Sort a vector by the names of items. If there are multiple items with the
+# same name, preserve the original order of those items. For empty
+# vectors/lists/NULL, return the original value.
+sortByName <- function(x) {
+  if (anyUnnamed(x))
+    stop("All items must be named")
+
+  # Special case for empty vectors/lists, and NULL
+  if (length(x) == 0)
+    return(x)
+
+  x[order(names(x))]
+}
+
+# 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.
@@ -1196,7 +1230,7 @@ need <- function(expr, message = paste(label, "must be provided"), label) {
 #' \strong{Truthy and falsy values}
 #'
 #' The terms "truthy" and "falsy" generally indicate whether a value, when
-#' coerced to a \code{\link{logical}}, is \code{TRUE} or \code{FALSE}. We use
+#' coerced to a \code{\link[base]{logical}}, is \code{TRUE} or \code{FALSE}. We use
 #' the term a little loosely here; our usage tries to match the intuitive
 #' notions of "Is this value missing or available?", or "Has the user provided
 #' an answer?", or in the case of action buttons, "Has the button been

README.md

@@ -59,6 +59,10 @@ devtools::install_version("shiny", version = "0.10.2.2")
 
 The Javascript code in Shiny is minified using tools that run on Node.js. See the tools/ directory for more information.
 
+## Guidelines for contributing
+
+We welcome contributions to the **shiny** package. Please see our [CONTRIBUTING.md](CONTRIBUTING.md) file for detailed guidelines of how to contribute.
+
 ## License
 
 The shiny package is licensed under the GPLv3. See these files in the inst directory for additional details:

inst/examples/07_widgets/Readme.md

@@ -1 +1 @@
-This example demonstrates some additional widgets included in Shiny, such as `helpText` and `submitButton`. The latter is used to delay rendering output until the user explicitly requests it.
+This example demonstrates some additional widgets included in Shiny, such as `helpText` and `actionButton`. The latter is used to delay rendering output until the user explicitly requests it (a construct which also introduces two important server functions, `eventReactive` and `isolate`).

inst/examples/07_widgets/server.R

@@ -1,26 +1,32 @@
 library(shiny)
 library(datasets)
 
-# Define server logic required to summarize and view the 
+# Define server logic required to summarize and view the
 # selected dataset
 function(input, output) {
-  
-  # Return the requested dataset
-  datasetInput <- reactive({
+
+  # Return the requested dataset. Note that we use `eventReactive()`
+  # here, which takes a dependency on input$update (the action
+  # button), so that the output is only updated when the user
+  # clicks the button.
+  datasetInput <- eventReactive(input$update, {
     switch(input$dataset,
            "rock" = rock,
            "pressure" = pressure,
            "cars" = cars)
-  })
-  
+  }, ignoreNULL = FALSE)
+
   # Generate a summary of the dataset
   output$summary <- renderPrint({
     dataset <- datasetInput()
     summary(dataset)
   })
-  
-  # Show the first "n" observations
+
+  # Show the first "n" observations. The use of `isolate()` here
+  # is necessary because we don't want the table to update
+  # whenever input$obs changes (only when the user clicks the
+  # action button).
   output$view <- renderTable({
-    head(datasetInput(), n = input$obs)
+    head(datasetInput(), n = isolate(input$obs))
   })
 }

inst/examples/07_widgets/ui.R

@@ -2,32 +2,32 @@ library(shiny)
 
 # Define UI for dataset viewer application
 fluidPage(
-  
+
   # Application title.
   titlePanel("More Widgets"),
-  
+
   # Sidebar with controls to select a dataset and specify the
   # number of observations to view. The helpText function is
   # also used to include clarifying text. Most notably, the
-  # inclusion of a submitButton defers the rendering of output
+  # inclusion of an actionButton defers the rendering of output
   # until the user explicitly clicks the button (rather than
   # doing it immediately when inputs change). This is useful if
   # the computations required to render output are inordinately
   # time-consuming.
   sidebarLayout(
     sidebarPanel(
-      selectInput("dataset", "Choose a dataset:", 
+      selectInput("dataset", "Choose a dataset:",
                   choices = c("rock", "pressure", "cars")),
-      
+
       numericInput("obs", "Number of observations to view:", 10),
-      
+
       helpText("Note: while the data view will show only the specified",
                "number of observations, the summary will still be based",
                "on the full dataset."),
-      
-      submitButton("Update View")
+
+      actionButton("update", "Update View")
     ),
-    
+
     # Show a summary of the dataset and an HTML table with the
     # requested number of observations. Note the use of the h4
     # function to provide an additional header above each output
@@ -35,7 +35,7 @@ fluidPage(
     mainPanel(
       h4("Summary"),
       verbatimTextOutput("summary"),
-      
+
       h4("Observations"),
       tableOutput("view")
     )

inst/staticdocs/index.r

@@ -124,6 +124,7 @@ sd_section("Reactive constructs",
     "makeReactiveBinding",
     "observe",
     "observeEvent",
+    "getCurrentObserver",
     "reactive",
     "reactiveFileReader",
     "reactivePoll",
@@ -184,10 +185,12 @@ sd_section("Utility functions",
     "safeError",
     "onFlush",
     "restoreInput",
+    "applyInputHandlers",
     "exprToFunction",
     "installExprFunction",
     "parseQueryString",
     "plotPNG",
+    "exportTestValues",
     "repeatable",
     "shinyDeprecated",
     "serverInfo",

inst/www/shared/shiny-testmode.js

@@ -0,0 +1,8 @@
+// Listen for messages from parent frame. This file is only added when the
+// shiny.testmode option is TRUE.
+window.addEventListener("message", function(e) {
+  var message = e.data;
+
+  if (message.code)
+    eval(message.code);
+});

inst/www/shared/shiny.css

@@ -1,3 +1,17 @@
+/* This is necessary so that an empty verbatimTextOutput slot
+is the same height as a non-empty one (only important when
+* placeholder = TRUE) */
+pre.shiny-text-output:empty::before {
+  content: " ";
+}
+
+pre.shiny-text-output.noplaceholder:empty {
+  margin: 0;
+  padding: 0;
+  border-width: 0;
+  height: 0;
+}
+
 #shiny-disconnected-overlay {
   position: fixed;
   top: 0;

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.';
@@ -1154,7 +1160,8 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
         // render the HTML and deps to a null target, so
         // the side-effect of rendering the deps, singletons,
         // and <head> still occur
-        exports.renderHtml($([]), message.content.html, message.content.deps);
+        console.warn('The selector you chose ("' + message.selector + '") could not be found in the DOM.');
+        exports.renderHtml(message.content.html, $([]), message.content.deps);
       } else {
         targets.each(function (i, target) {
           exports.renderContent(target, message.content, message.where);
@@ -1305,6 +1312,26 @@ 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.getTestSnapshotBaseUrl = function () {
+      var _ref = arguments.length > 0 && arguments[0] !== undefined ? arguments[0] : {};
+
+      var _ref$fullUrl = _ref.fullUrl;
+      var fullUrl = _ref$fullUrl === undefined ? true : _ref$fullUrl;
+
+      var loc = window.location;
+      var url = "";
+
+      if (fullUrl) {
+        // Strip off everything after last slash in path, like dirname() in R
+        url = loc.origin + loc.pathname.replace(/\/[^/]*$/, "");
+      }
+      url += "/session/" + encodeURIComponent(this.config.sessionId) + "/dataobj/shinytest?w=" + encodeURIComponent(this.config.workerId) + "&nonce=" + randomId();
+
+      return url;
+    };
   }).call(ShinyApp.prototype);
 
   exports.showReconnectDialog = function () {
@@ -1361,22 +1388,22 @@ 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 _ref2 = arguments.length > 0 && arguments[0] !== undefined ? arguments[0] : {};
 
-      var _ref$html = _ref.html;
-      var html = _ref$html === undefined ? '' : _ref$html;
-      var _ref$action = _ref.action;
-      var action = _ref$action === undefined ? '' : _ref$action;
-      var _ref$deps = _ref.deps;
-      var deps = _ref$deps === undefined ? [] : _ref$deps;
-      var _ref$duration = _ref.duration;
-      var duration = _ref$duration === undefined ? 5000 : _ref$duration;
-      var _ref$id = _ref.id;
-      var id = _ref$id === undefined ? null : _ref$id;
-      var _ref$closeButton = _ref.closeButton;
-      var closeButton = _ref$closeButton === undefined ? true : _ref$closeButton;
-      var _ref$type = _ref.type;
-      var type = _ref$type === undefined ? null : _ref$type;
+      var _ref2$html = _ref2.html;
+      var html = _ref2$html === undefined ? '' : _ref2$html;
+      var _ref2$action = _ref2.action;
+      var action = _ref2$action === undefined ? '' : _ref2$action;
+      var _ref2$deps = _ref2.deps;
+      var deps = _ref2$deps === undefined ? [] : _ref2$deps;
+      var _ref2$duration = _ref2.duration;
+      var duration = _ref2$duration === undefined ? 5000 : _ref2$duration;
+      var _ref2$id = _ref2.id;
+      var id = _ref2$id === undefined ? null : _ref2$id;
+      var _ref2$closeButton = _ref2.closeButton;
+      var closeButton = _ref2$closeButton === undefined ? true : _ref2$closeButton;
+      var _ref2$type = _ref2.type;
+      var type = _ref2$type === undefined ? null : _ref2$type;
 
       if (!id) id = randomId();
 
@@ -1520,16 +1547,16 @@ 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 _ref3 = arguments.length > 0 && arguments[0] !== undefined ? arguments[0] : {};
 
-      var _ref2$html = _ref2.html;
-      var html = _ref2$html === undefined ? '' : _ref2$html;
-      var _ref2$deps = _ref2.deps;
-      var deps = _ref2$deps === undefined ? [] : _ref2$deps;
+      var _ref3$html = _ref3.html;
+      var html = _ref3$html === undefined ? '' : _ref3$html;
+      var _ref3$deps = _ref3.deps;
+      var deps = _ref3$deps === undefined ? [] : _ref3$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();
 
@@ -1541,9 +1568,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 +2704,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 +3104,11 @@ 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";
+
+    if (where === "replace") {
+      exports.unbindAll(el);
+    }
 
     exports.unbindAll(el);
 
@@ -3112,7 +3145,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);
@@ -3134,8 +3167,10 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     var $head = $("head").first();
 
     if (dep.meta) {
-      var metas = $.map(asArray(dep.meta), function (content, name) {
-        return $("<meta>").attr("name", name).attr("content", content);
+      var metas = $.map(asArray(dep.meta), function (obj, idx) {
+        // only one named pair is expected in obj as it's already been decomposed
+        var name = Object.keys(obj)[0];
+        return $("<meta>").attr("name", name).attr("content", obj[name]);
       });
       $head.append(metas);
     }
@@ -3414,6 +3449,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 +3678,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 +3715,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 +3728,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 +4077,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 +4569,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');
         }
@@ -4717,6 +4763,18 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
         self.onError(error);
       });
       this.$bar().text('Finishing upload');
+
+      // Trigger event when all files are finished uploading.
+      var evt = jQuery.Event("shiny:fileuploaded");
+      evt.name = this.id;
+      evt.files = $.map(this.files, function (file, i) {
+        return {
+          name: file.name,
+          size: file.size,
+          type: file.type
+        };
+      });
+      $(document).trigger(evt);
     };
     this.onError = function (message) {
       this.$setError(message || '');
@@ -4848,7 +4906,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 +4922,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 +4952,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 +5015,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 +5073,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 +5103,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 +5128,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/builder.Rd

@@ -75,7 +75,7 @@ Dedicated functions are available for the most common HTML tags that do not
 conflict with common R functions.
 
 The result from these functions is a tag object, which can be converted using
-\code{\link{as.character}()}.
+\code{\link[base]{as.character}()}.
 }
 \examples{
 doc <- tags$html(

man/dateInput.Rd

@@ -56,7 +56,7 @@ the browser. It allows the following values:
   \item \code{yy} Year without century (12)
   \item \code{yyyy} Year with century (2012)
   \item \code{mm} Month number, with leading zero (01-12)
-  \item \code{m} Month number, without leading zero (01-12)
+  \item \code{m} Month number, without leading zero (1-12)
   \item \code{M} Abbreviated month name
   \item \code{MM} Full month name
   \item \code{dd} Day of month with leading zero

man/dateRangeInput.Rd

@@ -62,7 +62,7 @@ the browser. It allows the following values:
   \item \code{yy} Year without century (12)
   \item \code{yyyy} Year with century (2012)
   \item \code{mm} Month number, with leading zero (01-12)
-  \item \code{m} Month number, without leading zero (01-12)
+  \item \code{m} Month number, without leading zero (1-12)
   \item \code{M} Abbreviated month name
   \item \code{MM} Full month name
   \item \code{dd} Day of month with leading zero

man/downloadButton.Rd

@@ -5,9 +5,9 @@
 \alias{downloadLink}
 \title{Create a download button or link}
 \usage{
-downloadButton(outputId, label = "Download", class = NULL)
+downloadButton(outputId, label = "Download", class = NULL, ...)
 
-downloadLink(outputId, label = "Download", class = NULL)
+downloadLink(outputId, label = "Download", class = NULL, ...)
 }
 \arguments{
 \item{outputId}{The name of the output slot that the \code{downloadHandler}
@@ -16,6 +16,8 @@ is assigned to.}
 \item{label}{The label that should appear on the button.}
 
 \item{class}{Additional CSS classes to apply to the tag, if any.}
+
+\item{...}{Other arguments to pass to the container tag function.}
 }
 \description{
 Use these functions to create a download button or link; when clicked, it

man/exportTestValues.Rd

@@ -0,0 +1,71 @@
+% 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 snapshot URL 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 a snapshot URL.
+}
+\details{
+This function only has an effect if the app is launched in test mode. This is
+done by calling \code{runApp()} with \code{test.mode=TRUE}, or by setting the
+global option \code{shiny.testmode} to \code{TRUE}.
+}
+\examples{
+## Only run this example in interactive R sessions
+if (interactive()) {
+
+options(shiny.testmode = TRUE)
+
+# This application shows the test snapshot 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$getTestSnapshotUrl(format="json")
+      a(href = url, url)
+    })
+
+    output$values <- renderText({
+      paste0("vals$x: ", vals$x, "\\ny: ", y())
+    })
+  }
+)
+}
+}
+

man/getCurrentObserver.Rd

@@ -0,0 +1,124 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/reactives.R
+\name{getCurrentObserver}
+\alias{getCurrentObserver}
+\title{Return the current observer}
+\usage{
+getCurrentObserver(dig = FALSE)
+}
+\arguments{
+\item{dig}{If \code{FALSE} (default), \code{getCurrentObserver} will only
+return the observer if it's invoked directly from within the observer's
+body or from a regular function. If \code{TRUE}, it will always return
+the observer (if it exists on the stack), even if it's invoked from
+within a \code{reactive} or an \code{isolate} scope. See below for more
+information.}
+}
+\value{
+The observer (created with a call to either \code{observe} or to
+\code{observeEvent}) that is currently running.
+}
+\description{
+This function is useful when you want to access an observer's methods or
+variables directly. For example, you may have logic that destroys or
+suspends the observer (from within its own scope) on some condition.
+}
+\details{
+This function works by returning the observer that is currently being run
+when \code{getCurrentObserver()} is called. If there is no observer being
+run (for example, if you called it from outside of a reactive context),
+it will always return \code{NULL}. There are a few subtleties, however.
+Consider the following five situations:
+
+\enumerate{
+  \item \code{getCurrentObserver()   #outside of a reactive context}
+  \item \code{observe({              getCurrentObserver()      }) }
+  \item \code{observe({ (function(){ getCurrentObserver() })() )} }
+  \item \code{observe({ isolate({    getCurrentObserver() })   }) }
+  \item \code{observe({ reactive({   getCurrentObserver() })   }) }
+}
+
+In (1), since you're outside of a reactive context, we've already
+established that \code{getCurrentObserver()} will return \code{NULL}.
+In (2), we have the "vanilla" case, in which \code{getCurrentObserver()}
+is called directly from within the body of the \code{observe} call.
+This returns that observer. So far, so good. The problem comes with
+the last three cases -- should we be able to "retrieve" the outer
+observer if we're inside an inner function's scope, or inside of an
+\code{isolate} or a \code{reactive} block?
+
+Before we can even asnwer that, there is an important distinction to
+be made here: are function calls, \code{reactive} calls and
+\code{isolate} blocks the same \emph{type} of thing? As far as Shiny
+is concerned, the answer is no. Shiny-specific things (like observers,
+reactives and code inside of an \code{isolate} chunk) exist in what we
+call reactive contexts. Each run of an observer or a reactive is
+associated with a particular reactive context. But regular functions
+have no relation to reactive contexts. So, while calling a regular
+function inside of an observer does not change the reactive context,
+calling a \code{reactive} or \code{isolate} certainly does.
+
+With this distinction in mind, we can refine our definition of
+\code{getCurrentObserver()} as follows: it returns the observer (if any)
+that is currently running, as long as it is called from within the
+same reactive context that was created when the observer started
+running. If the reactive context changed (most likely because of a
+call to \code{reactive} or \code{isolate}), \code{getCurrentObserver}
+will return \code{NULL}. (There is another common way that the reactive
+context can change inside an observer, which is if there is a second,
+nested observer. In this case, \code{getCurrentObserver()} will return
+the second, nested observer, since that is the one that is actually
+running at that time.)
+
+So to recap, here's the return value for each of the five situations:
+\enumerate{
+  \item \code{NULL}
+  \item the observer
+  \item the observer
+  \item \code{NULL}
+  \item \code{NULL}
+}
+
+Now, you may be wondering why \code{getCurrentObserver()} should't be able
+to get the running observer even if the reactive context changes. This isn't
+technically impossible. In fact, if you want this behavior for some reason,
+you can set the argument \code{dig} to be \code{TRUE}, so that the function
+will "dig" through the reactive contexts until it retrieves the one for the
+observer and returns the observer.
+
+So, with \code{dig = TRUE}, here's the return value for each of the five
+situations:
+\enumerate{
+  \item \code{NULL}
+  \item the observer
+  \item the observer
+  \item the observer
+  \item the observer
+}
+
+The reason that this is not the default (or even encouraged) is because
+things can get messy quickly when you cross reactive contexts at will.
+For example, the return value of a \code{reactive} call is cached and that
+reactive is not re-run unless its reactive dependencies change. If that
+reactive has a call to \code{getCurrentObserver()}, this can produce
+undesirable and unintuitive results.
+}
+\examples{
+## Only run examples in interactive R sessions
+if (interactive()) {
+shinyApp(
+  ui = basicPage( actionButton("go", "Go")),
+  server = function(input, output, session) {
+    observeEvent(input$go, {
+      print(paste("This will only be printed once; all",
+            "subsequent button clicks won't do anything"))
+      getCurrentObserver()$destroy()
+    })
+  }
+)
+}
+}
+\seealso{
+\code{\link{observe}}
+}
+

man/isolate.Rd

@@ -25,7 +25,7 @@ relationship.
 The expression given to \code{isolate()} is evaluated in the calling
 environment. This means that if you assign a variable inside the
 \code{isolate()}, its value will be visible outside of the \code{isolate()}.
-If you want to avoid this, you can use \code{\link{local}()} inside the
+If you want to avoid this, you can use \code{\link[base]{local}()} inside the
 \code{isolate()}.
 
 This function can also be useful for calling reactive expression at the

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/plotOutput.Rd

@@ -86,7 +86,7 @@ application page.
 }
 \note{
 The arguments \code{clickId} and \code{hoverId} only work for R base
-  graphics (see the \pkg{\link{graphics}} package). They do not work for
+  graphics (see the \pkg{\link[graphics:graphics-package]{graphics}} package). They do not work for
   \pkg{\link[grid:grid-package]{grid}}-based graphics, such as \pkg{ggplot2},
   \pkg{lattice}, and so on.
 }

man/plotPNG.Rd

@@ -18,7 +18,7 @@ extension \code{.png}.}
 \item{height}{Height in pixels.}
 
 \item{res}{Resolution in pixels per inch. This value is passed to
-\code{\link{png}}. Note that this affects the resolution of PNG rendering in
+\code{\link[grDevices]{png}}. Note that this affects the resolution of PNG rendering in
 R; it won't change the actual ppi of the browser.}
 
 \item{...}{Arguments to be passed through to \code{\link[grDevices]{png}}.

man/reactiveTimer.Rd

@@ -18,7 +18,7 @@ occur.}
 A no-parameter function that can be called from a reactive context,
   in order to cause that context to be invalidated the next time the timer
   interval elapses. Calling the returned function also happens to yield the
-  current time (as in \code{\link{Sys.time}}).
+  current time (as in \code{\link[base]{Sys.time}}).
 }
 \description{
 Creates a reactive timer with the given interval. A reactive timer is like a

man/reactiveValuesToList.Rd

@@ -13,7 +13,7 @@ reactiveValuesToList(x, all.names = FALSE)
 \code{FALSE} (the default) don't include those objects.}
 }
 \description{
-This function does something similar to what you might \code{\link{as.list}}
+This function does something similar to what you might \code{\link[base]{as.list}}
 to do. The difference is that the calling context will take dependencies on
 every object in the reactivevalues object. To avoid taking dependencies on
 all the objects, you can wrap the call with \code{\link{isolate}()}.

man/renderDataTable.Rd

@@ -45,7 +45,7 @@ the server infrastructure.
 }
 \details{
 For the \code{options} argument, the character elements that have the class
-\code{"AsIs"} (usually returned from \code{\link{I}()}) will be evaluated in
+\code{"AsIs"} (usually returned from \code{\link[base]{I}()}) will be evaluated in
 JavaScript. This is useful when the type of the option value is not supported
 in JSON, e.g., a JavaScript function, which can be obtained by evaluating a
 character string. Note this only applies to the root-level elements of the

man/renderPlot.Rd

@@ -20,7 +20,7 @@ inline plot, you must provide numeric values (in pixels) to both
 \code{width} and \code{height}.}
 
 \item{res}{Resolution of resulting plot, in pixels per inch. This value is
-passed to \code{\link{png}}. Note that this affects the resolution of PNG
+passed to \code{\link[grDevices]{png}}. Note that this affects the resolution of PNG
 rendering in R; it won't change the actual ppi of the browser.}
 
 \item{...}{Arguments to be passed through to \code{\link[grDevices]{png}}.

man/renderPrint.Rd

@@ -16,7 +16,7 @@ object.}
 \item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})? This
 is useful if you want to save an expression in a variable.}
 
-\item{width}{The value for \code{\link{options}('width')}.}
+\item{width}{The value for \code{\link[base]{options}('width')}.}
 
 \item{outputArgs}{A list of arguments to be passed through to the implicit
 call to \code{\link{verbatimTextOutput}} when \code{renderPrint} is used
@@ -25,7 +25,7 @@ in an interactive R Markdown document.}
 \description{
 Makes a reactive version of the given function that captures any printed
 output, and also captures its printable result (unless
-\code{\link{invisible}}), into a string. The resulting function is suitable
+\code{\link[base]{invisible}}), into a string. The resulting function is suitable
 for assigning to an  \code{output} slot.
 }
 \details{
@@ -38,7 +38,7 @@ The result of executing \code{func} will be printed inside a
 
 Note that unlike most other Shiny output functions, if the given function
 returns \code{NULL} then \code{NULL} will actually be visible in the output.
-To display nothing, make your function return \code{\link{invisible}()}.
+To display nothing, make your function return \code{\link[base]{invisible}()}.
 }
 \examples{
 isolate({

man/req.Rd

@@ -60,7 +60,7 @@ way to check for a value "inline" with its first use.
 \strong{Truthy and falsy values}
 
 The terms "truthy" and "falsy" generally indicate whether a value, when
-coerced to a \code{\link{logical}}, is \code{TRUE} or \code{FALSE}. We use
+coerced to a \code{\link[base]{logical}}, is \code{TRUE} or \code{FALSE}. We use
 the term a little loosely here; our usage tries to match the intuitive
 notions of "Is this value missing or available?", or "Has the user provided
 an answer?", or in the case of action buttons, "Has the button been

man/runApp.Rd

@@ -7,7 +7,8 @@
 runApp(appDir = getwd(), port = getOption("shiny.port"),
   launch.browser = getOption("shiny.launch.browser", interactive()),
   host = getOption("shiny.host", "127.0.0.1"), workerId = "",
-  quiet = FALSE, display.mode = c("auto", "normal", "showcase"))
+  quiet = FALSE, display.mode = c("auto", "normal", "showcase"),
+  test.mode = getOption("shiny.testmode", FALSE))
 }
 \arguments{
 \item{appDir}{The application to run. Should be one of the following:
@@ -46,6 +47,10 @@ the value \code{"showcase"}, shows application code and metadata from a
 application. If set to \code{"normal"}, displays the application normally.
 Defaults to \code{"auto"}, which displays the application in the mode given
 in its \code{DESCRIPTION} file, if any.}
+
+\item{test.mode}{Should the application be launched in test mode? This is
+only used for recording or running automated tests. Defaults to the
+\code{shiny.testmode} option, or FALSE if the option is not set.}
 }
 \description{
 Runs a Shiny application. This function normally does not return; interrupt R

man/selectInput.Rd

@@ -16,7 +16,12 @@ selectizeInput(inputId, ..., options = NULL, width = NULL)
 \item{label}{Display label for the control, or \code{NULL} for no label.}
 
 \item{choices}{List of values to select from. If elements of the list are
-named then that name rather than the value is displayed to the user.}
+named, then that name rather than the value is displayed to the user.
+This can also be a named list whose elements are (either named or
+unnamed) lists or vectors. If this is the case, the outermost names
+will be used as the "optgroup" label for the elements in the respective
+sublist. This allows you to group and label similar choices. See the
+example section for a small demo of this feature.}
 
 \item{selected}{The initially selected value (or multiple values if
 \code{multiple = TRUE}). If not specified then defaults to the first value
@@ -37,7 +42,7 @@ list, but when \code{size} is set, it will be a box instead.}
 \item{...}{Arguments passed to \code{selectInput()}.}
 
 \item{options}{A list of options. See the documentation of \pkg{selectize.js}
-for possible options (character option values inside \code{\link{I}()} will
+for possible options (character option values inside \code{\link[base]{I}()} will
 be treated as literal JavaScript code; see \code{\link{renderDataTable}()}
 for details).}
 }
@@ -73,21 +78,38 @@ The selectize input created from \code{selectizeInput()} allows
 ## Only run examples in interactive R sessions
 if (interactive()) {
 
-ui <- fluidPage(
-  selectInput("variable", "Variable:",
-              c("Cylinders" = "cyl",
-                "Transmission" = "am",
-                "Gears" = "gear")),
-  tableOutput("data")
+# basic example
+shinyApp(
+  ui = fluidPage(
+    selectInput("variable", "Variable:",
+                c("Cylinders" = "cyl",
+                  "Transmission" = "am",
+                  "Gears" = "gear")),
+    tableOutput("data")
+  ),
+  server = function(input, output) {
+    output$data <- renderTable({
+      mtcars[, c("mpg", input$variable), drop = FALSE]
+    }, rownames = TRUE)
+  }
 )
 
-server <- function(input, output) {
-  output$data <- renderTable({
-    mtcars[, c("mpg", input$variable), drop = FALSE]
-  }, rownames = TRUE)
-}
-
-shinyApp(ui, server)
+# demoing optgroup support in the `choices` arg
+shinyApp(
+  ui = fluidPage(
+    selectInput("state", "Choose a state:",
+      list(`East Coast` = c("NY", "NJ", "CT"),
+           `West Coast` = c("WA", "OR", "CA"),
+           `Midwest` = c("MN", "WI", "IA"))
+    ),
+    textOutput("result")
+  ),
+  server = function(input, output) {
+    output$result <- renderText({
+      paste("You chose", input$state)
+    })
+  }
+)
 }
 }
 \seealso{

man/session.Rd

@@ -102,6 +102,10 @@
   This is the request that was used to initiate the websocket connection
   (as opposed to the request that downloaded the web page for the app).
 }
+\item{userData}{
+  An environment for app authors and module/package authors to store whatever
+  session-specific data they want.
+}
 \item{resetBrush(brushId)}{
   Resets/clears the brush with the given \code{brushId}, if it exists on
   any \code{imageOutput} or \code{plotOutput} in the app.
@@ -155,6 +159,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
+  snapshot URL.
+}
+\item{getTestSnapshotUrl(input=TRUE, output=TRUE, export=TRUE,
+  format="json")}{
+  Returns a URL for the test snapshots. Only has an effect when the
+  \code{shiny.testmode} option is set to TRUE. For the input, output, and
+  export 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{input=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.
+  }
 }
 }
 

man/shinyApp.Rd

@@ -44,9 +44,11 @@ is.shiny.appobj(x)
 This is only needed for \code{shinyAppObj}, since in the \code{shinyAppDir}
 case, a \code{global.R} file can be used for this purpose.}
 
-\item{options}{Named options that should be passed to the `runApp` call. You
-can also specify \code{width} and \code{height} parameters which provide a
-hint to the embedding environment about the ideal height/width for the app.}
+\item{options}{Named options that should be passed to the \code{runApp} call
+(these can be any of the following: "port", "launch.browser", "host", "quiet",
+"display.mode" and "test.mode"). You can also specify \code{width} and
+\code{height} parameters which provide a hint to the embedding environment
+about the ideal height/width for the app.}
 
 \item{uiPattern}{A regular expression that will be applied to each \code{GET}
 request to determine whether the \code{ui} should be used to handle the

man/sliderInput.Rd

@@ -62,7 +62,7 @@ see \code{\link{validateCssUnit}}.}
 format string, to be passed to the Javascript strftime library. See
 \url{https://github.com/samsonjs/strftime} for more details. The allowed
 format specifications are very similar, but not identical, to those for R's
-\code{\link{strftime}} function. For Dates, the default is \code{"\%F"}
+\code{\link[base]{strftime}} function. For Dates, the default is \code{"\%F"}
 (like \code{"2015-07-01"}), and for POSIXt, the default is \code{"\%F \%T"}
 (like \code{"2015-07-01 15:32:10"}).}
 

man/submitButton.Rd

@@ -18,13 +18,51 @@ see \code{\link{validateCssUnit}}.}
 A submit button that can be added to a UI definition.
 }
 \description{
-Create a submit button for an input form. Forms that include a submit
+Create a submit button for an app. Apps that include a submit
 button do not automatically update their outputs when inputs change,
 rather they wait until the user explicitly clicks the submit button.
+The use of \code{submitButton} is generally discouraged in favor of
+the more versatile \code{\link{actionButton}} (see details below).
+}
+\details{
+Submit buttons are unusual Shiny inputs, and we recommend using
+\code{\link{actionButton}} instead of \code{submitButton} when you
+want to delay a reaction.
+See \href{http://shiny.rstudio.com/articles/action-buttons.html}{this
+article} for more information (including a demo of how to "translate"
+code using a \code{submitButton} to code using an \code{actionButton}).
+
+In essence, the presence of a submit button stops all inputs from
+sending their values automatically to the server. This means, for
+instance, that if there are \emph{two} submit buttons in the same app,
+clicking either one will cause all inputs in the app to send their
+values to the server. This is probably not what you'd want, which is
+why submit button are unwieldy for all but the simplest apps. There
+are other problems with submit buttons: for example, dynamically
+created submit buttons (for example, with \code{\link{renderUI}}
+or \code{\link{insertUI}}) will not work.
 }
 \examples{
-submitButton("Update View")
-submitButton("Update View", icon("refresh"))
+if (interactive()) {
+
+shinyApp(
+  ui = basicPage(
+    numericInput("num", label = "Make changes", value = 1),
+    submitButton("Update View", icon("refresh")),
+    helpText("When you click the button above, you should see",
+             "the output below update to reflect the value you",
+             "entered at the top:"),
+    verbatimTextOutput("value")
+  ),
+  server = function(input, output) {
+
+    # submit buttons do not have a value of their own,
+    # they control when the app accesses values of other widgets.
+    # input$num is the value of the number widget.
+    output$value <- renderPrint({ input$num })
+  }
+)
+}
 }
 \seealso{
 Other input.elements: \code{\link{actionButton}},

man/tag.Rd

@@ -39,7 +39,7 @@ contain tags, text nodes, and HTML.}
 }
 \value{
 An HTML tag object that can be rendered as HTML using
-  \code{\link{as.character}()}.
+  \code{\link[base]{as.character}()}.
 }
 \description{
 \code{tag()} creates an HTML tag definition. Note that all of the valid HTML5

man/updateSelectInput.Rd

@@ -20,14 +20,19 @@ updateSelectizeInput(session, inputId, label = NULL, choices = NULL,
 \item{label}{The label to set for the input object.}
 
 \item{choices}{List of values to select from. If elements of the list are
-named then that name rather than the value is displayed to the user.}
+named, then that name rather than the value is displayed to the user.
+This can also be a named list whose elements are (either named or
+unnamed) lists or vectors. If this is the case, the outermost names
+will be used as the "optgroup" label for the elements in the respective
+sublist. This allows you to group and label similar choices. See the
+example section for a small demo of this feature.}
 
 \item{selected}{The initially selected value (or multiple values if
 \code{multiple = TRUE}). If not specified then defaults to the first value
 for single-select lists and no values for multiple select lists.}
 
 \item{options}{A list of options. See the documentation of \pkg{selectize.js}
-for possible options (character option values inside \code{\link{I}()} will
+for possible options (character option values inside \code{\link[base]{I}()} will
 be treated as literal JavaScript code; see \code{\link{renderDataTable}()}
 for details).}
 

man/verbatimTextOutput.Rd

@@ -4,10 +4,14 @@
 \alias{verbatimTextOutput}
 \title{Create a verbatim text output element}
 \usage{
-verbatimTextOutput(outputId)
+verbatimTextOutput(outputId, placeholder = FALSE)
 }
 \arguments{
 \item{outputId}{output variable to read the value from}
+
+\item{placeholder}{if the output is empty or \code{NULL}, should an empty
+rectangle be displayed to serve as a placeholder? (does not affect
+behavior when the the output in nonempty)}
 }
 \value{
 A verbatim text output element that can be included in a panel
@@ -18,16 +22,23 @@ application page. The text will be included within an HTML \code{pre} tag.
 }
 \details{
 Text is HTML-escaped prior to rendering. This element is often used
-with the \link{renderPrint} function to preserve fixed-width formatting
-of printed objects.
+  with the \link{renderPrint} function to preserve fixed-width formatting
+  of printed objects.
 }
 \examples{
-mainPanel(
-  h4("Summary"),
-  verbatimTextOutput("summary"),
-
-  h4("Observations"),
-  tableOutput("view")
-)
+## Only run this example in interactive R sessions
+if (interactive()) {
+  shinyApp(
+    ui = basicPage(
+      textInput("txt", "Enter the text to display below:"),
+      verbatimTextOutput("default"),
+      verbatimTextOutput("placeholder", placeholder = TRUE)
+    ),
+    server = function(input, output) {
+      output$default <- renderText({ input$txt })
+      output$placeholder <- renderText({ input$txt })
+    }
+  )
+}
 }
 

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_fileinput.js

@@ -126,6 +126,18 @@ $.extend(FileUploader.prototype, FileProcessor.prototype);
         self.onError(error);
       });
     this.$bar().text('Finishing upload');
+
+    // Trigger event when all files are finished uploading.
+    var evt = jQuery.Event("shiny:fileuploaded");
+    evt.name = this.id;
+    evt.files = $.map(this.files, function(file, i) {
+      return {
+        name: file.name,
+        size: file.size,
+        type: file.type
+      };
+    });
+    $(document).trigger(evt);
   };
   this.onError = function(message) {
     this.$setError(message || '');

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_html.js

@@ -25,6 +25,10 @@ var renderDependencies = exports.renderDependencies = function(dependencies) {
 // inputs/outputs. `content` can be null, a string, or an object with
 // properties 'html' and 'deps'.
 exports.renderContent = function(el, content, where="replace") {
+  if (where === "replace") {
+    exports.unbindAll(el);
+  }
+
   exports.unbindAll(el);
 
   var html;
@@ -81,8 +85,10 @@ function renderDependency(dep) {
   var $head = $("head").first();
 
   if (dep.meta) {
-    var metas = $.map(asArray(dep.meta), function(content, name) {
-      return $("<meta>").attr("name", name).attr("content", content);
+    var metas = $.map(asArray(dep.meta), function(obj, idx) {
+      // only one named pair is expected in obj as it's already been decomposed
+      var name = Object.keys(obj)[0];
+      return $("<meta>").attr("name", name).attr("content", obj[name]);
     });
     $head.append(metas);
   }

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.');
@@ -657,7 +663,9 @@ var ShinyApp = function() {
       // render the HTML and deps to a null target, so
       // the side-effect of rendering the deps, singletons,
       // and <head> still occur
-      exports.renderHtml($([]), message.content.html, message.content.deps);
+      console.warn('The selector you chose ("' + message.selector +
+                   '") could not be found in the DOM.');
+      exports.renderHtml(message.content.html, $([]), message.content.deps);
     } else {
       targets.each(function (i, target) {
         exports.renderContent(target, message.content, message.where);
@@ -832,6 +840,25 @@ 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.getTestSnapshotBaseUrl = function({ fullUrl = true } = {})
+  {
+    const loc = window.location;
+    let url = "";
+
+    if (fullUrl) {
+      // Strip off everything after last slash in path, like dirname() in R
+      url = loc.origin + loc.pathname.replace(/\/[^/]*$/, "");
+    }
+    url += "/session/" +
+      encodeURIComponent(this.config.sessionId) +
+      "/dataobj/shinytest?w=" +
+      encodeURIComponent(this.config.workerId) +
+      "&nonce=" + randomId();
+
+    return url;
+  };
 
 }).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))
 })
 

tests/testthat/test-utils.R

@@ -129,6 +129,31 @@ test_that("anyUnnamed works as expected", {
   expect_true(anyUnnamed(x))
 })
 
+test_that("sortByName works as expected", {
+  # Error if any unnamed elements
+  expect_error(sortByName(c("a", "b")))
+  expect_error(sortByName(list(a=1, 2)))
+
+  expect_identical(sortByName(NULL), NULL)
+  expect_identical(sortByName(numeric(0)), numeric(0))
+  expect_identical(sortByName(character(0)), character(0))
+  # Empty unnamed list
+  expect_identical(sortByName(list()), list())
+  # Empty named list
+  expect_identical(sortByName(list(a=1)[0]), list(a=1)[0])
+
+  expect_identical(sortByName(list(b=1, a=2)), list(a=2, b=1))
+  expect_identical(sortByName(list(b=1)), list(b=1))
+
+  # Ties are resolved by using original order
+  expect_identical(sortByName(list(b=1, a=2, b=3)), list(a=2, b=1, b=3))
+  expect_identical(sortByName(list(b=3, a=2, b=1)), list(a=2, b=3, b=1))
+
+  # Make sure atomic vectors work
+  expect_identical(sortByName(c(b=1, a=2)), c(a=2, b=1))
+  expect_identical(sortByName(c(b=1, a=2, b=3)), c(a=2, b=1, b=3))
+})
+
 test_that("Callbacks fire in predictable order", {
   cb <- Callbacks$new()
 

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",