remove call to validateselected

Make fileInput text customizable. Closes #1617

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 1.0.0
+Version: 1.0.0.9001
 Authors@R: c(
     person("Winston", "Chang", role = c("aut", "cre"), email = "winston@rstudio.com"),
     person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"),
@@ -98,6 +98,9 @@ Collate:
     'diagnose.R'
     'fileupload.R'
     'graph.R'
+    'reactives.R'
+    'reactive-domains.R'
+    'history.R'
     'hooks.R'
     'html-deps.R'
     'htmltools.R'
@@ -129,8 +132,6 @@ Collate:
     'priorityqueue.R'
     'progress.R'
     'react.R'
-    'reactive-domains.R'
-    'reactives.R'
     'render-plot.R'
     'render-table.R'
     'run-url.R'
@@ -146,4 +147,4 @@ Collate:
     'test-export.R'
     'timer.R'
     'update-input.R'
-RoxygenNote: 5.0.1
+RoxygenNote: 6.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/brianreavis/selectize.js
+- selectize.js, https://github.com/selectize/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

@@ -2,24 +2,18 @@
 
 S3method("$",reactivevalues)
 S3method("$",session_proxy)
-S3method("$",shinyapi)
 S3method("$",shinyoutput)
 S3method("$<-",reactivevalues)
 S3method("$<-",session_proxy)
-S3method("$<-",shinyapi)
 S3method("$<-",shinyoutput)
 S3method("[",reactivevalues)
-S3method("[",shinyapi)
 S3method("[",shinyoutput)
 S3method("[<-",reactivevalues)
-S3method("[<-",shinyapi)
 S3method("[<-",shinyoutput)
 S3method("[[",reactivevalues)
 S3method("[[",session_proxy)
-S3method("[[",shinyapi)
 S3method("[[",shinyoutput)
 S3method("[[<-",reactivevalues)
-S3method("[[<-",shinyapi)
 S3method("[[<-",shinyoutput)
 S3method("names<-",reactivevalues)
 S3method(as.list,reactivevalues)
@@ -92,7 +86,9 @@ export(fluidRow)
 export(formatStackTrace)
 export(freezeReactiveValue)
 export(getDefaultReactiveDomain)
+export(getQueryString)
 export(getShinyOption)
+export(getUrlHash)
 export(h1)
 export(h2)
 export(h3)
@@ -200,11 +196,6 @@ export(runUrl)
 export(safeError)
 export(selectInput)
 export(selectizeInput)
-export(serveCSV)
-export(serveJSON)
-export(servePlot)
-export(serveRaw)
-export(serveText)
 export(serverInfo)
 export(setBookmarkExclude)
 export(setProgress)
@@ -222,6 +213,7 @@ export(sidebarLayout)
 export(sidebarPanel)
 export(singleton)
 export(sliderInput)
+export(snapshotExclude)
 export(span)
 export(splitLayout)
 export(stopApp)
@@ -278,4 +270,3 @@ import(httpuv)
 import(methods)
 import(mime)
 import(xtable)
-importFrom(utils,write.csv)

NEWS.md

@@ -1,3 +1,64 @@
+shiny 1.0.0.9001
+================
+
+## 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
+
+### Minor new features and improvements
+
+* 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))
+
+### 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
 ===========
 

R/bookmark-state.R

@@ -342,10 +342,26 @@ RestoreContext <- R6Class("RestoreContext",
       }
 
 
-      inputs <- parseQueryStringJSON(inputStr, nested = TRUE)
-      values <- parseQueryStringJSON(valueStr, nested = TRUE)
+      inputs <- parseQueryString(inputStr, nested = TRUE)
+      values <- parseQueryString(valueStr, nested = TRUE)
 
+      valuesFromJSON <- function(vals) {
+        mapply(names(vals), vals, SIMPLIFY = FALSE,
+          FUN = function(name, value) {
+            tryCatch(
+              jsonlite::fromJSON(value),
+              error = function(e) {
+                stop("Failed to parse URL parameter \"", name, "\"")
+              }
+            )
+          }
+        )
+      }
+
+      inputs <- valuesFromJSON(inputs)
       self$input <- RestoreInputSet$new(inputs)
+
+      values <- valuesFromJSON(values)
       self$values <- list2env2(values, self$values)
     }
   )
@@ -477,12 +493,90 @@ 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}} for examples.
+#' @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)
+#'       })
+#'     }
+#'   )
+#' }
 #' @export
-updateQueryString <- function(queryString, session = getDefaultReactiveDomain()) {
-  session$updateQueryString(queryString)
+updateQueryString <- function(queryString, mode = c("replace", "push"),
+                              session = getDefaultReactiveDomain()) {
+  mode <- match.arg(mode)
+  session$updateQueryString(queryString, mode)
 }
 
 #' Create a button for bookmarking/sharing

R/bootstrap.R

@@ -1453,7 +1453,7 @@ uiOutput <- htmlOutput
 #' }
 #'
 #' @aliases downloadLink
-#' @seealso downloadHandler
+#' @seealso \code{\link{downloadHandler}}
 #' @export
 downloadButton <- function(outputId,
                            label="Download",

R/history.R

@@ -0,0 +1,95 @@
+
+#' @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,9 +6,21 @@
 #'
 #' @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.
+#'   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.
 #' @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
@@ -26,26 +38,47 @@
 #'   tableOutput("data")
 #' )
 #'
-#' server <- function(input, output) {
+#' server <- function(input, output, session) {
 #'   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, selected = NULL,
-  inline = FALSE, width = NULL) {
+checkboxGroupInput <- function(inputId, label, choices = NULL, selected = NULL,
+  inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL) {
+
+  args <- normalizeChoicesArgs(choices, choiceNames, choiceValues)
 
   selected <- restoreInput(id = inputId, default = selected)
 
-  # resolve names
-  choices <- choicesWithNames(choices)
-  if (!is.null(selected))
-    selected <- validateSelected(selected, choices, inputId)
+  # default value if it's not specified
+  if (!is.null(selected)) selected <- as.character(selected)
 
-  options <- generateOptions(inputId, choices, selected, inline)
+  options <- generateOptions(inputId, selected, inline,
+    'checkbox', args$choiceNames, args$choiceValues)
 
   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-weekstart` = weekstart,
+          `data-date-week-start` = 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-weekstart` = weekstart,
+          `data-date-week-start` = weekstart,
           `data-date-format` = format,
           `data-date-start-view` = startview,
           `data-min-date` = min,

R/input-file.R

@@ -27,6 +27,9 @@
 #'   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
@@ -70,7 +73,7 @@
 #' }
 #' @export
 fileInput <- function(inputId, label, multiple = FALSE, accept = NULL,
-  width = NULL) {
+  width = NULL, buttonLabel = "Browse...", placeholder = "No file selected") {
 
   restoredValue <- restoreInput(id = inputId, default = NULL)
 
@@ -105,12 +108,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",
-          "Browse...",
+          buttonLabel,
           inputTag
         )
       ),
       tags$input(type = "text", class = "form-control",
-        placeholder = "No file selected", readonly = "readonly"
+        placeholder = placeholder, readonly = "readonly"
       )
     ),
 

R/input-radiobuttons.R

@@ -11,11 +11,22 @@
 #'
 #' @inheritParams textInput
 #' @param choices List of values to select from (if elements of the list are
-#' named then that name rather than the value is displayed to the user)
+#'   named then that name rather than the value is displayed to the user). If
+#'   this argument is provided, then \code{choiceNames} and \code{choiceValues}
+#'   must not be provided, and vice-versa.
 #' @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}}
@@ -47,27 +58,46 @@
 #' }
 #'
 #' 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, selected = NULL,
-  inline = FALSE, width = NULL) {
+radioButtons <- function(inputId, label, choices = NULL, selected = NULL,
+  inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL) {
 
-  # resolve names
-  choices <- choicesWithNames(choices)
+  args <- normalizeChoicesArgs(choices, choiceNames, choiceValues)
 
   selected <- restoreInput(id = inputId, default = selected)
 
   # default value if it's not specified
-  selected <- if (is.null(selected)) choices[[1]] else {
-    validateSelected(selected, choices, inputId)
-  }
+  selected <- if (is.null(selected)) args$choiceValues[[1]] else as.character(selected)
+
   if (length(selected) > 1) stop("The 'selected' argument must be of length 1")
 
-  options <- generateOptions(inputId, choices, selected, inline, type = 'radio')
+  options <- generateOptions(inputId, selected, inline,
+    'radio', args$choiceNames, args$choiceValues)
 
   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/brianreavis/selectize.js}) to instead of the basic
