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

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 1.0.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"),
@@ -79,8 +79,7 @@ Suggests:
     knitr (>= 1.6),
     markdown,
     rmarkdown,
-    ggplot2,
-    magrittr
+    ggplot2
 URL: http://shiny.rstudio.com
 BugReports: https://github.com/rstudio/shiny/issues
 Collate:
@@ -98,9 +97,6 @@ Collate:
     'diagnose.R'
     'fileupload.R'
     'graph.R'
-    'reactives.R'
-    'reactive-domains.R'
-    'history.R'
     'hooks.R'
     'html-deps.R'
     'htmltools.R'
@@ -132,6 +128,8 @@ Collate:
     'priorityqueue.R'
     'progress.R'
     'react.R'
+    'reactive-domains.R'
+    'reactives.R'
     'render-plot.R'
     'render-table.R'
     'run-url.R'
@@ -147,4 +145,4 @@ Collate:
     'test-export.R'
     'timer.R'
     'update-input.R'
-RoxygenNote: 6.0.1
+RoxygenNote: 5.0.1

LICENSE

@@ -12,7 +12,7 @@ these components are included below):
 - Respond.js, https://github.com/scottjehl/Respond
 - bootstrap-datepicker, https://github.com/eternicode/bootstrap-datepicker
 - Font Awesome, https://github.com/FortAwesome/Font-Awesome
-- selectize.js, https://github.com/selectize/selectize.js
+- selectize.js, https://github.com/brianreavis/selectize.js
 - es5-shim, https://github.com/es-shims/es5-shim
 - ion.rangeSlider, https://github.com/IonDen/ion.rangeSlider
 - strftime for Javascript, https://github.com/samsonjs/strftime

NAMESPACE

@@ -22,8 +22,6 @@ S3method(as.shiny.appobj,list)
 S3method(as.shiny.appobj,shiny.appobj)
 S3method(as.tags,shiny.appobj)
 S3method(as.tags,shiny.render.function)
-S3method(format,reactiveExpr)
-S3method(format,reactiveVal)
 S3method(names,reactivevalues)
 S3method(print,reactive)
 S3method(print,shiny.appobj)
@@ -63,7 +61,6 @@ export(dataTableOutput)
 export(dateInput)
 export(dateRangeInput)
 export(dblclickOpts)
-export(debounce)
 export(dialogViewer)
 export(div)
 export(downloadButton)
@@ -86,12 +83,10 @@ export(flowLayout)
 export(fluidPage)
 export(fluidRow)
 export(formatStackTrace)
-export(freezeReactiveVal)
 export(freezeReactiveValue)
+export(getCurrentObserver)
 export(getDefaultReactiveDomain)
-export(getQueryString)
 export(getShinyOption)
-export(getUrlHash)
 export(h1)
 export(h2)
 export(h3)
@@ -173,7 +168,6 @@ export(reactiveTable)
 export(reactiveText)
 export(reactiveTimer)
 export(reactiveUI)
-export(reactiveVal)
 export(reactiveValues)
 export(reactiveValuesToList)
 export(registerInputHandler)
@@ -217,7 +211,6 @@ export(sidebarLayout)
 export(sidebarPanel)
 export(singleton)
 export(sliderInput)
-export(snapshotExclude)
 export(span)
 export(splitLayout)
 export(stopApp)
@@ -237,7 +230,6 @@ export(tags)
 export(textAreaInput)
 export(textInput)
 export(textOutput)
-export(throttle)
 export(titlePanel)
 export(uiOutput)
 export(updateActionButton)

NEWS.md