+#' (\url{https://github.com/selectize/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 <- validateSelected(selected, choices, inputId)
+  } else selected <- as.character(selected)
 
   if (!is.null(size) && selectize) {
     stop("'size' argument is incompatible with 'selectize=TRUE'.")

R/input-slider.R

@@ -164,23 +164,21 @@ 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,
-    `data-drag-interval` = dragRange,
+    # 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,
     # 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"
@@ -220,7 +218,7 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
   }
 
   dep <- list(
-    htmlDependency("ionrangeslider", "2.1.2", c(href="shared/ionrangeslider"),
+    htmlDependency("ionrangeslider", "2.1.6", 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,45 +2,62 @@ controlLabel <- function(controlName, label) {
   label %AND% tags$label(class = "control-label", `for` = controlName, label)
 }
 
-
-# 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, "'")
+# 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)
   }
-  selected
-}
 
+  return(list(choiceNames = as.list(choiceNames),
+              choiceValues = as.list(as.character(choiceValues))))
+}
 
 # generate options for radio buttons and checkbox groups (type = 'checkbox' or
 # 'radio')
-generateOptions <- function(inputId, choices, selected, inline, type = 'checkbox') {
+generateOptions <- function(inputId, selected, inline, type = 'checkbox',
+                            choiceNames, choiceValues,
+                            session = getDefaultReactiveDomain()) {
   # generate a list of <input type=? [checked] />
   options <- mapply(
-    choices, names(choices),
+    choiceValues, choiceNames,
     FUN = function(value, name) {
       inputTag <- tags$input(
         type = type, name = inputId, value = value
@@ -48,14 +65,18 @@ generateOptions <- function(inputId, choices, 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(name))
+        tags$label(class = paste0(type, "-inline"), inputTag,
+                   tags$span(pd$html, pd$dep))
       } else {
-        tags$div(class = type,
-          tags$label(inputTag, tags$span(name))
-        )
+        tags$div(class = type, tags$label(inputTag,
+                 tags$span(pd$html, pd$dep)))
       }
     },
     SIMPLIFY = FALSE, USE.NAMES = FALSE

R/middleware-shiny.R

@@ -41,229 +41,3 @@ sessionHandler <- function(req) {
     shinysession$handleRequest(subreq)
   })
 }
-
-apiHandler <- function(serverFuncSource) {
-  function(req) {
-    path <- req$PATH_INFO
-    if (is.null(path))
-      return(NULL)
-
-    matches <- regmatches(path, regexec('^/api/(.*)$', path))
-    if (length(matches[[1]]) == 0)
-      return(NULL)
-
-    apiName <- matches[[1]][2]
-
-    sharedSecret <- getOption('shiny.sharedSecret')
-    if (!is.null(sharedSecret)
-      && !identical(sharedSecret, req$HTTP_SHINY_SHARED_SECRET)) {
-      stop("Incorrect shared secret")
-    }
-
-    if (!is.null(getOption("shiny.observer.error", NULL))) {
-      warning(
-        call. = FALSE,
-        "options(shiny.observer.error) is no longer supported; please unset it!"
-      )
-      stopApp()
-    }
-
-    # need to give a fake websocket to the session
-    ws <- list(
-      request = req,
-      sendMessage = function(...) {
-        #print(list(...))
-      }
-    )
-
-    # Accept JSON query string and/or JSON body as input values
-    inputVals <- c(
-      parseQueryStringJSON(req$QUERY_STRING),
-      parseJSONBody(req)
-    )
-
-    shinysession <- ShinySession$new(ws)
-    on.exit({
-      try({
-        # Clean up the session. Very important, so that observers
-        # and such don't hang around, and to let memory get gc'd.
-        shinysession$wsClosed()
-        appsByToken$remove(shinysession$token)
-      })
-    }, add = TRUE)
-    appsByToken$set(shinysession$token, shinysession)
-    shinysession$setShowcase(.globals$showcaseDefault)
-
-    serverFunc <- withReactiveDomain(NULL, serverFuncSource())
-
-    tryCatch({
-      withReactiveDomain(shinysession, {
-        shinysession$manageInputs(inputVals)
-        do.call(serverFunc, argsForServerFunc(serverFunc, shinysession))
-        result <- NULL
-        shinysession$enableApi(apiName, function(value) {
-          result <<- try(withLogErrors(value), silent = TRUE)
-        })
-        flushReact()
-        resultToResponse(result)
-      })
-    }, error = function(e) {
-      return(httpResponse(
-        status=500,
-        content=htmlEscape(conditionMessage(e))
-      ))
-    })
-  }
-}
-
-apiWsHandler <- function(serverFuncSource) {
-  function(ws) {
-    path <- ws$request$PATH_INFO
-    if (is.null(path))
-      return(NULL)
-
-    matches <- regmatches(path, regexec('^/api/(.*)$', path))
-    if (length(matches[[1]]) == 0)
-      return(NULL)
-
-    apiName <- matches[[1]][2]
-
-    sharedSecret <- getOption('shiny.sharedSecret')
-    if (!is.null(sharedSecret)
-      && !identical(sharedSecret, ws$request$HTTP_SHINY_SHARED_SECRET)) {
-      ws$close()
-      return(TRUE)
-    }
-
-    if (!is.null(getOption("shiny.observer.error", NULL))) {
-      warning(
-        call. = FALSE,
-        "options(shiny.observer.error) is no longer supported; please unset it!"
-      )
-      stopApp()
-    }
-
-    inputVals <- parseQueryStringJSON(ws$request$QUERY_STRING)
-
-    # Give a fake websocket to suppress messages from session
-    shinysession <- ShinySession$new(list(
-      request = ws$request,
-      sendMessage = function(...) {
-        #print(list(...))
-      }
-    ))
-    appsByToken$set(shinysession$token, shinysession)
-    shinysession$setShowcase(.globals$showcaseDefault)
-
-    serverFunc <- withReactiveDomain(NULL, serverFuncSource())
-
-    tryCatch({
-      withReactiveDomain(shinysession, {
-        shinysession$manageInputs(inputVals)
-        do.call(serverFunc, argsForServerFunc(serverFunc, shinysession))
-        shinysession$enableApi(apiName, function(value) {
-          resp <- resultToResponse(value)
-          if (resp$status != 200L) {
-            warning("Error: ", responseToContent(resp))
-            ws$close()
-          } else {
-            content <- responseToContent(resp)
-            if (grepl("^image/", resp$content_type)) {
-              content <- paste0("data:", resp$content_type, ";base64,",
-                httpuv::rawToBase64(content))
-            }
-            try(ws$send(content), silent=TRUE)
-          }
-        })
-        flushReact()
-      })
-    }, error = function(e) {
-      ws$close()
-    })
-
-    ws$onClose(function() {
-      # Clean up the session. Very important, so that observers
-      # and such don't hang around, and to let memory get gc'd.
-      shinysession$wsClosed()
-      appsByToken$remove(shinysession$token)
-    })
-
-    # TODO: What to do on ws$onMessage?
-  }
-}
-
-parseJSONBody <- function(req) {
-  if (identical(req[["REQUEST_METHOD"]], "POST")) {
-    if (isTRUE(grepl(perl=TRUE, "^(text|application)/json(;\\s*charset\\s*=\\s*utf-8)?$", req[["HTTP_CONTENT_TYPE"]]))) {
-      tmp <- file("", "w+b")
-      on.exit(close(tmp))
-
-      input_file <- req[["rook.input"]]
-      while (TRUE) {
-        chunk <- input_file$read(8192L)
-        if (length(chunk) == 0)
-          break
-        writeBin(chunk, tmp)
-      }
-
-      return(jsonlite::fromJSON(tmp))
-    }
-
-    if (is.null(req[["HTTP_CONTENT_TYPE"]])) {
-      if (!is.null(req[["rook.input"]]) && length(req[["rook.input"]]$read(1L)) > 0) {
-        stop("Invalid POST request (body provided without content type)")
-      }
-      return()
-    }
-
-    stop("Invalid POST request (content type not supported)")
-  }
-}
-
-resultToResponse <- function(result) {
-  if (inherits(result, "httpResponse")) {
-    return(result)
-  } else if (inherits(result, "try-error")) {
-    return(httpResponse(
-      status=500,
-      content_type="text/plain",
-      content=conditionMessage(attr(result, "condition"))
-    ))
-  } else if (!is.null(attr(result, "content.type"))) {
-    return(httpResponse(
-      status=200L,
-      content_type=attr(result, "content.type"),
-      content=result
-    ))
-  } else {
-    return(httpResponse(
-      status=200L,
-      content_type="application/json",
-      content=toJSON(result, pretty=TRUE)
-    ))
-  }
-}
-
-responseToContent <- function(result) {
-  ct <- result$content_type
-  textMode <- grepl("^text/", ct) || ct == "application/json" ||
-    grepl("^application/xml($|\\+)", ct)
-
-  # TODO: Make sure text is UTF-8
-
-  if ("file" %in% names(result$content)) {
-    filename <- result$content$file
-    if ("owned" %in% names(result$content) && result$content$owned) {
-      on.exit(unlink(filename), add = TRUE)
-    }
-    if (textMode)
-      return(paste(readLines(filename), collapse = "\n"))
-    else
-      return(readBin(filename, raw(), file.info(filename)$size))
-  } else {
-    if (textMode)
-      return(paste(result$content, collapse = "\n"))
-    else
-      return(result$content)
-  }
-}

R/middleware.R

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

R/progress.R

@@ -55,7 +55,6 @@
 #'   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
@@ -98,7 +97,6 @@
 #' @export
 Progress <- R6Class(
   'Progress',
-  portable = TRUE,
   public = list(
 
     initialize = function(session = getDefaultReactiveDomain(),
@@ -112,8 +110,8 @@ Progress <- R6Class(
       private$id <- createUniqueId(8)
       private$min <- min
       private$max <- max
-      private$style <- match.arg(style, choices = c("notification", "old"))
       private$value <- NULL
+      private$style <- match.arg(style, choices = c("notification", "old"))
       private$closed <- FALSE
 
       session$sendProgress('open', list(id = private$id, style = private$style))
@@ -125,15 +123,15 @@ Progress <- R6Class(
         return()
       }
 
-      if (is.null(value) || is.na(value)) {
+      if (is.null(value) || is.na(value))
         value <- NULL
-      } else {
+
+      if (!is.null(value)) {
+        private$value <- value
         # 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,
@@ -142,11 +140,14 @@ Progress <- R6Class(
         style = private$style
       ))
 
-       private$session$sendProgress('update', data)
+      private$session$sendProgress('update', data)
     },
 
     inc = function(amount = 0.1, message = NULL, detail = NULL) {
-      value <- min(self$getValue() + amount, private$max)
+      if (is.null(private$value))
+        private$value <- private$min
+
+      value <- min(private$value + amount, private$max)
       self$set(value, message, detail)
     },
 
@@ -154,10 +155,7 @@ Progress <- R6Class(
 
     getMax = function() private$max,
 
-    # Return value (not the normalized 0-1 value, but in the original range)
-    getValue = function() {
-      private$value * (private$max - private$min) + private$min
-    },
+    getValue = function() private$value,
 
     close = function() {
       if (private$closed) {
@@ -173,12 +171,12 @@ Progress <- R6Class(
   ),
 
   private = list(
-    session = 'environment',
+    session = 'ShinySession',
     id = character(0),
     min = numeric(0),
     max = numeric(0),
     style = character(0),
-    value = NULL,
+    value = numeric(0),
     closed = logical(0)
   )
 )
@@ -239,8 +237,7 @@ 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}. \code{NULL} hides the
-#'   progress bar, if it is currently visible.
+#'   progress bar, relative to \code{min} and \code{max}.
 #'
 #' @examples
 #' ## Only run examples in interactive R sessions

R/render-plot.R

@@ -287,17 +287,30 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
 #   .. ..$ y: NULL
 #   ..$ mapping: Named list()
 #
-# For ggplot2, it might be something like:
-# p <- ggplot(mtcars, aes(wt, mpg)) + geom_point()
-# str(getGgplotCoordmap(p, 1))
+# 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))
 # 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
@@ -320,8 +333,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 <- ggplot(mtcars, aes(wt, mpg)) + geom_point() + facet_wrap(~ am)
-# str(getGgplotCoordmap(p, 1))
+# p <- print(ggplot(mtc, aes(wt, mpg)) + geom_point() + facet_wrap(~ am))
+# str(getGgplotCoordmap(p, 1, 72))
 # List of 2
 #  $ :List of 10
 #   ..$ panel     : int 1
@@ -329,8 +342,6 @@ 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
@@ -354,8 +365,6 @@ 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
@@ -418,81 +427,189 @@ 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.
-  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))
+  layout <- ggplot2::summarise_layout(b)
+  coord  <- ggplot2::summarise_coord(b)
+  layers <- ggplot2::summarise_layers(b)
 
-    # 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))
+  # 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_
       }
     }
 
-    # 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
-      )
-    })
+    # 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
+    )
   }
 
+  # 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 (new_ggplot) {
+    if (ggplot_format == "new") {
       range <- b$layout$panel_ranges[[panel_num]]
     } else {
       range <- b$panel$ranges[[panel_num]]
@@ -505,7 +622,7 @@ getGgplotCoordmap <- function(p, pixelratio, res) {
     )
 
     # Check for reversed scales
-    if (new_ggplot) {
+    if (ggplot_format == "new") {
       xscale <- b$layout$panel_scales$x[[scalex_num]]
       yscale <- b$layout$panel_scales$y[[scaley_num]]
     } else {
@@ -546,7 +663,7 @@ getGgplotCoordmap <- function(p, pixelratio, res) {
     y_names <- character(0)
 
     # Continuous scales have a trans; discrete ones don't
-    if (new_ggplot) {
+    if (ggplot_format == "new") {
       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))
@@ -620,129 +737,220 @@ getGgplotCoordmap <- function(p, pixelratio, res) {
     mappings
   }
 
-  # 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"
-      }
+  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))
+
+  # 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, ]
 
-  tryCatch({
-    # Get info from built ggplot object
-    info <- find_panel_info(p$build)
+    scale_x <- l$SCALE_X
+    scale_y <- l$SCALE_Y
 
-    # 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)
+    mapping <- find_plot_mappings(b)
 
-    for (i in seq_along(info)) {
-      info[[i]]$range <- ranges[[i]]
+    # 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]]
     }
 
-    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))
+    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
+    )
   })
 }