@@ -1,88 +1,5 @@
-shiny 1.0.1
-================
-
-This is a maintenance release of Shiny, mostly aimed at fixing bugs and introducing minor features. The most notable additions in this version of Shiny are the introduction of the `reactiveVal()` function (it's like `reactiveValues()`, but it only stores a single value), and that the choices of `radioButtons()` and `checkboxGroupInput()` can now contain HTML content instead of just plain text.
-
-## Full changelog
-
-### Breaking changes
-
-* The functions `radioButtons()`, `checkboxGroupInput()` and `selectInput()` (and the corresponding `updateXXX()` functions) no longer accept a `selected` argument whose value is the name of a choice, instead of the value of the choice. This feature had been deprecated since Shiny 0.10 (it printed a warning message, but still tried to match the name to the right choice) and it's now completely unsupported.
-
-### New features
-
-* Added `reactiveVal` function, for storing a single value which can be (reactively) read and written. Similar to `reactiveValues`, except that `reactiveVal` just lets you store a single value instead of storing multiple values by name. ([#1614](https://github.com/rstudio/shiny/pull/1614))
-
-### Minor new features and improvements
-
-* Fixed [#1637](https://github.com/rstudio/shiny/issues/1637): Outputs stay faded on MS Edge. ([#1640](https://github.com/rstudio/shiny/pull/1640))
-
-* Addressed [#1348](https://github.com/rstudio/shiny/issues/1348) and [#1437](https://github.com/rstudio/shiny/issues/1437) by adding two new arguments to `radioButtons()` and `checkboxGroupInput()`: `choiceNames` (list or vector) and `choiceValues` (list or vector). These can be passed in as an alternative to `choices`, with the added benefit that the elements in `choiceNames` can be arbitrary UI (i.e. anything created by `HTML()` and the `tags()` functions, like icons and images). While the underlying values for each choice (passed in through `choiceValues`) must still be simple text, their visual representation on the app (what the user actually clicks to select a different option) can be any valid HTML element. See `?radioButtons` for a small example. ([#1521](https://github.com/rstudio/shiny/pull/1521))
-
-* Updated `tools/README.md` with more detailed instructions. ([##1616](https://github.com/rstudio/shiny/pull/1616))
-
-* Fixed [#1565](https://github.com/rstudio/shiny/issues/1565), which meant that resources with spaces in their names return HTTP 404. ([#1566](https://github.com/rstudio/shiny/pull/1566))
-
-* Exported `session$user` (if it exists) to the client-side; it's accessible in the Shiny object: `Shiny.user`. ([#1563](https://github.com/rstudio/shiny/pull/1563))
-
-* Added support for HTML5's `pushState` which allows for pseudo-navigation
-in shiny apps. For more info, see the documentation (`?updateQueryString` and `?getQueryString`). ([#1447](https://github.com/rstudio/shiny/pull/1447))
-
-* Fixed [#1121](https://github.com/rstudio/shiny/issues/1121): plot interactions with ggplot2 now support `coord_fixed()`. ([#1525](https://github.com/rstudio/shiny/pull/1525))
-
-* Added `snapshotExclude` function, which marks an output so that it is not recorded in a test snapshot. ([#1559](https://github.com/rstudio/shiny/pull/1559))
-
-* Added `shiny:filedownload` JavaScript event, which is triggered when a `downloadButton` or `downloadLink` is clicked. Also, the values of `downloadHandler`s are not recorded in test snapshots, because the values change every time the application is run. ([#1559](https://github.com/rstudio/shiny/pull/1559))
-
-* Added support for plot interactions with ggplot2 > 2.2.1. ([#1578](https://github.com/rstudio/shiny/pull/1578))
-
-* Fixed [#1577](https://github.com/rstudio/shiny/issues/1577): Improved `escapeHTML` (util.js) in terms of the order dependency of replacing, XSS risk attack and performance. ([#1579](https://github.com/rstudio/shiny/pull/1579))
-
-* The `shiny:inputchanged` JavaScript event now includes two new fields, `binding` and `el`, which contain the input binding and DOM element, respectively. Additionally, `Shiny.onInputChange()` now accepts an optional argument, `opts`, which can contain the same fields. ([#1596](https://github.com/rstudio/shiny/pull/1596))
-
-* The `NS()` function now returns a vectorized function. ([#1613](https://github.com/rstudio/shiny/pull/1613))
-
-* Fixed [#1617](https://github.com/rstudio/shiny/issues/1617): `fileInput` can have customized text for the button and the placeholder. ([#1619](https://github.com/rstudio/shiny/pull/1619))
-
-### Bug fixes
-
-* Fixed [#1511](https://github.com/rstudio/shiny/issues/1511): `fileInput`s did not trigger the `shiny:inputchanged` event on the client. Also removed `shiny:fileuploaded` JavaScript event, because it is no longer needed after this fix. ([#1541](https://github.com/rstudio/shiny/pull/1541), [#1570](https://github.com/rstudio/shiny/pull/1570))
-
-* Fixed [#1472](https://github.com/rstudio/shiny/issues/1472): With a Progress object, calling `set(value=NULL)` made the progress bar go to 100%. Now it does not change the value of the progress bar. The documentation also incorrectly said that setting the `value` to `NULL` would hide the progress bar. ([#1547](https://github.com/rstudio/shiny/pull/1547))
-
-* Fixed [#162](https://github.com/rstudio/shiny/issues/162): When a dynamically-generated input changed to a different `inputType`, it might be incorrectly deduplicated.  ([#1594](https://github.com/rstudio/shiny/pull/1594))
-
-* Removed redundant call to `inputs.setInput`. ([#1595](https://github.com/rstudio/shiny/pull/1595))
-
-* Fixed bug where `dateRangeInput` did not respect `weekstart` argument. ([#1592](https://github.com/rstudio/shiny/pull/1592))
-
-* Fixed [#1598](https://github.com/rstudio/shiny/issues/1598): `setBookmarkExclude()` did not work properly inside of modules. ([#1599](https://github.com/rstudio/shiny/pull/1599))
-
-* Fixed [#1605](https://github.com/rstudio/shiny/issues/1605): sliders did not move when clicked on the bar area. ([#1610](https://github.com/rstudio/shiny/pull/1610))
-
-* Fixed [#1621](https://github.com/rstudio/shiny/issues/1621): if a `reactiveTimer`'s session was closed before the first time that the `reactiveTimer` fired, then the `reactiveTimer` would not get cleared and would keep firing indefinitely. ([#1623](https://github.com/rstudio/shiny/pull/1623))
-
-* Fixed [#1634](https://github.com/rstudio/shiny/issues/1634): If brushing on a plot causes the plot to redraw, then the redraw could in turn trigger the plot to redraw again and again. This was due to spurious changes in values of floating point numbers. ([#1641](https://github.com/rstudio/shiny/pull/1641))
-
-### Library updates
-
-* Closed [#1500](https://github.com/rstudio/shiny/issues/1500): Updated ion.rangeSlider to 2.1.6. ([#1540](https://github.com/rstudio/shiny/pull/1540))
-
-
-shiny 1.0.0
-===========
-
-Shiny has reached a milestone: version 1.0.0! In the last year, we've added two major features that we considered essential for a 1.0.0 release: bookmarking, and support for testing Shiny applications. As usual, this version of Shiny also includes many minor features and bug fixes.
-
-Here are some highlights from this release. For more details, see the full changelog below.
-
-## Support for testing Shiny applications
-
-Shiny now supports automated testing of applications, with the [shinytest](https://github.com/rstudio/shinytest) package. Shinytest has not yet been released on CRAN, but will be soon. ([#18](https://github.com/rstudio/shiny/issues/18), [#1464](https://github.com/rstudio/shiny/pull/1464))
-
-## Debounce/throttle reactives
-
-Now there's an official way to slow down reactive values and expressions that invalidate too quickly. Pass a reactive expression to the new `debounce` or `throttle` function, and get back a modified reactive expression that doesn't invalidate as often. ([#1510](https://github.com/rstudio/shiny/pull/1510))
+shiny 0.14.2.9000
+============
 
 ## Full changelog
 
@@ -90,30 +7,16 @@ Now there's an official way to slow down reactive values and expressions that in
 
 * 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))
 
-### New features
-
-* Added support for testing Shiny applications with the shinytest package. ([#18](https://github.com/rstudio/shiny/issues/18), [#1464](https://github.com/rstudio/shiny/pull/1464))
-
-* Added `debounce` and `throttle` functions, to control the rate at which reactive values and expressions invalidate. ([#1510](https://github.com/rstudio/shiny/pull/1510))
-
 ### Minor new features and improvements
 
-* Addressed [#1486](https://github.com/rstudio/shiny/issues/1486) by adding a new argument to `observeEvent` and `eventReactive`, called `ignoreInit` (defaults to `FALSE` for backwards compatibility). When set to `TRUE`, the action (i.e. the second argument: `handlerExpr` and `valueExpr`, respectively) will not be triggered when the observer/reactive is first created/initialized. In other words, `ignoreInit = TRUE` ensures that the `observeEvent` (or `eventReactive`) is *never* run right away. For more info, see the documentation (`?observeEvent`). ([#1494](https://github.com/rstudio/shiny/pull/1494))
-    
-* Added a new argument to `observeEvent` called `once`. When set to `TRUE`, it results in the observer being destroyed (stop observing) after the first time that `handlerExpr` is run (i.e. `once = TRUE` guarantees that the observer only runs, at most, once). For more info, see the documentation (`?observeEvent`). ([#1494](https://github.com/rstudio/shiny/pull/1494))
-
-* Addressed [#1358](https://github.com/rstudio/shiny/issues/1358): more informative error message when calling `runApp()` inside of an app's app.R (or inside ui.R or server.R). ([#1482](https://github.com/rstudio/shiny/pull/1482))
-
 * 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 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))
 
-* Relaxed naming requirements for `addResourcePath()` (the first character no longer needs to be a letter). ([#1529](https://github.com/rstudio/shiny/pull/1529))
-
 ### 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))
@@ -128,13 +31,6 @@ Now there's an official way to slow down reactive values and expressions that in
 
 * 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))
 
-* Fixed [#1453](https://github.com/rstudio/shiny/issues/1453): When using a modal dialog with `easyClose=TRUE` in a Shiny gadget, pressing Esc would close both the modal and the gadget. Now pressing Esc only closes the modal. ([#1523](https://github.com/rstudio/shiny/pull/1523))
-
-### Library updates
-
-* Updated to Font Awesome 4.7.0.
-
-
 shiny 0.14.2
 ============
 

R/app.R

@@ -41,8 +41,6 @@
 #' @examples
 #' ## Only run this example in interactive R sessions
 #' if (interactive()) {
-#'   options(device.ask.default = FALSE)
-#'
 #'   shinyApp(
 #'     ui = fluidPage(
 #'       numericInput("n", "n", 1),

R/bookmark-state.R

@@ -493,90 +493,12 @@ restoreInput <- function(id, default) {
 #' It typically is called from an observer. Note that this will not work in
 #' Internet Explorer 9 and below.
 #'
-#' For \code{mode = "push"}, only three updates are currently allowed:
-#' \enumerate{
-#'   \item the query string (format: \code{?param1=val1&param2=val2})
-#'   \item the hash (format: \code{#hash})
-#'   \item both the query string and the hash
-#'     (format: \code{?param1=val1&param2=val2#hash})
-#' }
-#'
-#' In other words, if \code{mode = "push"}, the \code{queryString} must start
-#' with either \code{?} or with \code{#}.
-#'
-#' A technical curiosity: under the hood, this function is calling the HTML5
-#' history API (which is where the names for the \code{mode} argument come from).
-#' When \code{mode = "replace"}, the function called is
-#' \code{window.history.replaceState(null, null, queryString)}.
-#' When \code{mode = "push"}, the function called is
-#' \code{window.history.pushState(null, null, queryString)}.
-#'
 #' @param queryString The new query string to show in the location bar.
-#' @param mode When the query string is updated, should the the current history
-#'   entry be replaced (default), or should a new history entry be pushed onto
-#'   the history stack? The former should only be used in a live bookmarking
-#'   context. The latter is useful if you want to navigate between states using
-#'   the browser's back and forward buttons. See Examples.
 #' @param session A Shiny session object.
-#' @seealso \code{\link{enableBookmarking}}, \code{\link{getQueryString}}
-#' @examples
-#' ## Only run these examples in interactive sessions
-#' if (interactive()) {
-#'
-#'   ## App 1: Doing "live" bookmarking
-#'   ## Update the browser's location bar every time an input changes.
-#'   ## This should not be used with enableBookmarking("server"),
-#'   ## because that would create a new saved state on disk every time
-#'   ## the user changes an input.
-#'   enableBookmarking("url")
-#'   shinyApp(
-#'     ui = function(req) {
-#'       fluidPage(
-#'         textInput("txt", "Text"),
-#'         checkboxInput("chk", "Checkbox")
-#'       )
-#'     },
-#'     server = function(input, output, session) {
-#'       observe({
-#'         # Trigger this observer every time an input changes
-#'         reactiveValuesToList(input)
-#'         session$doBookmark()
-#'       })
-#'       onBookmarked(function(url) {
-#'         updateQueryString(url)
-#'       })
-#'     }
-#'   )
-#'
-#'   ## App 2: Printing the value of the query string
-#'   ## (Use the back and forward buttons to see how the browser
-#'   ## keeps a record of each state)
-#'   shinyApp(
-#'     ui = fluidPage(
-#'       textInput("txt", "Enter new query string"),
-#'       helpText("Format: ?param1=val1&param2=val2"),
-#'       actionButton("go", "Update"),
-#'       hr(),
-#'       verbatimTextOutput("query")
-#'     ),
-#'     server = function(input, output, session) {
-#'       observeEvent(input$go, {
-#'         updateQueryString(input$txt, mode = "push")
-#'       })
-#'       output$query <- renderText({
-#'         query <- getQueryString()
-#'         queryText <- paste(names(query), query,
-#'                        sep = "=", collapse=", ")
-#'         paste("Your query string is:\n", queryText)
-#'       })
-#'     }
-#'   )
-#' }
+#' @seealso \code{\link{enableBookmarking}} for examples.
 #' @export
-updateQueryString <- function(queryString, mode = c("replace", "push"),
-                              session = getDefaultReactiveDomain()) {
-  mode <- match.arg(mode)
-  session$updateQueryString(queryString, mode)
+updateQueryString <- function(queryString, session = getDefaultReactiveDomain()) {
+  session$updateQueryString(queryString)
 }
 
 #' Create a button for bookmarking/sharing

R/bootstrap-layout.R

@@ -277,7 +277,6 @@ titlePanel <- function(title, windowTitle=title) {
 #' @examples
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {
-#' options(device.ask.default = FALSE)
 #'
 #' # Define UI
 #' ui <- fluidPage(
@@ -443,7 +442,6 @@ inputPanel <- function(...) {
 #' @examples
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {
-#' options(device.ask.default = FALSE)
 #'
 #' # Server code used for all examples
 #' server <- function(input, output) {

R/bootstrap.R

@@ -1453,7 +1453,7 @@ uiOutput <- htmlOutput
 #' }
 #'
 #' @aliases downloadLink
-#' @seealso \code{\link{downloadHandler}}
+#' @seealso downloadHandler
 #' @export
 downloadButton <- function(outputId,
                            label="Download",
@@ -1543,7 +1543,7 @@ icon <- function(name, class = NULL, lib = "font-awesome") {
   # font-awesome needs an additional dependency (glyphicon is in bootstrap)
   if (lib == "font-awesome") {
     htmlDependencies(iconTag) <- htmlDependency(
-      "font-awesome", "4.7.0", c(href="shared/font-awesome"),
+      "font-awesome", "4.6.3", c(href="shared/font-awesome"),
       stylesheet = "css/font-awesome.min.css"
     )
   }

R/history.R

@@ -1,95 +0,0 @@
-
-#' @include reactive-domains.R
-NULL
-
-#' @include reactives.R
-NULL
-
-#' Get the query string / hash component from the URL
-#'
-#' Two user friendly wrappers for getting the query string and the hash
-#' component from the app's URL.
-#'
-#' These can be particularly useful if you want to display different content
-#' depending on the values in the query string / hash (e.g. instead of basing
-#' the conditional on an input or a calculated reactive, you can base it on the
-#' query string). However, note that, if you're changing the query string / hash
-#' programatically from within the server code, you must use
-#' \code{updateQueryString(_yourNewQueryString_, mode = "push")}. The default
-#' \code{mode} for \code{updateQueryString} is \code{"replace"}, which doesn't
-#' raise any events, so any observers or reactives that depend on it will
-#' \emph{not} get triggered. However, if you're changing the query string / hash
-#' directly by typing directly in the browser and hitting enter, you don't have
-#' to worry about this.
-#'
-#' @param session	A Shiny session object.
-#'
-#' @return For \code{getQueryString}, a named list. For example, the query
-#'   string \code{?param1=value1&param2=value2} becomes \code{list(param1 =
-#'   value1, param2 = value2)}. For \code{getUrlHash}, a character vector with
-#'   the hash (including the leading \code{#} symbol).
-#'
-#' @seealso \code{\link{updateQueryString}}
-#'
-#' @examples
-#' ## Only run this example in interactive R sessions
-#' if (interactive()) {
-#'
-#'   ## App 1: getQueryString
-#'   ## Printing the value of the query string
-#'   ## (Use the back and forward buttons to see how the browser
-#'   ## keeps a record of each state)
-#'   shinyApp(
-#'     ui = fluidPage(
-#'       textInput("txt", "Enter new query string"),
-#'       helpText("Format: ?param1=val1&param2=val2"),
-#'       actionButton("go", "Update"),
-#'       hr(),
-#'       verbatimTextOutput("query")
-#'     ),
-#'     server = function(input, output, session) {
-#'       observeEvent(input$go, {
-#'         updateQueryString(input$txt, mode = "push")
-#'       })
-#'       output$query <- renderText({
-#'         query <- getQueryString()
-#'         queryText <- paste(names(query), query,
-#'                        sep = "=", collapse=", ")
-#'         paste("Your query string is:\n", queryText)
-#'       })
-#'     }
-#'   )
-#'
-#'   ## App 2: getUrlHash
-#'   ## Printing the value of the URL hash
-#'   ## (Use the back and forward buttons to see how the browser
-#'   ## keeps a record of each state)
-#'   shinyApp(
-#'     ui = fluidPage(
-#'       textInput("txt", "Enter new hash"),
-#'       helpText("Format: #hash"),
-#'       actionButton("go", "Update"),
-#'       hr(),
-#'       verbatimTextOutput("hash")
-#'     ),
-#'     server = function(input, output, session) {
-#'       observeEvent(input$go, {
-#'         updateQueryString(input$txt, mode = "push")
-#'       })
-#'       output$hash <- renderText({
-#'         hash <- getUrlHash()
-#'         paste("Your hash is:\n", hash)
-#'       })
-#'     }
-#'   )
-#' }
-#' @export
-getQueryString <- function(session = getDefaultReactiveDomain()) {
-  parseQueryString(session$clientData$url_search)
-}
-
-#' @rdname getQueryString
-#' @export
-getUrlHash <- function(session = getDefaultReactiveDomain()) {
-  session$clientData$url_hash
-}

R/input-checkboxgroup.R

@@ -6,21 +6,9 @@
 #'
 #' @inheritParams textInput
 #' @param choices List of values to show checkboxes for. If elements of the list
-#'   are named then that name rather than the value is displayed to the user. If
-#'   this argument is provided, then \code{choiceNames} and \code{choiceValues}
-#'   must not be provided, and vice-versa.
+#'   are named then that name rather than the value is displayed to the user.
 #' @param selected The values that should be initially selected, if any.
 #' @param inline If \code{TRUE}, render the choices inline (i.e. horizontally)
-#' @param choiceNames,choiceValues List of names and values, respectively,
-#'   that are displayed to the user in the app and correspond to the each
-#'   choice (for this reason, \code{choiceNames} and \code{choiceValues}
-#'   must have the same length). If either of these arguments is
-#'   provided, then the other \emph{must} be provided and \code{choices}
-#'   \emph{must not} be provided. The advantage of using both of these over
-#'   a named list for \code{choices} is that \code{choiceNames} allows any
-#'   type of UI object to be passed through (tag objects, icons, HTML code,
-#'   ...), instead of just simple text. See Examples.
-#'
 #' @return A list of HTML elements that can be added to a UI definition.
 #'
 #' @family input elements
@@ -38,47 +26,26 @@
 #'   tableOutput("data")
 #' )
 #'
-#' server <- function(input, output, session) {
+#' server <- function(input, output) {
 #'   output$data <- renderTable({
 #'     mtcars[, c("mpg", input$variable), drop = FALSE]
 #'   }, rownames = TRUE)
 #' }
 #'
 #' shinyApp(ui, server)
-#'
-#' ui <- fluidPage(
-#'   checkboxGroupInput("icons", "Choose icons:",
-#'     choiceNames =
-#'       list(icon("calendar"), icon("bed"),
-#'            icon("cog"), icon("bug")),
-#'     choiceValues =
-#'       list("calendar", "bed", "cog", "bug")
-#'   ),
-#'   textOutput("txt")
-#' )
-#'
-#' server <- function(input, output, session) {
-#'   output$txt <- renderText({
-#'     icons <- paste(input$icons, collapse = ", ")
-#'     paste("You chose", icons)
-#'   })
-#' }
-#'
-#' shinyApp(ui, server)
 #' }
 #' @export
-checkboxGroupInput <- function(inputId, label, choices = NULL, selected = NULL,
-  inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL) {
-
-  args <- normalizeChoicesArgs(choices, choiceNames, choiceValues)
+checkboxGroupInput <- function(inputId, label, choices, selected = NULL,
+  inline = FALSE, width = NULL) {
 
   selected <- restoreInput(id = inputId, default = selected)
 
-  # default value if it's not specified
-  if (!is.null(selected)) selected <- as.character(selected)
+  # resolve names
+  choices <- choicesWithNames(choices)
+  if (!is.null(selected))
+    selected <- validateSelected(selected, choices, inputId)
 
-  options <- generateOptions(inputId, selected, inline,
-    'checkbox', args$choiceNames, args$choiceValues)
+  options <- generateOptions(inputId, choices, selected, inline)
 
   divClass <- "form-group shiny-input-checkboxgroup shiny-input-container"
   if (inline)

R/input-daterange.R

@@ -98,7 +98,7 @@ dateRangeInput <- function(inputId, label, start = NULL, end = NULL,
           class = "input-sm form-control",
           type = "text",
           `data-date-language` = language,
-          `data-date-week-start` = weekstart,
+          `data-date-weekstart` = weekstart,
           `data-date-format` = format,
           `data-date-start-view` = startview,
           `data-min-date` = min,
@@ -110,7 +110,7 @@ dateRangeInput <- function(inputId, label, start = NULL, end = NULL,
           class = "input-sm form-control",
           type = "text",
           `data-date-language` = language,
-          `data-date-week-start` = weekstart,
+          `data-date-weekstart` = weekstart,
           `data-date-format` = format,
           `data-date-start-view` = startview,
           `data-min-date` = min,

R/input-file.R

@@ -27,9 +27,6 @@
 #'   Internet Explorer 9 and earlier.}
 #' @param accept A character vector of MIME types; gives the browser a hint of
 #'   what kind of files the server is expecting.
-#' @param buttonLabel The label used on the button. Can be text or an HTML tag
-#'   object.
-#' @param placeholder The text to show before a file has been uploaded.
 #'
 #' @examples
 #' ## Only run examples in interactive R sessions
@@ -73,7 +70,7 @@
 #' }
 #' @export
 fileInput <- function(inputId, label, multiple = FALSE, accept = NULL,
-  width = NULL, buttonLabel = "Browse...", placeholder = "No file selected") {
+  width = NULL) {
 
   restoredValue <- restoreInput(id = inputId, default = NULL)
 
@@ -108,12 +105,12 @@ fileInput <- function(inputId, label, multiple = FALSE, accept = NULL,
     div(class = "input-group",
       tags$label(class = "input-group-btn",
         span(class = "btn btn-default btn-file",
-          buttonLabel,
+          "Browse...",
           inputTag
         )
       ),
       tags$input(type = "text", class = "form-control",
-        placeholder = placeholder, readonly = "readonly"
+        placeholder = "No file selected", readonly = "readonly"
       )
     ),
 

R/input-radiobuttons.R

@@ -11,22 +11,11 @@
 #'
 #' @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). If
-#'   this argument is provided, then \code{choiceNames} and \code{choiceValues}
-#'   must not be provided, and vice-versa.
+#' named then that name rather than the value is displayed to the user)
 #' @param selected The initially selected value (if not specified then
-#'   defaults to the first value)
+#' defaults to the first value)
 #' @param inline If \code{TRUE}, render the choices inline (i.e. horizontally)
 #' @return A set of radio buttons that can be added to a UI definition.
-#' @param choiceNames,choiceValues List of names and values, respectively,
-#'   that are displayed to the user in the app and correspond to the each
-#'   choice (for this reason, \code{choiceNames} and \code{choiceValues}
-#'   must have the same length). If either of these arguments is
-#'   provided, then the other \emph{must} be provided and \code{choices}
-#'   \emph{must not} be provided. The advantage of using both of these over
-#'   a named list for \code{choices} is that \code{choiceNames} allows any
-#'   type of UI object to be passed through (tag objects, icons, HTML code,
-#'   ...), instead of just simple text. See Examples.
 #'
 #' @family input elements
 #' @seealso \code{\link{updateRadioButtons}}
@@ -58,46 +47,27 @@
 #' }
 #'
 #' shinyApp(ui, server)
-#'
-#' ui <- fluidPage(
-#'   radioButtons("rb", "Choose one:",
-#'                choiceNames = list(
-#'                  icon("calendar"),
-#'                  HTML("<p style='color:red;'>Red Text</p>"),
-#'                  "Normal text"
-#'                ),
-#'                choiceValues = list(
-#'                  "icon", "html", "text"
-#'                )),
-#'   textOutput("txt")
-#' )
-#'
-#' server <- function(input, output) {
-#'   output$txt <- renderText({
-#'     paste("You chose", input$rb)
-#'   })
-#' }
-#'
-#' shinyApp(ui, server)
 #' }
 #' @export
-radioButtons <- function(inputId, label, choices = NULL, selected = NULL,
-  inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL) {
+radioButtons <- function(inputId, label, choices, selected = NULL,
+  inline = FALSE, width = NULL) {
 
-  args <- normalizeChoicesArgs(choices, choiceNames, choiceValues)
+  # resolve names
+  choices <- choicesWithNames(choices)
 
   selected <- restoreInput(id = inputId, default = selected)
 
   # default value if it's not specified
-  selected <- if (is.null(selected)) args$choiceValues[[1]] else as.character(selected)
-
+  selected <- if (is.null(selected)) choices[[1]] else {
+    validateSelected(selected, choices, inputId)
+  }
   if (length(selected) > 1) stop("The 'selected' argument must be of length 1")
 
-  options <- generateOptions(inputId, selected, inline,
-    'radio', args$choiceNames, args$choiceValues)
+  options <- generateOptions(inputId, choices, selected, inline, type = 'radio')
 
   divClass <- "form-group shiny-input-radiogroup shiny-input-container"
-  if (inline) divClass <- paste(divClass, "shiny-input-container-inline")
+  if (inline)
+    divClass <- paste(divClass, "shiny-input-container-inline")
 
   tags$div(id = inputId,
     style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),

R/input-select.R

@@ -5,7 +5,7 @@
 #'
 #' By default, \code{selectInput()} and \code{selectizeInput()} use the
 #' JavaScript library \pkg{selectize.js}
-#' (\url{https://github.com/selectize/selectize.js}) to instead of the basic
+#' (\url{https://github.com/brianreavis/selectize.js}) to instead of the basic
 #' select input element. To use the standard HTML select input element, use
 #' \code{selectInput()} with \code{selectize=FALSE}.
 #'
@@ -74,8 +74,8 @@
 #' }
 #' @export
 selectInput <- function(inputId, label, choices, selected = NULL,
-  multiple = FALSE, selectize = TRUE, width = NULL,
-  size = NULL) {
+                        multiple = FALSE, selectize = TRUE, width = NULL,
+                        size = NULL) {
 
   selected <- restoreInput(id = inputId, default = selected)
 
@@ -85,7 +85,7 @@ selectInput <- function(inputId, label, choices, selected = NULL,
   # default value if it's not specified
   if (is.null(selected)) {
     if (!multiple) selected <- firstChoice(choices)
-  } else selected <- as.character(selected)
+  } else selected <- validateSelected(selected, choices, inputId)
 
   if (!is.null(size) && selectize) {
     stop("'size' argument is incompatible with 'selectize=TRUE'.")

R/input-slider.R

@@ -51,7 +51,6 @@
 #' @examples
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {
-#' options(device.ask.default = FALSE)
 #'
 #' ui <- fluidPage(
 #'   sliderInput("obs", "Number of observations:",
@@ -164,21 +163,23 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
     `data-grid` = ticks,
     `data-grid-num` = n_ticks,
     `data-grid-snap` = FALSE,
-    `data-prettify-separator` = sep,
-    `data-prettify-enabled` = (sep != ""),
     `data-prefix` = pre,
     `data-postfix` = post,
     `data-keyboard` = TRUE,
     `data-keyboard-step` = step / (max - min) * 100,
-    # This value is only relevant for range sliders; for non-range sliders it
-    # causes problems since ion.RangeSlider 2.1.2 (issue #1605).
-    `data-drag-interval` = if (length(value) > 1) dragRange,
+    `data-drag-interval` = dragRange,
     # The following are ignored by the ion.rangeSlider, but are used by Shiny.
     `data-data-type` = dataType,
     `data-time-format` = timeFormat,
     `data-timezone` = timezone
   ))
 
+  if (sep == "") {
+    sliderProps$`data-prettify-enabled` <- "0"
+  } else {
+    sliderProps$`data-prettify-separator` <- sep
+  }
+
   # Replace any TRUE and FALSE with "true" and "false"
   sliderProps <- lapply(sliderProps, function(x) {
     if (identical(x, TRUE)) "true"
@@ -218,7 +219,7 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
   }
 
   dep <- list(
-    htmlDependency("ionrangeslider", "2.1.6", c(href="shared/ionrangeslider"),
+    htmlDependency("ionrangeslider", "2.1.2", c(href="shared/ionrangeslider"),
       script = "js/ion.rangeSlider.min.js",
       # ion.rangeSlider also needs normalize.css, which is already included in
       # Bootstrap.

R/input-utils.R

@@ -2,62 +2,45 @@ controlLabel <- function(controlName, label) {
   label %AND% tags$label(class = "control-label", `for` = controlName, label)
 }
 
-# This function takes in either a list or vector for `choices` (and
-# `choiceNames` and `choiceValues` are passed in as NULL) OR it takes
-# in a list or vector for both `choiceNames` and `choiceValues` (and
-# `choices` is passed as NULL) and returns a list of two elements:
-#    - `choiceNames` is a vector or list that holds the options names
-#      (each element can be arbitrary UI, or simple text)
-#    - `choiceValues` is a vector or list that holds the options values
-#       (each element must be simple text)
-normalizeChoicesArgs <- function(choices, choiceNames, choiceValues,
-  mustExist = TRUE) {
-  # if-else to check that either choices OR (choiceNames + choiceValues)
-  # were correctly provided
-  if (is.null(choices)) {
-    if (is.null(choiceNames) || is.null(choiceValues)) {
-      if (mustExist) {
-        stop("Please specify a non-empty vector for `choices` (or, ",
-             "alternatively, for both `choiceNames` AND `choiceValues`).")
-      } else {
-        if (is.null(choiceNames) && is.null(choiceValues)) {
-          # this is useful when we call this function from `updateInputOptions()`
-          # in which case, all three `choices`, `choiceNames` and `choiceValues`
-          # may legitimately be NULL
-          return(list(choiceNames = NULL, choiceValues = NULL))
-        } else {
-          stop("One of `choiceNames` or `choiceValues` was set to ",
-               "NULL, but either both or none should be NULL.")
-        }
-      }
-    }
-    if (length(choiceNames) != length(choiceValues)) {
-      stop("`choiceNames` and `choiceValues` must have the same length.")
-    }
-    if (anyNamed(choiceNames) || anyNamed(choiceValues)) {
-      stop("`choiceNames` and `choiceValues` must not be named.")
-    }
-  } else {
-    if (!is.null(choiceNames) || !is.null(choiceValues)) {
-      warning("Using `choices` argument; ignoring `choiceNames` and `choiceValues`.")
-    }
-    choices <- choicesWithNames(choices) # resolve names if not specified
-    choiceNames <- names(choices)
-    choiceValues <- unname(choices)
-  }
 
-  return(list(choiceNames = as.list(choiceNames),
-              choiceValues = as.list(as.character(choiceValues))))
+# Before shiny 0.9, `selected` refers to names/labels of `choices`; now it
+# refers to values. Below is a function for backward compatibility. It also
+# coerces the value to `character`.
+validateSelected <- function(selected, choices, inputId) {
+  # this line accomplishes two tings:
+  #   - coerces selected to character
+  #   - drops name, otherwise toJSON() keeps it too
+  selected <- as.character(selected)
+  # if you are using optgroups, you're using shiny > 0.10.0, and you should
+  # already know that `selected` must be a value instead of a label
+  if (needOptgroup(choices)) return(selected)
+
+  if (is.list(choices)) choices <- unlist(choices)
+
+  nms <- names(choices)
+  # labels and values are identical, no need to validate
+  if (identical(nms, unname(choices))) return(selected)
+  # when selected labels instead of values
+  i <- (selected %in% nms) & !(selected %in% choices)
+  if (any(i)) {
+    warnFun <- if (all(i)) {
+      # replace names with values
+      selected <- unname(choices[selected])
+      warning
+    } else stop  # stop when it is ambiguous (some labels == values)
+    warnFun("'selected' must be the values instead of names of 'choices' ",
+            "for the input '", inputId, "'")
+  }
+  selected
 }
 
+
 # generate options for radio buttons and checkbox groups (type = 'checkbox' or
 # 'radio')
-generateOptions <- function(inputId, selected, inline, type = 'checkbox',
-                            choiceNames, choiceValues,
-                            session = getDefaultReactiveDomain()) {
+generateOptions <- function(inputId, choices, selected, inline, type = 'checkbox') {
   # generate a list of <input type=? [checked] />
   options <- mapply(
-    choiceValues, choiceNames,
+    choices, names(choices),
     FUN = function(value, name) {
       inputTag <- tags$input(
         type = type, name = inputId, value = value
@@ -65,18 +48,14 @@ generateOptions <- function(inputId, selected, inline, type = 'checkbox',
       if (value %in% selected)
         inputTag$attribs$checked <- "checked"
 
-      # in case, the options include UI code other than text
-      # (arbitrary HTML using the tags() function or equivalent)
-      pd <- processDeps(name, session)
-
       # If inline, there's no wrapper div, and the label needs a class like
       # checkbox-inline.
       if (inline) {
-        tags$label(class = paste0(type, "-inline"), inputTag,
-                   tags$span(pd$html, pd$dep))
+        tags$label(class = paste0(type, "-inline"), inputTag, tags$span(name))
       } else {
-        tags$div(class = type, tags$label(inputTag,
-                 tags$span(pd$html, pd$dep)))
+        tags$div(class = type,
+          tags$label(inputTag, tags$span(name))
+        )
       }
     },
     SIMPLIFY = FALSE, USE.NAMES = FALSE

R/middleware.R

@@ -191,7 +191,7 @@ staticHandler <- function(root) {
     if (!identical(req$REQUEST_METHOD, 'GET'))
       return(NULL)
 
-    path <- URLdecode(req$PATH_INFO)
+    path <- req$PATH_INFO
 
     if (is.null(path))
       return(httpResponse(400, content="<h1>Bad Request</h1>"))

R/progress.R

@@ -55,6 +55,7 @@
 #'   de-emphasized appearance relative to \code{message}.
 #' @param value A numeric value at which to set
 #'   the progress bar, relative to \code{min} and \code{max}.
+#'   \code{NULL} hides the progress bar, if it is currently visible.
 #' @param style Progress display style. If \code{"notification"} (the default),
 #'   the progress indicator will show using Shiny's notification API. If
 #'   \code{"old"}, use the same HTML and CSS used in Shiny 0.13.2 and below
@@ -97,6 +98,7 @@
 #' @export
 Progress <- R6Class(
   'Progress',
+  portable = TRUE,
   public = list(
 
     initialize = function(session = getDefaultReactiveDomain(),
@@ -110,8 +112,8 @@ Progress <- R6Class(
       private$id <- createUniqueId(8)
       private$min <- min
       private$max <- max
-      private$value <- NULL
       private$style <- match.arg(style, choices = c("notification", "old"))
+      private$value <- NULL
       private$closed <- FALSE
 
       session$sendProgress('open', list(id = private$id, style = private$style))
@@ -123,15 +125,15 @@ Progress <- R6Class(
         return()
       }
 
-      if (is.null(value) || is.na(value))
+      if (is.null(value) || is.na(value)) {
         value <- NULL
-
-      if (!is.null(value)) {
-        private$value <- value
+      } else {
         # Normalize value to number between 0 and 1
         value <- min(1, max(0, (value - private$min) / (private$max - private$min)))
       }
 
+      private$value <- value
+
       data <- dropNulls(list(
         id = private$id,
         message = message,
@@ -140,14 +142,11 @@ Progress <- R6Class(
         style = private$style
       ))
 
-      private$session$sendProgress('update', data)
+       private$session$sendProgress('update', data)
     },
 
     inc = function(amount = 0.1, message = NULL, detail = NULL) {
-      if (is.null(private$value))
-        private$value <- private$min
-
-      value <- min(private$value + amount, private$max)
+      value <- min(self$getValue() + amount, private$max)
       self$set(value, message, detail)
     },
 
@@ -155,7 +154,10 @@ Progress <- R6Class(
 
     getMax = function() private$max,
 
-    getValue = function() private$value,
+    # Return value (not the normalized 0-1 value, but in the original range)
+    getValue = function() {
+      private$value * (private$max - private$min) + private$min
+    },
 
     close = function() {
       if (private$closed) {
@@ -171,12 +173,12 @@ Progress <- R6Class(
   ),
 
   private = list(
-    session = 'ShinySession',
+    session = 'environment',
     id = character(0),
     min = numeric(0),
     max = numeric(0),
     style = character(0),
-    value = numeric(0),
+    value = NULL,
     closed = logical(0)
   )
 )
@@ -237,12 +239,12 @@ Progress <- R6Class(
 #'   \code{"old"}, use the same HTML and CSS used in Shiny 0.13.2 and below
 #'   (this is for backward-compatibility).
 #' @param value Single-element numeric vector; the value at which to set the
-#'   progress bar, relative to \code{min} and \code{max}.
+#'   progress bar, relative to \code{min} and \code{max}. \code{NULL} hides the
+#'   progress bar, if it is currently visible.
 #'
 #' @examples
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {
-#' options(device.ask.default = FALSE)
 #'
 #' ui <- fluidPage(
 #'   plotOutput("plot")

R/reactives.R

@@ -38,228 +38,6 @@ Dependents <- R6Class(
 )
 
 
-# ReactiveVal ---------------------------------------------------------------
-
-ReactiveVal <- R6Class(
-  'ReactiveVal',
-  portable = FALSE,
-  private = list(
-    value = NULL,
-    label = NULL,
-    frozen = FALSE,
-    dependents = Dependents$new()
-  ),
-  public = list(
-    initialize = function(value, label = NULL) {
-      private$value <- value
-      private$label <- label
-      .graphValueChange(private$label, value)
-    },
-    get = function() {
-      private$dependents$register(depLabel = private$label)
-
-      if (private$frozen)
-        reactiveStop()
-
-      private$value
-    },
-    set = function(value) {
-      if (identical(private$value, value)) {
-        return(invisible(FALSE))
-      }
-      private$value <- value
-      .graphValueChange(private$label, value)
-      private$dependents$invalidate()
-      invisible(TRUE)
-    },
-    freeze = function(session = getDefaultReactiveDomain()) {
-      if (is.null(session)) {
-        stop("Can't freeze a reactiveVal without a reactive domain")
-      }
-      session$onFlushed(function() {
-        self$thaw()
-      })
-      private$frozen <- TRUE
-    },
-    thaw = function() {
-      private$frozen <- FALSE
-    },
-    isFrozen = function() {
-      private$frozen
-    },
-    format = function(...) {
-      # capture.output(print()) is necessary because format() doesn't
-      # necessarily return a character vector, e.g. data.frame.
-      label <- capture.output(print(base::format(private$value, ...)))
-      if (length(label) == 1) {
-        paste0("reactiveVal: ", label)
-      } else {
-        c("reactiveVal:", label)
-      }
-    }
-  )
-)
-
-#' Create a (single) reactive value
-#'
-#' The \code{reactiveVal} function is used to construct a "reactive value"
-#' object. This is an object used for reading and writing a value, like a
-#' variable, but with special capabilities for reactive programming. When you
-#' read the value out of a reactiveVal object, the calling reactive expression
-#' takes a dependency, and when you change the value, it notifies any reactives
-#' that previously depended on that value.
-#'
-#' \code{reactiveVal} is very similar to \code{\link{reactiveValues}}, except
-#' that the former is for a single reactive value (like a variable), whereas the
-#' latter lets you conveniently use multiple reactive values by name (like a
-#' named list of variables). For a one-off reactive value, it's more natural to
-#' use \code{reactiveVal}. See the Examples section for an illustration.
-#'
-#' @param value An optional initial value.
-#' @param label An optional label, for debugging purposes (see
-#'   \code{\link{showReactLog}}). If missing, a label will be automatically
-#'   created.
-#'
-#' @return A function. Call the function with no arguments to (reactively) read
-#'   the value; call the function with a single argument to set the value.
-#'
-#' @examples
-#'
-#' \dontrun{
-#'
-#' # Create the object by calling reactiveVal
-#' r <- reactiveVal()
-#'
-#' # Set the value by calling with an argument
-#' r(10)
-#'
-#' # Read the value by calling without arguments
-#' r()
-#'
-#' }
-#'
-#' ## Only run examples in interactive R sessions
-#' if (interactive()) {
-#'
-#' ui <- fluidPage(
-#'   actionButton("minus", "-1"),
-#'   actionButton("plus", "+1"),
-#'   br(),
-#'   textOutput("value")
-#' )
-#'
-#' # The comments below show the equivalent logic using reactiveValues()
-#' server <- function(input, output, session) {
-#'   value <- reactiveVal(0)       # rv <- reactiveValues(value = 0)
-#'
-#'   observeEvent(input$minus, {
-#'     newValue <- value() - 1     # newValue <- rv$value - 1
-#'     value(newValue)             # rv$value <- newValue
-#'   })
-#'
-#'   observeEvent(input$plus, {
-#'     newValue <- value() + 1     # newValue <- rv$value + 1
-#'     value(newValue)             # rv$value <- newValue
-#'   })
-#'
-#'   output$value <- renderText({
-#'     value()                     # rv$value
-#'   })
-#' }
-#'
-#' shinyApp(ui, server)
-#'
-#' }
-#'
-#' @export
-reactiveVal <- function(value = NULL, label = NULL) {
-  if (missing(label)) {
-    call <- sys.call()
-    label <- rvalSrcrefToLabel(attr(call, "srcref", exact = TRUE))
-  }
-
-  rv <- ReactiveVal$new(value, label)
-  structure(
-    function(x) {
-      if (missing(x)) {
-        rv$get()
-      } else {
-        force(x)
-        rv$set(x)
-      }
-    },
-    class = c("reactiveVal", "reactive"),
-    label = label,
-    .impl = rv
-  )
-}
-
-#' @rdname freezeReactiveValue
-#' @export
-freezeReactiveVal <- function(x) {
-  domain <- getDefaultReactiveDomain()
-  if (is.null(domain)) {
-    stop("freezeReactiveVal() must be called when a default reactive domain is active.")
-  }
-  if (!inherits(x, "reactiveVal")) {
-    stop("x must be a reactiveVal object")
-  }
-
-  attr(x, ".impl", exact = TRUE)$freeze(domain)
-  invisible()
-}
-
-#' @export
-format.reactiveVal <- function(x, ...) {
-  attr(x, ".impl", exact = TRUE)$format(...)
-}
-
-# Attempts to extract the variable name that the reactiveVal object is being
-# assigned to (e.g. for `a <- reactiveVal()`, the result should be "a"). This
-# is a fragile, error-prone operation, so we default to a random label if
-# necessary.
-rvalSrcrefToLabel <- function(srcref,
-  defaultLabel = paste0("reactiveVal", createUniqueId(4))) {
-
-  if (is.null(srcref))
-    return(defaultLabel)
-
-  srcfile <- attr(srcref, "srcfile", exact = TRUE)
-  if (is.null(srcfile))
-    return(defaultLabel)
-
-  if (is.null(srcfile$lines))
-    return(defaultLabel)
-
-  lines <- srcfile$lines
-  # When pasting at the Console, srcfile$lines is not split
-  if (length(lines) == 1) {
-    lines <- strsplit(lines, "\n")[[1]]
-  }
-
-  if (length(lines) < srcref[1]) {
-    return(defaultLabel)
-  }
-
-  firstLine <- substring(lines[srcref[1]], srcref[2] - 1)
-
-  m <- regexec("\\s*([^[:space:]]+)\\s*(<-|=)\\s*reactiveVal\\b", firstLine)
-  if (m[[1]][1] == -1) {
-    return(defaultLabel)
-  }
-
-  sym <- regmatches(firstLine, m)[[1]][2]
-  res <- try(parse(text = sym), silent = TRUE)
-  if (inherits(res, "try-error"))
-    return(defaultLabel)
-
-  if (length(res) != 1)
-    return(defaultLabel)
-
-  return(as.character(res))
-}
-
-
 # ReactiveValues ------------------------------------------------------------
 
 ReactiveValues <- R6Class(
@@ -619,17 +397,14 @@ str.reactivevalues <- function(object, indent.str = " ", ...) {
 
 #' Freeze a reactive value
 #'
-#' These functions freeze a \code{\link{reactiveVal}}, or an element of a
-#' \code{\link{reactiveValues}}. If the value is accessed while frozen, a
+#' This freezes a reactive value. If the value is accessed while frozen, a
 #' "silent" exception is raised and the operation is stopped. This is the same
 #' thing that happens if \code{req(FALSE)} is called. The value is thawed
 #' (un-frozen; accessing it will no longer raise an exception) when the current
 #' reactive domain is flushed. In a Shiny application, this occurs after all of
 #' the observers are executed.
 #'
-#' @param x For \code{freezeReactiveValue}, a \code{\link{reactiveValues}}
-#'   object (like \code{input}); for \code{freezeReactiveVal}, a
-#'   \code{\link{reactiveVal}} object.
+#' @param x A \code{\link{reactiveValues}} object (like \code{input}).
 #' @param name The name of a value in the \code{\link{reactiveValues}} object.
 #'
 #' @seealso \code{\link{req}}
@@ -671,7 +446,7 @@ str.reactivevalues <- function(object, indent.str = " ", ...) {
 #' @export
 freezeReactiveValue <- function(x, name) {
   domain <- getDefaultReactiveDomain()
-  if (is.null(domain)) {
+  if (is.null(getDefaultReactiveDomain)) {
     stop("freezeReactiveValue() must be called when a default reactive domain is active.")
   }
 
@@ -686,7 +461,6 @@ Observable <- R6Class(
   'Observable',
   portable = FALSE,
   public = list(
-    .origFunc = 'function',
     .func = 'function',
     .label = character(0),
     .domain = NULL,
@@ -716,7 +490,6 @@ Observable <- R6Class(
         funcLabel <- paste0("<reactive:", label, ">")
       }
 
-      .origFunc <<- func
       .func <<- wrapFunctionLabel(func, funcLabel,
         ..stacktraceon = ..stacktraceon)
       .label <<- label
@@ -747,10 +520,6 @@ Observable <- R6Class(
       else
         invisible(.value)
     },
-    format = function() {
-      label <- sprintf('reactive(%s)', paste(deparse(body(.origFunc)), collapse='\n'))
-      strsplit(label, "\n")[[1]]
-    },
     .updateValue = function() {
       ctx <- Context$new(.domain, .label, type = 'observable',
                          prevId = .mostRecentCtxId)
@@ -860,13 +629,13 @@ reactive <- function(x, env = parent.frame(), quoted = FALSE, label = NULL,
   # Attach a label and a reference to the original user source for debugging
   srcref <- attr(substitute(x), "srcref", exact = TRUE)
   if (is.null(label)) {
-    label <- rexprSrcrefToLabel(srcref[[1]],
+    label <- srcrefToLabel(srcref[[1]],
       sprintf('reactive(%s)', paste(deparse(body(fun)), collapse='\n')))
   }
   if (length(srcref) >= 2) attr(label, "srcref") <- srcref[[2]]
   attr(label, "srcfile") <- srcFileOfRef(srcref[[1]])
   o <- Observable$new(fun, label, domain, ..stacktraceon = ..stacktraceon)
-  structure(o$getValue, observable = o, class = c("reactiveExpr", "reactive"))
+  structure(o$getValue, observable = o, class = "reactive")
 }
 
 # Given the srcref to a reactive expression, attempts to figure out what the
@@ -874,7 +643,7 @@ reactive <- function(x, env = parent.frame(), quoted = FALSE, label = NULL,
 # scans the line of code that started the reactive block and looks for something
 # that looks like assignment. If we fail, fall back to a default value (likely
 # the block of code in the body of the reactive).
-rexprSrcrefToLabel <- function(srcref, defaultLabel) {
+srcrefToLabel <- function(srcref, defaultLabel) {
   if (is.null(srcref))
     return(defaultLabel)
 
@@ -912,25 +681,19 @@ rexprSrcrefToLabel <- function(srcref, defaultLabel) {
   return(as.character(res))
 }
 
-#' @export
-format.reactiveExpr <- function(x, ...) {
-  attr(x, "observable", exact = TRUE)$format()
-}
-
 #' @export
 print.reactive <- function(x, ...) {
-  cat(paste(format(x), collapse = "\n"), "\n")
+  label <- attr(x, "observable", exact = TRUE)$.label
+  cat(label, "\n")
 }
 
 #' @export
 #' @rdname reactive
-is.reactive <- function(x) {
-  inherits(x, "reactive")
-}
+is.reactive <- function(x) inherits(x, "reactive")
 
 # Return the number of times that a reactive expression or observer has been run
 execCount <- function(x) {
-  if (inherits(x, "reactiveExpr"))
+  if (is.reactive(x))
     return(attr(x, "observable", exact = TRUE)$.execCount)
   else if (inherits(x, 'Observer'))
     return(x$.execCount)
@@ -940,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,
@@ -1051,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) {
@@ -1141,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.
@@ -1388,10 +1276,6 @@ setAutoflush <- local({
 #' }
 #' @export
 reactiveTimer <- function(intervalMs=1000, session = getDefaultReactiveDomain()) {
-  # Need to make sure that session is resolved at creation, not when the
-  # callback below is fired (see #1621).
-  force(session)
-
   dependents <- Map$new()
   timerCallbacks$schedule(intervalMs, function() {
     # Quit if the session is closed
@@ -1772,8 +1656,6 @@ maskReactiveContext <- function(expr) {
 #' invalidations that come from its reactive dependencies; it only invalidates
 #' in response to the given event.
 #'
-#' @section ignoreNULL and ignoreInit:
-#'
 #' Both \code{observeEvent} and \code{eventReactive} take an \code{ignoreNULL}
 #' parameter that affects behavior when the \code{eventExpr} evaluates to
 #' \code{NULL} (or in the special case of an \code{\link{actionButton}},
@@ -1786,44 +1668,6 @@ maskReactiveContext <- function(expr) {
 #' the action/calculation and just let the user re-initiate it (like a
 #' "Recalculate" button).
 #'
-#' Unlike what happens for \code{ignoreNULL}, only \code{observeEvent} takes in an
-#' \code{ignoreInit} argument. By default, \code{observeEvent} will run right when
-#' it is created (except if, at that moment, \code{eventExpr} evaluates to \code{NULL}
-#' and \code{ignoreNULL} is \code{TRUE}). But when responding to a click of an action
-#' button, it may often be useful to set \code{ignoreInit} to \code{TRUE}. For
-#' example, if you're setting up an \code{observeEvent} for a dynamically created
-#' button, then \code{ignoreInit = TRUE} will guarantee that the action (in
-#' \code{handlerExpr}) will only be triggered when the button is actually clicked,
-#' instead of also being triggered when it is created/initialized.
-#'
-#' Even though \code{ignoreNULL} and \code{ignoreInit} can be used for similar
-#' purposes they are independent from one another. Here's the result of combining
-#' these:
-#'
-#' \describe{
-#'   \item{\code{ignoreNULL = TRUE} and \code{ignoreInit = FALSE}}{
-#'      This is the default. This combination means that \code{handlerExpr} will
-#'      run every time that \code{eventExpr} is not \code{NULL}. If, at the time
-#'      of the \code{observeEvent}'s creation, \code{handleExpr} happens to
-#'      \emph{not} be \code{NULL}, then the code runs.
-#'   }
-#'   \item{\code{ignoreNULL = FALSE} and \code{ignoreInit = FALSE}}{
-#'      This combination means that \code{handlerExpr} will run every time no
-#'      matter what.
-#'   }
-#'   \item{\code{ignoreNULL = FALSE} and \code{ignoreInit = TRUE}}{
-#'      This combination means that \code{handlerExpr} will \emph{not} run when
-#'      the \code{observeEvent} is created (because \code{ignoreInit = TRUE}),
-#'      but it will run every other time.
-#'   }
-#'   \item{\code{ignoreNULL = TRUE} and \code{ignoreInit = TRUE}}{
-#'      This combination means that \code{handlerExpr} will \emph{not} run when
-#'      the \code{observeEvent} is created (because \code{ignoreInit = TRUE}).
-#'      After that, \code{handlerExpr} will run every time that \code{eventExpr}
-#'      is not \code{NULL}.
-#'   }
-#' }
-#'
 #' @param eventExpr A (quoted or unquoted) expression that represents the event;
 #'   this can be a simple reactive value like \code{input$click}, a call to a
 #'   reactive expression like \code{dataset()}, or even a complex expression
@@ -1865,15 +1709,6 @@ maskReactiveContext <- function(expr) {
 #' @param ignoreNULL Whether the action should be triggered (or value
 #'   calculated, in the case of \code{eventReactive}) when the input is
 #'   \code{NULL}. See Details.
-#' @param ignoreInit If \code{TRUE}, then, when this \code{observeEvent} is
-#'   first created/initialized, ignore the \code{handlerExpr} (the second
-#'   argument), whether it is otherwise supposed to run or not. The default is
-#'   \code{FALSE}. See Details.
-#' @param once Whether this \code{observeEvent} should be immediately destroyed
-#'   after the first time that the code in \code{handlerExpr} is run. This
-#'   pattern is useful when you want to subscribe to a event that should only
-#'   happen once.
-#'
 #' @return \code{observeEvent} returns an observer reference class object (see
 #'   \code{\link{observe}}). \code{eventReactive} returns a reactive expression
 #'   object (see \code{\link{reactive}}).
@@ -1883,71 +1718,37 @@ maskReactiveContext <- function(expr) {
 #' @examples
 #' ## Only run this example in interactive R sessions
 #' if (interactive()) {
-#'
-#'   ## App 1: Sample usage
-#'   shinyApp(
-#'     ui = fluidPage(
-#'       column(4,
-#'         numericInput("x", "Value", 5),
-#'         br(),
-#'         actionButton("button", "Show")
-#'       ),
-#'       column(8, tableOutput("table"))
+#'   ui <- fluidPage(
+#'     column(4,
+#'       numericInput("x", "Value", 5),
+#'       br(),
+#'       actionButton("button", "Show")
 #'     ),
-#'     server = function(input, output) {
-#'       # Take an action every time button is pressed;
-#'       # here, we just print a message to the console
-#'       observeEvent(input$button, {
-#'         cat("Showing", input$x, "rows\n")
-#'       })
-#'       # Take a reactive dependency on input$button, but
-#'       # not on any of the stuff inside the function
-#'       df <- eventReactive(input$button, {
-#'         head(cars, input$x)
-#'       })
-#'       output$table <- renderTable({
-#'         df()
-#'       })
-#'     }
-#'   )
-#'
-#'   ## App 2: Using `once`
-#'   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"))
-#'       }, once = TRUE)
-#'     }
-#'   )
-#'
-#'   ## App 3: Using `ignoreInit` and `once`
-#'   shinyApp(
-#'     ui = basicPage(actionButton("go", "Go")),
-#'     server = function(input, output, session) {
-#'       observeEvent(input$go, {
-#'         insertUI("#go", "afterEnd",
-#'                  actionButton("dynamic", "click to remove"))
-#'
-#'         # set up an observer that depends on the dynamic
-#'         # input, so that it doesn't run when the input is
-#'         # created, and only runs once after that (since
-#'         # the side effect is remove the input from the DOM)
-#'         observeEvent(input$dynamic, {
-#'           removeUI("#dynamic")
-#'         }, ignoreInit = TRUE, once = TRUE)
-#'       })
-#'     }
+#'     column(8, tableOutput("table"))
 #'   )
+#'   server <- function(input, output) {
+#'     # Take an action every time button is pressed;
+#'     # here, we just print a message to the console
+#'     observeEvent(input$button, {
+#'       cat("Showing", input$x, "rows\n")
+#'     })
+#'     # Take a reactive dependency on input$button, but
+#'     # not on any of the stuff inside the function
+#'     df <- eventReactive(input$button, {
+#'       head(cars, input$x)
+#'     })
+#'     output$table <- renderTable({
+#'       df()
+#'     })
+#'   }
+#'   shinyApp(ui=ui, server=server)
 #' }
 #' @export
 observeEvent <- function(eventExpr, handlerExpr,
   event.env = parent.frame(), event.quoted = FALSE,
   handler.env = parent.frame(), handler.quoted = FALSE,
-  label = NULL, suspended = FALSE, priority = 0,
-  domain = getDefaultReactiveDomain(), autoDestroy = TRUE,
-  ignoreNULL = TRUE, ignoreInit = FALSE, once = FALSE) {
+  label=NULL, suspended=FALSE, priority=0, domain=getDefaultReactiveDomain(),
+  autoDestroy = TRUE, ignoreNULL = TRUE) {
 
   eventFunc <- exprToFunction(eventExpr, event.env, event.quoted)
   if (is.null(label))
@@ -1957,29 +1758,16 @@ observeEvent <- function(eventExpr, handlerExpr,
   handlerFunc <- exprToFunction(handlerExpr, handler.env, handler.quoted)
   handlerFunc <- wrapFunctionLabel(handlerFunc, "observeEventHandler", ..stacktraceon = TRUE)
 
-  initialized <- FALSE
-
-  o <- observe({
+  invisible(observe({
     e <- eventFunc()
 
-    if (ignoreInit && !initialized) {
-      initialized <<- TRUE
-      return()
-    }
-
     if (ignoreNULL && isNullEvent(e)) {
       return()
     }
 
-    if (once) {
-      on.exit(o$destroy())
-    }
-
     isolate(handlerFunc())
   }, label = label, suspended = suspended, priority = priority, domain = domain,
-  autoDestroy = TRUE, ..stacktraceon = FALSE)
-
-  invisible(o)
+    autoDestroy = TRUE, ..stacktraceon = FALSE))
 }
 
 #' @rdname observeEvent
@@ -1987,8 +1775,8 @@ observeEvent <- function(eventExpr, handlerExpr,
 eventReactive <- function(eventExpr, valueExpr,
   event.env = parent.frame(), event.quoted = FALSE,
   value.env = parent.frame(), value.quoted = FALSE,
-  label = NULL, domain = getDefaultReactiveDomain(),
-  ignoreNULL = TRUE, ignoreInit = FALSE) {
+  label=NULL, domain=getDefaultReactiveDomain(),
+  ignoreNULL = TRUE) {
 
   eventFunc <- exprToFunction(eventExpr, event.env, event.quoted)
   if (is.null(label))
@@ -1998,17 +1786,13 @@ eventReactive <- function(eventExpr, valueExpr,
   handlerFunc <- exprToFunction(valueExpr, value.env, value.quoted)
   handlerFunc <- wrapFunctionLabel(handlerFunc, "eventReactiveHandler", ..stacktraceon = TRUE)
 
-  initialized <- FALSE
-
   invisible(reactive({
     e <- eventFunc()
 
-    if (ignoreInit && !initialized) {
-      initialized <<- TRUE
-      req(FALSE)
-    }
-
-    req(!ignoreNULL || !isNullEvent(e))
+    validate(need(
+      !ignoreNULL || !isNullEvent(e),
+      message = FALSE
+    ))
 
     isolate(handlerFunc())
   }, label = label, domain = domain, ..stacktraceon = FALSE))
@@ -2017,246 +1801,3 @@ eventReactive <- function(eventExpr, valueExpr,
 isNullEvent <- function(value) {
   is.null(value) || (inherits(value, 'shinyActionButtonValue') && value == 0)
 }
-
-#' Slow down a reactive expression with debounce/throttle
-#'
-#' Transforms a reactive expression by preventing its invalidation signals from
-#' being sent unnecessarily often. This lets you ignore a very "chatty" reactive
-#' expression until it becomes idle, which is useful when the intermediate
-#' values don't matter as much as the final value, and the downstream
-#' calculations that depend on the reactive expression take a long time.
-#' \code{debounce} and \code{throttle} use different algorithms for slowing down
-#' invalidation signals; see Details.
-#'
-#' @section Limitations:
-#'
-#'   Because R is single threaded, we can't come close to guaranteeing that the
-#'   timing of debounce/throttle (or any other timing-related functions in
-#'   Shiny) will be consistent or accurate; at the time we want to emit an
-#'   invalidation signal, R may be performing a different task and we have no
-#'   way to interrupt it (nor would we necessarily want to if we could).
-#'   Therefore, it's best to think of the time windows you pass to these
-#'   functions as minimums.
-#'
-#'   You may also see undesirable behavior if the amount of time spent doing
-#'   downstream processing for each change approaches or exceeds the time
-#'   window: in this case, debounce/throttle may not have any effect, as the
-#'   time each subsequent event is considered is already after the time window
-#'   has expired.
-#'
-#' @details
-#'
-#' This is not a true debounce/throttle in that it will not prevent \code{r}
-#' from being called many times (in fact it may be called more times than
-#' usual), but rather, the reactive invalidation signal that is produced by
-#' \code{r} is debounced/throttled instead. Therefore, these functions should be
-#' used when \code{r} is cheap but the things it will trigger (downstream
-#' outputs and reactives) are expensive.
-#'
-#' Debouncing means that every invalidation from \code{r} will be held for the
-#' specified time window. If \code{r} invalidates again within that time window,
-#' then the timer starts over again. This means that as long as invalidations
-#' continually arrive from \code{r} within the time window, the debounced
-#' reactive will not invalidate at all. Only after the invalidations stop (or
-#' slow down sufficiently) will the downstream invalidation be sent.
-#'
-#' \code{ooo-oo-oo---- => -----------o-}
-#'
-#' (In this graphical depiction, each character represents a unit of time, and
-#' the time window is 3 characters.)
-#'
-#' Throttling, on the other hand, delays invalidation if the \emph{throttled}
-#' reactive recently (within the time window) invalidated. New \code{r}
-#' invalidations do not reset the time window. This means that if invalidations
-#' continually come from \code{r} within the time window, the throttled reactive
-#' will invalidate regularly, at a rate equal to or slower than than the time
-#' window.
-#'
-#' \code{ooo-oo-oo---- => o--o--o--o---}
-#'
-#' @param r A reactive expression (that invalidates too often).
-#' @param millis The debounce/throttle time window. You may optionally pass a
-#'   no-arg function or reactive expression instead, e.g. to let the end-user
-#'   control the time window.
-#' @param priority Debounce/throttle is implemented under the hood using
-#'   \link[=observe]{observers}. Use this parameter to set the priority of
-#'   these observers. Generally, this should be higher than the priorities of
-#'   downstream observers and outputs (which default to zero).
-#' @param domain See \link{domains}.
-#'
-#' @examples
-#' ## Only run examples in interactive R sessions
-#' if (interactive()) {
-#' options(device.ask.default = FALSE)
-#'
-#' library(shiny)
-#' library(magrittr)
-#'
-#' ui <- fluidPage(
-#'   plotOutput("plot", click = clickOpts("hover")),
-#'   helpText("Quickly click on the plot above, while watching the result table below:"),
-#'   tableOutput("result")
-#' )
-#'
-#' server <- function(input, output, session) {
-#'   hover <- reactive({
-#'     if (is.null(input$hover))
-#'       list(x = NA, y = NA)
-#'     else
-#'       input$hover
-#'   })
-#'   hover_d <- hover %>% debounce(1000)
-#'   hover_t <- hover %>% throttle(1000)
-#'
-#'   output$plot <- renderPlot({
-#'     plot(cars)
-#'   })
-#'
-#'   output$result <- renderTable({
-#'     data.frame(
-#'       mode = c("raw", "throttle", "debounce"),
-#'       x = c(hover()$x, hover_t()$x, hover_d()$x),
-#'       y = c(hover()$y, hover_t()$y, hover_d()$y)
-#'     )
-#'   })
-#' }
-#'
-#' shinyApp(ui, server)
-#' }
-#'
-#' @export
-debounce <- function(r, millis, priority = 100, domain = getDefaultReactiveDomain()) {
-
-  # TODO: make a nice label for the observer(s)
-
-  force(r)
-  force(millis)
-
-  if (!is.function(millis)) {
-    origMillis <- millis
-    millis <- function() origMillis
-  }
-
-  v <- reactiveValues(
-    trigger = NULL,
-    when = NULL # the deadline for the timer to fire; NULL if not scheduled
-  )
-
-  # Responsible for tracking when f() changes.
-  firstRun <- TRUE
-  observe({
-    r()
-
-    if (firstRun) {
-      # During the first run we don't want to set v$when, as this will kick off
-      # the timer. We only want to do that when we see r() change.
-      firstRun <<- FALSE
-      return()
-    }
-
-    # The value (or possibly millis) changed. Start or reset the timer.
-    v$when <- Sys.time() + millis()/1000
-  }, label = "debounce tracker", domain = domain, priority = priority)
-
-  # This observer is the timer. It rests until v$when elapses, then touches
-  # v$trigger.
-  observe({
-    if (is.null(v$when))
-      return()
-
-    now <- Sys.time()
-    if (now >= v$when) {
-      # Mod by 999999999 to get predictable overflow behavior
-      v$trigger <- isolate(v$trigger %OR% 0) %% 999999999 + 1
-      v$when <- NULL
-    } else {
-      invalidateLater((v$when - now) * 1000)
-    }
-  }, label = "debounce timer", domain = domain, priority = priority)
-
-  # This is the actual reactive that is returned to the user. It returns the
-  # value of r(), but only invalidates/updates when v$trigger is touched.
-  er <- eventReactive(v$trigger, {
-    r()
-  }, label = "debounce result", ignoreNULL = FALSE, domain = domain)
-
-  # Force the value of er to be immediately cached upon creation. It's very hard
-  # to explain why this observer is needed, but if you want to understand, try
-  # commenting it out and studying the unit test failure that results.
-  primer <- observe({
-    primer$destroy()
-    er()
-  }, label = "debounce primer", domain = domain, priority = priority)
-
-  er
-}
-
-#' @rdname debounce
-#' @export
-throttle <- function(r, millis, priority = 100, domain = getDefaultReactiveDomain()) {
-
-  # TODO: make a nice label for the observer(s)
-
-  force(r)
-  force(millis)
-
-  if (!is.function(millis)) {
-    origMillis <- millis
-    millis <- function() origMillis
-  }
-
-  v <- reactiveValues(
-    trigger = 0,
-    lastTriggeredAt = NULL, # Last time we fired; NULL if never
-    pending = FALSE # If TRUE, trigger again when timer elapses
-  )
-
-  blackoutMillisLeft <- function() {
-    if (is.null(v$lastTriggeredAt)) {
-      0
-    } else {
-      max(0, (v$lastTriggeredAt + millis()/1000) - Sys.time()) * 1000
-    }
-  }
-
-  trigger <- function() {
-    v$lastTriggeredAt <- Sys.time()
-    # Mod by 999999999 to get predictable overflow behavior
-    v$trigger <- isolate(v$trigger) %% 999999999 + 1
-    v$pending <- FALSE
-  }
-
-  # Responsible for tracking when f() changes.
-  observeEvent(r(), {
-    if (v$pending) {
-      # In a blackout period and someone already scheduled; do nothing
-    } else if (blackoutMillisLeft() > 0) {
-      # In a blackout period but this is the first change in that period; set
-      # v$pending so that a trigger will be scheduled at the end of the period
-      v$pending <- TRUE
-    } else {
-      # Not in a blackout period. Trigger, which will start a new blackout
-      # period.
-      trigger()
-    }
-  }, label = "throttle tracker", ignoreNULL = FALSE, priority = priority, domain = domain)
-
-  observe({
-    if (!v$pending) {
-      return()
-    }
-
-    timeout <- blackoutMillisLeft()
-    if (timeout > 0) {
-      invalidateLater(timeout)
-    } else {
-      trigger()
-    }
-  }, priority = priority, domain = domain)
-
-  # This is the actual reactive that is returned to the user. It returns the
-  # value of r(), but only invalidates/updates when v$trigger is touched.
-  eventReactive(v$trigger, {
-    r()
-  }, label = "throttle result", ignoreNULL = FALSE, domain = domain)
-}

R/render-plot.R

@@ -287,30 +287,17 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
 #   .. ..$ y: NULL
 #   ..$ mapping: Named list()
 #
-# For ggplot2, first you need to define the print.ggplot function from inside
-# renderPlot, then use it to print the plot:
-# print.ggplot <- function(x) {
-#   grid::grid.newpage()
-#
-#   build <- ggplot2::ggplot_build(x)
-#
-#   gtable <- ggplot2::ggplot_gtable(build)
-#   grid::grid.draw(gtable)
-#
-#   structure(list(
-#     build = build,
-#     gtable = gtable
-#   ), class = "ggplot_build_gtable")
-# }
-#
-# p <- print(ggplot(mtcars, aes(wt, mpg)) + geom_point())
-# str(getGgplotCoordmap(p, 1, 72))
+# For ggplot2, it might be something like:
+# p <- ggplot(mtcars, aes(wt, mpg)) + geom_point()
+# str(getGgplotCoordmap(p, 1))
 # List of 1
 #  $ :List of 10
 #   ..$ panel     : int 1
 #   ..$ row       : int 1
 #   ..$ col       : int 1
 #   ..$ panel_vars: Named list()
+#   ..$ scale_x   : int 1
+#   ..$ scale_y   : int 1
 #   ..$ log       :List of 2
 #   .. ..$ x: NULL
 #   .. ..$ y: NULL
@@ -333,8 +320,8 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
 # can be up to two of them.
 # mtc <- mtcars
 # mtc$am <- factor(mtc$am)
-# p <- print(ggplot(mtc, aes(wt, mpg)) + geom_point() + facet_wrap(~ am))
-# str(getGgplotCoordmap(p, 1, 72))
+# p <- ggplot(mtcars, aes(wt, mpg)) + geom_point() + facet_wrap(~ am)
+# str(getGgplotCoordmap(p, 1))
 # List of 2
 #  $ :List of 10
 #   ..$ panel     : int 1
@@ -342,6 +329,8 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
 #   ..$ col       : int 1
 #   ..$ panel_vars:List of 1
 #   .. ..$ panelvar1: Factor w/ 2 levels "0","1": 1
+#   ..$ scale_x   : int 1
+#   ..$ scale_y   : int 1
 #   ..$ log       :List of 2
 #   .. ..$ x: NULL
 #   .. ..$ y: NULL
@@ -365,6 +354,8 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
 #   ..$ col       : int 2
 #   ..$ panel_vars:List of 1
 #   .. ..$ panelvar1: Factor w/ 2 levels "0","1": 2
+#   ..$ scale_x   : int 1
+#   ..$ scale_y   : int 1
 #   ..$ log       :List of 2
 #   .. ..$ x: NULL
 #   .. ..$ y: NULL
@@ -427,189 +418,81 @@ getPrevPlotCoordmap <- function(width, height) {
 
 # Given a ggplot_build_gtable object, return a coordmap for it.
 getGgplotCoordmap <- function(p, pixelratio, res) {
+  # Structure of ggplot objects changed after 2.1.0
+  new_ggplot <- (utils::packageVersion("ggplot2") > "2.1.0")
+
   if (!inherits(p, "ggplot_build_gtable"))
     return(NULL)
 
-  tryCatch({
-    # Get info from built ggplot object
-    info <- find_panel_info(p$build)
-
-    # Get ranges from gtable - it's possible for this to return more elements than
-    # info, because it calculates positions even for panels that aren't present.
-    # This can happen with facet_wrap.
-    ranges <- find_panel_ranges(p$gtable, pixelratio, res)
-
-    for (i in seq_along(info)) {
-      info[[i]]$range <- ranges[[i]]
-    }
-
-    return(info)
-
-  }, error = function(e) {
-    # If there was an error extracting info from the ggplot object, just return
-    # a list with the error message.
-    return(structure(list(), error = e$message))
-  })
-}
-
-
-find_panel_info <- function(b) {
-  # Structure of ggplot objects changed after 2.1.0. After 2.2.1, there was a
-  # an API for extracting the necessary information.
-  ggplot_ver <- utils::packageVersion("ggplot2")
-
-  if (ggplot_ver > "2.2.1") {
-    find_panel_info_api(b)
-  } else if (ggplot_ver > "2.1.0") {
-    find_panel_info_non_api(b, ggplot_format = "new")
-  } else {
-    find_panel_info_non_api(b, ggplot_format = "old")
-  }
-}
-
-# This is for ggplot2>2.2.1, after an API was introduced for extracting
-# information about the plot object.
-find_panel_info_api <- function(b) {
   # Given a built ggplot object, return x and y domains (data space coords) for
   # each panel.
-  layout <- ggplot2::summarise_layout(b)
-  coord  <- ggplot2::summarise_coord(b)
-  layers <- ggplot2::summarise_layers(b)
+  find_panel_info <- function(b) {
+    if (new_ggplot) {
+      layout <- b$layout$panel_layout
+    } else {
+      layout <- b$panel$layout
+    }
+    # Convert factor to numbers
+    layout$PANEL <- as.integer(as.character(layout$PANEL))
 
-  # Given x and y scale objects and a coord object, return a list that has
-  # the bases of log transformations for x and y, or NULL if it's not a
-  # log transform.
-  get_log_bases <- function(xscale, yscale, coord) {
-    # Given a transform object, find the log base; if the transform object is
-    # NULL, or if it's not a log transform, return NA.
-    get_log_base <- function(trans) {
-      if (!is.null(trans) && grepl("^log-", trans$name)) {
-        environment(trans$transform)$base
-      } else {
-        NA_real_
+    # Names of facets
+    facet_vars <- NULL
+    if (new_ggplot) {
+      facet <- b$layout$facet
+      if (inherits(facet, "FacetGrid")) {
+        facet_vars <- vapply(c(facet$params$cols, facet$params$rows), as.character, character(1))
+      } else if (inherits(facet, "FacetWrap")) {
+        facet_vars <- vapply(facet$params$facets, as.character, character(1))
+      }
+    } else {
+      facet <- b$plot$facet
+      if (inherits(facet, "grid")) {
+        facet_vars <- vapply(c(facet$cols, facet$rows), as.character, character(1))
+      } else if (inherits(facet, "wrap")) {
+        facet_vars <- vapply(facet$facets, as.character, character(1))
       }
     }
 
-    # First look for log base in scale, then coord; otherwise NULL.
-    list(
-      x = get_log_base(xscale$trans) %OR% coord$xlog %OR% NULL,
-      y = get_log_base(yscale$trans) %OR% coord$ylog %OR% NULL
-    )
+    # Iterate over each row in the layout data frame
+    lapply(seq_len(nrow(layout)), function(i) {
+      # Slice out one row
+      l <- layout[i, ]
+
+      scale_x <- l$SCALE_X
+      scale_y <- l$SCALE_Y
+
+      mapping <- find_plot_mappings(b)
+
+      # For each of the faceting variables, get the value of that variable in
+      # the current panel. Default to empty _named_ list so that it's sent as a
+      # JSON object, not array.
+      panel_vars <- list(a = NULL)[0]
+      for (i in seq_along(facet_vars)) {
+        var_name <- facet_vars[[i]]
+        vname <- paste0("panelvar", i)
+
+        mapping[[vname]] <- var_name
+        panel_vars[[vname]] <- l[[var_name]]
+      }
+
+      list(
+        panel   = l$PANEL,
+        row     = l$ROW,
+        col     = l$COL,
+        panel_vars = panel_vars,
+        scale_x = scale_x,
+        scale_y = scale_x,
+        log     = check_log_scales(b, scale_x, scale_y),
+        domain  = find_panel_domain(b, l$PANEL, scale_x, scale_y),
+        mapping = mapping
+      )
+    })
   }
 
-  # Given x/y min/max, and the x/y scale objects, create a list that
-  # represents the domain. Note that the x/y min/max should be taken from
-  # the layout summary table, not the scale objects.
-  get_domain <- function(xmin, xmax, ymin, ymax, xscale, yscale) {
-    is_reverse <- function(scale) {
-      identical(scale$trans$name, "reverse")
-    }
-
-    domain <- list(
-      left   = xmin,
-      right  = xmax,
-      bottom = ymin,
-      top    = ymax
-    )
-
-    if (is_reverse(xscale)) {
-      domain$left  <- -domain$left
-      domain$right <- -domain$right
-    }
-    if (is_reverse(yscale)) {
-      domain$top    <- -domain$top
-      domain$bottom <- -domain$bottom
-    }
-
-    domain
-  }
-
-  # Rename the items in vars to have names like panelvar1, panelvar2.
-  rename_panel_vars <- function(vars) {
-    for (i in seq_along(vars)) {
-      names(vars)[i] <- paste0("panelvar", i)
-    }
-    vars
-  }
-
-  get_mappings <- function(layers, layout, coord) {
-    # For simplicity, we'll just use the mapping from the first layer of the
-    # ggplot object. The original uses quoted expressions; convert to
-    # character.
-    mapping <- layers$mapping[[1]]
-    # lapply'ing as.character results in unexpected behavior for expressions
-    # like `wt/2`; deparse handles it correctly.
-    mapping <- lapply(mapping, deparse)
-
-    # If either x or y is not present, give it a NULL entry.
-    mapping <- mergeVectors(list(x = NULL, y = NULL), mapping)
-
-    # The names (not values) of panel vars are the same across all panels,
-    # so just look at the first one. Also, the order of panel vars needs
-    # to be reversed.
-    vars <- rev(layout$vars[[1]])
-    for (i in seq_along(vars)) {
-      mapping[[paste0("panelvar", i)]] <- names(vars)[i]
-    }
-
-    if (isTRUE(coord$flip)) {
-      mapping[c("x", "y")] <- mapping[c("y", "x")]
-    }
-
-    mapping
-  }
-
-  # Mapping is constant across all panels, so get it here and reuse later.
-  mapping <- get_mappings(layers, layout, coord)
-
-  # If coord_flip is used, these need to be swapped
-  flip_xy <- function(layout) {
-    l <- layout
-    l$xscale <- layout$yscale
-    l$yscale <- layout$xscale
-    l$xmin <- layout$ymin
-    l$xmax <- layout$ymax
-    l$ymin <- layout$xmin
-    l$ymax <- layout$xmax
-    l
-  }
-  if (coord$flip) {
-    layout <- flip_xy(layout)
-  }
-
-  # Iterate over each row in the layout data frame
-  lapply(seq_len(nrow(layout)), function(i) {
-    # Slice out one row, use it as a list. The (former) list-cols are still
-    # in lists, so we need to unwrap them.
-    l <- as.list(layout[i, ])
-    l$vars   <- l$vars[[1]]
-    l$xscale <- l$xscale[[1]]
-    l$yscale <- l$yscale[[1]]
-
-    list(
-      panel   = as.numeric(l$panel),
-      row     = l$row,
-      col     = l$col,
-      # Rename panel vars. They must also be in reversed order.
-      panel_vars = rename_panel_vars(rev(l$vars)),
-      log     = get_log_bases(l$xscale, l$yscale, coord),
-      domain  = get_domain(l$xmin, l$xmax, l$ymin, l$ymax, l$xscale, l$yscale),
-      mapping = mapping
-    )
-  })
-}
-
-
-# This is for ggplot2<=2.2.1, before an API was introduced for extracting
-# information about the plot object. The "old" format was used before 2.1.0.
-# The "new" format was used after 2.1.0, up to 2.2.1. The reason these two
-# formats are mixed together in a single function is historical, and it's not
-# worthwhile to separate them at this point.
-find_panel_info_non_api <- function(b, ggplot_format) {
   # Given a single range object (representing the data domain) from a built
   # ggplot object, return the domain.
   find_panel_domain <- function(b, panel_num, scalex_num = 1, scaley_num = 1) {
-    if (ggplot_format == "new") {
+    if (new_ggplot) {
       range <- b$layout$panel_ranges[[panel_num]]
     } else {
       range <- b$panel$ranges[[panel_num]]
@@ -622,7 +505,7 @@ find_panel_info_non_api <- function(b, ggplot_format) {
     )
 
     # Check for reversed scales
-    if (ggplot_format == "new") {
+    if (new_ggplot) {
       xscale <- b$layout$panel_scales$x[[scalex_num]]
       yscale <- b$layout$panel_scales$y[[scaley_num]]
     } else {
@@ -663,7 +546,7 @@ find_panel_info_non_api <- function(b, ggplot_format) {
     y_names <- character(0)
 
     # Continuous scales have a trans; discrete ones don't
-    if (ggplot_format == "new") {
+    if (new_ggplot) {
       if (!is.null(b$layout$panel_scales$x[[scalex_num]]$trans))
         x_names <- b$layout$panel_scales$x[[scalex_num]]$trans$name
       if (!is.null(b$layout$panel_scales$y[[scaley_num]]$trans))
@@ -737,220 +620,129 @@ find_panel_info_non_api <- function(b, ggplot_format) {
     mappings
   }
 
-  if (ggplot_format == "new") {
-    layout <- b$layout$panel_layout
-  } else {
-    layout <- b$panel$layout
-  }
-  # Convert factor to numbers
-  layout$PANEL <- as.integer(as.character(layout$PANEL))
+  # Given a gtable object, return the x and y ranges (in pixel dimensions)
+  find_panel_ranges <- function(g, pixelratio) {
+    # Given a vector of unit objects, return logical vector indicating which ones
+    # are "null" units. These units use the remaining available width/height --
+    # that is, the space not occupied by elements that have an absolute size.
+    is_null_unit <- function(x) {
+      # A vector of units can be either a list of individual units (a unit.list
+      # object), each with their own set of attributes, or an atomic vector with
+      # one set of attributes. ggplot2 switched from the former (in version
+      # 1.0.1) to the latter. We need to make sure that we get the correct
+      # result in both cases.
+      if (inherits(x, "unit.list")) {
+        # For ggplot2 <= 1.0.1
+        vapply(x, FUN.VALUE = logical(1), function(u) {
+          isTRUE(attr(u, "unit", exact = TRUE) == "null")
+        })
+      } else {
+        # For later versions of ggplot2
+        attr(x, "unit", exact = TRUE) == "null"
+      }
+    }
 
-  # Names of facets
-  facet_vars <- NULL
-  if (ggplot_format == "new") {
-    facet <- b$layout$facet
-    if (inherits(facet, "FacetGrid")) {
-      facet_vars <- vapply(c(facet$params$cols, facet$params$rows), as.character, character(1))
-    } else if (inherits(facet, "FacetWrap")) {
-      facet_vars <- vapply(facet$params$facets, as.character, character(1))
+    # Workaround for a bug in the quartz device. If you have a 400x400 image and
+    # run `convertWidth(unit(1, "npc"), "native")`, the result will depend on
+    # res setting of the device. If res=72, then it returns 400 (as expected),
+    # but if, e.g., res=96, it will return 300, which is incorrect.
+    devScaleFactor <- 1
+    if (grepl("quartz", names(grDevices::dev.cur()), fixed = TRUE)) {
+      devScaleFactor <- res / 72
     }
-  } else {
-    facet <- b$plot$facet
-    if (inherits(facet, "grid")) {
-      facet_vars <- vapply(c(facet$cols, facet$rows), as.character, character(1))
-    } else if (inherits(facet, "wrap")) {
-      facet_vars <- vapply(facet$facets, as.character, character(1))
+
+    # Convert a unit (or vector of units) to a numeric vector of pixel sizes
+    h_px <- function(x) {
+      devScaleFactor * grid::convertHeight(x, "native", valueOnly = TRUE)
     }
+    w_px <- function(x) {
+      devScaleFactor * grid::convertWidth(x, "native", valueOnly = TRUE)
+    }
+
+    # Given a vector of relative sizes (in grid units), and a function for
+    # converting grid units to numeric pixels, return a numeric vector of
+    # pixel sizes.
+    find_px_sizes <- function(rel_sizes, unit_to_px) {
+      # Total pixels (in height or width)
+      total_px <- unit_to_px(grid::unit(1, "npc"))
+      # Calculate size of all panel(s) together. Panels (and only panels) have
+      # null size.
+      null_idx <- is_null_unit(rel_sizes)
+      # All the absolute heights. At this point, null heights are 0. We need to
+      # calculate them separately and add them in later.
+      px_sizes <- unit_to_px(rel_sizes)
+      # Total size for panels is image size minus absolute (non-panel) elements
+      panel_px_total <- total_px - sum(px_sizes)
+      # Divide up the total panel size up into the panels (scaled by size)
+      panel_sizes_rel <- as.numeric(rel_sizes[null_idx])
+      panel_sizes_rel <- panel_sizes_rel / sum(panel_sizes_rel)
+      px_sizes[null_idx] <- panel_px_total * panel_sizes_rel
+      abs(px_sizes)
+    }
+
+    px_heights <- find_px_sizes(g$heights, h_px)
+    px_widths <- find_px_sizes(g$widths, w_px)
+
+    # Convert to absolute pixel positions
+    x_pos <- cumsum(px_widths)
+    y_pos <- cumsum(px_heights)
+
+    # Match up the pixel dimensions to panels
+    layout <- g$layout
+    # For panels:
+    # * For facet_wrap, they'll be named "panel-1", "panel-2", etc.
+    # * For no facet or facet_grid, they'll just be named "panel". For
+    #   facet_grid, we need to re-order the layout table. Assume that panel
+    #   numbers go from left to right, then next row.
+    # Assign a number to each panel, corresponding to PANEl in the built ggplot
+    # object.
+    layout <- layout[grepl("^panel", layout$name), ]
+    layout <- layout[order(layout$t, layout$l), ]
+    layout$panel <- seq_len(nrow(layout))
+
+    # When using a HiDPI client on a Linux server, the pixel
+    # dimensions are doubled, so we have to divide the dimensions by
+    # `pixelratio`. When a HiDPI client is used on a Mac server (with
+    # the quartz device), the pixel dimensions _aren't_ doubled, even though
+    # the image has double size. In the latter case we don't have to scale the
+    # numbers down.
+    pix_ratio <- 1
+    if (!grepl("^quartz", names(grDevices::dev.cur()))) {
+      pix_ratio <- pixelratio
+    }
+
+    # Return list of lists, where each inner list has left, right, top, bottom
+    # values for a panel
+    lapply(seq_len(nrow(layout)), function(i) {
+      p <- layout[i, , drop = FALSE]
+      list(
+        left   = x_pos[p$l - 1] / pix_ratio,
+        right  = x_pos[p$r] / pix_ratio,
+        bottom = y_pos[p$b] / pix_ratio,
+        top    = y_pos[p$t - 1] / pix_ratio
+      )
+    })
   }
 
-  # Iterate over each row in the layout data frame
-  lapply(seq_len(nrow(layout)), function(i) {
-    # Slice out one row
-    l <- layout[i, ]
 
-    scale_x <- l$SCALE_X
-    scale_y <- l$SCALE_Y
+  tryCatch({
+    # Get info from built ggplot object
+    info <- find_panel_info(p$build)
 
-    mapping <- find_plot_mappings(b)
+    # Get ranges from gtable - it's possible for this to return more elements than
+    # info, because it calculates positions even for panels that aren't present.
+    # This can happen with facet_wrap.
+    ranges <- find_panel_ranges(p$gtable, pixelratio)
 
-    # For each of the faceting variables, get the value of that variable in
-    # the current panel. Default to empty _named_ list so that it's sent as a
-    # JSON object, not array.
-    panel_vars <- list(a = NULL)[0]
-    for (i in seq_along(facet_vars)) {
-      var_name <- facet_vars[[i]]
-      vname <- paste0("panelvar", i)
-
-      mapping[[vname]] <- var_name
-      panel_vars[[vname]] <- l[[var_name]]
+    for (i in seq_along(info)) {
+      info[[i]]$range <- ranges[[i]]
     }
 
-    list(
-      panel   = l$PANEL,
-      row     = l$ROW,
-      col     = l$COL,
-      panel_vars = panel_vars,
-      scale_x = scale_x,
-      scale_y = scale_x,
-      log     = check_log_scales(b, scale_x, scale_y),
-      domain  = find_panel_domain(b, l$PANEL, scale_x, scale_y),
-      mapping = mapping
-    )
-  })
-}
-
-
-# Given a gtable object, return the x and y ranges (in pixel dimensions)
-find_panel_ranges <- function(g, pixelratio, res) {
-  # Given a vector of unit objects, return logical vector indicating which ones
-  # are "null" units. These units use the remaining available width/height --
-  # that is, the space not occupied by elements that have an absolute size.
-  is_null_unit <- function(x) {
-    # A vector of units can be either a list of individual units (a unit.list
-    # object), each with their own set of attributes, or an atomic vector with
-    # one set of attributes. ggplot2 switched from the former (in version
-    # 1.0.1) to the latter. We need to make sure that we get the correct
-    # result in both cases.
-    if (inherits(x, "unit.list")) {
-      # For ggplot2 <= 1.0.1
-      vapply(x, FUN.VALUE = logical(1), function(u) {
-        isTRUE(attr(u, "unit", exact = TRUE) == "null")
-      })
-    } else {
-      # For later versions of ggplot2
-      attr(x, "unit", exact = TRUE) == "null"
-    }
-  }
-
-  # Workaround for a bug in the quartz device. If you have a 400x400 image and
-  # run `convertWidth(unit(1, "npc"), "native")`, the result will depend on
-  # res setting of the device. If res=72, then it returns 400 (as expected),
-  # but if, e.g., res=96, it will return 300, which is incorrect.
-  devScaleFactor <- 1
-  if (grepl("quartz", names(grDevices::dev.cur()), fixed = TRUE)) {
-    devScaleFactor <- res / 72
-  }
-
-  # Convert a unit (or vector of units) to a numeric vector of pixel sizes
-  h_px <- function(x) {
-    devScaleFactor * grid::convertHeight(x, "native", valueOnly = TRUE)
-  }
-  w_px <- function(x) {
-    devScaleFactor * grid::convertWidth(x, "native", valueOnly = TRUE)
-  }
-
-  # Given a vector of relative sizes (in grid units), and a function for
-  # converting grid units to numeric pixels, return a list with: known pixel
-  # dimensions, scalable dimensions, and the overall space for the scalable
-  # objects.
-  find_size_info <- function(rel_sizes, unit_to_px) {
-    # Total pixels (in height or width)
-    total_px <- unit_to_px(grid::unit(1, "npc"))
-    # Calculate size of all panel(s) together. Panels (and only panels) have
-    # null size.
-    null_idx <- is_null_unit(rel_sizes)
-
-    # All the absolute heights. At this point, null heights are 0. We need to
-    # calculate them separately and add them in later.
-    px_sizes <- unit_to_px(rel_sizes)
-    # Mark the null heights as NA.
-    px_sizes[null_idx] <- NA_real_
-
-    # The plotting panels all are 'null' units.
-    null_sizes <- rep(NA_real_, length(rel_sizes))
-    null_sizes[null_idx] <- as.numeric(rel_sizes[null_idx])
-
-    # Total size allocated for panels is the total image size minus absolute
-    # (non-panel) elements.
-    panel_px_total <- total_px - sum(px_sizes, na.rm = TRUE)
-
-    # Size of a 1null unit
-    null_px <- abs(panel_px_total / sum(null_sizes, na.rm = TRUE))
-
-    # This returned list contains:
-    # * px_sizes: A vector of known pixel dimensions. The values that were
-    #   null units will be assigned NA. The null units are ones that scale
-    #   when the plotting area is resized.
-    # * null_sizes: A vector of the null units. All others will be assigned
-    #   NA. The null units often are 1, but they may be any value, especially
-    #   when using coord_fixed.
-    # * null_px: The size (in pixels) of a 1null unit.
-    # * null_px_scaled: The size (in pixels) of a 1null unit when scaled to
-    #   fit a smaller dimension (used for plots with coord_fixed).
-    list(
-      px_sizes       = abs(px_sizes),
-      null_sizes     = null_sizes,
-      null_px        = null_px,
-      null_px_scaled = null_px
-    )
-  }
-
-  # Given a size_info, return absolute pixel positions
-  size_info_to_px <- function(info) {
-    px_sizes <- info$px_sizes
-
-    null_idx <- !is.na(info$null_sizes)
-    px_sizes[null_idx] <- info$null_sizes[null_idx] * info$null_px_scaled
-
-    # If this direction is scaled down because of coord_fixed, we need to add an
-    # offset so that the pixel locations are centered.
-    offset <- (info$null_px - info$null_px_scaled) *
-              sum(info$null_sizes, na.rm = TRUE) / 2
-
-    # Get absolute pixel positions
-    cumsum(px_sizes) + offset
-  }
-
-  heights_info <- find_size_info(g$heights, h_px)
-  widths_info  <- find_size_info(g$widths,  w_px)
-
-  if (g$respect) {
-    # This is a plot with coord_fixed. The grid 'respect' option means to use
-    # the same pixel value for 1null, for width and height. We want the
-    # smaller of the two values -- that's what makes the plot fit in the
-    # viewport.
-    null_px_min <- min(heights_info$null_px, widths_info$null_px)
-    heights_info$null_px_scaled <- null_px_min
-    widths_info$null_px_scaled  <- null_px_min
-  }
-
-  # Convert to absolute pixel positions
-  y_pos <- size_info_to_px(heights_info)
-  x_pos <- size_info_to_px(widths_info)
-
-  # Match up the pixel dimensions to panels
-  layout <- g$layout
-  # For panels:
-  # * For facet_wrap, they'll be named "panel-1", "panel-2", etc.
-  # * For no facet or facet_grid, they'll just be named "panel". For
-  #   facet_grid, we need to re-order the layout table. Assume that panel
-  #   numbers go from left to right, then next row.
-  # Assign a number to each panel, corresponding to PANEl in the built ggplot
-  # object.
-  layout <- layout[grepl("^panel", layout$name), ]
-  layout <- layout[order(layout$t, layout$l), ]
-  layout$panel <- seq_len(nrow(layout))
-
-  # When using a HiDPI client on a Linux server, the pixel
-  # dimensions are doubled, so we have to divide the dimensions by
-  # `pixelratio`. When a HiDPI client is used on a Mac server (with
-  # the quartz device), the pixel dimensions _aren't_ doubled, even though
-  # the image has double size. In the latter case we don't have to scale the
-  # numbers down.
-  pix_ratio <- 1
-  if (!grepl("^quartz", names(grDevices::dev.cur()))) {
-    pix_ratio <- pixelratio
-  }
-
-  # Return list of lists, where each inner list has left, right, top, bottom
-  # values for a panel
-  lapply(seq_len(nrow(layout)), function(i) {
-    p <- layout[i, , drop = FALSE]
-    list(
-      left   = x_pos[p$l - 1] / pix_ratio,
-      right  = x_pos[p$r] / pix_ratio,
-      bottom = y_pos[p$b] / pix_ratio,
-      top    = y_pos[p$t - 1] / pix_ratio
-    )
+    return(info)
+
+  }, error = function(e) {
+    # If there was an error extracting info from the ggplot object, just return
+    # a list with the error message.
+    return(structure(list(), error = e$message))
   })
 }

R/server.R

@@ -34,7 +34,7 @@ registerClient <- function(client) {
 #' JavaScript/CSS files available to their components.
 #'
 #' @param prefix The URL prefix (without slashes). Valid characters are a-z,
-#'   A-Z, 0-9, hyphen, period, and underscore.
+#'   A-Z, 0-9, hyphen, period, and underscore; and must begin with a-z or A-Z.
 #'   For example, a value of 'foo' means that any request paths that begin with
 #'   '/foo' will be mapped to the given directory.
 #' @param directoryPath The directory that contains the static resources to be
@@ -52,7 +52,7 @@ registerClient <- function(client) {
 #' @export
 addResourcePath <- function(prefix, directoryPath) {
   prefix <- prefix[1]
-  if (!grepl('^[a-z0-9\\-_][a-z0-9\\-_.]*$', prefix, ignore.case=TRUE, perl=TRUE)) {
+  if (!grepl('^[a-z][a-z0-9\\-_.]*$', prefix, ignore.case=TRUE, perl=TRUE)) {
     stop("addResourcePath called with invalid prefix; please see documentation")
   }
 
@@ -462,9 +462,6 @@ serviceApp <- function() {
 
 .shinyServerMinVersion <- '0.3.4'
 
-# Global flag that's TRUE whenever we're inside of the scope of a call to runApp
-.globals$running <- FALSE
-
 #' Run Shiny Application
 #'
 #' Runs a Shiny application. This function normally does not return; interrupt R
@@ -521,8 +518,6 @@ serviceApp <- function() {
 #'
 #' ## Only run this example in interactive R sessions
 #' if (interactive()) {
-#'   options(device.ask.default = FALSE)
-#'
 #'   # Apps can be run without a server.r and ui.r file
 #'   runApp(list(
 #'     ui = bootstrapPage(
@@ -560,15 +555,6 @@ runApp <- function(appDir=getwd(),
     handlerManager$clear()
   }, add = TRUE)
 
-  if (.globals$running) {
-    stop("Can't call `runApp()` from within `runApp()`. If your ",
-         "application code contains `runApp()`, please remove it.")
-  }
-  .globals$running <- TRUE
-  on.exit({
-    .globals$running <- FALSE
-  }, add = TRUE)
-
   # Enable per-app Shiny options
   oldOptionSet <- .globals$options
   on.exit({

R/shiny.R

@@ -201,13 +201,12 @@ workerId <- local({
 #'     }
 #'     \item{\code{singletons} - for internal use}
 #'     \item{\code{url_protocol}, \code{url_hostname}, \code{url_port},
-#'       \code{url_pathname}, \code{url_search}, \code{url_hash_initial}
-#'       and \code{url_hash} can be used to get the components of the URL
-#'       that was requested by the browser to load the Shiny app page.
-#'       These values are from the browser's perspective, so neither HTTP
-#'       proxies nor Shiny Server will affect these values. The
-#'       \code{url_search} value may be used with \code{\link{parseQueryString}}
-#'       to access query string parameters.
+#'       \code{url_pathname}, \code{url_search}, and \code{url_hash_initial}
+#'       can be used to get the components of the URL that was requested by the
+#'       browser to load the Shiny app page. These values are from the
+#'       browser's perspective, so neither HTTP proxies nor Shiny Server will
+#'       affect these values. The \code{url_search} value may be used with
+#'       \code{\link{parseQueryString}} to access query string parameters.
 #'     }
 #'   }
 #'   \code{clientData} also contains information about each output.
@@ -375,24 +374,12 @@ NULL
 #' @seealso \url{http://shiny.rstudio.com/articles/modules.html}
 #' @export
 NS <- function(namespace, id = NULL) {
-  if (length(namespace) == 0)
-    ns_prefix <- character(0)
-  else
-    ns_prefix <- paste(namespace, collapse = ns.sep)
-
-  f <- function(id) {
-    if (length(id) == 0)
-      return(ns_prefix)
-    if (length(ns_prefix) == 0)
-      return(id)
-
-    paste(ns_prefix, id, sep = ns.sep)
-  }
-
   if (missing(id)) {
-    f
+    function(id) {
+      paste(c(namespace, id), collapse = ns.sep)
+    }
   } else {
-    f(id)
+    paste(c(namespace, id), collapse = ns.sep)
   }
 }
 
@@ -428,7 +415,6 @@ ShinySession <- R6Class(
     restoreCallbacks = 'Callbacks',
     restoredCallbacks = 'Callbacks',
     bookmarkExclude = character(0),  # Names of inputs to exclude from bookmarking
-    getBookmarkExcludeFuns = list(),
 
     testMode = FALSE,                # Are we running in test mode?
     testExportExprs = list(),
@@ -593,16 +579,6 @@ ShinySession <- R6Class(
       }) # withReactiveDomain
     },
 
-    # Modules (scopes) call this to register a function that returns a vector
-    # of names to exclude from bookmarking. The function should return
-    # something like c("scope1-x", "scope1-y"). This doesn't use a Callback
-    # object because the return values of the functions are needed, but
-    # Callback$invoke() discards return values.
-    registerBookmarkExclude = function(fun) {
-      len <- length(private$getBookmarkExcludeFuns) + 1
-      private$getBookmarkExcludeFuns[[len]] <- fun
-    },
-
     # Save output values and errors. This is only used for testing mode.
     storeOutputValues = function(values = NULL) {
       private$outputValues <- mergeVectors(private$outputValues, values)
@@ -652,12 +628,6 @@ ShinySession <- R6Class(
               values$output <- private$outputValues[items]
             }
 
-            # Filter out those outputs that have the snapshotExclude attribute.
-            exclude_idx <- vapply(names(values$output), function(name) {
-              isTRUE(attr(private$.outputs[[name]], "snapshotExclude", TRUE))
-            }, logical(1))
-            values$output <- values$output[!exclude_idx]
-
             values$output <- sortByName(values$output)
           }
 
@@ -787,8 +757,7 @@ ShinySession <- R6Class(
       private$sendMessage(
         config = list(
           workerId = workerId(),
-          sessionId = self$token,
-          user = self$user
+          sessionId = self$token
         )
       )
     },
@@ -856,7 +825,7 @@ ShinySession <- R6Class(
           if (anyUnnamed(dots))
             stop("exportTestValues: all arguments must be named.")
 
-          names(dots) <- ns(names(dots))
+          names(dots) <- vapply(names(dots), ns, character(1))
 
           do.call(
             .subset2(self, "exportTestValues"),
@@ -970,12 +939,6 @@ ShinySession <- R6Class(
         restoredCallbacks$invoke(scopeState)
       })
 
-      # Returns the excluded names with the scope's ns prefix on them.
-      private$registerBookmarkExclude(function() {
-        excluded <- scope$getBookmarkExclude()
-        ns(excluded)
-      })
-
       scope
     },
     ns = function(id) {
@@ -1059,10 +1022,6 @@ ShinySession <- R6Class(
       }
 
       if (is.function(func)) {
-        # Extract any output attributes attached to the render function. These
-        # will be attached to the observer after it's created.
-        outputAttrs <- attr(func, "outputAttrs", TRUE)
-
         funcFormals <- formals(func)
         # ..stacktraceon matches with the top-level ..stacktraceoff.., because
         # the observer we set up below has ..stacktraceon=FALSE
@@ -1092,17 +1051,17 @@ ShinySession <- R6Class(
             shinyCallingHandlers(func()),
             shiny.custom.error = function(cond) {
               if (isTRUE(getOption("show.error.messages"))) printError(cond)
-              structure(list(), class = "try-error", condition = cond)
+              structure(NULL, class = "try-error", condition = cond)
             },
             shiny.output.cancel = function(cond) {
-              structure(list(), class = "cancel-output")
+              structure(NULL, class = "cancel-output")
             },
             shiny.silent.error = function(cond) {
               # Don't let shiny.silent.error go through the normal stop
               # path of try, because we don't want it to print. But we
               # do want to try to return the same looking result so that
               # the code below can send the error to the browser.
-              structure(list(), class = "try-error", condition = cond)
+              structure(NULL, class = "try-error", condition = cond)
             },
             error = function(cond) {
               if (isTRUE(getOption("show.error.messages"))) printError(cond)
@@ -1111,7 +1070,7 @@ ShinySession <- R6Class(
                                           "logs or contact the app author for",
                                           "clarification."))
               }
-              invisible(structure(list(), class = "try-error", condition = cond))
+              invisible(structure(NULL, class = "try-error", condition = cond))
             },
             finally = {
               private$sendMessage(recalculating = list(
@@ -1140,12 +1099,6 @@ ShinySession <- R6Class(
             private$invalidatedOutputValues$set(name, value)
         }, suspended=private$shouldSuspend(name), label=label)
 
-        # If any output attributes were added to the render function attach
-        # them to observer.
-        lapply(names(outputAttrs), function(name) {
-          attr(obs, name) <- outputAttrs[[name]]
-        })
-
         obs$onInvalidate(function() {
           self$showProgress(name)
         })
@@ -1307,12 +1260,8 @@ ShinySession <- R6Class(
       private$bookmarkExclude <- names
     },
     getBookmarkExclude = function() {
-      scopedExcludes <- lapply(private$getBookmarkExcludeFuns, function(f) f())
-      scopedExcludes <- unlist(scopedExcludes)
-
-      c(private$bookmarkExclude, scopedExcludes)
+      private$bookmarkExclude
     },
-
     onBookmark = function(fun) {
       if (!is.function(fun) || length(fun) != 1) {
         stop("`fun` must be a function that takes one argument")
@@ -1453,9 +1402,8 @@ ShinySession <- R6Class(
         )
       )
     },
-    updateQueryString = function(queryString, mode) {
-      private$sendMessage(updateQueryString = list(
-        queryString = queryString, mode = mode))
+    updateQueryString = function(queryString) {
+      private$sendMessage(updateQueryString = list(queryString = queryString))
     },
     resetBrush = function(brushId) {
       private$sendMessage(
@@ -1862,16 +1810,6 @@ outputOptions <- function(x, name, ...) {
 }
 
 
-#' Mark an output to be excluded from test snapshots
-#'
-#' @param x A reactive which will be assigned to an output.
-#'
-#' @export
-snapshotExclude <- function(x) {
-  markOutputAttrs(x, snapshotExclude = TRUE)
-}
-
-
 #' Add callbacks for Shiny session events
 #'
 #' These functions are for registering callbacks on Shiny session events.

R/shinyui.R

@@ -45,6 +45,7 @@ renderPage <- function(ui, connection, showcase=0, testMode=FALSE) {
   shiny_deps <- list(
     htmlDependency("json2", "2014.02.04", c(href="shared"), script = "json2-min.js"),
     htmlDependency("jquery", "1.12.4", c(href="shared"), script = "jquery.min.js"),
+    htmlDependency("babel-polyfill", "6.7.2", c(href="shared"), script = "babel-polyfill.min.js"),
     htmlDependency("shiny", utils::packageVersion("shiny"), c(href="shared"),
       script = if (getOption("shiny.minified", TRUE)) "shiny.min.js" else "shiny.js",
       stylesheet = "shiny.css")

R/shinywrappers.R

@@ -88,26 +88,6 @@ as.tags.shiny.render.function <- function(x, ..., inline = FALSE) {
   useRenderFunction(x, inline = inline)
 }
 
-
-#' Mark a render function with attributes that will be used by the output
-#'
-#' @inheritParams markRenderFunction
-#' @param snapshotExclude If TRUE, exclude the output from test snapshots.
-#'
-#' @keywords internal
-markOutputAttrs <- function(renderFunc, snapshotExclude = NULL) {
-  # Add the outputAttrs attribute if necessary
-  if (is.null(attr(renderFunc, "outputAttrs", TRUE))) {
-    attr(renderFunc, "outputAttrs") <- list()
-  }
-
-  if (!is.null(snapshotExclude)) {
-    attr(renderFunc, "outputAttrs")$snapshotExclude <- snapshotExclude
-  }
-
-  renderFunc
-}
-
 #' Image file output
 #'
 #' Renders a reactive image that is suitable for assigning to an \code{output}
@@ -147,7 +127,6 @@ markOutputAttrs <- function(renderFunc, snapshotExclude = NULL) {
 #' @examples
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {
-#' options(device.ask.default = FALSE)
 #'
 #' ui <- fluidPage(
 #'   sliderInput("n", "Number of observations", 2, 1000, 500),
@@ -430,9 +409,7 @@ downloadHandler <- function(filename, content, contentType=NA, outputArgs=list()
   renderFunc <- function(shinysession, name, ...) {
     shinysession$registerDownload(name, filename, contentType, content)
   }
-  snapshotExclude(
-    markRenderFunction(downloadButton, renderFunc, outputArgs = outputArgs)
-  )
+  markRenderFunction(downloadButton, renderFunc, outputArgs = outputArgs)
 }
 
 #' Table output with the JavaScript library DataTables

R/update-input.R

@@ -452,18 +452,16 @@ updateSliderInput <- function(session, inputId, label = NULL, value = NULL,
 
 
 updateInputOptions <- function(session, inputId, label = NULL, choices = NULL,
-                               selected = NULL, inline = FALSE, type = NULL,
-                               choiceNames = NULL, choiceValues = NULL) {
-  if (is.null(type)) stop("Please specify the type ('checkbox' or 'radio')")
+                               selected = NULL, inline = FALSE,
+                               type = 'checkbox') {
+  if (!is.null(choices))
+    choices <- choicesWithNames(choices)
+  if (!is.null(selected))
+    selected <- validateSelected(selected, choices, session$ns(inputId))
 
-  args <- normalizeChoicesArgs(choices, choiceNames, choiceValues, mustExist = FALSE)
-
-  if (!is.null(selected)) selected <- as.character(selected)
-
-  options <- if (!is.null(args$choiceValues)) {
+  options <- if (!is.null(choices)) {
     format(tagList(
-      generateOptions(session$ns(inputId), selected, inline, type,
-        args$choiceNames, args$choiceValues)
+      generateOptions(session$ns(inputId), choices, selected, inline, type = type)
     ))
   }
 
@@ -512,10 +510,9 @@ updateInputOptions <- function(session, inputId, label = NULL, choices = NULL,
 #' }
 #' @export
 updateCheckboxGroupInput <- function(session, inputId, label = NULL,
-  choices = NULL, selected = NULL, inline = FALSE,
-  choiceNames = NULL, choiceValues = NULL) {
-  updateInputOptions(session, inputId, label, choices, selected,
-                     inline, "checkbox", choiceNames, choiceValues)
+                                     choices = NULL, selected = NULL,
+                                     inline = FALSE) {
+  updateInputOptions(session, inputId, label, choices, selected, inline)
 }
 
 
@@ -555,15 +552,10 @@ updateCheckboxGroupInput <- function(session, inputId, label = NULL,
 #' }
 #' @export
 updateRadioButtons <- function(session, inputId, label = NULL, choices = NULL,
-                               selected = NULL, inline = FALSE,
-                               choiceNames = NULL, choiceValues = NULL) {
+                               selected = NULL, inline = FALSE) {
   # you must select at least one radio button
-  if (is.null(selected)) {
-    if (!is.null(choices)) selected <- choices[[1]]
-    else if (!is.null(choiceValues)) selected <- choiceValues[[1]]
-  }
-  updateInputOptions(session, inputId, label, choices, selected,
-    inline, 'radio', choiceNames, choiceValues)
+  if (is.null(selected) && !is.null(choices)) selected <- choices[[1]]
+  updateInputOptions(session, inputId, label, choices, selected, inline, type = 'radio')
 }
 
 
@@ -609,7 +601,8 @@ updateRadioButtons <- function(session, inputId, label = NULL, choices = NULL,
 updateSelectInput <- function(session, inputId, label = NULL, choices = NULL,
                               selected = NULL) {
   choices <- if (!is.null(choices)) choicesWithNames(choices)
-  if (!is.null(selected)) selected <- as.character(selected)
+  if (!is.null(selected))
+    selected <- validateSelected(selected, choices, inputId)
   options <- if (!is.null(choices)) selectOptions(choices, selected)
   message <- dropNulls(list(label = label, options = options, value = selected))
   session$sendInputMessage(inputId, message)

R/utils.R

@@ -1128,7 +1128,6 @@ reactiveStop <- function(message = "", class = NULL) {
 #' @examples
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {
-#' options(device.ask.default = FALSE)
 #'
 #' ui <- fluidPage(
 #'   checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)),

inst/examples/02_text/ui.R

@@ -17,7 +17,7 @@ fluidPage(
     ),
     
     # Show a summary of the dataset and an HTML table with the 
-    # requested number of observations
+	 # requested number of observations
     mainPanel(
       verbatimTextOutput("summary"),
       

inst/examples/03_reactivity/server.R

@@ -10,7 +10,7 @@ function(input, output) {
   #
   #  1) It is only called when the inputs it depends on changes
   #  2) The computation and result are shared by all the callers 
-  #     (it only executes a single time)
+  #	  (it only executes a single time)
   #
   datasetInput <- reactive({
     switch(input$dataset,

inst/examples/03_reactivity/ui.R

@@ -22,7 +22,7 @@ fluidPage(
     
     
     # Show the caption, a summary of the dataset and an HTML 
-    # table with the requested number of observations
+	 # table with the requested number of observations
     mainPanel(
       h3(textOutput("caption", container = span)),
       

inst/examples/04_mpg/ui.R

@@ -18,8 +18,8 @@ fluidPage(
       checkboxInput("outliers", "Show outliers", FALSE)
     ),
     
-    # Show the caption and plot of the requested variable against
-    # mpg
+	 # Show the caption and plot of the requested variable against
+	 # mpg
     mainPanel(
       h3(textOutput("caption")),
       

inst/examples/05_sliders/ui.R

@@ -23,16 +23,16 @@ fluidPage(
                   min = 1, max = 1000, value = c(200,500)),
 
       # Provide a custom currency format for value display,
-    # with basic animation
+		# with basic animation
       sliderInput("format", "Custom Format:",
                   min = 0, max = 10000, value = 0, step = 2500,
                   pre = "$", sep = ",", animate=TRUE),
 
       # Animation with custom interval (in ms) to control speed,
-    # plus looping
+		# plus looping
       sliderInput("animation", "Looping Animation:", 1, 2000, 1,
-                  step = 10, animate =
-                  animationOptions(interval=300, loop=TRUE))
+					  	step = 10, animate=
+							animationOptions(interval=300, loop=TRUE))
     ),
 
     # Show a table summarizing the values entered

inst/examples/09_upload/server.R

@@ -14,7 +14,7 @@ function(input, output) {
     if (is.null(inFile))
       return(NULL)
     
-    read.csv(inFile$datapath, header=input$header, sep=input$sep,
-             quote=input$quote)
+    read.csv(inFile$datapath, header=input$header, sep=input$sep, 
+				 quote=input$quote)
   })
 }

inst/examples/09_upload/ui.R

@@ -6,8 +6,8 @@ fluidPage(
     sidebarPanel(
       fileInput('file1', 'Choose CSV File',
                 accept=c('text/csv', 
-                'text/comma-separated-values,text/plain',
-                '.csv')),
+								 'text/comma-separated-values,text/plain', 
+								 '.csv')),
       tags$hr(),
       checkboxInput('header', 'Header', TRUE),
       radioButtons('sep', 'Separator',

inst/examples/10_download/server.R

@@ -12,8 +12,8 @@ function(input, output) {
   
   output$downloadData <- downloadHandler(
     filename = function() { 
-      paste(input$dataset, '.csv', sep='')
-    },
+		 paste(input$dataset, '.csv', sep='') 
+	 },
     content = function(file) {
       write.csv(datasetInput(), file)
     }

inst/staticdocs/index.r

@@ -59,8 +59,7 @@ sd_section("UI Inputs",
     "updateTabsetPanel",
     "updateTextInput",
     "updateTextAreaInput",
-    "updateQueryString",
-    "getQueryString"
+    "updateQueryString"
   )
 )
 sd_section("UI Outputs",
@@ -116,26 +115,25 @@ sd_section("Rendering functions",
     "reactiveUI"
   )
 )
-sd_section("Reactive programming",
+sd_section("Reactive constructs",
   "A sub-library that provides reactive programming facilities for R.",
   c(
-    "reactive",
-    "observe",
-    "observeEvent",
-    "reactiveVal",
-    "reactiveValues",
-    "reactiveValuesToList",
+    "invalidateLater",
     "is.reactivevalues",
     "isolate",
-    "invalidateLater",
-    "debounce",
-    "showReactLog",
     "makeReactiveBinding",
+    "observe",
+    "observeEvent",
+    "getCurrentObserver",
+    "reactive",
     "reactiveFileReader",
     "reactivePoll",
     "reactiveTimer",
+    "reactiveValues",
+    "reactiveValuesToList",
+    "freezeReactiveValue",
     "domains",
-    "freezeReactiveValue"
+    "showReactLog"
   )
 )
 sd_section("Boilerplate",
@@ -193,8 +191,6 @@ sd_section("Utility functions",
     "parseQueryString",
     "plotPNG",
     "exportTestValues",
-    "snapshotExclude",
-    "markOutputAttrs",
     "repeatable",
     "shinyDeprecated",
     "serverInfo",

inst/www/shared/font-awesome/css/font-awesome.css

@@ -1,13 +1,13 @@
 /*!
- *  Font Awesome 4.7.0 by @davegandy - http://fontawesome.io - @fontawesome
+ *  Font Awesome 4.6.3 by @davegandy - http://fontawesome.io - @fontawesome
  *  License - http://fontawesome.io/license (Font: SIL OFL 1.1, CSS: MIT License)
  */
 /* FONT PATH
  * -------------------------- */
 @font-face {
   font-family: 'FontAwesome';
-  src: url('../fonts/fontawesome-webfont.eot?v=4.7.0');
-  src: url('../fonts/fontawesome-webfont.eot?#iefix&v=4.7.0') format('embedded-opentype'), url('../fonts/fontawesome-webfont.woff2?v=4.7.0') format('woff2'), url('../fonts/fontawesome-webfont.woff?v=4.7.0') format('woff'), url('../fonts/fontawesome-webfont.ttf?v=4.7.0') format('truetype'), url('../fonts/fontawesome-webfont.svg?v=4.7.0#fontawesomeregular') format('svg');
+  src: url('../fonts/fontawesome-webfont.eot?v=4.6.3');
+  src: url('../fonts/fontawesome-webfont.eot?#iefix&v=4.6.3') format('embedded-opentype'), url('../fonts/fontawesome-webfont.woff2?v=4.6.3') format('woff2'), url('../fonts/fontawesome-webfont.woff?v=4.6.3') format('woff'), url('../fonts/fontawesome-webfont.ttf?v=4.6.3') format('truetype'), url('../fonts/fontawesome-webfont.svg?v=4.6.3#fontawesomeregular') format('svg');
   font-weight: normal;
   font-style: normal;
 }
@@ -1832,7 +1832,6 @@
   content: "\f23e";
 }
 .fa-battery-4:before,
-.fa-battery:before,
 .fa-battery-full:before {
   content: "\f240";
 }
@@ -2179,143 +2178,6 @@
 .fa-font-awesome:before {
   content: "\f2b4";
 }
-.fa-handshake-o:before {
-  content: "\f2b5";
-}
-.fa-envelope-open:before {
-  content: "\f2b6";
-}
-.fa-envelope-open-o:before {
-  content: "\f2b7";
-}
-.fa-linode:before {
-  content: "\f2b8";
-}
-.fa-address-book:before {
-  content: "\f2b9";
-}
-.fa-address-book-o:before {
-  content: "\f2ba";
-}
-.fa-vcard:before,
-.fa-address-card:before {
-  content: "\f2bb";
-}
-.fa-vcard-o:before,
-.fa-address-card-o:before {
-  content: "\f2bc";
-}
-.fa-user-circle:before {
-  content: "\f2bd";
-}
-.fa-user-circle-o:before {
-  content: "\f2be";
-}
-.fa-user-o:before {
-  content: "\f2c0";
-}
-.fa-id-badge:before {
-  content: "\f2c1";
-}
-.fa-drivers-license:before,
-.fa-id-card:before {
-  content: "\f2c2";
-}
-.fa-drivers-license-o:before,
-.fa-id-card-o:before {
-  content: "\f2c3";
-}
-.fa-quora:before {
-  content: "\f2c4";
-}
-.fa-free-code-camp:before {
-  content: "\f2c5";
-}
-.fa-telegram:before {
-  content: "\f2c6";
-}
-.fa-thermometer-4:before,
-.fa-thermometer:before,
-.fa-thermometer-full:before {
-  content: "\f2c7";
-}
-.fa-thermometer-3:before,
-.fa-thermometer-three-quarters:before {
-  content: "\f2c8";
-}
-.fa-thermometer-2:before,
-.fa-thermometer-half:before {
-  content: "\f2c9";
-}
-.fa-thermometer-1:before,
-.fa-thermometer-quarter:before {
-  content: "\f2ca";
-}
-.fa-thermometer-0:before,
-.fa-thermometer-empty:before {
-  content: "\f2cb";
-}
-.fa-shower:before {
-  content: "\f2cc";
-}
-.fa-bathtub:before,
-.fa-s15:before,
-.fa-bath:before {
-  content: "\f2cd";
-}
-.fa-podcast:before {
-  content: "\f2ce";
-}
-.fa-window-maximize:before {
-  content: "\f2d0";
-}
-.fa-window-minimize:before {
-  content: "\f2d1";
-}
-.fa-window-restore:before {
-  content: "\f2d2";
-}
-.fa-times-rectangle:before,
-.fa-window-close:before {
-  content: "\f2d3";
-}
-.fa-times-rectangle-o:before,
-.fa-window-close-o:before {
-  content: "\f2d4";
-}
-.fa-bandcamp:before {
-  content: "\f2d5";
-}
-.fa-grav:before {
-  content: "\f2d6";
-}
-.fa-etsy:before {
-  content: "\f2d7";
-}
-.fa-imdb:before {
-  content: "\f2d8";
-}
-.fa-ravelry:before {
-  content: "\f2d9";
-}
-.fa-eercast:before {
-  content: "\f2da";
-}
-.fa-microchip:before {
-  content: "\f2db";
-}
-.fa-snowflake-o:before {
-  content: "\f2dc";
-}
-.fa-superpowers:before {
-  content: "\f2dd";
-}
-.fa-wpexplorer:before {
-  content: "\f2de";
-}
-.fa-meetup:before {
-  content: "\f2e0";
-}
 .sr-only {
   position: absolute;
   width: 1px;

inst/www/shared/ionrangeslider/css/ion.rangeSlider.css

@@ -141,7 +141,6 @@
     line-height: 0 !important;
     padding: 0 !important;
     margin: 0 !important;
-    overflow: hidden;
     outline: none !important;
     z-index: -9999 !important;
     background: none !important;

inst/www/shared/ionrangeslider/js/ion.rangeSlider.js

@@ -1,6 +1,6 @@
-// Ion.RangeSlider
-// version 2.1.6 Build: 369
-// © Denis Ineshin, 2016
+// Ion.RangeSlider
+// version 2.1.2 Build: 350
+// © Denis Ineshin, 2015
 // https://github.com/IonDen
 //
 // Project page:    http://ionden.com/a/plugins/ion.rangeSlider/en.html
@@ -10,17 +10,7 @@
 // http://ionden.com/a/plugins/licence-en.html
 // =====================================================================================================================
 
-;(function(factory) {
-    if (typeof define === "function" && define.amd) {
-        define(["jquery"], function (jQuery) {
-            return factory(jQuery, document, window, navigator);
-        });
-    } else if (typeof exports === "object") {
-        factory(require("jquery"), document, window, navigator);
-    } else {
-        factory(jQuery, document, window, navigator);
-    }
-} (function ($, document, window, navigator, undefined) {
+;(function ($, document, window, navigator, undefined) {
     "use strict";
 
     // =================================================================================================================
@@ -156,7 +146,7 @@
      * @constructor
      */
     var IonRangeSlider = function (input, options, plugin_count) {
-        this.VERSION = "2.1.6";
+        this.VERSION = "2.1.2";
         this.input = input;
         this.plugin_count = plugin_count;
         this.current_plugin = 0;
@@ -171,15 +161,12 @@
         this.no_diapason = false;
         this.is_key = false;
         this.is_update = false;
-        this.is_first_update = true;
         this.is_start = true;
         this.is_finish = false;
         this.is_active = false;
         this.is_resize = false;
         this.is_click = false;
 
-        options = options || {};
-
         // cache for links to all DOM elements
         this.$cache = {
             win: $(window),
@@ -331,11 +318,6 @@
         };
 
 
-        // check if base element is input
-        if ($inp[0].nodeName !== "INPUT") {
-            console && console.warn && console.warn("Base element should be <input>!", $inp[0]);
-        }
-
 
         // config from data-attributes extends js config
         config_from_data = {
@@ -393,15 +375,16 @@
 
         for (prop in config_from_data) {
             if (config_from_data.hasOwnProperty(prop)) {
-                if (config_from_data[prop] === undefined || config_from_data[prop] === "") {
+                if (!config_from_data[prop] && config_from_data[prop] !== 0) {
                     delete config_from_data[prop];
                 }
             }
         }
 
 
+
         // input value extends default config
-        if (val !== undefined && val !== "") {
+        if (val) {
             val = val.split(config_from_data.input_values_separator || options.input_values_separator || ";");
 
             if (val[0] && val[0] == +val[0]) {
@@ -433,7 +416,6 @@
 
 
         // validate config, to be sure that all data types are correct
-        this.update_check = {};
         this.validate();
 
 
@@ -465,7 +447,7 @@
         /**
          * Starts or updates the plugin instance
          *
-         * @param [is_update] {boolean}
+         * @param is_update {boolean}
          */
         init: function (is_update) {
             this.no_diapason = false;
@@ -752,6 +734,7 @@
 
             // callbacks call
             if ($.contains(this.$cache.cont[0], e.target) || this.dragging) {
+                this.is_finish = true;
                 this.callOnFinish();
             }
             
@@ -778,7 +761,7 @@
             }
 
             if (!target) {
-                target = this.target || "from";
+                target = this.target;
             }
 
             this.current_plugin = this.plugin_count;
@@ -965,12 +948,6 @@
             this.calcPointerPercent();
             var handle_x = this.getHandleX();
 
-
-            if (this.target === "both") {
-                this.coords.p_gap = 0;
-                handle_x = this.getHandleX();
-            }
-
             if (this.target === "click") {
                 this.coords.p_gap = this.coords.p_handle / 2;
                 handle_x = this.getHandleX();
@@ -1058,7 +1035,7 @@
                         break;
                     }
 
-                    handle_x = this.toFixed(handle_x + (this.coords.p_handle * 0.001));
+                    handle_x = this.toFixed(handle_x + (this.coords.p_handle * 0.1));
 
                     this.coords.p_from_real = this.convertToRealPercent(handle_x) - this.coords.p_gap_left;
                     this.coords.p_from_real = this.calcWithStep(this.coords.p_from_real);
@@ -1336,6 +1313,13 @@
                     this.$cache.s_single[0].style.left = this.coords.p_single_fake + "%";
 
                     this.$cache.single[0].style.left = this.labels.p_single_left + "%";
+
+                    if (this.options.values.length) {
+                        this.$cache.input.prop("value", this.result.from_value);
+                    } else {
+                        this.$cache.input.prop("value", this.result.from);
+                    }
+                    this.$cache.input.data("from", this.result.from);
                 } else {
                     this.$cache.s_from[0].style.left = this.coords.p_from_fake + "%";
                     this.$cache.s_to[0].style.left = this.coords.p_to_fake + "%";
@@ -1348,13 +1332,18 @@
                     }
 
                     this.$cache.single[0].style.left = this.labels.p_single_left + "%";
-                }
 
-                this.writeToInput();
+                    if (this.options.values.length) {
+                        this.$cache.input.prop("value", this.result.from_value + this.options.input_values_separator + this.result.to_value);
+                    } else {
+                        this.$cache.input.prop("value", this.result.from + this.options.input_values_separator + this.result.to);
+                    }
+                    this.$cache.input.data("from", this.result.from);
+                    this.$cache.input.data("to", this.result.to);
+                }
 
                 if ((this.old_from !== this.result.from || this.old_to !== this.result.to) && !this.is_start) {
                     this.$cache.input.trigger("change");
-                    this.$cache.input.trigger("input");
                 }
 
                 this.old_from = this.result.from;
@@ -1364,10 +1353,9 @@
                 if (!this.is_resize && !this.is_update && !this.is_start && !this.is_finish) {
                     this.callOnChange();
                 }
-                if (this.is_key || this.is_click || this.is_first_update) {
+                if (this.is_key || this.is_click) {
                     this.is_key = false;
                     this.is_click = false;
-                    this.is_first_update = false;
                     this.callOnFinish();
                 }
 
@@ -1479,8 +1467,6 @@
                             this.$cache.from[0].style.visibility = "visible";
                         } else if (this.target === "to") {
                             this.$cache.to[0].style.visibility = "visible";
-                        } else if (!this.target) {
-                            this.$cache.from[0].style.visibility = "visible";
                         }
                         this.$cache.single[0].style.visibility = "hidden";
                         max = to_left;
@@ -1575,57 +1561,25 @@
 
 
 
-        /**
-         * Write values to input element
-         */
-        writeToInput: function () {
-            if (this.options.type === "single") {
-                if (this.options.values.length) {
-                    this.$cache.input.prop("value", this.result.from_value);
-                } else {
-                    this.$cache.input.prop("value", this.result.from);
-                }
-                this.$cache.input.data("from", this.result.from);
-            } else {
-                if (this.options.values.length) {
-                    this.$cache.input.prop("value", this.result.from_value + this.options.input_values_separator + this.result.to_value);
-                } else {
-                    this.$cache.input.prop("value", this.result.from + this.options.input_values_separator + this.result.to);
-                }
-                this.$cache.input.data("from", this.result.from);
-                this.$cache.input.data("to", this.result.to);
-            }
-        },
-
-
-
         // =============================================================================================================
         // Callbacks
 
         callOnStart: function () {
-            this.writeToInput();
-
             if (this.options.onStart && typeof this.options.onStart === "function") {
                 this.options.onStart(this.result);
             }
         },
         callOnChange: function () {
-            this.writeToInput();
-
             if (this.options.onChange && typeof this.options.onChange === "function") {
                 this.options.onChange(this.result);
             }
         },
         callOnFinish: function () {
-            this.writeToInput();
-
             if (this.options.onFinish && typeof this.options.onFinish === "function") {
                 this.options.onFinish(this.result);
             }
         },
         callOnUpdate: function () {
-            this.writeToInput();
-
             if (this.options.onUpdate && typeof this.options.onUpdate === "function") {
                 this.options.onUpdate(this.result);
             }
@@ -1633,7 +1587,6 @@
 
 
 
-
         // =============================================================================================================
         // Service methods
 
@@ -1843,7 +1796,7 @@
         },
 
         toFixed: function (num) {
-            num = num.toFixed(20);
+            num = num.toFixed(9);
             return +num;
         },
 
@@ -1931,36 +1884,31 @@
                 o.from = o.min;
             }
 
-            if (typeof o.to !== "number" || isNaN(o.to)) {
+            if (typeof o.to !== "number" || isNaN(o.from)) {
                 o.to = o.max;
             }
 
             if (o.type === "single") {
 
-                if (o.from < o.min) o.from = o.min;
-                if (o.from > o.max) o.from = o.max;
+                if (o.from < o.min) {
+                    o.from = o.min;
+                }
+
+                if (o.from > o.max) {
+                    o.from = o.max;
+                }
 
             } else {
 
-                if (o.from < o.min) o.from = o.min;
-                if (o.from > o.max) o.from = o.max;
-
-                if (o.to < o.min) o.to = o.min;
-                if (o.to > o.max) o.to = o.max;
-
-                if (this.update_check.from) {
-
-                    if (this.update_check.from !== o.from) {
-                        if (o.from > o.to) o.from = o.to;
-                    }
-                    if (this.update_check.to !== o.to) {
-                        if (o.to < o.from) o.to = o.from;
-                    }
-
+                if (o.from < o.min || o.from > o.max) {
+                    o.from = o.min;
+                }
+                if (o.to > o.max || o.to < o.min) {
+                    o.to = o.max;
+                }
+                if (o.from > o.to) {
+                    o.from = o.to;
                 }
-
-                if (o.from > o.to) o.from = o.to;
-                if (o.to < o.from) o.to = o.from;
 
             }
 
@@ -2219,10 +2167,7 @@
 
             for (i = 0; i < num; i++) {
                 label = this.$cache.grid_labels[i][0];
-
-                if (this.coords.big_x[i] !== Number.POSITIVE_INFINITY) {
-                    label.style.marginLeft = -this.coords.big_x[i] + "%";
-                }
+                label.style.marginLeft = -this.coords.big_x[i] + "%";
             }
         },
 
@@ -2284,8 +2229,6 @@
 
             this.options.from = this.result.from;
             this.options.to = this.result.to;
-            this.update_check.from = this.result.from;
-            this.update_check.to = this.result.to;
 
             this.options = $.extend(this.options, options);
             this.validate();
@@ -2363,4 +2306,4 @@
             };
     }());
 
-}));
+} (jQuery, document, window, navigator));

inst/www/shared/shiny-showcase.js

@@ -217,7 +217,7 @@
     var app = document.getElementById("showcase-app-container");
     $(app).animate({
         width: appWidth + "px",
-        zoom: (zoom*100) + "%"
+        zoom: zoom
       }, animate ? animateMs : 0);
   };
 

inst/www/shared/shiny.css

@@ -95,13 +95,6 @@ pre.shiny-text-output.noplaceholder:empty {
   font-weight: inherit;
 }
 
-/* Work around MS Edge transition bug (issue #1637) */
-@supports (-ms-ime-align:auto) {
-  .shiny-bound-output {
-    transition: 0;
-  }
-}
-
 .recalculating {
   opacity: 0.3;
   transition: opacity 250ms ease 500ms;

inst/www/shared/shiny.js

@@ -10,13 +10,6 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
   var exports = window.Shiny = window.Shiny || {};
 
-  var origPushState = window.history.pushState;
-  window.history.pushState = function () {
-    var result = origPushState.apply(this, arguments);
-    $(document).trigger("pushstate");
-    return result;
-  };
-
   $(document).on('submit', 'form:not([action])', function (e) {
     e.preventDefault();
   });
@@ -25,18 +18,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
   // Source file: ../srcjs/utils.js
 
   function escapeHTML(str) {
-    var escaped = {
-      "&": "&",
-      "<": "&lt;",
-      ">": "&gt;",
-      '"': "&quot;",
-      "'": "&#039;",
-      "/": "&#x2F;"
-    };
-
-    return str.replace(/[&<>'"\/]/g, function (m) {
-      return escaped[m];
-    });
+    return str.replace(/&/g, "&amp;").replace(/</g, "&lt;").replace(/>/g, "&gt;").replace(/"/g, "&quot;").replace(/'/g, "&#039;").replace(/\//g, "&#x2F;");
   }
 
   function randomId() {
@@ -78,18 +60,6 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     }return str;
   }
 
-  // Round to a specified number of significant digits.
-  function roundSignif(x) {
-    var digits = arguments.length > 1 && arguments[1] !== undefined ? arguments[1] : 1;
-
-    if (digits < 1) throw "Significant digits must be at least 1.";
-
-    // This converts to a string and back to a number, which is inelegant, but
-    // is less prone to FP rounding error than an alternate method which used
-    // Math.round().
-    return parseFloat(x.toPrecision(digits));
-  }
-
   // Take a string with format "YYYY-MM-DD" and return a Date object.
   // IE8 and QTWebKit don't support YYYY-MM-DD, but they support YYYY/MM/DD
   function parseDate(dateString) {
@@ -230,16 +200,6 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     return val.replace(/([!"#$%&'()*+,.\/:;<=>?@\[\\\]^`{|}~])/g, '\\$1');
   };
 
-  // Maps a function over an object, preserving keys. Like the mapValues
-  // function from lodash.
-  function mapValues(obj, f) {
-    var newObj = {};
-    for (var key in obj) {
-      if (obj.hasOwnProperty(key)) newObj[key] = f(obj[key]);
-    }
-    return newObj;
-  }
-
   //---------------------------------------------------------------------
   // Source file: ../srcjs/browser.js
 
@@ -468,7 +428,6 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
       var self = this;
 
       this.pendingData[name] = value;
-
       if (!this.timerId && !this.reentrant) {
         this.timerId = setTimeout(function () {
           self.reentrant = true;
@@ -490,78 +449,55 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
   var InputNoResendDecorator = function InputNoResendDecorator(target, initialValues) {
     this.target = target;
-    this.lastSentValues = this.reset(initialValues);
+    this.lastSentValues = initialValues || {};
   };
   (function () {
     this.setInput = function (name, value) {
-      // Note that opts is not passed to setInput at this stage of the input
-      // decorator stack. If in the future this setInput keeps track of opts, it
-      // would be best not to store the `el`, because that could prevent it from
-      // being GC'd.
-      var _splitInputNameType = splitInputNameType(name);
-
-      var inputName = _splitInputNameType.name;
-      var inputType = _splitInputNameType.inputType;
-
       var jsonValue = JSON.stringify(value);
-
-      if (this.lastSentValues[inputName] && this.lastSentValues[inputName].jsonValue === jsonValue && this.lastSentValues[inputName].inputType === inputType) {
-        return;
-      }
-      this.lastSentValues[inputName] = { jsonValue: jsonValue, inputType: inputType };
+      if (this.lastSentValues[name] === jsonValue) return;
+      this.lastSentValues[name] = jsonValue;
       this.target.setInput(name, value);
     };
-    this.reset = function () {
-      var values = arguments.length > 0 && arguments[0] !== undefined ? arguments[0] : {};
-
-      // Given an object with flat name-value format:
-      //   { x: "abc", "y.shiny.number": 123 }
-      // Create an object in cache format and save it:
-      //   { x: { jsonValue: '"abc"', inputType: "" },
-      //     y: { jsonValue: "123", inputType: "shiny.number" } }
-      var cacheValues = {};
-
-      for (var inputName in values) {
-        if (values.hasOwnProperty(inputName)) {
-          var _splitInputNameType2 = splitInputNameType(inputName);
-
-          var name = _splitInputNameType2.name;
-          var inputType = _splitInputNameType2.inputType;
-
-          cacheValues[name] = {
-            jsonValue: JSON.stringify(values[inputName]),
-            inputType: inputType
-          };
-        }
-      }
-
-      this.lastSentValues = cacheValues;
+    this.reset = function (values) {
+      values = values || {};
+      var strValues = {};
+      $.each(values, function (key, value) {
+        strValues[key] = JSON.stringify(value);
+      });
+      this.lastSentValues = strValues;
     };
   }).call(InputNoResendDecorator.prototype);
 
+  var InputDeferDecorator = function InputDeferDecorator(target) {
+    this.target = target;
+    this.pendingInput = {};
+  };
+  (function () {
+    this.setInput = function (name, value) {
+      if (/^\./.test(name)) this.target.setInput(name, value);else this.pendingInput[name] = value;
+    };
+    this.submit = function () {
+      for (var name in this.pendingInput) {
+        if (this.pendingInput.hasOwnProperty(name)) this.target.setInput(name, this.pendingInput[name]);
+      }
+    };
+  }).call(InputDeferDecorator.prototype);
+
   var InputEventDecorator = function InputEventDecorator(target) {
     this.target = target;
   };
   (function () {
-    this.setInput = function (name, value, opts) {
+    this.setInput = function (name, value, immediate) {
       var evt = jQuery.Event("shiny:inputchanged");
-
-      var input = splitInputNameType(name);
-      evt.name = input.name;
-      evt.inputType = input.inputType;
+      var name2 = name.split(':');
+      evt.name = name2[0];
+      evt.inputType = name2.length > 1 ? name2[1] : '';
       evt.value = value;
-      evt.binding = opts.binding;
-      evt.el = opts.el;
-
       $(document).trigger(evt);
-
       if (!evt.isDefaultPrevented()) {
         name = evt.name;
         if (evt.inputType !== '') name += ':' + evt.inputType;
-
-        // opts aren't passed along to lower levels in the input decorator
-        // stack.
-        this.target.setInput(name, evt.value);
+        this.target.setInput(name, evt.value, immediate);
       }
     };
   }).call(InputEventDecorator.prototype);
@@ -571,10 +507,9 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     this.inputRatePolicies = {};
   };
   (function () {
-    this.setInput = function (name, value, opts) {
+    this.setInput = function (name, value, immediate) {
       this.$ensureInit(name);
-
-      if (opts.immediate) this.inputRatePolicies[name].immediateCall(name, value, opts);else this.inputRatePolicies[name].normalCall(name, value, opts);
+      if (immediate) this.inputRatePolicies[name].immediateCall(name, value, immediate);else this.inputRatePolicies[name].normalCall(name, value, immediate);
     };
     this.setRatePolicy = function (name, mode, millis) {
       if (mode === 'direct') {
@@ -588,59 +523,11 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     this.$ensureInit = function (name) {
       if (!(name in this.inputRatePolicies)) this.setRatePolicy(name, 'direct');
     };
-    this.$doSetInput = function (name, value, opts) {
-      this.target.setInput(name, value, opts);
+    this.$doSetInput = function (name, value) {
+      this.target.setInput(name, value);
     };
   }).call(InputRateDecorator.prototype);
 
-  var InputDeferDecorator = function InputDeferDecorator(target) {
-    this.target = target;
-    this.pendingInput = {};
-  };
-  (function () {
-    this.setInput = function (name, value, opts) {
-      if (/^\./.test(name)) this.target.setInput(name, value, opts);else this.pendingInput[name] = { value: value, opts: opts };
-    };
-    this.submit = function () {
-      for (var name in this.pendingInput) {
-        if (this.pendingInput.hasOwnProperty(name)) {
-          var input = this.pendingInput[name];
-          this.target.setInput(name, input.value, input.opts);
-        }
-      }
-    };
-  }).call(InputDeferDecorator.prototype);
-
-  var InputValidateDecorator = function InputValidateDecorator(target) {
-    this.target = target;
-  };
-  (function () {
-    this.setInput = function (name, value, opts) {
-      if (!name) throw "Can't set input with empty name.";
-
-      opts = addDefaultInputOpts(opts);
-
-      this.target.setInput(name, value, opts);
-    };
-  }).call(InputValidateDecorator.prototype);
-
-  // Merge opts with defaults, and return a new object.
-  function addDefaultInputOpts(opts) {
-    return $.extend({
-      immediate: false,
-      binding: null,
-      el: null
-    }, opts);
-  }
-
-  function splitInputNameType(name) {
-    var name2 = name.split(':');
-    return {
-      name: name2[0],
-      inputType: name2.length > 1 ? name2[1] : ''
-    };
-  }
-
   //---------------------------------------------------------------------
   // Source file: ../srcjs/shinyapp.js
 
@@ -650,9 +537,6 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     // Cached input values
     this.$inputValues = {};
 
-    // Input values at initialization (and reconnect)
-    this.$initialInput = {};
-
     // Output bindings
     this.$bindings = {};
 
@@ -675,6 +559,11 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     this.connect = function (initialInput) {
       if (this.$socket) throw "Connect was already called on this application object";
 
+      $.extend(initialInput, {
+        // IE8 and IE9 have some limitations with data URIs
+        ".clientdata_allowDataUriScheme": typeof WebSocket !== 'undefined'
+      });
+
       this.$socket = this.createSocket();
       this.$initialInput = initialInput;
       $.extend(this.$inputValues, initialInput);
@@ -1239,8 +1128,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     });
 
     addMessageHandler('config', function (message) {
-      this.config = { workerId: message.workerId, sessionId: message.sessionId };
-      if (message.user) exports.user = message.user;
+      this.config = message;
     });
 
     addMessageHandler('busy', function (message) {
@@ -1295,46 +1183,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     });
 
     addMessageHandler('updateQueryString', function (message) {
-
-      // leave the bookmarking code intact
-      if (message.mode === "replace") {
-        window.history.replaceState(null, null, message.queryString);
-        return;
-      }
-
-      var what = null;
-      if (message.queryString.charAt(0) === "#") what = "hash";else if (message.queryString.charAt(0) === "?") what = "query";else throw "The 'query' string must start with either '?' " + "(to update the query string) or with '#' (to " + "update the hash).";
-
-      var path = window.location.pathname;
-      var oldQS = window.location.search;
-      var oldHash = window.location.hash;
-
-      /* Barbara -- December 2016
-      Note: we could check if the new QS and/or hash are different
-      from the old one(s) and, if not, we could choose not to push
-      a new state (whether or not we would replace it is moot/
-      inconsequential). However, I think that it is better to
-      interpret each call to `updateQueryString` as representing
-      new state (even if the message.queryString is the same), so
-      that check isn't even performed as of right now.
-      */
-
-      var relURL = path;
-      if (what === "query") relURL += message.queryString;else relURL += oldQS + message.queryString; // leave old QS if it exists
-      window.history.pushState(null, null, relURL);
-
-      // for the case when message.queryString has both a query string
-      // and a hash (`what = "hash"` allows us to trigger the
-      // hashchange event)
-      if (message.queryString.indexOf("#") !== -1) what = "hash";
-
-      // for the case when there was a hash before, but there isn't
-      // any hash now (e.g. for when only the query string is updated)
-      if (window.location.hash !== oldHash) what = "hash";
-
-      // This event needs to be triggered manually because pushState() never
-      // causes a hashchange event to be fired,
-      if (what === "hash") $(document).trigger("hashchange");
+      window.history.replaceState(null, null, message.queryString);
     });
 
     addMessageHandler("resetBrush", function (message) {
@@ -1411,9 +1260,13 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
           if (typeof message.detail !== 'undefined') {
             $progress.find('.progress-detail').text(message.detail);
           }
-          if (typeof message.value !== 'undefined' && message.value !== null) {
-            $progress.find('.progress').show();
-            $progress.find('.progress-bar').width(message.value * 100 + '%');
+          if (typeof message.value !== 'undefined') {
+            if (message.value !== null) {
+              $progress.find('.progress').show();
+              $progress.find('.progress-bar').width(message.value * 100 + '%');
+            } else {
+              $progress.find('.progress').hide();
+            }
           }
         } else if (message.style === "old") {
           // For old-style (Shiny <=0.13.2) progress indicators.
@@ -1425,9 +1278,13 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
           if (typeof message.detail !== 'undefined') {
             $progress.find('.progress-detail').text(message.detail);
           }
-          if (typeof message.value !== 'undefined' && message.value !== null) {
-            $progress.find('.progress').show();
-            $progress.find('.bar').width(message.value * 100 + '%');
+          if (typeof message.value !== 'undefined') {
+            if (message.value !== null) {
+              $progress.find('.progress').show();
+              $progress.find('.bar').width(message.value * 100 + '%');
+            } else {
+              $progress.find('.progress').hide();
+            }
           }
 
           $progress.fadeIn();
@@ -1719,20 +1576,6 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
         });
       }
 
-      $modal.on('keydown.shinymodal', function (e) {
-        // If we're listening for Esc, don't let the event propagate. See
-        // https://github.com/rstudio/shiny/issues/1453. The value of
-        // data("keyboard") needs to be checked inside the handler, because at
-        // the time that $modal.on() is called, the $("#shiny-modal") div doesn't
-        // yet exist.
-        if ($("#shiny-modal").data("keyboard") === false) return;
-
-        if (e.keyCode === 27) {
-          e.stopPropagation();
-          e.preventDefault();
-        }
-      });
-
       // Set/replace contents of wrapper with html.
       exports.renderContent($modal, { html: html, deps: deps });
     },
@@ -1740,8 +1583,6 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     remove: function remove() {
       var $modal = $('#shiny-modal-wrapper');
 
-      $modal.off('keydown.shinymodal');
-
       // Look for a Bootstrap modal and if present, trigger hide event. This will
       // trigger the hidden.bs.modal callback that we set in show(), which unbinds
       // and removes the element.
@@ -2983,11 +2824,6 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
       // For reversed scales, the min and max can be reversed, so use findBox
       // to ensure correct order.
       state.boundsData = coordmap.findBox(minData, maxData);
-      // Round to 14 significant digits to avoid spurious changes in FP values
-      // (#1634).
-      state.boundsData = mapValues(state.boundsData, function (val) {
-        return roundSignif(val, 14);
-      });
 
       // We also need to attach the data bounds and panel as data attributes, so
       // that if the image is re-sent, we can grab the data bounds to create a new
@@ -3471,14 +3307,6 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
   });
   outputBindings.register(downloadLinkOutputBinding, 'shiny.downloadLink');
 
-  // Trigger shiny:filedownload event whenever a downloadButton/Link is clicked
-  $(document).on('click.shinyDownloadLink', 'a.shiny-download-link', function (e) {
-    var evt = jQuery.Event('shiny:filedownload');
-    evt.name = this.id;
-    evt.href = this.href;
-    $(document).trigger(evt);
-  });
-
   //---------------------------------------------------------------------
   // Source file: ../srcjs/output_binding_datatable.js
 
@@ -4855,10 +4683,9 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     };
   }).call(IE8FileUploader.prototype);
 
-  var FileUploader = function FileUploader(shinyapp, id, files, el) {
+  var FileUploader = function FileUploader(shinyapp, id, files) {
     this.shinyapp = shinyapp;
     this.id = id;
-    this.el = el;
     FileProcessor.call(this, files);
   };
   $.extend(FileUploader.prototype, FileProcessor.prototype);
@@ -4928,26 +4755,6 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     };
     this.onComplete = function () {
       var self = this;
-
-      var fileInfo = $.map(this.files, function (file, i) {
-        return {
-          name: file.name,
-          size: file.size,
-          type: file.type
-        };
-      });
-
-      // Trigger shiny:inputchanged. Unlike a normal shiny:inputchanged event,
-      // it's not possible to modify the information before the values get
-      // sent to the server.
-      var evt = jQuery.Event("shiny:inputchanged");
-      evt.name = this.id;
-      evt.value = fileInfo;
-      evt.binding = fileInputBinding;
-      evt.el = this.el;
-      evt.inputType = 'shiny.fileupload';
-      $(document).trigger(evt);
-
       this.makeRequest('uploadEnd', [this.jobId, this.id], function (response) {
         self.$setActive(false);
         self.onProgress(null, 1);
@@ -4956,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 || '');
@@ -5022,7 +4841,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
       /*jshint nonew:false */
       new IE8FileUploader(exports.shinyapp, id, evt.target);
     } else {
-      $el.data('currentUploader', new FileUploader(exports.shinyapp, id, files, evt.target));
+      $el.data('currentUploader', new FileUploader(exports.shinyapp, id, files));
     }
   }
 
@@ -5168,27 +4987,19 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     var inputsRate = new InputRateDecorator(inputsEvent);
     var inputsDefer = new InputDeferDecorator(inputsEvent);
 
-    var inputs;
-    if ($('input[type="submit"], button[type="submit"]').length > 0) {
+    // By default, use rate decorator
+    var inputs = inputsRate;
+    $('input[type="submit"], button[type="submit"]').each(function () {
       // If there is a submit button on the page, use defer decorator
       inputs = inputsDefer;
-
-      $('input[type="submit"], button[type="submit"]').each(function () {
-        $(this).click(function (event) {
-          event.preventDefault();
-          inputsDefer.submit();
-        });
+      $(this).click(function (event) {
+        event.preventDefault();
+        inputsDefer.submit();
       });
-    } else {
-      // By default, use rate decorator
-      inputs = inputsRate;
-    }
+    });
 
-    inputs = new InputValidateDecorator(inputs);
-
-    exports.onInputChange = function (name, value, opts) {
-      opts = addDefaultInputOpts(opts);
-      inputs.setInput(name, value, opts);
+    exports.onInputChange = function (name, value) {
+      inputs.setInput(name, value);
     };
 
     var boundInputs = {};
@@ -5199,9 +5010,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
         var value = binding.getValue(el);
         var type = binding.getType(el);
         if (type) id = id + ":" + type;
-
-        var opts = { immediate: !allowDeferred, binding: binding, el: el };
-        inputs.setInput(id, value, opts);
+        inputs.setInput(id, value, !allowDeferred);
       }
     }
 
@@ -5210,7 +5019,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
       var bindings = inputBindings.getBindings();
 
-      var inputItems = {};
+      var currentValues = {};
 
       for (var i = 0; i < bindings.length; i++) {
         var binding = bindings[i].binding;
@@ -5224,14 +5033,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
           var type = binding.getType(el);
           var effectiveId = type ? id + ":" + type : id;
-          inputItems[effectiveId] = {
-            value: binding.getValue(el),
-            opts: {
-              immediate: true,
-              binding: binding,
-              el: el
-            }
-          };
+          currentValues[effectiveId] = binding.getValue(el);
 
           /*jshint loopfunc:true*/
           var thisCallback = function () {
@@ -5260,10 +5062,14 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
             binding: binding,
             bindingType: 'input'
           });
+
+          if (shinyapp.isConnected()) {
+            valueChangeCallback(binding, el, false);
+          }
         }
       }
 
-      return inputItems;
+      return currentValues;
     }
 
     function unbindInputs() {
@@ -5303,11 +5109,12 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
       unbindOutputs(scope, includeSelf);
     }
     exports.bindAll = function (scope) {
-      // _bindAll returns input values; it doesn't send them to the server.
-      // export.bindAll needs to send the values to the server.
-      var currentInputItems = _bindAll(scope);
-      $.each(currentInputItems, function (name, item) {
-        inputs.setInput(name, item.value, item.opts);
+      // _bindAll alone returns initial values, it doesn't send them to the
+      // server. export.bindAll needs to send the values to the server, so we
+      // wrap _bindAll in a closure that does that.
+      var currentValues = _bindAll(scope);
+      $.each(currentValues, function (name, value) {
+        inputs.setInput(name, value);
       });
 
       // Not sure if the iframe stuff is an intrinsic part of bindAll, but bindAll
@@ -5350,16 +5157,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     // Initialize all input objects in the document, before binding
     initializeInputs(document);
 
-    // The input values returned by _bindAll() each have a structure like this:
-    //   { value: 123, opts: { ... } }
-    // We want to only keep the value. This is because when the initialValues is
-    // passed to ShinyApp.connect(), the ShinyApp object stores the
-    // initialValues object for the duration of the session, and the opts may
-    // have a reference to the DOM element, which would prevent it from being
-    // GC'd.
-    var initialValues = mapValues(_bindAll(document), function (x) {
-      return x.value;
-    });
+    var initialValues = _bindAll(document);
 
     // The server needs to know the size of each image and plot output element,
     // in case it is auto-sizing
@@ -5513,28 +5311,12 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     initialValues['.clientdata_url_hostname'] = window.location.hostname;
     initialValues['.clientdata_url_port'] = window.location.port;
     initialValues['.clientdata_url_pathname'] = window.location.pathname;
-
-    // Send initial URL search (query string) and update it if it changes
     initialValues['.clientdata_url_search'] = window.location.search;
-
-    $(window).on('pushstate', function (e) {
-      inputs.setInput('.clientdata_url_search', window.location.search);
-    });
-
-    $(window).on('popstate', function (e) {
-      inputs.setInput('.clientdata_url_search', window.location.search);
-    });
-
     // This is only the initial value of the hash. The hash can change, but
-    // a reactive version of this isn't sent because watching for changes can
+    // a reactive version of this isn't sent because w atching for changes can
     // require polling on some browsers. The JQuery hashchange plugin can be
     // used if this capability is important.
     initialValues['.clientdata_url_hash_initial'] = window.location.hash;
-    initialValues['.clientdata_url_hash'] = window.location.hash;
-
-    $(window).on('hashchange', function (e) {
-      inputs.setInput('.clientdata_url_hash', location.hash);
-    });
 
     // The server needs to know what singletons were rendered as part of
     // the page loading
@@ -5549,9 +5331,6 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
       }
     });
 
-    // IE8 and IE9 have some limitations with data URIs
-    initialValues['.clientdata_allowDataUriScheme'] = typeof WebSocket !== 'undefined';
-
     // We've collected all the initial values--start the server process!
     inputsNoResend.reset(initialValues);
     shinyapp.connect(initialValues);

man/NS.Rd

@@ -41,3 +41,4 @@ into a namespaced one, by combining them with \code{ns.sep} in between.
 \url{http://shiny.rstudio.com/articles/modules.html}
 }
 \keyword{datasets}
+

man/Progress.Rd

@@ -24,7 +24,8 @@ detail message (if any). The detail message will be shown with a
 de-emphasized appearance relative to \code{message}.}
 
 \item{value}{A numeric value at which to set
-the progress bar, relative to \code{min} and \code{max}.}
+the progress bar, relative to \code{min} and \code{max}.
+\code{NULL} hides the progress bar, if it is currently visible.}
 
 \item{style}{Progress display style. If \code{"notification"} (the default),
 the progress indicator will show using Shiny's notification API. If
@@ -111,3 +112,4 @@ shinyApp(ui, server)
 \code{\link{withProgress}}
 }
 \keyword{datasets}
+

man/absolutePanel.Rd

@@ -80,3 +80,4 @@ specify \code{0} for \code{top}, \code{left}, \code{right}, and \code{bottom}
 rather than the more obvious \code{width = "100\%"} and \code{height =
 "100\%"}.
 }
+

man/actionButton.Rd

@@ -56,7 +56,7 @@ shinyApp(ui, server)
 \seealso{
 \code{\link{observeEvent}} and \code{\link{eventReactive}}
 
-Other input elements: \code{\link{checkboxGroupInput}},
+Other input.elements: \code{\link{checkboxGroupInput}},
   \code{\link{checkboxInput}}, \code{\link{dateInput}},
   \code{\link{dateRangeInput}}, \code{\link{fileInput}},
   \code{\link{numericInput}}, \code{\link{passwordInput}},
@@ -64,3 +64,4 @@ Other input elements: \code{\link{checkboxGroupInput}},
   \code{\link{sliderInput}}, \code{\link{submitButton}},
   \code{\link{textAreaInput}}, \code{\link{textInput}}
 }
+

man/addResourcePath.Rd

@@ -8,7 +8,7 @@ addResourcePath(prefix, directoryPath)
 }
 \arguments{
 \item{prefix}{The URL prefix (without slashes). Valid characters are a-z,
-A-Z, 0-9, hyphen, period, and underscore.
+A-Z, 0-9, hyphen, period, and underscore; and must begin with a-z or A-Z.
 For example, a value of 'foo' means that any request paths that begin with
 '/foo' will be mapped to the given directory.}
 
@@ -32,3 +32,4 @@ addResourcePath('datasets', system.file('data', package='datasets'))
 \seealso{
 \code{\link{singleton}}
 }
+

man/applyInputHandlers.Rd

@@ -27,3 +27,4 @@ output.
 registerInputHandler
 }
 \keyword{internal}
+

man/bookmarkButton.Rd

@@ -70,3 +70,4 @@ shinyApp(ui, server)
 \seealso{
 \code{\link{enableBookmarking}} for more examples.
 }
+

man/bootstrapLib.Rd

@@ -21,3 +21,4 @@ It isn't necessary to call this function if you use
 \code{\link{pageWithSidebar}}, and \code{\link{navbarPage}}, because they
 already include the Bootstrap web dependencies.
 }
+

man/bootstrapPage.Rd

@@ -1,8 +1,8 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/bootstrap.R
 \name{bootstrapPage}
-\alias{bootstrapPage}
 \alias{basicPage}
+\alias{bootstrapPage}
 \title{Create a Bootstrap page}
 \usage{
 bootstrapPage(..., title = NULL, responsive = NULL, theme = NULL)
@@ -41,3 +41,4 @@ The \code{basicPage} function is deprecated, you should use the
 \seealso{
 \code{\link{fluidPage}}, \code{\link{fixedPage}}
 }
+

man/brushOpts.Rd

@@ -49,3 +49,4 @@ This generates an object representing brushing options, to be passed as the
 \code{brush} argument of \code{\link{imageOutput}} or
 \code{\link{plotOutput}}.
 }
+

man/brushedPoints.Rd

@@ -69,3 +69,4 @@ using just the x or y variable, whichever is appropriate.
 \seealso{
 \code{\link{plotOutput}} for example usage.
 }
+

man/callModule.Rd

@@ -29,3 +29,4 @@ modules are easier to reuse and easier to reason about. See the article at
 \seealso{
 \url{http://shiny.rstudio.com/articles/modules.html}
 }
+

man/checkboxGroupInput.Rd

@@ -4,8 +4,8 @@
 \alias{checkboxGroupInput}
 \title{Checkbox Group Input Control}
 \usage{
-checkboxGroupInput(inputId, label, choices = NULL, selected = NULL,
-  inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL)
+checkboxGroupInput(inputId, label, choices, selected = NULL, inline = FALSE,
+  width = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -13,9 +13,7 @@ checkboxGroupInput(inputId, label, choices = NULL, selected = NULL,
 \item{label}{Display label for the control, or \code{NULL} for no label.}
 
 \item{choices}{List of values to show checkboxes for. If elements of the list
-are named then that name rather than the value is displayed to the user. If
-this argument is provided, then \code{choiceNames} and \code{choiceValues}
-must not be provided, and vice-versa.}
+are named then that name rather than the value is displayed to the user.}
 
 \item{selected}{The values that should be initially selected, if any.}
 
@@ -23,16 +21,6 @@ must not be provided, and vice-versa.}
 
 \item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
 see \code{\link{validateCssUnit}}.}
-
-\item{choiceNames, choiceValues}{List of names and values, respectively,
-that are displayed to the user in the app and correspond to the each
-choice (for this reason, \code{choiceNames} and \code{choiceValues}
-must have the same length). If either of these arguments is
-provided, then the other \emph{must} be provided and \code{choices}
-\emph{must not} be provided. The advantage of using both of these over
-a named list for \code{choices} is that \code{choiceNames} allows any
-type of UI object to be passed through (tag objects, icons, HTML code,
-...), instead of just simple text. See Examples.}
 }
 \value{
 A list of HTML elements that can be added to a UI definition.
@@ -54,39 +42,19 @@ ui <- fluidPage(
   tableOutput("data")
 )
 
-server <- function(input, output, session) {
+server <- function(input, output) {
   output$data <- renderTable({
     mtcars[, c("mpg", input$variable), drop = FALSE]
   }, rownames = TRUE)
 }
 
-shinyApp(ui, server)
-
-ui <- fluidPage(
-  checkboxGroupInput("icons", "Choose icons:",
-    choiceNames =
-      list(icon("calendar"), icon("bed"),
-           icon("cog"), icon("bug")),
-    choiceValues =
-      list("calendar", "bed", "cog", "bug")
-  ),
-  textOutput("txt")
-)
-
-server <- function(input, output, session) {
-  output$txt <- renderText({
-    icons <- paste(input$icons, collapse = ", ")
-    paste("You chose", icons)
-  })
-}
-
 shinyApp(ui, server)
 }
 }
 \seealso{
 \code{\link{checkboxInput}}, \code{\link{updateCheckboxGroupInput}}
 
-Other input elements: \code{\link{actionButton}},
+Other input.elements: \code{\link{actionButton}},
   \code{\link{checkboxInput}}, \code{\link{dateInput}},
   \code{\link{dateRangeInput}}, \code{\link{fileInput}},
   \code{\link{numericInput}}, \code{\link{passwordInput}},
@@ -94,3 +62,4 @@ Other input elements: \code{\link{actionButton}},
   \code{\link{sliderInput}}, \code{\link{submitButton}},
   \code{\link{textAreaInput}}, \code{\link{textInput}}
 }
+

man/checkboxInput.Rd

@@ -39,7 +39,7 @@ shinyApp(ui, server)
 \seealso{
 \code{\link{checkboxGroupInput}}, \code{\link{updateCheckboxInput}}
 
-Other input elements: \code{\link{actionButton}},
+Other input.elements: \code{\link{actionButton}},
   \code{\link{checkboxGroupInput}},
   \code{\link{dateInput}}, \code{\link{dateRangeInput}},
   \code{\link{fileInput}}, \code{\link{numericInput}},
@@ -48,3 +48,4 @@ Other input elements: \code{\link{actionButton}},
   \code{\link{submitButton}}, \code{\link{textAreaInput}},
   \code{\link{textInput}}
 }
+

man/clickOpts.Rd

@@ -19,3 +19,4 @@ This generates an object representing click options, to be passed as the
 \code{click} argument of \code{\link{imageOutput}} or
 \code{\link{plotOutput}}.
 }
+

man/column.Rd

@@ -64,3 +64,4 @@ shinyApp(ui, server = function(input, output) { })
 \seealso{
 \code{\link{fluidRow}}, \code{\link{fixedRow}}.
 }
+

man/conditionalPanel.Rd

@@ -56,3 +56,4 @@ sidebarPanel(
    )
 )
 }
+

man/createWebDependency.Rd

@@ -21,3 +21,4 @@ served over Shiny's HTTP server. This function works by using
 \code{\link{addResourcePath}} to map the HTML dependency's directory to a
 URL.
 }
+

man/dateInput.Rd

@@ -97,7 +97,7 @@ shinyApp(ui, server = function(input, output) { })
 \seealso{
 \code{\link{dateRangeInput}}, \code{\link{updateDateInput}}
 
-Other input elements: \code{\link{actionButton}},
+Other input.elements: \code{\link{actionButton}},
   \code{\link{checkboxGroupInput}},
   \code{\link{checkboxInput}},
   \code{\link{dateRangeInput}}, \code{\link{fileInput}},
@@ -106,3 +106,4 @@ Other input elements: \code{\link{actionButton}},
   \code{\link{sliderInput}}, \code{\link{submitButton}},
   \code{\link{textAreaInput}}, \code{\link{textInput}}
 }
+

man/dateRangeInput.Rd

@@ -114,7 +114,7 @@ shinyApp(ui, server = function(input, output) { })
 \seealso{
 \code{\link{dateInput}}, \code{\link{updateDateRangeInput}}
 
-Other input elements: \code{\link{actionButton}},
+Other input.elements: \code{\link{actionButton}},
   \code{\link{checkboxGroupInput}},
   \code{\link{checkboxInput}}, \code{\link{dateInput}},
   \code{\link{fileInput}}, \code{\link{numericInput}},
@@ -123,3 +123,4 @@ Other input elements: \code{\link{actionButton}},
   \code{\link{submitButton}}, \code{\link{textAreaInput}},
   \code{\link{textInput}}
 }
+

man/dblclickOpts.Rd

@@ -23,3 +23,4 @@ This generates an object representing dobule-click options, to be passed as
 the \code{dblclick} argument of \code{\link{imageOutput}} or
 \code{\link{plotOutput}}.
 }
+

man/debounce.Rd

@@ -1,122 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/reactives.R
-\name{debounce}
-\alias{debounce}
-\alias{throttle}
-\title{Slow down a reactive expression with debounce/throttle}
-\usage{
-debounce(r, millis, priority = 100, domain = getDefaultReactiveDomain())
-
-throttle(r, millis, priority = 100, domain = getDefaultReactiveDomain())
-}
-\arguments{
-\item{r}{A reactive expression (that invalidates too often).}
-
-\item{millis}{The debounce/throttle time window. You may optionally pass a
-no-arg function or reactive expression instead, e.g. to let the end-user
-control the time window.}
-
-\item{priority}{Debounce/throttle is implemented under the hood using
-\link[=observe]{observers}. Use this parameter to set the priority of
-these observers. Generally, this should be higher than the priorities of
-downstream observers and outputs (which default to zero).}
-
-\item{domain}{See \link{domains}.}
-}
-\description{
-Transforms a reactive expression by preventing its invalidation signals from
-being sent unnecessarily often. This lets you ignore a very "chatty" reactive
-expression until it becomes idle, which is useful when the intermediate
-values don't matter as much as the final value, and the downstream
-calculations that depend on the reactive expression take a long time.
-\code{debounce} and \code{throttle} use different algorithms for slowing down
-invalidation signals; see Details.
-}
-\details{
-This is not a true debounce/throttle in that it will not prevent \code{r}
-from being called many times (in fact it may be called more times than
-usual), but rather, the reactive invalidation signal that is produced by
-\code{r} is debounced/throttled instead. Therefore, these functions should be
-used when \code{r} is cheap but the things it will trigger (downstream
-outputs and reactives) are expensive.
-
-Debouncing means that every invalidation from \code{r} will be held for the
-specified time window. If \code{r} invalidates again within that time window,
-then the timer starts over again. This means that as long as invalidations
-continually arrive from \code{r} within the time window, the debounced
-reactive will not invalidate at all. Only after the invalidations stop (or
-slow down sufficiently) will the downstream invalidation be sent.
-
-\code{ooo-oo-oo---- => -----------o-}
-
-(In this graphical depiction, each character represents a unit of time, and
-the time window is 3 characters.)
-
-Throttling, on the other hand, delays invalidation if the \emph{throttled}
-reactive recently (within the time window) invalidated. New \code{r}
-invalidations do not reset the time window. This means that if invalidations
-continually come from \code{r} within the time window, the throttled reactive
-will invalidate regularly, at a rate equal to or slower than than the time
-window.
-
-\code{ooo-oo-oo---- => o--o--o--o---}
-}
-\section{Limitations}{
-
-
-  Because R is single threaded, we can't come close to guaranteeing that the
-  timing of debounce/throttle (or any other timing-related functions in
-  Shiny) will be consistent or accurate; at the time we want to emit an
-  invalidation signal, R may be performing a different task and we have no
-  way to interrupt it (nor would we necessarily want to if we could).
-  Therefore, it's best to think of the time windows you pass to these
-  functions as minimums.
-
-  You may also see undesirable behavior if the amount of time spent doing
-  downstream processing for each change approaches or exceeds the time
-  window: in this case, debounce/throttle may not have any effect, as the
-  time each subsequent event is considered is already after the time window
-  has expired.
-}
-
-\examples{
-## Only run examples in interactive R sessions
-if (interactive()) {
-options(device.ask.default = FALSE)
-
-library(shiny)
-library(magrittr)
-
-ui <- fluidPage(
-  plotOutput("plot", click = clickOpts("hover")),
-  helpText("Quickly click on the plot above, while watching the result table below:"),
-  tableOutput("result")
-)
-
-server <- function(input, output, session) {
-  hover <- reactive({
-    if (is.null(input$hover))
-      list(x = NA, y = NA)
-    else
-      input$hover
-  })
-  hover_d <- hover \%>\% debounce(1000)
-  hover_t <- hover \%>\% throttle(1000)
-
-  output$plot <- renderPlot({
-    plot(cars)
-  })
-
-  output$result <- renderTable({
-    data.frame(
-      mode = c("raw", "throttle", "debounce"),
-      x = c(hover()$x, hover_t()$x, hover_d()$x),
-      y = c(hover()$y, hover_t()$y, hover_d()$y)
-    )
-  })
-}
-
-shinyApp(ui, server)
-}
-
-}

man/domains.Rd

@@ -3,9 +3,8 @@
 \name{domains}
 \alias{domains}
 \alias{getDefaultReactiveDomain}
-\alias{withReactiveDomain}
 \alias{onReactiveDomainEnded}
-\alias{domains}
+\alias{withReactiveDomain}
 \title{Reactive domains}
 \usage{
 getDefaultReactiveDomain()
@@ -52,3 +51,4 @@ as a convenience function for registering callbacks. If the reactive domain
 is \code{NULL} and \code{failIfNull} is \code{FALSE}, then the callback will
 never be invoked.
 }
+

man/downloadButton.Rd

@@ -3,7 +3,6 @@
 \name{downloadButton}
 \alias{downloadButton}
 \alias{downloadLink}
-\alias{downloadLink}
 \title{Create a download button or link}
 \usage{
 downloadButton(outputId, label = "Download", class = NULL, ...)
@@ -44,5 +43,6 @@ downloadLink('downloadData', 'Download')
 
 }
 \seealso{
-\code{\link{downloadHandler}}
+downloadHandler
 }
+

man/downloadHandler.Rd

@@ -61,3 +61,4 @@ server <- function(input, output) {
 shinyApp(ui, server)
 }
 }
+

man/enableBookmarking.Rd

@@ -228,3 +228,4 @@ shinyApp(ui, server)
 
   Also see \code{\link{updateQueryString}}.
 }
+

man/exportTestValues.Rd

@@ -68,3 +68,4 @@ shinyApp(
 )
 }
 }
+

man/exprToFunction.Rd

@@ -58,3 +58,4 @@ tripleA <- renderTriple({
 isolate(tripleA())
 # "text, text, text"
 }
+

man/fileInput.Rd

@@ -4,8 +4,7 @@
 \alias{fileInput}
 \title{File Upload Control}
 \usage{
-fileInput(inputId, label, multiple = FALSE, accept = NULL, width = NULL,
-  buttonLabel = "Browse...", placeholder = "No file selected")
+fileInput(inputId, label, multiple = FALSE, accept = NULL, width = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -21,11 +20,6 @@ what kind of files the server is expecting.}
 
 \item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
 see \code{\link{validateCssUnit}}.}
-
-\item{buttonLabel}{The label used on the button. Can be text or an HTML tag
-object.}
-
-\item{placeholder}{The text to show before a file has been uploaded.}
 }
 \description{
 Create a file upload control that can be used to upload one or more files.
@@ -90,7 +84,7 @@ shinyApp(ui, server)
 }
 }
 \seealso{
-Other input elements: \code{\link{actionButton}},
+Other input.elements: \code{\link{actionButton}},
   \code{\link{checkboxGroupInput}},
   \code{\link{checkboxInput}}, \code{\link{dateInput}},
   \code{\link{dateRangeInput}}, \code{\link{numericInput}},
@@ -99,3 +93,4 @@ Other input elements: \code{\link{actionButton}},
   \code{\link{submitButton}}, \code{\link{textAreaInput}},
   \code{\link{textInput}}
 }
+

man/fillPage.Rd

@@ -81,3 +81,4 @@ fillPage(
   )
 )
 }
+

man/fillRow.Rd

@@ -1,8 +1,8 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/bootstrap-layout.R
 \name{fillRow}
-\alias{fillRow}
 \alias{fillCol}
+\alias{fillRow}
 \title{Flex Box-based row/column layouts}
 \usage{
 fillRow(..., flex = 1, width = "100\%", height = "100\%")
@@ -75,3 +75,4 @@ shinyApp(ui, server)
 
 }
 }
+

man/fixedPage.Rd

@@ -68,3 +68,4 @@ shinyApp(ui, server = function(input, output) { })
 \seealso{
 \code{\link{column}}
 }
+

man/flowLayout.Rd

@@ -34,3 +34,4 @@ shinyApp(ui, server = function(input, output) { })
 \seealso{
 \code{\link{verticalLayout}}
 }
+

man/fluidPage.Rd

@@ -102,3 +102,4 @@ shinyApp(ui, server = function(input, output) { })
 \seealso{
 \code{\link{column}}, \code{\link{sidebarLayout}}
 }
+

man/freezeReactiveValue.Rd

@@ -1,24 +1,18 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/reactives.R
-\name{freezeReactiveVal}
-\alias{freezeReactiveVal}
+\name{freezeReactiveValue}
 \alias{freezeReactiveValue}
 \title{Freeze a reactive value}
 \usage{
-freezeReactiveVal(x)
-
 freezeReactiveValue(x, name)
 }
 \arguments{
-\item{x}{For \code{freezeReactiveValue}, a \code{\link{reactiveValues}}
-object (like \code{input}); for \code{freezeReactiveVal}, a
-\code{\link{reactiveVal}} object.}
+\item{x}{A \code{\link{reactiveValues}} object (like \code{input}).}
 
 \item{name}{The name of a value in the \code{\link{reactiveValues}} object.}
 }
 \description{
-These functions freeze a \code{\link{reactiveVal}}, or an element of a
-\code{\link{reactiveValues}}. If the value is accessed while frozen, a
+This freezes a reactive value. If the value is accessed while frozen, a
 "silent" exception is raised and the operation is stopped. This is the same
 thing that happens if \code{req(FALSE)} is called. The value is thawed
 (un-frozen; accessing it will no longer raise an exception) when the current
@@ -64,3 +58,4 @@ shinyApp(ui, server)
 \seealso{
 \code{\link{req}}
 }
+

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

@@ -1,93 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/history.R
-\name{getQueryString}
-\alias{getQueryString}
-\alias{getUrlHash}
-\title{Get the query string / hash component from the URL}
-\usage{
-getQueryString(session = getDefaultReactiveDomain())
-
-getUrlHash(session = getDefaultReactiveDomain())
-}
-\arguments{
-\item{session}{A Shiny session object.}
-}
-\value{
-For \code{getQueryString}, a named list. For example, the query
-  string \code{?param1=value1&param2=value2} becomes \code{list(param1 =
-  value1, param2 = value2)}. For \code{getUrlHash}, a character vector with
-  the hash (including the leading \code{#} symbol).
-}
-\description{
-Two user friendly wrappers for getting the query string and the hash
-component from the app's URL.
-}
-\details{
-These can be particularly useful if you want to display different content
-depending on the values in the query string / hash (e.g. instead of basing
-the conditional on an input or a calculated reactive, you can base it on the
-query string). However, note that, if you're changing the query string / hash
-programatically from within the server code, you must use
-\code{updateQueryString(_yourNewQueryString_, mode = "push")}. The default
-\code{mode} for \code{updateQueryString} is \code{"replace"}, which doesn't
-raise any events, so any observers or reactives that depend on it will
-\emph{not} get triggered. However, if you're changing the query string / hash
-directly by typing directly in the browser and hitting enter, you don't have
-to worry about this.
-}
-\examples{
-## Only run this example in interactive R sessions
-if (interactive()) {
-
-  ## App 1: getQueryString
-  ## Printing the value of the query string
-  ## (Use the back and forward buttons to see how the browser
-  ## keeps a record of each state)
-  shinyApp(
-    ui = fluidPage(
-      textInput("txt", "Enter new query string"),
-      helpText("Format: ?param1=val1&param2=val2"),
-      actionButton("go", "Update"),
-      hr(),
-      verbatimTextOutput("query")
-    ),
-    server = function(input, output, session) {
-      observeEvent(input$go, {
-        updateQueryString(input$txt, mode = "push")
-      })
-      output$query <- renderText({
-        query <- getQueryString()
-        queryText <- paste(names(query), query,
-                       sep = "=", collapse=", ")
-        paste("Your query string is:\\n", queryText)
-      })
-    }
-  )
-
-  ## App 2: getUrlHash
-  ## Printing the value of the URL hash
-  ## (Use the back and forward buttons to see how the browser
-  ## keeps a record of each state)
-  shinyApp(
-    ui = fluidPage(
-      textInput("txt", "Enter new hash"),
-      helpText("Format: #hash"),
-      actionButton("go", "Update"),
-      hr(),
-      verbatimTextOutput("hash")
-    ),
-    server = function(input, output, session) {
-      observeEvent(input$go, {
-        updateQueryString(input$txt, mode = "push")
-      })
-      output$hash <- renderText({
-        hash <- getUrlHash()
-        paste("Your hash is:\\n", hash)
-      })
-    }
-  )
-}
-}
-\seealso{
-\code{\link{updateQueryString}}
-}

man/headerPanel.Rd

@@ -21,3 +21,4 @@ Create a header panel containing an application title.
 \examples{
 headerPanel("Hello Shiny!")
 }
+

man/helpText.Rd

@@ -21,3 +21,4 @@ helpText("Note: while the data view will show only",
          "the specified number of observations, the",
          "summary will be based on the full dataset.")
 }
+

man/hoverOpts.Rd

@@ -33,3 +33,4 @@ This generates an object representing hovering options, to be passed as the
 \code{hover} argument of \code{\link{imageOutput}} or
 \code{\link{plotOutput}}.
 }
+

man/htmlOutput.Rd

@@ -42,3 +42,4 @@ tags$ul(
   htmlOutput("summary", container = tags$li, class = "custom-li-output")
 )
 }
+

man/icon.Rd

@@ -47,3 +47,4 @@ For lists of available icons, see
   \href{http://fontawesome.io/icons/}{http://fontawesome.io/icons/} and
   \href{http://getbootstrap.com/components/#glyphicons}{http://getbootstrap.com/components/#glyphicons}.
 }
+

man/inputPanel.Rd

@@ -13,3 +13,4 @@ inputPanel(...)
 A \code{\link{flowLayout}} with a grey border and light grey background,
 suitable for wrapping inputs.
 }
+

man/insertUI.Rd

@@ -86,3 +86,4 @@ shinyApp(ui, server)
 \seealso{
 \code{\link{removeUI}}
 }
+

man/installExprFunction.Rd

@@ -40,3 +40,4 @@ function named \code{func} in the current environment.
 Wraps \code{\link{exprToFunction}}; see that method's documentation
   for more documentation and examples.
 }
+

man/invalidateLater.Rd

@@ -63,3 +63,4 @@ shinyApp(ui, server)
 \seealso{
 \code{\link{reactiveTimer}} is a slightly less safe alternative.
 }
+

man/is.reactivevalues.Rd

@@ -15,3 +15,4 @@ Checks whether its argument is a reactivevalues object.
 \seealso{
 \code{\link{reactiveValues}}.
 }
+