R/server.R

@@ -189,7 +189,6 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
   appHandlers <- list(
     http = joinHandlers(c(
       sessionHandler,
-      apiHandler(serverFuncSource),
       httpHandlers,
       sys.www.root,
       resourcePathHandler,
@@ -201,11 +200,6 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
         return(TRUE)
       }
 
-      if (grepl("^/api/", ws$request$PATH_INFO)) {
-        apiWsHandler(serverFuncSource)(ws)
-        return(TRUE)
-      }
-
       if (!is.null(getOption("shiny.observer.error", NULL))) {
         warning(
           call. = FALSE,

R/shiny.R

@@ -201,12 +201,13 @@ workerId <- local({
 #'     }
 #'     \item{\code{singletons} - for internal use}
 #'     \item{\code{url_protocol}, \code{url_hostname}, \code{url_port},
-#'       \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{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{clientData} also contains information about each output.
@@ -374,12 +375,24 @@ 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)) {
-    function(id) {
-      paste(c(namespace, id), collapse = ns.sep)
-    }
+    f
   } else {
-    paste(c(namespace, id), collapse = ns.sep)
+    f(id)
   }
 }
 
@@ -405,7 +418,6 @@ ShinySession <- R6Class(
     fileUploadContext = 'FileUploadContext',
     .input      = 'ANY', # Internal ReactiveValues object for normal input sent from client
     .clientData = 'ANY', # Internal ReactiveValues object for other data sent from the client
-    apiObservers = list(),
     busyCount = 0L, # Number of observer callbacks that are pending. When 0, we are idle
     closedCallbacks = 'Callbacks',
     flushCallbacks = 'Callbacks',
@@ -416,6 +428,7 @@ 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(),
@@ -580,6 +593,16 @@ 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)
@@ -629,6 +652,12 @@ 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)
           }
 
@@ -690,7 +719,6 @@ ShinySession <- R6Class(
     progressStack = 'Stack', # Stack of progress objects
     input       = 'reactivevalues', # Externally-usable S3 wrapper object for .input
     output      = 'ANY',    # Externally-usable S3 wrapper object for .outputs
-    api         = 'ANY',    # Externally-usable S3 wrapper object for APIs
     clientData  = 'reactivevalues', # Externally-usable S3 wrapper object for .clientData
     token = 'character',  # Used to identify this instance in URLs
     files = 'Map',        # For keeping track of files sent to client
@@ -727,7 +755,6 @@ ShinySession <- R6Class(
       .setLabel(self$clientData, 'clientData')
 
       self$output <- .createOutputWriter(self)
-      self$api <- .createApiWriter(self)
 
       self$token <- createUniqueId(16)
       private$.outputs <- list()
@@ -760,7 +787,8 @@ ShinySession <- R6Class(
       private$sendMessage(
         config = list(
           workerId = workerId(),
-          sessionId = self$token
+          sessionId = self$token,
+          user = self$user
         )
       )
     },
@@ -828,7 +856,7 @@ ShinySession <- R6Class(
           if (anyUnnamed(dots))
             stop("exportTestValues: all arguments must be named.")
 
-          names(dots) <- vapply(names(dots), ns, character(1))
+          names(dots) <- ns(names(dots))
 
           do.call(
             .subset2(self, "exportTestValues"),
@@ -942,6 +970,12 @@ 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) {
@@ -1025,6 +1059,10 @@ 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
@@ -1102,6 +1140,12 @@ 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)
         })
@@ -1263,8 +1307,12 @@ ShinySession <- R6Class(
       private$bookmarkExclude <- names
     },
     getBookmarkExclude = function() {
-      private$bookmarkExclude
+      scopedExcludes <- lapply(private$getBookmarkExcludeFuns, function(f) f())
+      scopedExcludes <- unlist(scopedExcludes)
+
+      c(private$bookmarkExclude, scopedExcludes)
     },
+
     onBookmark = function(fun) {
       if (!is.function(fun) || length(fun) != 1) {
         stop("`fun` must be a function that takes one argument")
@@ -1405,8 +1453,9 @@ ShinySession <- R6Class(
         )
       )
     },
-    updateQueryString = function(queryString) {
-      private$sendMessage(updateQueryString = list(queryString = queryString))
+    updateQueryString = function(queryString, mode) {
+      private$sendMessage(updateQueryString = list(
+        queryString = queryString, mode = mode))
     },
     resetBrush = function(brushId) {
       private$sendMessage(
@@ -1635,19 +1684,6 @@ ShinySession <- R6Class(
                      workerId(),
                      URLencode(createUniqueId(8), TRUE)))
     },
-    registerApi = function(name, func) {
-      private$apiObservers[[name]] <- func
-    },
-    enableApi = function(name, callback) {
-      rexpr <- private$apiObservers[[name]]
-      if (is.null(rexpr)) {
-        stop("API not found")
-      }
-
-      observe({
-        callback(..stacktraceon..(rexpr()))
-      }, ..stacktraceon = FALSE)
-    },
     # This function suspends observers for hidden outputs and resumes observers
     # for un-hidden outputs.
     manageHiddenOutputs = function() {
@@ -1825,6 +1861,17 @@ outputOptions <- function(x, name, ...) {
   .subset2(x, 'impl')$outputOptions(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.
@@ -1880,47 +1927,3 @@ flushAllSessions <- function() {
     NULL
   })
 }
-
-.createApiWriter <- function(shinysession, ns = identity) {
-  structure(list(impl=shinysession, ns=ns), class='shinyapi')
-}
-
-#' @export
-`$<-.shinyapi` <- function(x, name, value) {
-  name <- .subset2(x, 'ns')(name)
-
-  label <- deparse(substitute(value))
-  if (length(substitute(value)) > 1) {
-    # value is an object consisting of a call and its arguments. Here we want
-    # to find the source references for the first argument (if there are
-    # arguments), which generally corresponds to the reactive expression--
-    # e.g. in renderTable({ x }), { x } is the expression to trace.
-    attr(label, "srcref") <- srcrefFromShinyCall(substitute(value)[[2]])
-    srcref <- attr(substitute(value)[[2]], "srcref")
-    if (length(srcref) > 0)
-      attr(label, "srcfile") <- srcFileOfRef(srcref[[1]])
-  }
-  .subset2(x, 'impl')$registerApi(name, value)
-  return(invisible(x))
-}
-
-#' @export
-`[[<-.shinyapi` <- `$<-.shinyapi`
-
-#' @export
-`$.shinyapi` <- function(x, name) {
-  stop("Reading objects from shinyapi object not allowed.")
-}
-
-#' @export
-`[[.shinyapi` <- `$.shinyapi`
-
-#' @export
-`[.shinyapi` <- function(values, name) {
-  stop("Single-bracket indexing of shinyapi object is not allowed.")
-}
-
-#' @export
-`[<-.shinyapi` <- function(values, name, value) {
-  stop("Single-bracket indexing of shinyapi object is not allowed.")
-}

R/shinywrappers.R

@@ -88,6 +88,26 @@ 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}
@@ -354,98 +374,6 @@ renderUI <- function(expr, env=parent.frame(), quoted=FALSE,
   markRenderFunction(uiOutput, renderFunc, outputArgs = outputArgs)
 }
 
-#' @export
-serveJSON <- function(expr, env=parent.frame(), quoted=FALSE) {
-  installExprFunction(expr, "func", env, quoted)
-  function() {
-    structure(
-      toJSON(func(), pretty = TRUE),
-      content.type = "application/json"
-    )
-  }
-}
-
-#' @export
-servePlot <- function(expr, env=parent.frame(), quoted=FALSE,
-  defaultWidth = 600, defaultHeight = 400) {
-
-  if (!is.function(defaultWidth))
-    defaultWidth <- valueToFunc(defaultWidth)
-  if (!is.function(defaultHeight))
-    defaultHeight <- valueToFunc(defaultHeight)
-
-  installExprFunction(expr, "func", env, quoted)
-  function() {
-    input <- getDefaultReactiveDomain()$input
-    w <- if (!is.null(input$`plot-width`)) as.numeric(input$`plot-width`) else defaultWidth()
-    h <- if (!is.null(input$`plot-height`)) as.numeric(input$`plot-height`) else defaultHeight()
-
-    pngfile <- plotPNG(function() {
-      result <- withVisible(func())
-      if (result$visible) {
-        # Use capture.output to squelch printing to the actual console; we
-        # are only interested in plot output
-        utils::capture.output({
-          # The value needs to be printed just in case it's an object that
-          # requires printing to generate plot output, similar to ggplot2. But
-          # for base graphics, it would already have been rendered when func was
-          # called above, and the print should have no effect.
-          print(result$value)
-        })
-      }
-    }, width = w, height = h)
-
-    structure(
-      list(file = pngfile, owned = TRUE),
-      content.type = "image/png"
-    )
-  }
-}
-
-#' @importFrom utils write.csv
-#' @export
-serveCSV <- function(expr, env=parent.frame(), quoted=FALSE, row.names=FALSE) {
-  installExprFunction(expr, "func", env, quoted)
-  function() {
-    tmp <- tempfile(".csv")
-    write.csv(func(), tmp, row.names=row.names)
-    structure(
-      list(file = tmp, owned = TRUE),
-      content.type = "text/csv"
-    )
-  }
-}
-
-#' @export
-serveText <- function(expr, env=parent.frame(), quoted=FALSE) {
-  installExprFunction(expr, "func", env, quoted)
-  function() {
-    structure(
-      paste(func(), collapse = "\n"),
-      content.type = "text/plain"
-    )
-  }
-}
-
-#' @export
-serveRaw <- function(expr, env=parent.frame(), quoted=FALSE, contentType) {
-
-  if (!is.function(contentType))
-    contentType <- valueToFunc(contentType)
-
-  installExprFunction(expr, "func", env, quoted)
-  function() {
-    bytes <- func()
-    if (!is.raw(bytes)) {
-      stop("serveRaw expects raw vector data")
-    }
-    structure(
-      bytes,
-      content.type = contentType()
-    )
-  }
-}
-
 #' File Downloads
 #'
 #' Allows content from the Shiny application to be made available to the user as
@@ -502,7 +430,9 @@ downloadHandler <- function(filename, content, contentType=NA, outputArgs=list()
   renderFunc <- function(shinysession, name, ...) {
     shinysession$registerDownload(name, filename, contentType, content)
   }
-  markRenderFunction(downloadButton, renderFunc, outputArgs = outputArgs)
+  snapshotExclude(
+    markRenderFunction(downloadButton, renderFunc, outputArgs = outputArgs)
+  )
 }
 
 #' Table output with the JavaScript library DataTables

R/update-input.R

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

R/utils.R

@@ -576,20 +576,6 @@ parseQueryString <- function(str, nested = FALSE) {
   res
 }
 
-parseQueryStringJSON <- function(str, nested = FALSE) {
-  vals <- parseQueryString(str, nested)
-  mapply(names(vals), vals, SIMPLIFY = FALSE,
-    FUN = function(name, value) {
-      tryCatch(
-        jsonlite::fromJSON(value),
-        error = function(e) {
-          stop("Failed to parse URL parameter \"", name, "\"")
-        }
-      )
-    }
-  )
-}
-
 # Assign value to the bottom element of the list x using recursive indices idx
 assignNestedList <- function(x = list(), idx, value) {
   for (i in seq_along(idx)) {
@@ -1599,9 +1585,3 @@ Mutable <- R6Class("Mutable",
     get = function() { private$value }
   )
 )
-
-# Turn a value into a no-arg function that returns that value
-valueToFunc <- function(val) {
-  force(val)
-  function() val
-}

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,7 +59,8 @@ sd_section("UI Inputs",
     "updateTabsetPanel",
     "updateTextInput",
     "updateTextAreaInput",
-    "updateQueryString"
+    "updateQueryString",
+    "getQueryString"
   )
 )
 sd_section("UI Outputs",
@@ -191,6 +192,8 @@ sd_section("Utility functions",
     "parseQueryString",
     "plotPNG",
     "exportTestValues",
+    "snapshotExclude",
+    "markOutputAttrs",
     "repeatable",
     "shinyDeprecated",
     "serverInfo",

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

@@ -141,6 +141,7 @@
     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.2 Build: 350
-// © Denis Ineshin, 2015
+// Ion.RangeSlider
+// version 2.1.6 Build: 369
+// © Denis Ineshin, 2016
 // https://github.com/IonDen
 //
 // Project page:    http://ionden.com/a/plugins/ion.rangeSlider/en.html
@@ -10,7 +10,17 @@
 // http://ionden.com/a/plugins/licence-en.html
 // =====================================================================================================================
 
-;(function ($, document, window, navigator, undefined) {
+;(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) {
     "use strict";
 
     // =================================================================================================================
@@ -146,7 +156,7 @@
      * @constructor
      */
     var IonRangeSlider = function (input, options, plugin_count) {
-        this.VERSION = "2.1.2";
+        this.VERSION = "2.1.6";
         this.input = input;
         this.plugin_count = plugin_count;
         this.current_plugin = 0;
@@ -161,12 +171,15 @@
         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),
@@ -318,6 +331,11 @@
         };
 
 
+        // 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 = {
@@ -375,16 +393,15 @@
 
         for (prop in config_from_data) {
             if (config_from_data.hasOwnProperty(prop)) {
-                if (!config_from_data[prop] && config_from_data[prop] !== 0) {
+                if (config_from_data[prop] === undefined || config_from_data[prop] === "") {
                     delete config_from_data[prop];
                 }
             }
         }
 
 
-
         // input value extends default config
-        if (val) {
+        if (val !== undefined && val !== "") {
             val = val.split(config_from_data.input_values_separator || options.input_values_separator || ";");
 
             if (val[0] && val[0] == +val[0]) {
@@ -416,6 +433,7 @@
 
 
         // validate config, to be sure that all data types are correct
+        this.update_check = {};
         this.validate();
 
 
@@ -447,7 +465,7 @@
         /**
          * Starts or updates the plugin instance
          *
-         * @param is_update {boolean}
+         * @param [is_update] {boolean}
          */
         init: function (is_update) {
             this.no_diapason = false;
@@ -734,7 +752,6 @@
 
             // callbacks call
             if ($.contains(this.$cache.cont[0], e.target) || this.dragging) {
-                this.is_finish = true;
                 this.callOnFinish();
             }
             
@@ -750,7 +767,6 @@
          */
         pointerDown: function (target, e) {
             e.preventDefault();
-            e.stopPropagation();
             var x = e.pageX || e.originalEvent.touches && e.originalEvent.touches[0].pageX;
             if (e.button === 2) {
                 return;
@@ -761,7 +777,7 @@
             }
 
             if (!target) {
-                target = this.target;
+                target = this.target || "from";
             }
 
             this.current_plugin = this.plugin_count;
@@ -794,7 +810,6 @@
          */
         pointerClick: function (target, e) {
             e.preventDefault();
-            e.stopPropagation();
             var x = e.pageX || e.originalEvent.touches && e.originalEvent.touches[0].pageX;
             if (e.button === 2) {
                 return;
@@ -948,6 +963,12 @@
             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();
@@ -1035,7 +1056,7 @@
                         break;
                     }
 
-                    handle_x = this.toFixed(handle_x + (this.coords.p_handle * 0.1));
+                    handle_x = this.toFixed(handle_x + (this.coords.p_handle * 0.001));
 
                     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);
@@ -1313,13 +1334,6 @@
                     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 + "%";
@@ -1332,18 +1346,13 @@
                     }
 
                     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 + 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);
                 }
 
+                this.writeToInput();
+
                 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;
@@ -1353,9 +1362,10 @@
                 if (!this.is_resize && !this.is_update && !this.is_start && !this.is_finish) {
                     this.callOnChange();
                 }
-                if (this.is_key || this.is_click) {
+                if (this.is_key || this.is_click || this.is_first_update) {
                     this.is_key = false;
                     this.is_click = false;
+                    this.is_first_update = false;
                     this.callOnFinish();
                 }
 
@@ -1467,6 +1477,8 @@
                             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;
@@ -1561,25 +1573,57 @@
 
 
 
+        /**
+         * 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);
             }
@@ -1587,6 +1631,7 @@
 
 
 
+
         // =============================================================================================================
         // Service methods
 
@@ -1796,7 +1841,7 @@
         },
 
         toFixed: function (num) {
-            num = num.toFixed(9);
+            num = num.toFixed(20);
             return +num;
         },
 
@@ -1884,32 +1929,37 @@
                 o.from = o.min;
             }
 
-            if (typeof o.to !== "number" || isNaN(o.from)) {
+            if (typeof o.to !== "number" || isNaN(o.to)) {
                 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.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.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.to) o.from = o.to;
+                if (o.to < o.from) o.to = o.from;
+
             }
 
             if (typeof o.step !== "number" || isNaN(o.step) || !o.step || o.step < 0) {
@@ -2167,7 +2217,10 @@
 
             for (i = 0; i < num; i++) {
                 label = this.$cache.grid_labels[i][0];
-                label.style.marginLeft = -this.coords.big_x[i] + "%";
+
+                if (this.coords.big_x[i] !== Number.POSITIVE_INFINITY) {
+                    label.style.marginLeft = -this.coords.big_x[i] + "%";
+                }
             }
         },
 
@@ -2229,6 +2282,8 @@
 
             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();
@@ -2306,4 +2361,4 @@
             };
     }());
 
-} (jQuery, document, window, navigator));
+}));

inst/www/shared/shiny.js

@@ -10,6 +10,13 @@ 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();
   });
@@ -18,7 +25,18 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
   // Source file: ../srcjs/utils.js
 
   function escapeHTML(str) {
-    return str.replace(/&/g, "&amp;").replace(/</g, "&lt;").replace(/>/g, "&gt;").replace(/"/g, "&quot;").replace(/'/g, "&#039;").replace(/\//g, "&#x2F;");
+    var escaped = {
+      "&": "&amp;",
+      "<": "&lt;",
+      ">": "&gt;",
+      '"': "&quot;",
+      "'": "&#039;",
+      "/": "&#x2F;"
+    };
+
+    return str.replace(/[&<>'"\/]/g, function (m) {
+      return escaped[m];
+    });
   }
 
   function randomId() {
@@ -200,6 +218,16 @@ 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
 
@@ -428,6 +456,7 @@ 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;
@@ -449,55 +478,78 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
   var InputNoResendDecorator = function InputNoResendDecorator(target, initialValues) {
     this.target = target;
-    this.lastSentValues = initialValues || {};
+    this.lastSentValues = this.reset(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[name] === jsonValue) return;
-      this.lastSentValues[name] = jsonValue;
+
+      if (this.lastSentValues[inputName] && this.lastSentValues[inputName].jsonValue === jsonValue && this.lastSentValues[inputName].inputType === inputType) {
+        return;
+      }
+      this.lastSentValues[inputName] = { jsonValue: jsonValue, inputType: inputType };
       this.target.setInput(name, value);
     };
-    this.reset = function (values) {
-      values = values || {};
-      var strValues = {};
-      $.each(values, function (key, value) {
-        strValues[key] = JSON.stringify(value);
-      });
-      this.lastSentValues = strValues;
+    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;
     };
   }).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, immediate) {
+    this.setInput = function (name, value, opts) {
       var evt = jQuery.Event("shiny:inputchanged");
-      var name2 = name.split(':');
-      evt.name = name2[0];
-      evt.inputType = name2.length > 1 ? name2[1] : '';
+
+      var input = splitInputNameType(name);
+      evt.name = input.name;
+      evt.inputType = input.inputType;
       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;
-        this.target.setInput(name, evt.value, immediate);
+
+        // opts aren't passed along to lower levels in the input decorator
+        // stack.
+        this.target.setInput(name, evt.value);
       }
     };
   }).call(InputEventDecorator.prototype);
@@ -507,9 +559,10 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     this.inputRatePolicies = {};
   };
   (function () {
-    this.setInput = function (name, value, immediate) {
+    this.setInput = function (name, value, opts) {
       this.$ensureInit(name);
-      if (immediate) this.inputRatePolicies[name].immediateCall(name, value, immediate);else this.inputRatePolicies[name].normalCall(name, value, immediate);
+
+      if (opts.immediate) this.inputRatePolicies[name].immediateCall(name, value, opts);else this.inputRatePolicies[name].normalCall(name, value, opts);
     };
     this.setRatePolicy = function (name, mode, millis) {
       if (mode === 'direct') {
@@ -523,11 +576,59 @@ 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) {
-      this.target.setInput(name, value);
+    this.$doSetInput = function (name, value, opts) {
+      this.target.setInput(name, value, opts);
     };
   }).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 Object.assign({
+      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
 
@@ -537,6 +638,9 @@ 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 = {};
 
@@ -559,11 +663,6 @@ 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);
@@ -1128,7 +1227,8 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     });
 
     addMessageHandler('config', function (message) {
-      this.config = message;
+      this.config = { workerId: message.workerId, sessionId: message.sessionId };
+      if (message.user) exports.user = message.user;
     });
 
     addMessageHandler('busy', function (message) {
@@ -1183,7 +1283,46 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     });
 
     addMessageHandler('updateQueryString', function (message) {
-      window.history.replaceState(null, null, message.queryString);
+
+      // 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");
     });
 
     addMessageHandler("resetBrush", function (message) {
@@ -1260,13 +1399,9 @@ 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') {
-            if (message.value !== null) {
-              $progress.find('.progress').show();
-              $progress.find('.progress-bar').width(message.value * 100 + '%');
-            } else {
-              $progress.find('.progress').hide();
-            }
+          if (typeof message.value !== 'undefined' && message.value !== null) {
+            $progress.find('.progress').show();
+            $progress.find('.progress-bar').width(message.value * 100 + '%');
           }
         } else if (message.style === "old") {
           // For old-style (Shiny <=0.13.2) progress indicators.
@@ -1278,13 +1413,9 @@ 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') {
-            if (message.value !== null) {
-              $progress.find('.progress').show();
-              $progress.find('.bar').width(message.value * 100 + '%');
-            } else {
-              $progress.find('.progress').hide();
-            }
+          if (typeof message.value !== 'undefined' && message.value !== null) {
+            $progress.find('.progress').show();
+            $progress.find('.bar').width(message.value * 100 + '%');
           }
 
           $progress.fadeIn();
@@ -3323,6 +3454,14 @@ 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
 
@@ -4699,9 +4838,10 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     };
   }).call(IE8FileUploader.prototype);
 
-  var FileUploader = function FileUploader(shinyapp, id, files) {
+  var FileUploader = function FileUploader(shinyapp, id, files, el) {
     this.shinyapp = shinyapp;
     this.id = id;
+    this.el = el;
     FileProcessor.call(this, files);
   };
   $.extend(FileUploader.prototype, FileProcessor.prototype);
@@ -4771,6 +4911,26 @@ 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);
@@ -4779,18 +4939,6 @@ 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 || '');
@@ -4857,7 +5005,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));
+      $el.data('currentUploader', new FileUploader(exports.shinyapp, id, files, evt.target));
     }
   }
 
@@ -5003,19 +5151,27 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     var inputsRate = new InputRateDecorator(inputsEvent);
     var inputsDefer = new InputDeferDecorator(inputsEvent);
 
-    // By default, use rate decorator
-    var inputs = inputsRate;
-    $('input[type="submit"], button[type="submit"]').each(function () {
+    var inputs;
+    if ($('input[type="submit"], button[type="submit"]').length > 0) {
       // If there is a submit button on the page, use defer decorator
       inputs = inputsDefer;
-      $(this).click(function (event) {
-        event.preventDefault();
-        inputsDefer.submit();
-      });
-    });
 
-    exports.onInputChange = function (name, value) {
-      inputs.setInput(name, value);
+      $('input[type="submit"], button[type="submit"]').each(function () {
+        $(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);
     };
 
     var boundInputs = {};
@@ -5026,7 +5182,9 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
         var value = binding.getValue(el);
         var type = binding.getType(el);
         if (type) id = id + ":" + type;
-        inputs.setInput(id, value, !allowDeferred);
+
+        var opts = { immediate: !allowDeferred, binding: binding, el: el };
+        inputs.setInput(id, value, opts);
       }
     }
 
@@ -5035,7 +5193,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
       var bindings = inputBindings.getBindings();
 
-      var currentValues = {};
+      var inputItems = {};
 
       for (var i = 0; i < bindings.length; i++) {
         var binding = bindings[i].binding;
@@ -5049,7 +5207,14 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
           var type = binding.getType(el);
           var effectiveId = type ? id + ":" + type : id;
-          currentValues[effectiveId] = binding.getValue(el);
+          inputItems[effectiveId] = {
+            value: binding.getValue(el),
+            opts: {
+              immediate: true,
+              binding: binding,
+              el: el
+            }
+          };
 
           /*jshint loopfunc:true*/
           var thisCallback = function () {
@@ -5078,14 +5243,10 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
             binding: binding,
             bindingType: 'input'
           });
-
-          if (shinyapp.isConnected()) {
-            valueChangeCallback(binding, el, false);
-          }
         }
       }
 
-      return currentValues;
+      return inputItems;
     }
 
     function unbindInputs() {
@@ -5125,12 +5286,11 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
       unbindOutputs(scope, includeSelf);
     }
     exports.bindAll = function (scope) {
-      // _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);
+      // _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);
       });
 
       // Not sure if the iframe stuff is an intrinsic part of bindAll, but bindAll
@@ -5173,7 +5333,16 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     // Initialize all input objects in the document, before binding
     initializeInputs(document);
 
-    var initialValues = _bindAll(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;
+    });
 
     // The server needs to know the size of each image and plot output element,
     // in case it is auto-sizing
@@ -5327,12 +5496,28 @@ 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 w atching for changes can
+    // a reactive version of this isn't sent because watching 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
@@ -5347,6 +5532,9 @@ 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,4 +41,3 @@ 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,8 +24,7 @@ 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}.
-\code{NULL} hides the progress bar, if it is currently visible.}
+the progress bar, relative to \code{min} and \code{max}.}
 
 \item{style}{Progress display style. If \code{"notification"} (the default),
 the progress indicator will show using Shiny's notification API. If
@@ -112,4 +111,3 @@ shinyApp(ui, server)
 \code{\link{withProgress}}
 }
 \keyword{datasets}
-

man/absolutePanel.Rd

@@ -80,4 +80,3 @@ 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,4 +64,3 @@ Other input.elements: \code{\link{checkboxGroupInput}},
   \code{\link{sliderInput}}, \code{\link{submitButton}},
   \code{\link{textAreaInput}}, \code{\link{textInput}}
 }
-

man/addResourcePath.Rd

@@ -32,4 +32,3 @@ addResourcePath('datasets', system.file('data', package='datasets'))
 \seealso{
 \code{\link{singleton}}
 }
-

man/applyInputHandlers.Rd

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

man/bookmarkButton.Rd

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

man/bootstrapLib.Rd

@@ -21,4 +21,3 @@ 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{basicPage}
 \alias{bootstrapPage}
+\alias{basicPage}
 \title{Create a Bootstrap page}
 \usage{
 bootstrapPage(..., title = NULL, responsive = NULL, theme = NULL)
@@ -41,4 +41,3 @@ The \code{basicPage} function is deprecated, you should use the
 \seealso{
 \code{\link{fluidPage}}, \code{\link{fixedPage}}
 }
-

man/brushOpts.Rd

@@ -49,4 +49,3 @@ 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,4 +69,3 @@ using just the x or y variable, whichever is appropriate.
 \seealso{
 \code{\link{plotOutput}} for example usage.
 }
-

man/callModule.Rd

@@ -29,4 +29,3 @@ 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, selected = NULL, inline = FALSE,
-  width = NULL)
+checkboxGroupInput(inputId, label, choices = NULL, selected = NULL,
+  inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -13,7 +13,9 @@ checkboxGroupInput(inputId, label, choices, selected = NULL, inline = FALSE,
 \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.}
+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.}
 
 \item{selected}{The values that should be initially selected, if any.}
 
@@ -21,6 +23,16 @@ are named then that name rather than the value is displayed to the user.}
 
 \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.
@@ -42,19 +54,39 @@ ui <- fluidPage(
   tableOutput("data")
 )
 
-server <- function(input, output) {
+server <- function(input, output, session) {
   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}},
@@ -62,4 +94,3 @@ 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,4 +48,3 @@ Other input.elements: \code{\link{actionButton}},
   \code{\link{submitButton}}, \code{\link{textAreaInput}},
   \code{\link{textInput}}
 }
-

man/clickOpts.Rd

@@ -19,4 +19,3 @@ 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,4 +64,3 @@ shinyApp(ui, server = function(input, output) { })
 \seealso{
 \code{\link{fluidRow}}, \code{\link{fixedRow}}.
 }
-

man/conditionalPanel.Rd

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

man/createWebDependency.Rd

@@ -21,4 +21,3 @@ 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,4 +106,3 @@ 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,4 +123,3 @@ Other input.elements: \code{\link{actionButton}},
   \code{\link{submitButton}}, \code{\link{textAreaInput}},
   \code{\link{textInput}}
 }
-

man/dblclickOpts.Rd

@@ -23,4 +23,3 @@ 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

@@ -78,6 +78,7 @@ window.
   time each subsequent event is considered is already after the time window
   has expired.
 }
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {
@@ -119,4 +120,3 @@ shinyApp(ui, server)
 }
 
 }
-

man/domains.Rd

@@ -3,8 +3,9 @@
 \name{domains}
 \alias{domains}
 \alias{getDefaultReactiveDomain}
-\alias{onReactiveDomainEnded}
 \alias{withReactiveDomain}
+\alias{onReactiveDomainEnded}
+\alias{domains}
 \title{Reactive domains}
 \usage{
 getDefaultReactiveDomain()
@@ -51,4 +52,3 @@ 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,6 +3,7 @@
 \name{downloadButton}
 \alias{downloadButton}
 \alias{downloadLink}
+\alias{downloadLink}
 \title{Create a download button or link}
 \usage{
 downloadButton(outputId, label = "Download", class = NULL, ...)
@@ -43,6 +44,5 @@ downloadLink('downloadData', 'Download')
 
 }
 \seealso{
-downloadHandler
+\code{\link{downloadHandler}}
 }
-

man/downloadHandler.Rd

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

man/enableBookmarking.Rd

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

man/exportTestValues.Rd

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

man/exprToFunction.Rd

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

man/fileInput.Rd

@@ -4,7 +4,8 @@
 \alias{fileInput}
 \title{File Upload Control}
 \usage{
-fileInput(inputId, label, multiple = FALSE, accept = NULL, width = NULL)
+fileInput(inputId, label, multiple = FALSE, accept = NULL, width = NULL,
+  buttonLabel = "Browse...", placeholder = "No file selected")
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -20,6 +21,11 @@ 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.
@@ -84,7 +90,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}},
@@ -93,4 +99,3 @@ Other input.elements: \code{\link{actionButton}},
   \code{\link{submitButton}}, \code{\link{textAreaInput}},
   \code{\link{textInput}}
 }
-

man/fillPage.Rd

@@ -81,4 +81,3 @@ 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{fillCol}
 \alias{fillRow}
+\alias{fillCol}
 \title{Flex Box-based row/column layouts}
 \usage{
 fillRow(..., flex = 1, width = "100\%", height = "100\%")
@@ -75,4 +75,3 @@ shinyApp(ui, server)
 
 }
 }
-

man/fixedPage.Rd

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

man/flowLayout.Rd

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

man/fluidPage.Rd

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

man/freezeReactiveValue.Rd

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

man/getQueryString.Rd

@@ -0,0 +1,93 @@
+% 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,4 +21,3 @@ Create a header panel containing an application title.
 \examples{
 headerPanel("Hello Shiny!")
 }
-

man/helpText.Rd

@@ -21,4 +21,3 @@ 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,4 +33,3 @@ 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,4 +42,3 @@ tags$ul(
   htmlOutput("summary", container = tags$li, class = "custom-li-output")
 )
 }
-

man/icon.Rd

@@ -47,4 +47,3 @@ 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,4 +13,3 @@ inputPanel(...)
 A \code{\link{flowLayout}} with a grey border and light grey background,
 suitable for wrapping inputs.
 }
-

man/insertUI.Rd

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

man/installExprFunction.Rd

@@ -40,4 +40,3 @@ 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,4 +63,3 @@ shinyApp(ui, server)
 \seealso{
 \code{\link{reactiveTimer}} is a slightly less safe alternative.
 }
-

man/is.reactivevalues.Rd

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

man/isolate.Rd

@@ -77,4 +77,3 @@ isolate(fun())
 # isolate also works if the reactive expression accesses values from the
 # input object, like input$x
 }
-

man/knitr_methods.Rd

@@ -1,10 +1,10 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/app.R
 \name{knitr_methods}
-\alias{knit_print.reactive}
+\alias{knitr_methods}
 \alias{knit_print.shiny.appobj}
 \alias{knit_print.shiny.render.function}
-\alias{knitr_methods}
+\alias{knit_print.reactive}
 \title{Knitr S3 methods}
 \usage{
 knit_print.shiny.appobj(x, ...)
@@ -24,4 +24,3 @@ knit_print.reactive(x, ..., inline = FALSE)
 These S3 methods are necessary to help Shiny applications and UI chunks embed
 themselves in knitr/rmarkdown documents.
 }
-

man/mainPanel.Rd

@@ -27,4 +27,3 @@ mainPanel(
    plotOutput("mpgPlot")
 )
 }
-

man/makeReactiveBinding.Rd

@@ -30,4 +30,3 @@ observe(print(b()))
 a <- 20
 }
 }
-

man/markOutputAttrs.Rd

@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/shinywrappers.R
+\name{markOutputAttrs}
+\alias{markOutputAttrs}
+\title{Mark a render function with attributes that will be used by the output}
+\usage{
+markOutputAttrs(renderFunc, snapshotExclude = NULL)
+}
+\arguments{
+\item{renderFunc}{A function that is suitable for assigning to a Shiny output
+slot.}
+
+\item{snapshotExclude}{If TRUE, exclude the output from test snapshots.}
+}
+\description{
+Mark a render function with attributes that will be used by the output
+}
+\keyword{internal}

man/markRenderFunction.Rd

@@ -30,4 +30,3 @@ Shiny regarding what UI function is most commonly used with this type of
 render function. This can be used in R Markdown documents to create complete
 output widgets out of just the render function.
 }
-

man/maskReactiveContext.Rd

@@ -21,4 +21,3 @@ default, an error).
 \seealso{
 \code{\link{isolate}}
 }
-

man/modalButton.Rd

@@ -18,4 +18,3 @@ When clicked, a \code{modalButton} will dismiss the modal dialog.
 \seealso{
 \code{\link{modalDialog}} for examples.
 }
-

man/modalDialog.Rd

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

man/navbarPage.Rd

@@ -1,8 +1,8 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/bootstrap.R
 \name{navbarPage}
-\alias{navbarMenu}
 \alias{navbarPage}
+\alias{navbarMenu}
 \title{Create a page with a top level navigation bar}
 \usage{
 navbarPage(title, ..., id = NULL, selected = NULL,
@@ -100,4 +100,3 @@ navbarPage("App Title",
 \code{\link{tabPanel}}, \code{\link{tabsetPanel}},
   \code{\link{updateNavbarPage}}
 }
-

man/navlistPanel.Rd

@@ -55,4 +55,3 @@ fluidPage(
 \seealso{
 \code{\link{tabPanel}}, \code{\link{updateNavlistPanel}}
 }
-

man/nearPoints.Rd

@@ -87,4 +87,3 @@ nearPoints(mtcars, input$plot_click, threshold = 10, maxpoints = 1)
 \seealso{
 \code{\link{plotOutput}} for more examples.
 }
-

man/numericInput.Rd

@@ -46,7 +46,7 @@ shinyApp(ui, server)
 \seealso{
 \code{\link{updateNumericInput}}
 
-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{fileInput}},
@@ -55,4 +55,3 @@ Other input.elements: \code{\link{actionButton}},
   \code{\link{submitButton}}, \code{\link{textAreaInput}},
   \code{\link{textInput}}
 }
-

man/observe.Rd

@@ -116,4 +116,3 @@ obsD <- observe(expr_q, quoted = TRUE)
 # are at the console, you can force a flush with flushReact()
 shiny:::flushReact()
 }
-

man/observeEvent.Rd

@@ -1,8 +1,8 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/reactives.R
 \name{observeEvent}
-\alias{eventReactive}
 \alias{observeEvent}
+\alias{eventReactive}
 \title{Event handler}
 \usage{
 observeEvent(eventExpr, handlerExpr, event.env = parent.frame(),
@@ -173,6 +173,7 @@ these:
   }
 }
 }
+
 \examples{
 ## Only run this example in interactive R sessions
 if (interactive()) {
@@ -238,4 +239,3 @@ if (interactive()) {
 \seealso{
 \code{\link{actionButton}}
 }
-