Fix NEWS formatting

Fix runGist

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 0.12.0
-Date: 2015-05-18
+Version: 0.12.2
+Date: 2015-08-04
 Authors@R: c(
     person("Winston", "Chang", role = c("aut", "cre"), email = "winston@rstudio.com"),
     person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"),
@@ -42,6 +42,8 @@ Authors@R: c(
     comment = "es5-shim library"),
     person("Denis", "Ineshin", role = c("ctb", "cph"),
     comment = "ion.rangeSlider library"),
+    person("Sami", "Samhuri", role = c("ctb", "cph"),
+    comment = "Javascript strftime library"),
     person(family = "SpryMedia Limited", role = c("ctb", "cph"),
     comment = "DataTables library"),
     person("John", "Fraser", role = c("ctb", "cph"),
@@ -59,10 +61,11 @@ Description: Makes it incredibly easy to build interactive web
     beautiful, responsive, and powerful applications with minimal effort.
 License: GPL-3 | file LICENSE
 Depends:
-    R (>= 3.0.0)
+    R (>= 3.0.0),
+    methods
 Imports:
     utils,
-    httpuv (>= 1.3.2),
+    httpuv (>= 1.3.3),
     mime (>= 0.3),
     jsonlite (>= 0.9.16),
     xtable,
@@ -95,6 +98,20 @@ Collate:
     'image-interact-opts.R'
     'image-interact.R'
     'imageutils.R'
+    'input-action.R'
+    'input-checkbox.R'
+    'input-checkboxgroup.R'
+    'input-date.R'
+    'input-daterange.R'
+    'input-file.R'
+    'input-numeric.R'
+    'input-password.R'
+    'input-radiobuttons.R'
+    'input-select.R'
+    'input-slider.R'
+    'input-submit.R'
+    'input-text.R'
+    'input-utils.R'
     'jqueryui.R'
     'middleware-shiny.R'
     'middleware.R'
@@ -105,12 +122,12 @@ Collate:
     'reactives.R'
     'render-plot.R'
     'run-url.R'
+    'server-input-handlers.R'
     'server.R'
     'shiny.R'
     'shinyui.R'
     'shinywrappers.R'
     'showcase.R'
-    'slider.R'
     'tar.R'
     'timer.R'
     'update-input.R'

LICENSE

@@ -15,6 +15,7 @@ these components are included below):
 - selectize.js, https://github.com/brianreavis/selectize.js
 - es5-shim, https://github.com/es-shims/es5-shim
 - ion.rangeSlider, https://github.com/IonDen/ion.rangeSlider
+- strftime for Javascript, https://github.com/samsonjs/strftime
 - DataTables, https://github.com/DataTables/DataTables
 - showdown.js, https://github.com/showdownjs/showdown
 - highlight.js, https://github.com/isagalaev/highlight.js
@@ -1051,6 +1052,31 @@ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 SOFTWARE.
 
 
+strftime for Javascript License
+----------------------------------------------------------------------
+
+The MIT License (MIT)
+Copyright © 2015 Sami Samhuri, http://samhuri.net <sami@samhuri.net>
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the “Software”), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
+
 DataTables License
 ----------------------------------------------------------------------
 

NAMESPACE

@@ -180,6 +180,8 @@ export(updateCheckboxGroupInput)
 export(updateCheckboxInput)
 export(updateDateInput)
 export(updateDateRangeInput)
+export(updateNavbarPage)
+export(updateNavlistPanel)
 export(updateNumericInput)
 export(updateRadioButtons)
 export(updateSelectInput)
@@ -200,5 +202,6 @@ import(R6)
 import(digest)
 import(htmltools)
 import(httpuv)
+import(methods)
 import(mime)
 import(xtable)

NEWS

@@ -1,3 +1,45 @@
+shiny 0.12.2
+--------------------------------------------------------------------------------
+
+* GitHub changed URLs for gists from .tar.gz to .zip, so `runGist` was updated
+  to work with the new URLs.
+
+* Callbacks from the session object are now guaranteed to execute in the order
+  in which registration occurred.
+
+* Minor bugs in sliderInput's animation behavior have been fixed. (#852)
+
+* Updated to ion.rangeSlider to 2.0.12.
+
+* Added `shiny.minified` option, which controls whether the minified version
+  of shiny.js is used. Setting it to FALSe can be useful for debugging. (#826,
+  #850)
+
+* Fixed an issue for outputting plots from ggplot objects which also have an
+  additional class whose print method takes precedence over `print.ggplot`.
+  (#840, 841)
+
+* Added `width` option to Shiny's input functions. (#589, #834)
+
+* Added two alias functions of `updateTabsetPanel()` to update the selected tab:
+  `updateNavbarPage()` and `updateNavlistPanel()`. (#881)
+
+* All non-base functions are now explicitly namespaced, to pass checks in
+  R-devel.
+
+* Shiny now correctly handles HTTP HEAD requests. (#876)
+
+shiny 0.12.1
+--------------------------------------------------------------------------------
+
+* Fixed an issue where unbindAll() causes subsequent bindAll() to be ignored for
+  previously bound outputs. (#856)
+
+* Undeprecate `dataTableOutput` and `renderDataTable`, which had been deprecated
+  in favor of the new DT package. The DT package is a bit too new and has a
+  slightly different API, we were too hasty in deprecating the existing Shiny
+  functions.
+
 shiny 0.12.0
 --------------------------------------------------------------------------------
 

R/app.R

@@ -91,7 +91,7 @@ shinyApp <- function(ui=NULL, server=NULL, onStart=NULL, options=list(),
 #'   file and either ui.R or www/index.html)
 #' @export
 shinyAppDir <- function(appDir, options=list()) {
-  if (!file_test('-d', appDir)) {
+  if (!utils::file_test('-d', appDir)) {
     stop("No Shiny application exists at the path \"", appDir, "\"")
   }
 

R/fileupload.R

@@ -81,33 +81,47 @@ FileUploadOperation <- R6Class(
 #' @include map.R
 FileUploadContext <- R6Class(
   'FileUploadContext',
-  portable = FALSE,
   class = FALSE,
+  private = list(
+    basedir = character(0),
+    operations = 'Map',
+    ids = character(0)  # Keep track of all ids used for file uploads
+  ),
   public = list(
-    .basedir = character(0),
-    .operations = 'Map',
-
     initialize = function(dir=tempdir()) {
-      .basedir <<- dir
-      .operations <<- Map$new()
+      private$basedir <- dir
+      private$operations <- Map$new()
     },
     createUploadOperation = function(fileInfos) {
       while (TRUE) {
         id <- paste(as.raw(p_runif(12, min=0, max=0xFF)), collapse='')
-        dir <- file.path(.basedir, id)
+        private$ids <- c(private$ids, id)
+        dir <- file.path(private$basedir, id)
         if (!dir.create(dir))
           next
 
         op <- FileUploadOperation$new(self, id, dir, fileInfos)
-        .operations$set(id, op)
+        private$operations$set(id, op)
         return(id)
       }
     },
     getUploadOperation = function(jobId) {
-      .operations$get(jobId)
+      private$operations$get(jobId)
     },
     onJobFinished = function(jobId) {
-      .operations$remove(jobId)
+      private$operations$remove(jobId)
+    },
+    # Remove the directories containing file uploads; this is to be called when
+    # a session ends.
+    rmUploadDirs = function() {
+      # Make sure all_paths is underneath the tempdir()
+      if (!grepl(normalizePath(tempdir()), normalizePath(private$basedir), fixed = TRUE)) {
+        stop("Won't remove upload path ", private$basedir,
+          "because it is not under tempdir(): ", tempdir())
+      }
+
+      all_paths <- file.path(private$basedir, private$ids)
+      unlink(all_paths, recursive = TRUE)
     }
   )
 )

R/graph.R

@@ -37,7 +37,7 @@ writeReactLog <- function(file=stdout()) {
 #'
 #' @export
 showReactLog <- function() {
-  browseURL(renderReactLog())
+  utils::browseURL(renderReactLog())
 }
 
 renderReactLog <- function() {
@@ -91,7 +91,7 @@ renderReactLog <- function() {
   .graphAppend(list(
     action = 'valueChange',
     id = label,
-    value = paste(capture.output(str(value)), collapse='\n')
+    value = paste(utils::capture.output(utils::str(value)), collapse='\n')
   ))
 }
 

R/imageutils.R

@@ -33,12 +33,12 @@ plotPNG <- function(func, filename=tempfile(fileext='.png'),
   # Otherwise, if the Cairo package is installed, use CairoPNG().
   # Finally, if neither quartz nor Cairo, use png().
   if (capabilities("aqua")) {
-    pngfun <- png
+    pngfun <- grDevices::png
   } else if ((getOption('shiny.usecairo') %OR% TRUE) &&
              nchar(system.file(package = "Cairo"))) {
     pngfun <- Cairo::CairoPNG
   } else {
-    pngfun <- png
+    pngfun <- grDevices::png
   }
 
   pngfun(filename=filename, width=width, height=height, res=res, ...)
@@ -49,10 +49,10 @@ plotPNG <- function(func, filename=tempfile(fileext='.png'),
   # by plot.new() with the default (large) margin. However, this does not
   # guarantee user's code in func() will not trigger the error -- they may have
   # to set par(mar = smaller_value) before they draw base graphics.
-  op <- par(mar = rep(0, 4))
-  tryCatch(plot.new(), finally = par(op))
-  dv <- dev.cur()
-  tryCatch(shinyCallingHandlers(func()), finally = dev.off(dv))
+  op <- graphics::par(mar = rep(0, 4))
+  tryCatch(graphics::plot.new(), finally = graphics::par(op))
+  dv <- grDevices::dev.cur()
+  tryCatch(shinyCallingHandlers(func()), finally = grDevices::dev.off(dv))
 
   filename
 }

R/input-action.R

@@ -0,0 +1,51 @@
+#' Action button/link
+#'
+#' Creates an action button or link whose value is initially zero, and increments by one
+#' each time it is pressed.
+#'
+#' @inheritParams textInput
+#' @param label The contents of the button or link--usually a text label, but
+#'   you could also use any other HTML, like an image.
+#' @param icon An optional \code{\link{icon}} to appear on the button.
+#' @param ... Named attributes to be applied to the button or link.
+#'
+#' @family input elements
+#' @examples
+#' \dontrun{
+#' # In server.R
+#' output$distPlot <- renderPlot({
+#'   # Take a dependency on input$goButton
+#'   input$goButton
+#'
+#'   # Use isolate() to avoid dependency on input$obs
+#'   dist <- isolate(rnorm(input$obs))
+#'   hist(dist)
+#' })
+#'
+#' # In ui.R
+#' actionButton("goButton", "Go!")
+#' }
+#'
+#' @seealso \code{\link{observeEvent}} and \code{\link{eventReactive}}
+#'
+#' @export
+actionButton <- function(inputId, label, icon = NULL, width = NULL, ...) {
+  tags$button(id=inputId,
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+    type="button",
+    class="btn btn-default action-button",
+    list(icon, label),
+    ...
+  )
+}
+
+#' @rdname actionButton
+#' @export
+actionLink <- function(inputId, label, icon = NULL, ...) {
+  tags$a(id=inputId,
+    href="#",
+    class="action-button",
+    list(icon, label),
+    ...
+  )
+}

R/input-checkbox.R

@@ -0,0 +1,26 @@
+#' Checkbox Input Control
+#'
+#' Create a checkbox that can be used to specify logical values.
+#'
+#' @inheritParams textInput
+#' @param value Initial value (\code{TRUE} or \code{FALSE}).
+#' @return A checkbox control that can be added to a UI definition.
+#'
+#' @family input elements
+#' @seealso \code{\link{checkboxGroupInput}}, \code{\link{updateCheckboxInput}}
+#'
+#' @examples
+#' checkboxInput("outliers", "Show outliers", FALSE)
+#' @export
+checkboxInput <- function(inputId, label, value = FALSE, width = NULL) {
+  inputTag <- tags$input(id = inputId, type="checkbox")
+  if (!is.null(value) && value)
+    inputTag$attribs$checked <- "checked"
+
+  div(class = "form-group shiny-input-container",
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+    div(class = "checkbox",
+      tags$label(inputTag, tags$span(label))
+    )
+  )
+}

R/input-checkboxgroup.R

@@ -0,0 +1,45 @@
+#' Checkbox Group Input Control
+#'
+#' Create a group of checkboxes that can be used to toggle multiple choices
+#' independently. The server will receive the input as a character vector of the
+#' selected values.
+#'
+#' @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.
+#' @param selected The values that should be initially selected, if any.
+#' @param inline If \code{TRUE}, render the choices inline (i.e. horizontally)
+#' @return A list of HTML elements that can be added to a UI definition.
+#'
+#' @family input elements
+#' @seealso \code{\link{checkboxInput}}, \code{\link{updateCheckboxGroupInput}}
+#'
+#' @examples
+#' checkboxGroupInput("variable", "Variable:",
+#'                    c("Cylinders" = "cyl",
+#'                      "Transmission" = "am",
+#'                      "Gears" = "gear"))
+#'
+#' @export
+checkboxGroupInput <- function(inputId, label, choices, selected = NULL,
+  inline = FALSE, width = NULL) {
+
+  # resolve names
+  choices <- choicesWithNames(choices)
+  if (!is.null(selected))
+    selected <- validateSelected(selected, choices, inputId)
+
+  options <- generateOptions(inputId, choices, selected, inline)
+
+  divClass <- "form-group shiny-input-checkboxgroup shiny-input-container"
+  if (inline)
+    divClass <- paste(divClass, "shiny-input-container-inline")
+
+  # return label and select tag
+  tags$div(id = inputId,
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+    class = divClass,
+    controlLabel(inputId, label),
+    options
+  )
+}

R/input-date.R

@@ -0,0 +1,102 @@
+#' Create date input
+#'
+#' Creates a text input which, when clicked on, brings up a calendar that
+#' the user can click on to select dates.
+#'
+#' The date \code{format} string specifies how the date will be displayed in
+#' the browser. It allows the following values:
+#'
+#' \itemize{
+#'   \item \code{yy} Year without century (12)
+#'   \item \code{yyyy} Year with century (2012)
+#'   \item \code{mm} Month number, with leading zero (01-12)
+#'   \item \code{m} Month number, without leading zero (01-12)
+#'   \item \code{M} Abbreviated month name
+#'   \item \code{MM} Full month name
+#'   \item \code{dd} Day of month with leading zero
+#'   \item \code{d} Day of month without leading zero
+#'   \item \code{D} Abbreviated weekday name
+#'   \item \code{DD} Full weekday name
+#' }
+#'
+#' @inheritParams textInput
+#' @param value The starting date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format. If NULL (the default), will use the current
+#'   date in the client's time zone.
+#' @param min The minimum allowed date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#' @param max The maximum allowed date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#' @param format The format of the date to display in the browser. Defaults to
+#'   \code{"yyyy-mm-dd"}.
+#' @param startview The date range shown when the input object is first
+#'   clicked. Can be "month" (the default), "year", or "decade".
+#' @param weekstart Which day is the start of the week. Should be an integer
+#'   from 0 (Sunday) to 6 (Saturday).
+#' @param language The language used for month and day names. Default is "en".
+#'   Other valid values include "bg", "ca", "cs", "da", "de", "el", "es", "fi",
+#'   "fr", "he", "hr", "hu", "id", "is", "it", "ja", "kr", "lt", "lv", "ms",
+#'   "nb", "nl", "pl", "pt", "pt-BR", "ro", "rs", "rs-latin", "ru", "sk", "sl",
+#'   "sv", "sw", "th", "tr", "uk", "zh-CN", and "zh-TW".
+#'
+#' @family input elements
+#' @seealso \code{\link{dateRangeInput}}, \code{\link{updateDateInput}}
+#'
+#' @examples
+#' dateInput("date", "Date:", value = "2012-02-29")
+#'
+#' # Default value is the date in client's time zone
+#' dateInput("date", "Date:")
+#'
+#' # value is always yyyy-mm-dd, even if the display format is different
+#' dateInput("date", "Date:", value = "2012-02-29", format = "mm/dd/yy")
+#'
+#' # Pass in a Date object
+#' dateInput("date", "Date:", value = Sys.Date()-10)
+#'
+#' # Use different language and different first day of week
+#' dateInput("date", "Date:",
+#'           language = "de",
+#'           weekstart = 1)
+#'
+#' # Start with decade view instead of default month view
+#' dateInput("date", "Date:",
+#'           startview = "decade")
+#'
+#' @export
+dateInput <- function(inputId, label, value = NULL, min = NULL, max = NULL,
+  format = "yyyy-mm-dd", startview = "month", weekstart = 0, language = "en",
+  width = NULL) {
+
+  # If value is a date object, convert it to a string with yyyy-mm-dd format
+  # Same for min and max
+  if (inherits(value, "Date"))  value <- format(value, "%Y-%m-%d")
+  if (inherits(min,   "Date"))  min   <- format(min,   "%Y-%m-%d")
+  if (inherits(max,   "Date"))  max   <- format(max,   "%Y-%m-%d")
+
+  attachDependencies(
+    tags$div(id = inputId,
+      class = "shiny-date-input form-group shiny-input-container",
+      style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+
+      controlLabel(inputId, label),
+      tags$input(type = "text",
+                 # datepicker class necessary for dropdown to display correctly
+                 class = "form-control datepicker",
+                 `data-date-language` = language,
+                 `data-date-weekstart` = weekstart,
+                 `data-date-format` = format,
+                 `data-date-start-view` = startview,
+                 `data-min-date` = min,
+                 `data-max-date` = max,
+                 `data-initial-date` = value
+      )
+    ),
+    datePickerDependency
+  )
+}
+
+datePickerDependency <- htmlDependency(
+  "bootstrap-datepicker", "1.0.2", c(href = "shared/datepicker"),
+  script = "js/bootstrap-datepicker.min.js",
+  stylesheet = "css/datepicker.css")

R/input-daterange.R

@@ -0,0 +1,113 @@
+#' Create date range input
+#'
+#' Creates a pair of text inputs which, when clicked on, bring up calendars that
+#' the user can click on to select dates.
+#'
+#' The date \code{format} string specifies how the date will be displayed in
+#' the browser. It allows the following values:
+#'
+#' \itemize{
+#'   \item \code{yy} Year without century (12)
+#'   \item \code{yyyy} Year with century (2012)
+#'   \item \code{mm} Month number, with leading zero (01-12)
+#'   \item \code{m} Month number, without leading zero (01-12)
+#'   \item \code{M} Abbreviated month name
+#'   \item \code{MM} Full month name
+#'   \item \code{dd} Day of month with leading zero
+#'   \item \code{d} Day of month without leading zero
+#'   \item \code{D} Abbreviated weekday name
+#'   \item \code{DD} Full weekday name
+#' }
+#'
+#' @inheritParams dateInput
+#' @param start The initial start date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format. If NULL (the default), will use the current
+#'   date in the client's time zone.
+#' @param end The initial end date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format. If NULL (the default), will use the current
+#'   date in the client's time zone.
+#' @param separator String to display between the start and end input boxes.
+#'
+#' @family input elements
+#' @seealso \code{\link{dateInput}}, \code{\link{updateDateRangeInput}}
+#'
+#' @examples
+#' dateRangeInput("daterange", "Date range:",
+#'                start = "2001-01-01",
+#'                end   = "2010-12-31")
+#'
+#' # Default start and end is the current date in the client's time zone
+#' dateRangeInput("daterange", "Date range:")
+#'
+#' # start and end are always specified in yyyy-mm-dd, even if the display
+#' # format is different
+#' dateRangeInput("daterange", "Date range:",
+#'                start  = "2001-01-01",
+#'                end    = "2010-12-31",
+#'                min    = "2001-01-01",
+#'                max    = "2012-12-21",
+#'                format = "mm/dd/yy",
+#'                separator = " - ")
+#'
+#' # Pass in Date objects
+#' dateRangeInput("daterange", "Date range:",
+#'                start = Sys.Date()-10,
+#'                end = Sys.Date()+10)
+#'
+#' # Use different language and different first day of week
+#' dateRangeInput("daterange", "Date range:",
+#'                language = "de",
+#'                weekstart = 1)
+#'
+#' # Start with decade view instead of default month view
+#' dateRangeInput("daterange", "Date range:",
+#'                startview = "decade")
+#'
+#' @export
+dateRangeInput <- function(inputId, label, start = NULL, end = NULL,
+    min = NULL, max = NULL, format = "yyyy-mm-dd", startview = "month",
+    weekstart = 0, language = "en", separator = " to ", width = NULL) {
+
+  # If start and end are date objects, convert to a string with yyyy-mm-dd format
+  # Same for min and max
+  if (inherits(start, "Date"))  start <- format(start, "%Y-%m-%d")
+  if (inherits(end,   "Date"))  end   <- format(end,   "%Y-%m-%d")
+  if (inherits(min,   "Date"))  min   <- format(min,   "%Y-%m-%d")
+  if (inherits(max,   "Date"))  max   <- format(max,   "%Y-%m-%d")
+
+  attachDependencies(
+    div(id = inputId,
+      class = "shiny-date-range-input form-group shiny-input-container",
+      style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+
+      controlLabel(inputId, label),
+      # input-daterange class is needed for dropdown behavior
+      div(class = "input-daterange input-group",
+        tags$input(
+          class = "input-sm form-control",
+          type = "text",
+          `data-date-language` = language,
+          `data-date-weekstart` = weekstart,
+          `data-date-format` = format,
+          `data-date-start-view` = startview,
+          `data-min-date` = min,
+          `data-max-date` = max,
+          `data-initial-date` = start
+        ),
+        span(class = "input-group-addon", separator),
+        tags$input(
+          class = "input-sm form-control",
+          type = "text",
+          `data-date-language` = language,
+          `data-date-weekstart` = weekstart,
+          `data-date-format` = format,
+          `data-date-start-view` = startview,
+          `data-min-date` = min,
+          `data-max-date` = max,
+          `data-initial-date` = end
+        )
+      )
+    ),
+    datePickerDependency
+  )
+}

R/input-file.R

@@ -0,0 +1,51 @@
+#' File Upload Control
+#'
+#' Create a file upload control that can be used to upload one or more files.
+#'
+#' Whenever a file upload completes, the corresponding input variable is set
+#' to a dataframe. This dataframe contains one row for each selected file, and
+#' the following columns:
+#' \describe{
+#'   \item{\code{name}}{The filename provided by the web browser. This is
+#'   \strong{not} the path to read to get at the actual data that was uploaded
+#'   (see
+#'   \code{datapath} column).}
+#'   \item{\code{size}}{The size of the uploaded data, in
+#'   bytes.}
+#'   \item{\code{type}}{The MIME type reported by the browser (for example,
+#'   \code{text/plain}), or empty string if the browser didn't know.}
+#'   \item{\code{datapath}}{The path to a temp file that contains the data that was
+#'   uploaded. This file may be deleted if the user performs another upload
+#'   operation.}
+#' }
+#'
+#' @family input elements
+#'
+#' @inheritParams textInput
+#' @param multiple Whether the user should be allowed to select and upload
+#'   multiple files at once. \bold{Does not work on older browsers, including
+#'   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.
+#'
+#' @export
+fileInput <- function(inputId, label, multiple = FALSE, accept = NULL,
+  width = NULL) {
+
+  inputTag <- tags$input(id = inputId, name = inputId, type = "file")
+  if (multiple)
+    inputTag$attribs$multiple <- "multiple"
+  if (length(accept) > 0)
+    inputTag$attribs$accept <- paste(accept, collapse=',')
+
+  div(class = "form-group shiny-input-container",
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+    label %AND% tags$label(label),
+    inputTag,
+    tags$div(
+      id=paste(inputId, "_progress", sep=""),
+      class="progress progress-striped active shiny-file-input-progress",
+      tags$div(class="progress-bar")
+    )
+  )
+}

R/input-numeric.R

@@ -0,0 +1,37 @@
+
+#' Create a numeric input control
+#'
+#' Create an input control for entry of numeric values
+#'
+#' @inheritParams textInput
+#' @param min Minimum allowed value
+#' @param max Maximum allowed value
+#' @param step Interval to use when stepping between min and max
+#' @return A numeric input control that can be added to a UI definition.
+#'
+#' @family input elements
+#' @seealso \code{\link{updateNumericInput}}
+#'
+#' @examples
+#' numericInput("obs", "Observations:", 10,
+#'              min = 1, max = 100)
+#' @export
+numericInput <- function(inputId, label, value, min = NA, max = NA, step = NA,
+  width = NULL) {
+
+  # build input tag
+  inputTag <- tags$input(id = inputId, type = "number", class="form-control",
+                         value = formatNoSci(value))
+  if (!is.na(min))
+    inputTag$attribs$min = min
+  if (!is.na(max))
+    inputTag$attribs$max = max
+  if (!is.na(step))
+    inputTag$attribs$step = step
+
+  div(class = "form-group shiny-input-container",
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+    label %AND% tags$label(label, `for` = inputId),
+    inputTag
+  )
+}

R/input-password.R

@@ -0,0 +1,20 @@
+#' Create a password input control
+#'
+#' Create an password control for entry of passwords.
+#'
+#' @inheritParams textInput
+#' @return A text input control that can be added to a UI definition.
+#'
+#' @family input elements
+#' @seealso \code{\link{updateTextInput}}
+#'
+#' @examples
+#' passwordInput("password", "Password:")
+#' @export
+passwordInput <- function(inputId, label, value = "", width = NULL) {
+  div(class = "form-group shiny-input-container",
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+    label %AND% tags$label(label, `for` = inputId),
+    tags$input(id = inputId, type="password", class="form-control", value=value)
+  )
+}

R/input-radiobuttons.R

@@ -0,0 +1,54 @@
+#' Create radio buttons
+#'
+#' Create a set of radio buttons used to select an item from a list.
+#'
+#' If you need to represent a "None selected" state, it's possible to default
+#' the radio buttons to have no options selected by using
+#' \code{selected = character(0)}. However, this is not recommended, as it gives
+#' the user no way to return to that state once they've made a selection.
+#' Instead, consider having the first of your choices be \code{c("None selected"
+#' = "")}.
+#'
+#' @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)
+#' @param selected The initially selected value (if not specified then
+#' 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.
+#'
+#' @family input elements
+#' @seealso \code{\link{updateRadioButtons}}
+#'
+#' @examples
+#' radioButtons("dist", "Distribution type:",
+#'              c("Normal" = "norm",
+#'                "Uniform" = "unif",
+#'                "Log-normal" = "lnorm",
+#'                "Exponential" = "exp"))
+#' @export
+radioButtons <- function(inputId, label, choices, selected = NULL,
+  inline = FALSE, width = NULL) {
+
+  # resolve names
+  choices <- choicesWithNames(choices)
+
+  # default value if it's not specified
+  selected <- if (is.null(selected)) choices[[1]] else {
+    validateSelected(selected, choices, inputId)
+  }
+  if (length(selected) > 1) stop("The 'selected' argument must be of length 1")
+
+  options <- generateOptions(inputId, choices, selected, inline, type = 'radio')
+
+  divClass <- "form-group shiny-input-radiogroup shiny-input-container"
+  if (inline)
+    divClass <- paste(divClass, "shiny-input-container-inline")
+
+  tags$div(id = inputId,
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+    class = divClass,
+    controlLabel(inputId, label),
+    options
+  )
+}

R/input-select.R

@@ -0,0 +1,167 @@
+#' Create a select list input control
+#'
+#' Create a select list that can be used to choose a single or multiple items
+#' from a list of values.
+#'
+#' 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
+#' select input element. To use the standard HTML select input element, use
+#' \code{selectInput()} with \code{selectize=FALSE}.
+#'
+#' In selectize mode, if the first element in \code{choices} has a value of
+#' \code{""}, its name will be treated as a placeholder prompt. For example:
+#' \code{selectInput("letter", "Letter", c("Choose one" = "", LETTERS))}
+#'
+#' @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.
+#' @param selected The initially selected value (or multiple values if
+#'   \code{multiple = TRUE}). If not specified then defaults to the first value
+#'   for single-select lists and no values for multiple select lists.
+#' @param multiple Is selection of multiple items allowed?
+#' @param selectize Whether to use \pkg{selectize.js} or not.
+#' @param size Number of items to show in the selection box; a larger number
+#'   will result in a taller box. Not compatible with \code{selectize=TRUE}.
+#'   Normally, when \code{multiple=FALSE}, a select input will be a drop-down
+#'   list, but when \code{size} is set, it will be a box instead.
+#' @return A select list control that can be added to a UI definition.
+#'
+#' @family input elements
+#' @seealso \code{\link{updateSelectInput}}
+#'
+#' @examples
+#' selectInput("variable", "Variable:",
+#'             c("Cylinders" = "cyl",
+#'               "Transmission" = "am",
+#'               "Gears" = "gear"))
+#' @export
+selectInput <- function(inputId, label, choices, selected = NULL,
+                        multiple = FALSE, selectize = TRUE, width = NULL,
+                        size = NULL) {
+  # resolve names
+  choices <- choicesWithNames(choices)
+
+  # default value if it's not specified
+  if (is.null(selected)) {
+    if (!multiple) selected <- firstChoice(choices)
+  } else selected <- validateSelected(selected, choices, inputId)
+
+  if (!is.null(size) && selectize) {
+    stop("'size' argument is incompatible with 'selectize=TRUE'.")
+  }
+
+  # create select tag and add options
+  selectTag <- tags$select(
+    id = inputId,
+    class = if (!selectize) "form-control",
+    size = size,
+    selectOptions(choices, selected)
+  )
+  if (multiple)
+    selectTag$attribs$multiple <- "multiple"
+
+  # return label and select tag
+  res <- div(
+    class = "form-group shiny-input-container",
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+    controlLabel(inputId, label),
+    div(selectTag)
+  )
+
+  if (!selectize) return(res)
+
+  selectizeIt(inputId, res, NULL, nonempty = !multiple && !("" %in% choices))
+}
+
+firstChoice <- function(choices) {
+  if (length(choices) == 0L) return()
+  choice <- choices[[1]]
+  if (is.list(choice)) firstChoice(choice) else choice
+}
+
+# Create tags for each of the options; use <optgroup> if necessary.
+# This returns a HTML string instead of tags, because of the 'selected'
+# attribute.
+selectOptions <- function(choices, selected = NULL) {
+  html <- mapply(choices, names(choices), FUN = function(choice, label) {
+    if (is.list(choice)) {
+      # If sub-list, create an optgroup and recurse into the sublist
+      sprintf(
+        '<optgroup label="%s">\n%s\n</optgroup>',
+        htmlEscape(label),
+        selectOptions(choice, selected)
+      )
+
+    } else {
+      # If single item, just return option string
+      sprintf(
+        '<option value="%s"%s>%s</option>',
+        htmlEscape(choice),
+        if (choice %in% selected) ' selected' else '',
+        htmlEscape(label)
+      )
+    }
+  })
+
+  HTML(paste(html, collapse = '\n'))
+}
+
+# need <optgroup> when choices contains sub-lists
+needOptgroup <- function(choices) {
+  any(vapply(choices, is.list, logical(1)))
+}
+
+#' @rdname selectInput
+#' @param ... Arguments passed to \code{selectInput()}.
+#' @param options A list of options. See the documentation of \pkg{selectize.js}
+#'   for possible options (character option values inside \code{\link{I}()} will
+#'   be treated as literal JavaScript code; see \code{\link{renderDataTable}()}
+#'   for details).
+#' @param width The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
+#'   see \code{\link{validateCssUnit}}.
+#' @note The selectize input created from \code{selectizeInput()} allows
+#'   deletion of the selected option even in a single select input, which will
+#'   return an empty string as its value. This is the default behavior of
+#'   \pkg{selectize.js}. However, the selectize input created from
+#'   \code{selectInput(..., selectize = TRUE)} will ignore the empty string
+#'   value when it is a single choice input and the empty string is not in the
+#'   \code{choices} argument. This is to keep compatibility with
+#'   \code{selectInput(..., selectize = FALSE)}.
+#' @export
+selectizeInput <- function(inputId, ..., options = NULL, width = NULL) {
+  selectizeIt(
+    inputId,
+    selectInput(inputId, ..., selectize = FALSE, width = width),
+    options
+  )
+}
+
+# given a select input and its id, selectize it
+selectizeIt <- function(inputId, select, options, nonempty = FALSE) {
+  res <- checkAsIs(options)
+
+  selectizeDep <- htmlDependency(
+    "selectize", "0.11.2", c(href = "shared/selectize"),
+    stylesheet = "css/selectize.bootstrap3.css",
+    head = format(tagList(
+      HTML('<!--[if lt IE 9]>'),
+      tags$script(src = 'shared/selectize/js/es5-shim.min.js'),
+      HTML('<![endif]-->'),
+      tags$script(src = 'shared/selectize/js/selectize.min.js')
+    ))
+  )
+
+  # Insert script on same level as <select> tag
+  select$children[[2]] <- tagAppendChild(
+    select$children[[2]],
+    tags$script(
+      type = 'application/json',
+      `data-for` = inputId, `data-nonempty` = if (nonempty) '',
+      `data-eval` = if (length(res$eval)) HTML(toJSON(res$eval)),
+      if (length(res$options)) HTML(toJSON(res$options)) else '{}'
+    )
+  )
+
+  attachDependencies(select, selectizeDep)
+}

R/input-slider.R

@@ -0,0 +1,234 @@
+#' Slider Input Widget
+#'
+#' Constructs a slider widget to select a numeric value from a range.
+#'
+#' @inheritParams textInput
+#' @param min The minimum value (inclusive) that can be selected.
+#' @param max The maximum value (inclusive) that can be selected.
+#' @param value The initial value of the slider. A numeric vector of length one
+#'   will create a regular slider; a numeric vector of length two will create a
+#'   double-ended range slider. A warning will be issued if the value doesn't
+#'   fit between \code{min} and \code{max}.
+#' @param step Specifies the interval between each selectable value on the
+#'   slider (if \code{NULL}, a heuristic is used to determine the step size). If
+#'   the values are dates, \code{step} is in days; if the values are times
+#'   (POSIXt), \code{step} is in seconds.
+#' @param round \code{TRUE} to round all values to the nearest integer;
+#'   \code{FALSE} if no rounding is desired; or an integer to round to that
+#'   number of digits (for example, 1 will round to the nearest 10, and -2 will
+#'   round to the nearest .01). Any rounding will be applied after snapping to
+#'   the nearest step.
+#' @param format Deprecated.
+#' @param locale Deprecated.
+#' @param ticks \code{FALSE} to hide tick marks, \code{TRUE} to show them
+#'   according to some simple heuristics.
+#' @param animate \code{TRUE} to show simple animation controls with default
+#'   settings; \code{FALSE} not to; or a custom settings list, such as those
+#'   created using \code{\link{animationOptions}}.
+#' @param sep Separator between thousands places in numbers.
+#' @param pre A prefix string to put in front of the value.
+#' @param post A suffix string to put after the value.
+#' @param dragRange This option is used only if it is a range slider (with two
+#'   values). If \code{TRUE} (the default), the range can be dragged. In other
+#'   words, the min and max can be dragged together. If \code{FALSE}, the range
+#'   cannot be dragged.
+#' @param timeFormat Only used if the values are Date or POSIXt objects. A time
+#'   format string, to be passed to the Javascript strftime library. See
+#'   \url{https://github.com/samsonjs/strftime} for more details. The allowed
+#'   format specifications are very similar, but not identical, to those for R's
+#'   \code{\link{strftime}} function. For Dates, the default is \code{"\%F"}
+#'   (like \code{"2015-07-01"}), and for POSIXt, the default is \code{"\%F \%T"}
+#'   (like \code{"2015-07-01 15:32:10"}).
+#' @param timezone Only used if the values are POSIXt objects. A string
+#'   specifying the time zone offset for the displayed times, in the format
+#'   \code{"+HHMM"} or \code{"-HHMM"}. If \code{NULL} (the default), times will
+#'   be displayed in the browser's time zone. The value \code{"+0000"} will
+#'   result in UTC time.
+#' @inheritParams selectizeInput
+#' @family input elements
+#' @seealso \code{\link{updateSliderInput}}
+#'
+#' @export
+sliderInput <- function(inputId, label, min, max, value, step = NULL,
+                        round = FALSE, format = NULL, locale = NULL,
+                        ticks = TRUE, animate = FALSE, width = NULL, sep = ",",
+                        pre = NULL, post = NULL, timeFormat = NULL,
+                        timezone = NULL, dragRange = TRUE)
+{
+  if (!missing(format)) {
+    shinyDeprecated(msg = "The `format` argument to sliderInput is deprecated. Use `sep`, `pre`, and `post` instead.",
+                    version = "0.10.2.2")
+  }
+  if (!missing(locale)) {
+    shinyDeprecated(msg = "The `locale` argument to sliderInput is deprecated. Use `sep`, `pre`, and `post` instead.",
+                    version = "0.10.2.2")
+  }
+
+  # If step is NULL, use heuristic to set the step size.
+  findStepSize <- function(min, max, step) {
+    if (!is.null(step)) return(step)
+
+    range <- max - min
+    # If short range or decimals, use continuous decimal with ~100 points
+    if (range < 2 || hasDecimals(min) || hasDecimals(max)) {
+      step <- pretty(c(min, max), n = 100)
+      step[2] - step[1]
+    } else {
+      1
+    }
+  }
+
+  if (inherits(min, "Date")) {
+    if (!inherits(max, "Date") || !inherits(value, "Date"))
+      stop("`min`, `max`, and `value must all be Date or non-Date objects")
+    dataType <- "date"
+
+    if (is.null(timeFormat))
+      timeFormat <- "%F"
+
+  } else if (inherits(min, "POSIXt")) {
+    if (!inherits(max, "POSIXt") || !inherits(value, "POSIXt"))
+      stop("`min`, `max`, and `value must all be POSIXt or non-POSIXt objects")
+    dataType <- "datetime"
+
+    if (is.null(timeFormat))
+      timeFormat <- "%F %T"
+
+  } else {
+    dataType <- "number"
+  }
+
+  step <- findStepSize(min, max, step)
+
+  if (dataType %in% c("date", "datetime")) {
+    # For Dates, this conversion uses midnight on that date in UTC
+    to_ms <- function(x) 1000 * as.numeric(as.POSIXct(x))
+
+    # Convert values to milliseconds since epoch (this is the value JS uses)
+    # Find step size in ms
+    step  <- to_ms(max) - to_ms(max - step)
+    min   <- to_ms(min)
+    max   <- to_ms(max)
+    value <- to_ms(value)
+  }
+
+  range <- max - min
+
+  # Try to get a sane number of tick marks
+  if (ticks) {
+    n_steps <- range / step
+
+    # Make sure there are <= 10 steps.
+    # n_ticks can be a noninteger, which is good when the range is not an
+    # integer multiple of the step size, e.g., min=1, max=10, step=4
+    scale_factor <- ceiling(n_steps / 10)
+    n_ticks <- n_steps / scale_factor
+
+  } else {
+    n_ticks <- NULL
+  }
+
+  sliderProps <- dropNulls(list(
+    class = "js-range-slider",
+    id = inputId,
+    `data-type` = if (length(value) > 1) "double",
+    `data-min` = formatNoSci(min),
+    `data-max` = formatNoSci(max),
+    `data-from` = formatNoSci(value[1]),
+    `data-to` = if (length(value) > 1) formatNoSci(value[2]),
+    `data-step` = formatNoSci(step),
+    `data-grid` = ticks,
+    `data-grid-num` = n_ticks,
+    `data-grid-snap` = FALSE,
+    `data-prettify-separator` = sep,
+    `data-prefix` = pre,
+    `data-postfix` = post,
+    `data-keyboard` = TRUE,
+    `data-keyboard-step` = step / (max - min) * 100,
+    `data-drag-interval` = dragRange,
+    # The following are ignored by the ion.rangeSlider, but are used by Shiny.
+    `data-data-type` = dataType,
+    `data-time-format` = timeFormat,
+    `data-timezone` = timezone
+  ))
+
+  # Replace any TRUE and FALSE with "true" and "false"
+  sliderProps <- lapply(sliderProps, function(x) {
+    if (identical(x, TRUE)) "true"
+    else if (identical(x, FALSE)) "false"
+    else x
+  })
+
+  sliderTag <- div(class = "form-group shiny-input-container",
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+    if (!is.null(label)) controlLabel(inputId, label),
+    do.call(tags$input, sliderProps)
+  )
+
+  # Add animation buttons
+  if (identical(animate, TRUE))
+    animate <- animationOptions()
+
+  if (!is.null(animate) && !identical(animate, FALSE)) {
+    if (is.null(animate$playButton))
+      animate$playButton <- icon('play', lib = 'glyphicon')
+    if (is.null(animate$pauseButton))
+      animate$pauseButton <- icon('pause', lib = 'glyphicon')
+
+    sliderTag <- tagAppendChild(
+      sliderTag,
+      tags$div(class='slider-animate-container',
+        tags$a(href='#',
+          class='slider-animate-button',
+          'data-target-id'=inputId,
+          'data-interval'=animate$interval,
+          'data-loop'=animate$loop,
+          span(class = 'play', animate$playButton),
+          span(class = 'pause', animate$pauseButton)
+        )
+      )
+    )
+  }
+
+  dep <- list(
+    htmlDependency("ionrangeslider", "2.0.12", c(href="shared/ionrangeslider"),
+      script = "js/ion.rangeSlider.min.js",
+      # ion.rangeSlider also needs normalize.css, which is already included in
+      # Bootstrap.
+      stylesheet = c("css/ion.rangeSlider.css",
+                     "css/ion.rangeSlider.skinShiny.css")
+    ),
+    htmlDependency("strftime", "0.9.2", c(href="shared/strftime"),
+      script = "strftime-min.js"
+    )
+  )
+
+  attachDependencies(sliderTag, dep)
+}
+
+hasDecimals <- function(value) {
+  truncatedValue <- round(value)
+  return (!identical(value, truncatedValue))
+}
+
+#' @rdname sliderInput
+#'
+#' @param interval The interval, in milliseconds, between each animation step.
+#' @param loop \code{TRUE} to automatically restart the animation when it
+#'   reaches the end.
+#' @param playButton Specifies the appearance of the play button. Valid values
+#'   are a one-element character vector (for a simple text label), an HTML tag
+#'   or list of tags (using \code{\link{tag}} and friends), or raw HTML (using
+#'   \code{\link{HTML}}).
+#' @param pauseButton Similar to \code{playButton}, but for the pause button.
+#'
+#' @export
+animationOptions <- function(interval=1000,
+                             loop=FALSE,
+                             playButton=NULL,
+                             pauseButton=NULL) {
+  list(interval=interval,
+       loop=loop,
+       playButton=playButton,
+       pauseButton=pauseButton)
+}

R/input-submit.R

@@ -0,0 +1,28 @@
+#' Create a submit button
+#'
+#' Create a submit button for an input form. Forms that include a submit
+#' button do not automatically update their outputs when inputs change,
+#' rather they wait until the user explicitly clicks the submit button.
+#'
+#' @param text Button caption
+#' @param icon Optional \code{\link{icon}} to appear on the button
+#' @param width The width of the button, e.g. \code{'400px'}, or \code{'100\%'};
+#'   see \code{\link{validateCssUnit}}.
+#' @return A submit button that can be added to a UI definition.
+#'
+#' @family input elements
+#'
+#' @examples
+#' submitButton("Update View")
+#' submitButton("Update View", icon("refresh"))
+#' @export
+submitButton <- function(text = "Apply Changes", icon = NULL, width = NULL) {
+  div(
+    tags$button(
+      type="submit",
+      class="btn btn-primary",
+      style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+      list(icon, text)
+    )
+  )
+}

R/input-text.R

@@ -0,0 +1,24 @@
+#' Create a text input control
+#'
+#' Create an input control for entry of unstructured text values
+#'
+#' @param inputId The \code{input} slot that will be used to access the value.
+#' @param label Display label for the control, or \code{NULL} for no label.
+#' @param value Initial value.
+#' @param width The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
+#'   see \code{\link{validateCssUnit}}.
+#' @return A text input control that can be added to a UI definition.
+#'
+#' @family input elements
+#' @seealso \code{\link{updateTextInput}}
+#'
+#' @examples
+#' textInput("caption", "Caption:", "Data Summary")
+#' @export
+textInput <- function(inputId, label, value = "", width = NULL) {
+  div(class = "form-group shiny-input-container",
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
+    label %AND% tags$label(label, `for` = inputId),
+    tags$input(id = inputId, type="text", class="form-control", value=value)
+  )
+}

R/input-utils.R

@@ -0,0 +1,105 @@
+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.
+validateSelected <- function(selected, choices, inputId) {
+  # drop names, otherwise toJSON() keeps them too
+  selected <- unname(selected)
+  # if you are using optgroups, you're using shiny > 0.10.0, and you should
+  # already know that `selected` must be a value instead of a label
+  if (needOptgroup(choices)) return(selected)
+
+  if (is.list(choices)) choices <- unlist(choices)
+
+  nms <- names(choices)
+  # labels and values are identical, no need to validate
+  if (identical(nms, unname(choices))) return(selected)
+  # when selected labels instead of values
+  i <- (selected %in% nms) & !(selected %in% choices)
+  if (any(i)) {
+    warnFun <- if (all(i)) {
+      # replace names with values
+      selected <- unname(choices[selected])
+      warning
+    } else stop  # stop when it is ambiguous (some labels == values)
+    warnFun("'selected' must be the values instead of names of 'choices' ",
+            "for the input '", inputId, "'")
+  }
+  selected
+}
+
+
+# generate options for radio buttons and checkbox groups (type = 'checkbox' or
+# 'radio')
+generateOptions <- function(inputId, choices, selected, inline, type = 'checkbox') {
+  # generate a list of <input type=? [checked] />
+  options <- mapply(
+    choices, names(choices),
+    FUN = function(value, name) {
+      inputTag <- tags$input(
+        type = type, name = inputId, value = value
+      )
+      if (value %in% selected)
+        inputTag$attribs$checked <- "checked"
+
+      # 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))
+      } else {
+        tags$div(class = type,
+          tags$label(inputTag, tags$span(name))
+        )
+      }
+    },
+    SIMPLIFY = FALSE, USE.NAMES = FALSE
+  )
+
+  div(class = "shiny-options-group", options)
+}
+
+
+# Takes a vector or list, and adds names (same as the value) to any entries
+# without names.
+choicesWithNames <- function(choices) {
+  # Take a vector or list, and convert to list. Also, if any children are
+  # vectors with length > 1, convert those to list. If the list is unnamed,
+  # convert it to a named list with blank names.
+  listify <- function(obj) {
+    # If a list/vector is unnamed, give it blank names
+    makeNamed <- function(x) {
+      if (is.null(names(x))) names(x) <- character(length(x))
+      x
+    }
+
+    res <- lapply(obj, function(val) {
+      if (is.list(val))
+        listify(val)
+      else if (length(val) == 1 && is.null(names(val)))
+        val
+      else
+        makeNamed(as.list(val))
+    })
+
+    makeNamed(res)
+  }
+
+  choices <- listify(choices)
+  if (length(choices) == 0) return(choices)
+
+  # Recurse into any subgroups
+  choices <- mapply(choices, names(choices), FUN = function(choice, name) {
+    if (!is.list(choice)) return(choice)
+    if (name == "") stop('All sub-lists in "choices" must be named.')
+    choicesWithNames(choice)
+  }, SIMPLIFY = FALSE)
+
+  # default missing names to choice values
+  missing <- names(choices) == ""
+  names(choices)[missing] <- as.character(choices)[missing]
+
+  choices
+}

R/map.R

@@ -23,6 +23,9 @@ Map <- R6Class(
       env[[key]] <- value
       value
     },
+    mget = function(keys) {
+      base::mget(keys, env)
+    },
     mset = function(...) {
       args <- list(...)
       if (length(args) == 0)

R/middleware.R

@@ -332,6 +332,15 @@ HandlerManager <- R6Class("HandlerManager",
             headers=list('Content-Type' = 'text/html')))
         }
 
+        # Catch HEAD requests. For the purposes of handler functions, they
+        # should be treated like GET. The difference is that  they shouldn't
+        # return a body in the http response.
+        head_request <- FALSE
+        if (identical(req$REQUEST_METHOD, "HEAD")) {
+          head_request <- TRUE
+          req$REQUEST_METHOD <- "GET"
+        }
+
         response <- handler(req)
         if (is.null(response))
           response <- httpResponse(404, content="<h1>Not Found</h1>")
@@ -341,9 +350,21 @@ HandlerManager <- R6Class("HandlerManager",
           headers$'Content-Type' <- response$content_type
 
           response <- filter(req, response)
-          return(list(status=response$status,
-            body=response$content,
-            headers=headers))
+          if (head_request) {
+            headers$`Content-Length` <- nchar(response$content, type = "bytes")
+            return(list(
+              status = response$status,
+              body = "",
+              headers = headers
+            ))
+          } else {
+            return(list(
+              status = response$status,
+              body = response$content,
+              headers = headers
+            ))
+          }
+
         } else {
           # Assume it's a Rook-compatible response
           return(response)

R/progress.R

@@ -87,7 +87,7 @@ Progress <- R6Class(
         stop("'session' is not a ShinySession object.")
 
       private$session <- session
-      private$id <- paste(as.character(as.raw(runif(8, min=0, max=255))), collapse='')
+      private$id <- paste(as.character(as.raw(stats::runif(8, min=0, max=255))), collapse='')
       private$min <- min
       private$max <- max
       private$value <- NULL

R/reactives.R

@@ -307,10 +307,10 @@ reactiveValuesToList <- function(x, all.names=FALSE) {
 # x[['impl']].
 #' @export
 str.reactivevalues <- function(object, indent.str = " ", ...) {
-  str(unclass(object), indent.str = indent.str, ...)
+  utils::str(unclass(object), indent.str = indent.str, ...)
   # Need to manually print out the class field,
   cat(indent.str, '- attr(*, "class")=', sep = "")
-  str(class(object))
+  utils::str(class(object))
 }
 
 # Observable ----------------------------------------------------------------

R/render-plot.R

@@ -93,9 +93,9 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
 
         # Special case for ggplot objects - need to capture coordmap
         if (inherits(result$value, "ggplot")) {
-          capture.output(coordmap <<- getGgplotCoordmap(result$value, pixelratio))
+          utils::capture.output(coordmap <<- getGgplotCoordmap(result$value, pixelratio))
         } else {
-          capture.output(print(result$value))
+          utils::capture.output(print(result$value))
         }
       }
 
@@ -237,12 +237,12 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
 # Requires width and height of output image, in pixels.
 # Must be called before the graphics device is closed.
 getPrevPlotCoordmap <- function(width, height) {
-  usrCoords <- par('usr')
+  usrCoords <- graphics::par('usr')
   usrBounds <- usrCoords
-  if (par('xlog')) {
+  if (graphics::par('xlog')) {
     usrBounds[c(1,2)] <- 10 ^ usrBounds[c(1,2)]
   }
-  if (par('ylog')) {
+  if (graphics::par('ylog')) {
     usrBounds[c(3,4)] <- 10 ^ usrBounds[c(3,4)]
   }
 
@@ -257,14 +257,14 @@ getPrevPlotCoordmap <- function(width, height) {
     ),
     # The bounds of the plot area, in DOM pixels
     range = list(
-      left = grconvertX(usrBounds[1], 'user', 'nfc') * width,
-      right = grconvertX(usrBounds[2], 'user', 'nfc') * width,
-      bottom = (1-grconvertY(usrBounds[3], 'user', 'nfc')) * height - 1,
-      top = (1-grconvertY(usrBounds[4], 'user', 'nfc')) * height - 1
+      left = graphics::grconvertX(usrBounds[1], 'user', 'nfc') * width,
+      right = graphics::grconvertX(usrBounds[2], 'user', 'nfc') * width,
+      bottom = (1-graphics::grconvertY(usrBounds[3], 'user', 'nfc')) * height - 1,
+      top = (1-graphics::grconvertY(usrBounds[4], 'user', 'nfc')) * height - 1
     ),
     log = list(
-      x = if (par('xlog')) 10 else NULL,
-      y = if (par('ylog')) 10 else NULL
+      x = if (graphics::par('xlog')) 10 else NULL,
+      y = if (graphics::par('ylog')) 10 else NULL
     ),
     # We can't extract the original variable names from a base graphic.
     # `mapping` is an empty _named_ list, so that it is converted to an object
@@ -278,9 +278,14 @@ getGgplotCoordmap <- function(p, pixelratio) {
   if (!inherits(p, "ggplot"))
     return(NULL)
 
-  # A modified version of print.ggplot which returns the built ggplot object
-  # as well as the gtable grob.
-  print_ggplot <- function(x) {
+  # A modified version of print.ggplot which returns the built ggplot object as
+  # well as the gtable grob. This overrides the ggplot::print.ggplot method, but
+  # only within the context of getGgplotCoordmap. The reason this needs to be an
+  # (pseudo) S3 method is so that, if an object has a class in addition to
+  # ggplot, and there's a print method for that class, that we won't override
+  # that method.
+  # https://github.com/rstudio/shiny/issues/841
+  print.ggplot <- function(x) {
     grid::grid.newpage()
 
     build <- ggplot2::ggplot_build(x)
@@ -294,6 +299,21 @@ getGgplotCoordmap <- function(p, pixelratio) {
     )
   }
 
+  # Given the name of a generic function and an object, return the class name
+  # for the method that would be used on the object.
+  which_method <- function(generic, x) {
+    classes <- class(x)
+    method_names <- paste(generic, classes, sep = ".")
+    idx <- which(method_names %in% utils::methods(generic))
+
+    if (length(idx) == 0)
+      return(NULL)
+
+    # Return name of first class with matching method
+    classes[idx[1]]
+  }
+
+
   # Given a built ggplot object, return x and y domains (data space coords) for
   # each panel.
   find_panel_info <- function(b) {
@@ -519,7 +539,7 @@ getGgplotCoordmap <- function(p, pixelratio) {
     # 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(dev.cur()))) {
+    if (!grepl("^quartz", names(grDevices::dev.cur()))) {
       pix_ratio <- pixelratio
     }
 
@@ -536,27 +556,36 @@ getGgplotCoordmap <- function(p, pixelratio) {
     })
   }
 
+  # If print(p) gets dispatched to print.ggplot(p), attempt to extract coordmap.
+  # If dispatched to another method, just print the object and don't attempt to
+  # extract the coordmap. This can happen if there's another print method that
+  # takes precedence.
+  if (identical(which_method("print", p), "ggplot")) {
+    res <- print(p)
 
-  res <- print_ggplot(p)
+    tryCatch({
+      # Get info from built ggplot object
+      info <- find_panel_info(res$build)
 
-  tryCatch({
-    # Get info from built ggplot object
-    info <- find_panel_info(res$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(res$gtable, pixelratio)
 
-    # 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(res$gtable, pixelratio)
+      for (i in seq_along(info)) {
+        info[[i]]$range <- ranges[[i]]
+      }
 
-    for (i in seq_along(info)) {
-      info[[i]]$range <- ranges[[i]]
-    }
+      return(info)
 
-    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))
+    })
 
-  }, 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))
-  })
+  } else {
+    print(p)
+    return(list())
+  }
 }

R/run-url.R

@@ -71,8 +71,8 @@ runUrl <- function(url, filetype = NULL, subdir = NULL, destdir = NULL, ...) {
     untar2(filePath, exdir = fileDir)
 
   } else if (fileext == ".zip") {
-    first <- as.character(unzip(filePath, list=TRUE)$Name)[1]
-    unzip(filePath, exdir = fileDir)
+    first <- as.character(utils::unzip(filePath, list=TRUE)$Name)[1]
+    utils::unzip(filePath, exdir = fileDir)
   }
 
   if(is.null(destdir)){
@@ -80,7 +80,7 @@ runUrl <- function(url, filetype = NULL, subdir = NULL, destdir = NULL, ...) {
   }
 
   appdir <- file.path(fileDir, first)
-  if (!file_test('-d', appdir)) appdir <- dirname(appdir)
+  if (!utils::file_test('-d', appdir)) appdir <- dirname(appdir)
 
   if (!is.null(subdir)) appdir <- file.path(appdir, subdir)
   runApp(appdir, ...)
@@ -112,7 +112,7 @@ runGist <- function(gist, destdir = NULL, ...) {
     stop('Unrecognized gist identifier format')
   }
 
-  runUrl(gistUrl, filetype = ".tar.gz", destdir = destdir, ...)
+  runUrl(gistUrl, filetype = ".zip", destdir = destdir, ...)
 }
 
 

R/server-input-handlers.R

@@ -0,0 +1,111 @@
+# Create a map for input handlers and register the defaults.
+inputHandlers <- Map$new()
+
+#' Register an Input Handler
+#'
+#' Adds an input handler for data of this type. When called, Shiny will use the
+#' function provided to refine the data passed back from the client (after being
+#' deserialized by jsonlite) before making it available in the \code{input}
+#' variable of the \code{server.R} file.
+#'
+#' This function will register the handler for the duration of the R process
+#' (unless Shiny is explicitly reloaded). For that reason, the \code{type} used
+#' should be very specific to this package to minimize the risk of colliding
+#' with another Shiny package which might use this data type name. We recommend
+#' the format of "packageName.widgetName".
+#'
+#' Currently Shiny registers the following handlers: \code{shiny.matrix},
+#' \code{shiny.number}, and \code{shiny.date}.
+#'
+#' The \code{type} of a custom Shiny Input widget will be deduced using the
+#' \code{getType()} JavaScript function on the registered Shiny inputBinding.
+#' @param type The type for which the handler should be added -- should be a
+#' single-element character vector.
+#' @param fun The handler function. This is the function that will be used to
+#'   parse the data delivered from the client before it is available in the
+#'   \code{input} variable. The function will be called with the following three
+#'   parameters:
+#'    \enumerate{
+#'      \item{The value of this input as provided by the client, deserialized
+#'      using jsonlite.}
+#'      \item{The \code{shinysession} in which the input exists.}
+#'      \item{The name of the input.}
+#'    }
+#' @param force If \code{TRUE}, will overwrite any existing handler without
+#' warning. If \code{FALSE}, will throw an error if this class already has
+#' a handler defined.
+#' @examples
+#' \dontrun{
+#' # Register an input handler which rounds a input number to the nearest integer
+#' registerInputHandler("mypackage.validint", function(x, shinysession, name) {
+#'   if (is.null(x)) return(NA)
+#'   round(x)
+#' })
+#'
+#' ## On the Javascript side, the associated input binding must have a corresponding getType method:
+#' getType: function(el) {
+#'   return "mypackage.validint";
+#' }
+#'
+#' }
+#' @seealso \code{\link{removeInputHandler}}
+#' @export
+registerInputHandler <- function(type, fun, force=FALSE){
+  if (inputHandlers$containsKey(type) && !force){
+    stop("There is already an input handler for type: ", type)
+  }
+  inputHandlers$set(type, fun)
+}
+
+#' Deregister an Input Handler
+#'
+#' Removes an Input Handler. Rather than using the previously specified handler
+#' for data of this type, the default jsonlite serialization will be used.
+#'
+#' @param type The type for which handlers should be removed.
+#' @return The handler previously associated with this \code{type}, if one
+#'   existed. Otherwise, \code{NULL}.
+#' @seealso \code{\link{registerInputHandler}}
+#' @export
+removeInputHandler <- function(type){
+  inputHandlers$remove(type)
+}
+
+# Takes a list-of-lists and returns a matrix. The lists
+# must all be the same length. NULL is replaced by NA.
+registerInputHandler("shiny.matrix", function(data, ...) {
+  if (length(data) == 0)
+    return(matrix(nrow=0, ncol=0))
+
+  m <- matrix(unlist(lapply(data, function(x) {
+    sapply(x, function(y) {
+      ifelse(is.null(y), NA, y)
+    })
+  })), nrow = length(data[[1]]), ncol = length(data))
+  return(m)
+})
+
+registerInputHandler("shiny.number", function(val, ...){
+  ifelse(is.null(val), NA, val)
+})
+
+registerInputHandler("shiny.date", function(val, ...){
+  # First replace NULLs with NA, then convert to Date vector
+  datelist <- ifelse(lapply(val, is.null), NA, val)
+  as.Date(unlist(datelist))
+})
+
+registerInputHandler("shiny.datetime", function(val, ...){
+  # First replace NULLs with NA, then convert to POSIXct vector
+  times <- lapply(val, function(x) {
+    if (is.null(x)) NA
+    else x
+  })
+  as.POSIXct(unlist(times), origin = "1970-01-01", tz = "UTC")
+})
+
+registerInputHandler("shiny.action", function(val, ...) {
+  # mark up the action button value with a special class so we can recognize it later
+  class(val) <- c(class(val), "shinyActionButtonValue")
+  val
+})

R/server.R

@@ -1,110 +1,7 @@
-#' @include globals.R
+#' @include server-input-handlers.R
 
 appsByToken <- Map$new()
 
-# Create a map for input handlers and register the defaults.
-inputHandlers <- Map$new()
-
-#' Register an Input Handler
-#'
-#' Adds an input handler for data of this type. When called, Shiny will use the
-#' function provided to refine the data passed back from the client (after being
-#' deserialized by jsonlite) before making it available in the \code{input}
-#' variable of the \code{server.R} file.
-#'
-#' This function will register the handler for the duration of the R process
-#' (unless Shiny is explicitly reloaded). For that reason, the \code{type} used
-#' should be very specific to this package to minimize the risk of colliding
-#' with another Shiny package which might use this data type name. We recommend
-#' the format of "packageName.widgetName".
-#'
-#' Currently Shiny registers the following handlers: \code{shiny.matrix},
-#' \code{shiny.number}, and \code{shiny.date}.
-#'
-#' The \code{type} of a custom Shiny Input widget will be deduced using the
-#' \code{getType()} JavaScript function on the registered Shiny inputBinding.
-#' @param type The type for which the handler should be added -- should be a
-#' single-element character vector.
-#' @param fun The handler function. This is the function that will be used to
-#'   parse the data delivered from the client before it is available in the
-#'   \code{input} variable. The function will be called with the following three
-#'   parameters:
-#'    \enumerate{
-#'      \item{The value of this input as provided by the client, deserialized
-#'      using jsonlite.}
-#'      \item{The \code{shinysession} in which the input exists.}
-#'      \item{The name of the input.}
-#'    }
-#' @param force If \code{TRUE}, will overwrite any existing handler without
-#' warning. If \code{FALSE}, will throw an error if this class already has
-#' a handler defined.
-#' @examples
-#' \dontrun{
-#' # Register an input handler which rounds a input number to the nearest integer
-#' registerInputHandler("mypackage.validint", function(x, shinysession, name) {
-#'   if (is.null(x)) return(NA)
-#'   round(x)
-#' })
-#'
-#' ## On the Javascript side, the associated input binding must have a corresponding getType method:
-#' getType: function(el) {
-#'   return "mypackage.validint";
-#' }
-#'
-#' }
-#' @seealso \code{\link{removeInputHandler}}
-#' @export
-registerInputHandler <- function(type, fun, force=FALSE){
-  if (inputHandlers$containsKey(type) && !force){
-    stop("There is already an input handler for type: ", type)
-  }
-  inputHandlers$set(type, fun)
-}
-
-#' Deregister an Input Handler
-#'
-#' Removes an Input Handler. Rather than using the previously specified handler
-#' for data of this type, the default jsonlite serialization will be used.
-#'
-#' @param type The type for which handlers should be removed.
-#' @return The handler previously associated with this \code{type}, if one
-#'   existed. Otherwise, \code{NULL}.
-#' @seealso \code{\link{registerInputHandler}}
-#' @export
-removeInputHandler <- function(type){
-  inputHandlers$remove(type)
-}
-
-# Takes a list-of-lists and returns a matrix. The lists
-# must all be the same length. NULL is replaced by NA.
-registerInputHandler("shiny.matrix", function(data, ...) {
-  if (length(data) == 0)
-    return(matrix(nrow=0, ncol=0))
-
-  m <- matrix(unlist(lapply(data, function(x) {
-    sapply(x, function(y) {
-      ifelse(is.null(y), NA, y)
-    })
-  })), nrow = length(data[[1]]), ncol = length(data))
-  return(m)
-})
-
-registerInputHandler("shiny.number", function(val, ...){
-  ifelse(is.null(val), NA, val)
-})
-
-registerInputHandler("shiny.date", function(val, ...){
-  # First replace NULLs with NA, then convert to Date vector
-  datelist <- ifelse(lapply(val, is.null), NA, val)
-  as.Date(unlist(datelist))
-})
-
-registerInputHandler("shiny.action", function(val, ...) {
-  # mark up the action button value with a special class so we can recognize it later
-  class(val) <- c(class(val), "shinyActionButtonValue")
-  val
-})
-
 # Provide a character representation of the WS that can be used
 # as a key in a Map.
 wsToKey <- function(WS) {
@@ -650,7 +547,7 @@ runApp <- function(appDir=getwd(),
     # SHINY_SERVER_VERSION, those will return "" which is considered less than
     # any valid version.
     ver <- Sys.getenv('SHINY_SERVER_VERSION')
-    if (compareVersion(ver, .shinyServerMinVersion) < 0) {
+    if (utils::compareVersion(ver, .shinyServerMinVersion) < 0) {
       warning('Shiny Server v', .shinyServerMinVersion,
               ' or later is required; please upgrade!')
     }

R/shiny.R

@@ -20,6 +20,14 @@ NULL
 #' @import htmltools httpuv xtable digest R6 mime
 NULL
 
+# It's necessary to Depend on methods so Rscript doesn't fail. It's necessary
+# to import(methods) in NAMESPACE so R CMD check doesn't complain. This
+# approach isn't foolproof because Rscript -e pkgname::func() doesn't actually
+# cause methods to be attached, but it's not a problem for shiny::runApp()
+# since we call require(shiny) as part of loading the app.
+#' @import methods
+NULL
+
 
 #' Global options for Shiny
 #'
@@ -53,6 +61,10 @@ NULL
 #'     \code{\link{runApp}} for more information.}
 #'   \item{shiny.json.digits}{The number of digits to use when converting
 #'     numbers to JSON format to send to the client web browser.}
+#'   \item{shiny.minified}{If this is \code{TRUE} or unset (the default), then
+#'     Shiny will use minified JavaScript (\code{shiny.min.js}). If
+#'     \code{FALSE}, then Shiny will use the un-minified JavaScript
+#'     (\code{shiny.js}); this can be useful during development.}
 #'   \item{shiny.error}{This can be a function which is called when an error
 #'     occurs. For example, \code{options(shiny.error=recover)} will result a
 #'     the debugger prompt when an error occurs.}
@@ -301,6 +313,14 @@ ShinySession <- R6Class(
       if (is.null(hidden)) hidden <- TRUE
 
       return(hidden && private$getOutputOption(name, 'suspendWhenHidden', TRUE))
+    },
+
+    registerSessionEndCallbacks = function() {
+      # This is to be called from the initialization. It registers functions
+      # that are called when a session ends.
+
+      # Clear file upload directories, if present
+      self$onSessionEnded(private$fileUploadContext$rmUploadDirs)
     }
   ),
   public = list(
@@ -346,6 +366,8 @@ ShinySession <- R6Class(
       private$.outputs <- list()
       private$.outputOptions <- list()
 
+      private$registerSessionEndCallbacks()
+
       if (!is.null(websocket$request$HTTP_SHINY_SERVER_CREDENTIALS)) {
         try({
           creds <- jsonlite::fromJSON(websocket$request$HTTP_SHINY_SERVER_CREDENTIALS)
@@ -477,7 +499,7 @@ ShinySession <- R6Class(
             private$invalidatedOutputErrors$set(
               name,
               list(message = cond$message,
-                   call = capture.output(print(cond$call)),
+                   call = utils::capture.output(print(cond$call)),
                    type = if (length(type)) type))
           }
           else

R/shinyui.R

@@ -39,8 +39,9 @@ renderPage <- function(ui, connection, showcase=0) {
     list(
       htmlDependency("json2", "2014.02.04", c(href="shared"), script = "json2-min.js"),
       htmlDependency("jquery", "1.11.0", c(href="shared"), script = "jquery.min.js"),
-      htmlDependency("shiny", packageVersion("shiny"), c(href="shared"),
-        script = "shiny.min.js", stylesheet = "shiny.css")
+      htmlDependency("shiny", utils::packageVersion("shiny"), c(href="shared"),
+        script = if (getOption("shiny.minified", TRUE)) "shiny.min.js" else "shiny.js",
+        stylesheet = "shiny.css")
     ),
     result$dependencies
   )

R/shinywrappers.R

@@ -185,7 +185,7 @@ renderTable <- function(expr, ..., env=parent.frame(), quoted=FALSE, func=NULL)
       return("")
 
     return(paste(
-      capture.output(
+      utils::capture.output(
         print(xtable(data, ...),
               type='html',
               html.table.attributes=paste('class="',
@@ -238,7 +238,7 @@ renderPrint <- function(expr, env = parent.frame(), quoted = FALSE, func = NULL,
   markRenderFunction(verbatimTextOutput, function() {
     op <- options(width = width)
     on.exit(options(op), add = TRUE)
-    paste(capture.output(func()), collapse = "\n")
+    paste(utils::capture.output(func()), collapse = "\n")
   })
 }
 
@@ -278,7 +278,7 @@ renderText <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
 
   markRenderFunction(textOutput, function() {
     value <- func()
-    return(paste(capture.output(cat(value)), collapse="\n"))
+    return(paste(utils::capture.output(cat(value)), collapse="\n"))
   })
 }
 
@@ -416,10 +416,9 @@ downloadHandler <- function(filename, content, contentType=NA) {
 #' @note This function only provides the server-side version of DataTables
 #'   (using R to process the data object on the server side). There is a
 #'   separate package \pkg{DT} (\url{https://github.com/rstudio/DT}) that allows
-#'   you to create both server-side and client-side DataTables. The functions
-#'   \code{renderDataTable()} and \code{dataTableOutput()} in \pkg{shiny} have
-#'   been deprecated since v0.11.1. Please use \code{DT::renderDataTable()} and
-#'   \code{DT::dataTableOutput()} (see
+#'   you to create both server-side and client-side DataTables, and supports
+#'   additional DataTables features. Consider using \code{DT::renderDataTable()}
+#'   and \code{DT::dataTableOutput()} (see
 #'   \url{http://rstudio.github.io/DT/shiny.html} for more information).
 #' @export
 #' @inheritParams renderPlot
@@ -448,9 +447,6 @@ downloadHandler <- function(filename, content, contentType=NA) {
 renderDataTable <- function(expr, options = NULL, searchDelay = 500,
                             callback = 'function(oTable) {}', escape = TRUE,
                             env = parent.frame(), quoted = FALSE) {
-  shinyDeprecated(
-    'DT::renderDataTable', old = 'shiny::renderDataTable', version = '0.11.1'
-  )
   installExprFunction(expr, "func", env, quoted)
 
   markRenderFunction(dataTableOutput, function(shinysession, name, ...) {
@@ -464,7 +460,7 @@ renderDataTable <- function(expr, options = NULL, searchDelay = 500,
     colnames <- colnames(data)
     # if escape is column names, turn names to numeric indices
     if (is.character(escape)) {
-      escape <- setNames(seq_len(ncol(data)), colnames)[escape]
+      escape <- stats::setNames(seq_len(ncol(data)), colnames)[escape]
       if (any(is.na(escape)))
         stop("Some column names in the 'escape' argument not found in data")
     }
@@ -485,8 +481,10 @@ renderDataTable <- function(expr, options = NULL, searchDelay = 500,
 # a data frame containing the DataTables 1.9 and 1.10 names
 DT10Names <- function() {
   rbind(
-    read.table(system.file('www/shared/datatables/upgrade1.10.txt', package = 'shiny'),
-               stringsAsFactors = FALSE),
+    utils::read.table(
+      system.file('www/shared/datatables/upgrade1.10.txt', package = 'shiny'),
+      stringsAsFactors = FALSE
+    ),
     c('aoColumns', 'Removed')  # looks like an omission on the upgrade guide
   )
 }
@@ -504,7 +502,7 @@ checkDT9 <- function(options) {
     'and DataTables 1.10.x uses different parameter names with 1.9.x. ',
     'Please follow the upgrade guide https://datatables.net/upgrade/1.10-convert',
     ' to change your DataTables parameter names:\n\n',
-    paste(formatUL(nms[i]), collapse = '\n'), '\n', sep = ''
+    paste(utils::formatUL(nms[i]), collapse = '\n'), '\n', sep = ''
   )
   j <- gsub('[.].*', '', DT10[, 1]) %in% nms
   # I cannot help you upgrade automatically in these cases, so I have to stop
@@ -513,7 +511,7 @@ checkDT9 <- function(options) {
   nms10 <- DT10[match(nms[i], DT10[, 1]), 2]
   if (any(nms10 == 'Removed')) stop(
     "These parameters have been removed in DataTables 1.10.x:\n\n",
-    paste(formatUL(nms[i][nms10 == 'Removed']), collapse = '\n'),
+    paste(utils::formatUL(nms[i][nms10 == 'Removed']), collapse = '\n'),
     "\n\n", msg
   )
   names(options)[i] <- nms10

R/slider.R

@@ -1,26 +0,0 @@
-hasDecimals <- function(value) {
-  truncatedValue <- round(value)
-  return (!identical(value, truncatedValue))
-}
-
-#' @rdname sliderInput
-#'
-#' @param interval The interval, in milliseconds, between each animation step.
-#' @param loop \code{TRUE} to automatically restart the animation when it
-#'   reaches the end.
-#' @param playButton Specifies the appearance of the play button. Valid values
-#'   are a one-element character vector (for a simple text label), an HTML tag
-#'   or list of tags (using \code{\link{tag}} and friends), or raw HTML (using
-#'   \code{\link{HTML}}).
-#' @param pauseButton Similar to \code{playButton}, but for the pause button.
-#'
-#' @export
-animationOptions <- function(interval=1000,
-                             loop=FALSE,
-                             playButton=NULL,
-                             pauseButton=NULL) {
-  list(interval=interval,
-       loop=loop,
-       playButton=playButton,
-       pauseButton=pauseButton)
-}

R/tar.R

@@ -46,7 +46,7 @@ untar2 <- function(tarfile, files = NULL, list = FALSE, exdir = ".")
     mydir.create <- function(path, ...) {
         ## for Windows' sake
         path <- sub("[\\/]$", "", path)
-        if(file_test("-d", path)) return()
+        if(utils::file_test("-d", path)) return()
         if(!dir.create(path, showWarnings = TRUE, recursive = TRUE, ...))
            stop(gettextf("failed to create directory %s", sQuote(path)),
                 domain = NA)

R/update-input.R

@@ -185,6 +185,13 @@ updateTabsetPanel <- function(session, inputId, selected = NULL) {
   session$sendInputMessage(inputId, message)
 }
 
+#' @rdname updateTabsetPanel
+#' @export
+updateNavbarPage <- updateTabsetPanel
+
+#' @rdname updateTabsetPanel
+#' @export
+updateNavlistPanel <- updateTabsetPanel
 
 #' Change the value of a number input on the client
 #'
@@ -242,9 +249,9 @@ updateNumericInput <- function(session, inputId, label = NULL, value = NULL,
 #'       sidebarLayout(
 #'         sidebarPanel(
 #'           p("The first slider controls the second"),
-#'           slider2Input("control", "Controller:", min=0, max=20, value=10,
+#'           sliderInput("control", "Controller:", min=0, max=20, value=10,
 #'                        step=1),
-#'           slider2Input("receive", "Receiver:", min=0, max=20, value=10,
+#'           sliderInput("receive", "Receiver:", min=0, max=20, value=10,
 #'                        step=1)
 #'         ),
 #'         mainPanel()
@@ -262,7 +269,39 @@ updateNumericInput <- function(session, inputId, label = NULL, value = NULL,
 #'   )
 #' }
 #' @export
-updateSliderInput <- updateNumericInput
+updateSliderInput <- function(session, inputId, label = NULL, value = NULL,
+  min = NULL, max = NULL, step = NULL)
+{
+  # Make sure that value, min, max all have the same type, because we need
+  # special handling for dates and datetimes.
+  vals <- dropNulls(list(value, min, max))
+
+  type <- unique(lapply(vals, function(x) {
+    if      (inherits(x, "Date"))   "date"
+    else if (inherits(x, "POSIXt")) "datetime"
+    else                            "number"
+  }))
+  if (length(type) > 1) {
+    stop("Type mismatch for value, min, and max")
+  }
+
+  if (type == "date" || type == "datetime") {
+    to_ms <- function(x) 1000 * as.numeric(as.POSIXct(x))
+    if (!is.null(min))   min   <- to_ms(min)
+    if (!is.null(max))   max   <- to_ms(max)
+    if (!is.null(value)) value <- to_ms(value)
+  }
+
+  message <- dropNulls(list(
+    label = label,
+    value = formatNoSci(value),
+    min = formatNoSci(min),
+    max = formatNoSci(max),
+    step = formatNoSci(step)
+  ))
+  session$sendInputMessage(inputId, message)
+}
+
 
 updateInputOptions <- function(session, inputId, label = NULL, choices = NULL,
                                selected = NULL, inline = FALSE,
@@ -450,7 +489,7 @@ updateSelectizeInput <- function(session, inputId, label = NULL, choices = NULL,
 selectizeJSON <- function(data, req) {
   query <- parseQueryString(req$QUERY_STRING)
   # extract the query variables, conjunction (and/or), search string, maximum options
-  var <- unlist(jsonlite::fromJSON(query$field))
+  var <- c(jsonlite::fromJSON(query$field))
   cjn <- if (query$conju == 'and') all else any
   # all keywords in lower-case, for case-insensitive matching
   key <- unique(strsplit(tolower(query$query), '\\s+')[[1]])
@@ -478,7 +517,7 @@ selectizeJSON <- function(data, req) {
     idx <- idx | apply(matches, 1, cjn)
   }
   # only return the first n rows (n = maximum options in configuration)
-  idx <- head(if (length(key)) which(idx) else seq_along(idx), mop)
+  idx <- utils::head(if (length(key)) which(idx) else seq_along(idx), mop)
   data <- data[idx, ]
 
   res <- toJSON(columnToRowData(data))

R/utils.R

@@ -25,7 +25,7 @@ NULL
 #' rnormB(5)  # [1] -0.7946034  0.2568374 -0.6567597  1.2451387 -0.8375699
 #'
 #' @export
-repeatable <- function(rngfunc, seed = runif(1, 0, .Machine$integer.max)) {
+repeatable <- function(rngfunc, seed = stats::runif(1, 0, .Machine$integer.max)) {
   force(seed)
 
   function(...) {
@@ -95,7 +95,7 @@ reinitializeSeed <- if (getRversion() >= '3.0.0') {
 
 # Version of runif that runs with private seed
 p_runif <- function(...) {
-  withPrivateSeed(runif(...))
+  withPrivateSeed(stats::runif(...))
 }
 
 # Version of sample that runs with private seed
@@ -258,7 +258,7 @@ download <- function(url, ...) {
 
       # Needed for https
       mySI2(TRUE)
-      download.file(url, ...)
+      utils::download.file(url, ...)
 
     } else {
       # If non-Windows, check for curl/wget/lynx, then call download.file with
@@ -282,11 +282,11 @@ download <- function(url, ...) {
         stop("no download method found")
       }
 
-      download.file(url, method = method, ...)
+      utils::download.file(url, method = method, ...)
     }
 
   } else {
-    download.file(url, ...)
+    utils::download.file(url, ...)
   }
 }
 
@@ -474,7 +474,7 @@ parseQueryString <- function(str, nested = FALSE) {
   keys   <- URLdecode(keys)
   values <- URLdecode(values)
 
-  res <- setNames(as.list(values), keys)
+  res <- stats::setNames(as.list(values), keys)
   if (!nested) return(res)
 
   # Make a nested list from a query of the form ?a[1][1]=x11&a[1][2]=x12&...
@@ -580,7 +580,11 @@ Callbacks <- R6Class(
       })
     },
     invoke = function(..., onError=NULL) {
-      for (callback in .callbacks$values()) {
+      # Ensure that calls are invoked in the order that they were registered
+      keys <- as.character(sort(as.integer(.callbacks$keys()), decreasing = TRUE))
+      callbacks <- .callbacks$mget(keys)
+
+      for (callback in callbacks) {
         if (is.null(onError)) {
           callback(...)
         } else {
@@ -604,7 +608,7 @@ dataTablesJSON <- function(data, req) {
 
   # global searching
   i <- seq_len(n)
-  if (q$search[['value']] != '') {
+  if (length(q$search[['value']]) && q$search[['value']] != '') {
     i0 <- apply(data, 2, function(x) {
       grep2(q$search[['value']], as.character(x),
             fixed = q$search[['regex']] == 'false', ignore.case = ci)
@@ -888,7 +892,7 @@ validate <- function(..., errorClass = character(0)) {
       stop("Unexpected validation result: ", as.character(x))
   })
 
-  results <- na.omit(results)
+  results <- stats::na.omit(results)
   if (length(results) == 0)
     return(invisible())
 
@@ -932,11 +936,11 @@ isTruthy <- function(x) {
     return(FALSE)
   if (all(is.na(x)))
     return(FALSE)
-  if (is.character(x) && !any(nzchar(na.omit(x))))
+  if (is.character(x) && !any(nzchar(stats::na.omit(x))))
     return(FALSE)
   if (inherits(x, 'shinyActionButtonValue') && x == 0)
     return(FALSE)
-  if (is.logical(x) && !any(na.omit(x)))
+  if (is.logical(x) && !any(stats::na.omit(x)))
     return(FALSE)
 
   return(TRUE)

inst/examples/01_hello/rsconnect/localhost/admin/01_hello.dcf

@@ -0,0 +1,6 @@
+name: 01_hello
+account: admin
+server: localhost
+bundleId: 1
+url: http://localhost:3939/admin/01_hello/
+when: 1436550957.65385

inst/staticdocs/index.r

@@ -59,7 +59,6 @@ sd_section("UI Outputs",
   "Functions for creating user interface elements that, in conjunction with rendering functions, display different kinds of output from your application.",
   c(
     "htmlOutput",
-    "imageOutput",
     "plotOutput",
     "outputOptions",
     "tableOutput",
@@ -160,6 +159,17 @@ sd_section("Utility functions",
     "shiny-options"
   )
 )
+sd_section("Plot interaction",
+  "Functions related to interactive plots",
+  c(
+    "brushedPoints",
+    "brushOpts",
+    "clickOpts",
+    "dblclickOpts",
+    "hoverOpts",
+    "nearPoints"
+  )
+)
 sd_section("Embedding",
   "Functions that are intended for third-party packages that embed Shiny applications.",
   c(

inst/tests/test-utils.R

@@ -100,3 +100,20 @@ test_that("anyUnnamed works as expected", {
   x <- x[3:4]
   expect_true(anyUnnamed(x))
 })
+
+test_that("Callbacks fire in predictable order", {
+  cb <- Callbacks$new()
+
+  x <- numeric(0)
+  cb$register(function() {
+    x <<- c(x, 1)
+  })
+  cb$register(function() {
+    x <<- c(x, 2)
+  })
+  cb$register(function() {
+    x <<- c(x, 3)
+  })
+  cb$invoke()
+  expect_equal(x, c(1, 2, 3))
+})

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

@@ -1,5 +1,5 @@
 // Ion.RangeSlider
-// version 2.0.6 Build: 300
+// version 2.0.12 Build: 331
 // © Denis Ineshin, 2015
 // https://github.com/IonDen
 //
@@ -18,6 +18,7 @@
 
     var plugin_count = 0;
 
+    // IE8 fix
     var is_old_ie = (function () {
         var n = navigator.userAgent,
             r = /msie\s\d+/i,
@@ -32,8 +33,6 @@
         }
         return false;
     } ());
-
-    // IE8 fix
     if (!Function.prototype.bind) {
         Function.prototype.bind = function bind(that) {
 
@@ -139,11 +138,12 @@
     // Core
 
     var IonRangeSlider = function (input, options, plugin_count) {
-        this.VERSION = "2.0.6";
+        this.VERSION = "2.0.12";
         this.input = input;
         this.plugin_count = plugin_count;
         this.current_plugin = 0;
         this.calc_count = 0;
+        this.update_tm = 0;
         this.old_from = 0;
         this.old_to = 0;
         this.raf_id = null;
@@ -175,6 +175,7 @@
             shad_single: null,
             shad_from: null,
             shad_to: null,
+            edge: null,
             grid: null,
             grid_labels: []
         };
@@ -231,7 +232,6 @@
             disable: $inp.data("disable")
         };
         data.values = data.values && data.values.split(",");
-        options = $.extend(data, options);
 
         // get from and to out of input
         var val = $inp.prop("value");
@@ -245,7 +245,7 @@
                 val[1] = +val[1];
             }
 
-            if (options.values && options.values.length) {
+            if (options && options.values && options.values.length) {
                 data.from = val[0] && options.values.indexOf(val[0]);
                 data.to = val[1] && options.values.indexOf(val[1]);
             } else {
@@ -254,6 +254,9 @@
             }
         }
 
+        // JS config has a priority
+        options = $.extend(data, options);
+
         // get config from options
         this.options = $.extend({
             type: "single",
@@ -413,7 +416,6 @@
             }
 
             this.updateScene();
-            this.raf_id = requestAnimationFrame(this.updateScene.bind(this));
         },
 
         append: function () {
@@ -436,6 +438,7 @@
 
             if (this.options.type === "single") {
                 this.$cache.cont.append(single_html);
+                this.$cache.edge = this.$cache.cont.find(".irs-bar-edge");
                 this.$cache.s_single = this.$cache.cont.find(".single");
                 this.$cache.from[0].style.visibility = "hidden";
                 this.$cache.to[0].style.visibility = "hidden";
@@ -446,6 +449,8 @@
                 this.$cache.s_to = this.$cache.cont.find(".to");
                 this.$cache.shad_from = this.$cache.cont.find(".shadow-from");
                 this.$cache.shad_to = this.$cache.cont.find(".shadow-to");
+
+                this.setTopHandler();
             }
 
             if (this.options.hide_from_to) {
@@ -466,6 +471,19 @@
             }
         },
 
+        setTopHandler: function () {
+            var min = this.options.min,
+                max = this.options.max,
+                from = this.options.from,
+                to = this.options.to;
+
+            if (from > min && to === max) {
+                this.$cache.s_from.addClass("type_last");
+            } else if (to < max) {
+                this.$cache.s_to.addClass("type_last");
+            }
+        },
+
         appendDisableMask: function () {
             this.$cache.cont.append(disable_html);
             this.$cache.cont.addClass("irs-disabled");
@@ -520,6 +538,7 @@
                 this.$cache.shad_single.on("touchstart.irs_" + this.plugin_count, this.pointerClick.bind(this, "click"));
 
                 this.$cache.s_single.on("mousedown.irs_" + this.plugin_count, this.pointerDown.bind(this, "single"));
+                this.$cache.edge.on("mousedown.irs_" + this.plugin_count, this.pointerClick.bind(this, "click"));
                 this.$cache.shad_single.on("mousedown.irs_" + this.plugin_count, this.pointerClick.bind(this, "click"));
             } else {
                 this.$cache.s_from.on("touchstart.irs_" + this.plugin_count, this.pointerDown.bind(this, "from"));
@@ -580,27 +599,11 @@
             if (is_old_ie) {
                 $("*").prop("unselectable", false);
             }
+
+            this.updateScene();
         },
 
-        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;
-            }
-
-            this.current_plugin = this.plugin_count;
-            this.target = target;
-
-            this.is_active = true;
-            this.dragging = true;
-
-            this.coords.x_gap = this.$cache.rs.offset().left;
-            this.coords.x_pointer = x - this.coords.x_gap;
-
-            this.calcPointer();
-
+        changeLevel: function (target) {
             switch (target) {
                 case "single":
                     this.coords.p_gap = this.toFixed(this.coords.p_pointer - this.coords.p_single);
@@ -624,12 +627,35 @@
                     this.$cache.s_from.removeClass("type_last");
                     break;
             }
+        },
+
+        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;
+            }
+
+            this.current_plugin = this.plugin_count;
+            this.target = target;
+
+            this.is_active = true;
+            this.dragging = true;
+
+            this.coords.x_gap = this.$cache.rs.offset().left;
+            this.coords.x_pointer = x - this.coords.x_gap;
+
+            this.calcPointer();
+            this.changeLevel(target);
 
             if (is_old_ie) {
                 $("*").prop("unselectable", true);
             }
 
             this.$cache.line.trigger("focus");
+
+            this.updateScene();
         },
 
         pointerClick: function (target, e) {
@@ -679,7 +705,7 @@
             return true;
         },
 
-        // Move by key beta
+        // Move by key. Beta
         // TODO: refactor than have plenty of time
         moveByKey: function (right) {
             var p = this.coords.p_pointer;
@@ -751,7 +777,8 @@
                 real_x = this.toFixed(this.coords.p_pointer - this.coords.p_gap);
 
             if (this.target === "click") {
-                real_x = this.toFixed(this.coords.p_pointer - (this.coords.p_handle / 2));
+                this.coords.p_gap = this.coords.p_handle / 2;
+                real_x = this.toFixed(this.coords.p_pointer - this.coords.p_gap);
                 this.target = this.chooseHandle(real_x);
             }
 
@@ -827,6 +854,10 @@
                     break;
 
                 case "both":
+                    if (this.options.from_fixed || this.options.to_fixed) {
+                        break;
+                    }
+
                     real_x = this.toFixed(real_x + (this.coords.p_handle * 0.1));
 
                     this.coords.p_from_real = this.calcWithStep((real_x - this.coords.p_gap_left) / real_width * 100);
@@ -890,9 +921,9 @@
             } else {
                 var m_point = this.coords.p_from_real + ((this.coords.p_to_real - this.coords.p_from_real) / 2);
                 if (real_x >= m_point) {
-                    return "to";
+                    return this.options.to_fixed ? "from" : "to";
                 } else {
-                    return "from";
+                    return this.options.from_fixed ? "to" : "from";
                 }
             }
         },
@@ -947,13 +978,25 @@
         // Drawings
 
         updateScene: function () {
+            if (this.raf_id) {
+                cancelAnimationFrame(this.raf_id);
+                this.raf_id = null;
+            }
+
+            clearTimeout(this.update_tm);
+            this.update_tm = null;
+
             if (!this.options) {
                 return;
             }
 
             this.drawHandles();
 
-            this.raf_id = requestAnimationFrame(this.updateScene.bind(this));
+            if (this.is_active) {
+                this.raf_id = requestAnimationFrame(this.updateScene.bind(this));
+            } else {
+                this.update_tm = setTimeout(this.updateScene.bind(this), 300);
+            }
         },
 
         drawHandles: function () {
@@ -1119,11 +1162,11 @@
                 } else {
 
                     if (this.options.decorate_both) {
-                        text_single = this.decorate(this._prettify(this.result.from));
+                        text_single = this.decorate(this._prettify(this.result.from), this.result.from);
                         text_single += this.options.values_separator;
-                        text_single += this.decorate(this._prettify(this.result.to));
+                        text_single += this.decorate(this._prettify(this.result.to), this.result.to);
                     } else {
-                        text_single = this.decorate(this._prettify(this.result.from) + this.options.values_separator + this._prettify(this.result.to), this.result.from);
+                        text_single = this.decorate(this._prettify(this.result.from) + this.options.values_separator + this._prettify(this.result.to), this.result.to);
                     }
                     text_from = this.decorate(this._prettify(this.result.from), this.result.from);
                     text_to = this.decorate(this._prettify(this.result.to), this.result.to);
@@ -1192,8 +1235,8 @@
 
             if (o.type === "single") {
                 if (o.from_shadow && (is_from_min || is_from_max)) {
-                    from_min = this.calcPercent(o.from_min || o.min);
-                    from_max = this.calcPercent(o.from_max || o.max) - from_min;
+                    from_min = this.calcPercent(is_from_min ? o.from_min : o.min);
+                    from_max = this.calcPercent(is_from_max ? o.from_max : o.max) - from_min;
                     from_min = this.toFixed(from_min - (this.coords.p_handle / 100 * from_min));
                     from_max = this.toFixed(from_max - (this.coords.p_handle / 100 * from_max));
                     from_min = from_min + (this.coords.p_handle / 2);
@@ -1206,8 +1249,8 @@
                 }
             } else {
                 if (o.from_shadow && (is_from_min || is_from_max)) {
-                    from_min = this.calcPercent(o.from_min || o.min);
-                    from_max = this.calcPercent(o.from_max || o.max) - from_min;
+                    from_min = this.calcPercent(is_from_min ? o.from_min : o.min);
+                    from_max = this.calcPercent(is_from_max ? o.from_max : o.max) - from_min;
                     from_min = this.toFixed(from_min - (this.coords.p_handle / 100 * from_min));
                     from_max = this.toFixed(from_max - (this.coords.p_handle / 100 * from_max));
                     from_min = from_min + (this.coords.p_handle / 2);
@@ -1220,8 +1263,8 @@
                 }
 
                 if (o.to_shadow && (is_to_min || is_to_max)) {
-                    to_min = this.calcPercent(o.to_min || o.min);
-                    to_max = this.calcPercent(o.to_max || o.max) - to_min;
+                    to_min = this.calcPercent(is_to_min ? o.to_min : o.min);
+                    to_max = this.calcPercent(is_to_max ? o.to_max : o.max) - to_min;
                     to_min = this.toFixed(to_min - (this.coords.p_handle / 100 * to_min));
                     to_max = this.toFixed(to_max - (this.coords.p_handle / 100 * to_max));
                     to_min = to_min + (this.coords.p_handle / 2);
@@ -1254,22 +1297,48 @@
         calcReal: function (percent) {
             var min = this.options.min,
                 max = this.options.max,
+                min_decimals = min.toString().split(".")[1],
+                max_decimals = max.toString().split(".")[1],
+                min_length, max_length,
+                avg_decimals = 0,
                 abs = 0;
 
+            if (percent === 0) {
+                return this.options.min;
+            }
+            if (percent === 100) {
+                return this.options.max;
+            }
+
+
+            if (min_decimals) {
+                min_length = min_decimals.length;
+                avg_decimals = min_length;
+            }
+            if (max_decimals) {
+                max_length = max_decimals.length;
+                avg_decimals = max_length;
+            }
+            if (min_length && max_length) {
+                avg_decimals = (min_length >= max_length) ? min_length : max_length;
+            }
+
             if (min < 0) {
                 abs = Math.abs(min);
-                min = min + abs;
-                max = max + abs;
+                min = +(min + abs).toFixed(avg_decimals);
+                max = +(max + abs).toFixed(avg_decimals);
             }
 
             var number = ((max - min) / 100 * percent) + min,
-                string = this.options.step.toString().split(".")[1];
+                string = this.options.step.toString().split(".")[1],
+                result;
 
             if (string) {
                 number = +number.toFixed(string.length);
             } else {
                 number = number / this.options.step;
                 number = number * this.options.step;
+
                 number = +number.toFixed(0);
             }
 
@@ -1277,17 +1346,19 @@
                 number -= abs;
             }
 
-            if (number < this.options.min) {
-                number = this.options.min;
-            } else if (number > this.options.max) {
-                number = this.options.max;
+            if (string) {
+                result = +number.toFixed(string.length);
+            } else {
+                result = this.toFixed(number);
             }
 
-            if (string) {
-                return +number.toFixed(string.length);
-            } else {
-                return this.toFixed(number);
+            if (result < this.options.min) {
+                result = this.options.min;
+            } else if (result > this.options.max) {
+                result = this.options.max;
             }
+
+            return result;
         },
 
         calcWithStep: function (percent) {
@@ -1365,11 +1436,11 @@
             var num = this.calcReal(p_num),
                 o = this.options;
 
-            if (!min || typeof min !== "number") {
+            if (typeof min !== "number") {
                 min = o.min;
             }
 
-            if (!max || typeof max !== "number") {
+            if (typeof max !== "number") {
                 max = o.max;
             }
 
@@ -1385,7 +1456,7 @@
         },
 
         toFixed: function (num) {
-            num = num.toFixed(5);
+            num = num.toFixed(9);
             return +num;
         },
 
@@ -1482,16 +1553,28 @@
                 o.to = o.max;
             }
 
-            if (o.from < o.min || o.from > o.max) {
-                o.from = o.min;
-            }
+            if (o.type === "single") {
 
-            if (o.to > o.max || o.to < o.min) {
-                o.to = 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.type === "double" && o.from > o.to) {
-                o.from = o.to;
             }
 
             if (typeof o.step !== "number" || isNaN(o.step) || !o.step || o.step < 0) {
@@ -1502,19 +1585,19 @@
                 o.keyboard_step = 5;
             }
 
-            if (o.from_min && o.from < o.from_min) {
+            if (typeof o.from_min === "number" && o.from < o.from_min) {
                 o.from = o.from_min;
             }
 
-            if (o.from_max && o.from > o.from_max) {
+            if (typeof o.from_max === "number" && o.from > o.from_max) {
                 o.from = o.from_max;
             }
 
-            if (o.to_min && o.to < o.to_min) {
+            if (typeof o.to_min === "number" && o.to < o.to_min) {
                 o.to = o.to_min;
             }
 
-            if (o.to_max && o.from > o.to_max) {
+            if (typeof o.to_max === "number" && o.from > o.to_max) {
                 o.to = o.to_max;
             }
 
@@ -1660,6 +1743,7 @@
                 local_small_max = small_max;
 
                 big_w = this.toFixed(big_p * i);
+
                 if (big_w > 100) {
                     big_w = 100;
 
@@ -1728,15 +1812,15 @@
             }
 
             if (this.options.force_edges) {
-                if (start[0] < this.coords.grid_gap) {
-                    start[0] = this.coords.grid_gap;
+                if (start[0] < -this.coords.grid_gap) {
+                    start[0] = -this.coords.grid_gap;
                     finish[0] = this.toFixed(start[0] + this.coords.big_p[0]);
 
                     this.coords.big_x[0] = this.coords.grid_gap;
                 }
 
-                if (finish[num - 1] > 100 - this.coords.grid_gap) {
-                    finish[num - 1] = 100 - this.coords.grid_gap;
+                if (finish[num - 1] > 100 + this.coords.grid_gap) {
+                    finish[num - 1] = 100 + this.coords.grid_gap;
                     start[num - 1] = this.toFixed(finish[num - 1] - this.coords.big_p[num - 1]);
 
                     this.coords.big_x[num - 1] = this.toFixed(this.coords.big_p[num - 1] - this.coords.grid_gap);

inst/www/shared/shiny.js

@@ -10,6 +10,7 @@
   curly:false,
   indent:2
 */
+/* global strftime */
 
 (function() {
   var $ = jQuery;
@@ -85,6 +86,20 @@ function parseDate(dateString) {
   return date;
 }
 
+// Given a Date object, return a string in yyyy-mm-dd format, using the
+// UTC date. This may be a day off from the date in the local time zone.
+function formatDateUTC(date) {
+  if (date instanceof Date) {
+    return date.getUTCFullYear() + '-' +
+           padZeros(date.getUTCMonth()+1, 2) + '-' +
+           padZeros(date.getUTCDate(), 2);
+
+  } else {
+    return null;
+  }
+}
+
+
 // Given an element and a function(width, height), returns a function(). When
 // the output function is called, it calls the input function with the offset
 // width and height of the input element--but only if the size of the element
@@ -628,6 +643,10 @@ var ShinyApp = function() {
 
     var socket = createSocketFunc();
     socket.onopen = function() {
+      $(document).trigger({
+        type: 'shiny:connected',
+        socket: socket
+      });
       socket.send(JSON.stringify({
         method: 'init',
         data: self.$initialInput
@@ -642,6 +661,10 @@ var ShinyApp = function() {
       self.dispatchMessage(e.data);
     };
     socket.onclose = function() {
+      $(document).trigger({
+        type: 'shiny:disconnected',
+        socket: socket
+      });
       $(document.body).addClass('disconnected');
       self.$notifyDisconnected();
     };
@@ -3136,14 +3159,42 @@ $.extend(sliderInputBinding, textInputBinding, {
 
     return $(scope).find('input.js-range-slider');
   },
+  getType: function(el) {
+    var dataType = $(el).data('data-type');
+    if (dataType === 'date')
+      return 'shiny.date';
+    else if (dataType === 'datetime')
+      return 'shiny.datetime';
+    else
+      return false;
+  },
   getValue: function(el) {
+    var $el = $(el);
     var result = $(el).data('ionRangeSlider').result;
+
+    // Function for converting numeric value from slider to appropriate type.
+    var convert;
+    var dataType = $el.data('data-type');
+    if (dataType === 'date') {
+      convert = function(val) {
+        return formatDateUTC(new Date(+val));
+      };
+    } else if (dataType === 'datetime') {
+      convert = function(val) {
+        // Convert ms to s
+        return +val / 1000;
+      };
+    } else {
+      convert = function(val) { return +val; };
+    }
+
     if (this._numValues(el) == 2) {
-      return [+result.from, +result.to];
+      return [convert(result.from), convert(result.to)];
     }
     else {
-      return +result.from;
+      return convert(result.from);
     }
+
   },
   setValue: function(el, value) {
     var slider = $(el).data('ionRangeSlider');
@@ -3163,7 +3214,8 @@ $.extend(sliderInputBinding, textInputBinding, {
     $(el).off('.sliderInputBinding');
   },
   receiveMessage: function(el, data) {
-    var slider = $(el).data('ionRangeSlider');
+    var $el = $(el);
+    var slider = $el.data('ionRangeSlider');
     var msg = {};
 
     if (data.hasOwnProperty('value')) {
@@ -3172,8 +3224,6 @@ $.extend(sliderInputBinding, textInputBinding, {
         msg.to = data.value[1];
       } else {
         msg.from = data.value;
-        // Workaround for ionRangeSlider issue #143
-        msg.to = data.value;
       }
     }
     if (data.hasOwnProperty('min'))  msg.min   = data.min;
@@ -3181,13 +3231,13 @@ $.extend(sliderInputBinding, textInputBinding, {
     if (data.hasOwnProperty('step')) msg.step  = data.step;
 
     if (data.hasOwnProperty('label'))
-      $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
+      $el.parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
 
-    $(el).data('updating', true);
+    $el.data('updating', true);
     try {
       slider.update(msg);
     } finally {
-      $(el).data('updating', false);
+      $el.data('updating', false);
     }
   },
   getRatePolicy: function() {
@@ -3199,7 +3249,32 @@ $.extend(sliderInputBinding, textInputBinding, {
   getState: function(el) {
   },
   initialize: function(el) {
-    $(el).ionRangeSlider();
+    var opts = {};
+    var $el = $(el);
+    var dataType = $el.data('data-type');
+    var timeFormat = $el.data('time-format');
+    var timeFormatter;
+
+    // Set up formatting functions
+    if (dataType === 'date') {
+      timeFormatter = strftime.utc();
+      opts.prettify = function(num) {
+        return timeFormatter(timeFormat, new Date(num));
+      };
+
+    } else if (dataType === 'datetime') {
+      var timezone = $el.data('timezone');
+      if (timezone)
+        timeFormatter = strftime.timezone(timezone);
+      else
+        timeFormatter = strftime;
+
+      opts.prettify = function(num) {
+        return timeFormatter(timeFormat, new Date(num));
+      };
+    }
+
+    $el.ionRangeSlider(opts);
   },
 
   // Number of values; 1 for single slider, 2 for range slider
@@ -3256,14 +3331,32 @@ $(document).on('click', '.slider-animate-button', function(evt) {
 
     } else {
       slider = target.data('ionRangeSlider');
+      // Single sliders have slider.options.type == "single", and only the
+      // `from` value is used. Double sliders have type == "double", and also
+      // use the `to` value for the right handle.
       var sliderCanStep = function() {
-        return slider.result.from < slider.result.max;
+        if (slider.options.type === "double")
+          return slider.result.to < slider.result.max;
+        else
+          return slider.result.from < slider.result.max;
       };
       var sliderReset = function() {
-        slider.update({from: slider.result.min});
+        var val = { from: slider.result.min };
+        // Preserve the current spacing for double sliders
+        if (slider.options.type === "double")
+          val.to = val.from + (slider.result.to - slider.result.from);
+
+        slider.update(val);
       };
       var sliderStep = function() {
-        slider.update({from: slider.result.from + slider.options.step});
+        // Don't overshoot the end
+        var val = {
+          from: Math.min(slider.result.max, slider.result.from + slider.options.step)
+        };
+        if (slider.options.type === "double")
+          val.to = Math.min(slider.result.max, slider.result.to + slider.options.step);
+
+        slider.update(val);
       };
 
       // If we're currently at the end, restart
@@ -3312,7 +3405,7 @@ $.extend(dateInputBinding, {
   // format like mm/dd/yyyy)
   getValue: function(el) {
     var date = $(el).find('input').data('datepicker').getUTCDate();
-    return this._formatDate(date);
+    return formatDateUTC(date);
   },
   // value must be an unambiguous string like '2001-01-01', or a Date object.
   setValue: function(el, value) {
@@ -3332,8 +3425,8 @@ $.extend(dateInputBinding, {
 
     // Stringify min and max. If min and max aren't set, they will be
     // -Infinity and Infinity; replace these with null.
-    min = (min === -Infinity) ? null : this._formatDate(min);
-    max = (max ===  Infinity) ? null : this._formatDate(max);
+    min = (min === -Infinity) ? null : formatDateUTC(min);
+    max = (max ===  Infinity) ? null : formatDateUTC(max);
 
     // startViewMode is stored as a number; convert to string
     var startview = $input.data('datepicker').startViewMode;
@@ -3408,18 +3501,6 @@ $.extend(dateInputBinding, {
     this._setMin($input[0], $input.data('min-date'));
     this._setMax($input[0], $input.data('max-date'));
   },
-  // Given a Date object, return a string in yyyy-mm-dd format, using the
-  // UTC date. This may be a day off from the date in the local time zone.
-  _formatDate: function(date) {
-    if (date instanceof Date) {
-      return date.getUTCFullYear() + '-' +
-             padZeros(date.getUTCMonth()+1, 2) + '-' +
-             padZeros(date.getUTCDate(), 2);
-
-    } else {
-      return null;
-    }
-  },
   // Given a format object from a date picker, return a string
   _formatToString: function(format) {
     // Format object has structure like:
@@ -3499,7 +3580,7 @@ $.extend(dateRangeInputBinding, dateInputBinding, {
     var start = $inputs.eq(0).data('datepicker').getUTCDate();
     var end   = $inputs.eq(1).data('datepicker').getUTCDate();
 
-    return [this._formatDate(start), this._formatDate(end)];
+    return [formatDateUTC(start), formatDateUTC(end)];
   },
   // value must be an array of unambiguous strings like '2001-01-01', or
   // Date objects.
@@ -3533,8 +3614,8 @@ $.extend(dateRangeInputBinding, dateInputBinding, {
 
     // Stringify min and max. If min and max aren't set, they will be
     // -Infinity and Infinity; replace these with null.
-    min = (min === -Infinity) ? null : this._formatDate(min);
-    max = (max ===  Infinity) ? null : this._formatDate(max);
+    min = (min === -Infinity) ? null : formatDateUTC(min);
+    max = (max ===  Infinity) ? null : formatDateUTC(max);
 
     // startViewMode is stored as a number; convert to string
     var startview = $startinput.data('datepicker').startViewMode;
@@ -4282,7 +4363,7 @@ function initShiny() {
           continue;
 
         var $el = $(el);
-        if ($el.data('shiny-output-binding')) {
+        if ($el.hasClass('shiny-bound-output')) {
           // Already bound; can happen with nested uiOutput (bindAll
           // gets called on two ancestors)
           continue;
@@ -4306,12 +4387,14 @@ function initShiny() {
 
     var outputs = $(scope).find('.shiny-bound-output');
     for (var i = 0; i < outputs.length; i++) {
-      var bindingAdapter = $(outputs[i]).data('shiny-output-binding');
+      var $el = $(outputs[i]);
+      var bindingAdapter = $el.data('shiny-output-binding');
       if (!bindingAdapter)
         continue;
       var id = bindingAdapter.binding.getId(outputs[i]);
       shinyapp.unbindOutput(id, bindingAdapter);
-      $(outputs[i]).removeClass('shiny-bound-output');
+      $el.removeClass('shiny-bound-output');
+      $el.removeData('shiny-output-binding');
     }
 
     setTimeout(sendOutputHiddenState, 0);

inst/www/shared/strftime/strftime-min.js

@@ -0,0 +1,12 @@
+(function(){function k(b,a){s[b]||(typeof console!=="undefined"&&typeof console.warn=="function"&&console.warn("[WARNING] "+b+" is deprecated and will be removed in version 1.0. Instead, use `"+a+"`."),s[b]=!0)}function t(b){b.localize=i.localize.bind(i);b.timezone=i.timezone.bind(i);b.utc=i.utc.bind(i)}function r(b,a,e){a&&a.days&&(e=a,a=void 0);e&&k("`"+g+"(format, [date], [locale])`","var s = "+g+".localize(locale); s(format, [date])");return(e?i.localize(e):i)(b,a)}function u(b,a,e){e?k("`"+g+
+".strftime(format, [date], [locale])`","var s = "+g+".localize(locale); s(format, [date])"):k("`"+g+".strftime(format, [date])`",g+"(format, [date])");return(e?i.localize(e):i)(b,a)}function p(b,a,e){function g(b,c,h,a){for(var d="",f=null,e=!1,i=b.length,j=!1,o=0;o<i;o++){var n=b.charCodeAt(o);if(e===!0)if(n===45)f="";else if(n===95)f=" ";else if(n===48)f="0";else if(n===58)j&&typeof console!=="undefined"&&typeof console.warn=="function"&&console.warn("[WARNING] detected use of unsupported %:: or %::: modifiers to strftime"),
+j=!0;else{switch(n){case 65:d+=h.days[c.getDay()];break;case 66:d+=h.months[c.getMonth()];break;case 67:d+=l(Math.floor(c.getFullYear()/100),f);break;case 68:d+=g(h.formats.D,c,h,a);break;case 70:d+=g(h.formats.F,c,h,a);break;case 72:d+=l(c.getHours(),f);break;case 73:d+=l(v(c.getHours()),f);break;case 76:d+=Math.floor(a%1E3)>99?Math.floor(a%1E3):Math.floor(a%1E3)>9?"0"+Math.floor(a%1E3):"00"+Math.floor(a%1E3);break;case 77:d+=l(c.getMinutes(),f);break;case 80:d+=c.getHours()<12?h.am:h.pm;break;case 82:d+=
+g(h.formats.R,c,h,a);break;case 83:d+=l(c.getSeconds(),f);break;case 84:d+=g(h.formats.T,c,h,a);break;case 85:d+=l(w(c,"sunday"),f);break;case 87:d+=l(w(c,"monday"),f);break;case 88:d+=g(h.formats.X,c,h,a);break;case 89:d+=c.getFullYear();break;case 90:k&&m===0?d+="GMT":(f=c.toString().match(/\(([\w\s]+)\)/),d+=f&&f[1]||"");break;case 97:d+=h.shortDays[c.getDay()];break;case 98:d+=h.shortMonths[c.getMonth()];break;case 99:d+=g(h.formats.c,c,h,a);break;case 100:d+=l(c.getDate(),f);break;case 101:d+=
+l(c.getDate(),f==null?" ":f);break;case 104:d+=h.shortMonths[c.getMonth()];break;case 106:f=new Date(c.getFullYear(),0,1);f=Math.ceil((c.getTime()-f.getTime())/864E5);d+=f>99?f:f>9?"0"+f:"00"+f;break;case 107:d+=l(c.getHours(),f==null?" ":f);break;case 108:d+=l(v(c.getHours()),f==null?" ":f);break;case 109:d+=l(c.getMonth()+1,f);break;case 110:d+="\n";break;case 111:d+=String(c.getDate())+A(c.getDate());break;case 112:d+=c.getHours()<12?h.AM:h.PM;break;case 114:d+=g(h.formats.r,c,h,a);break;case 115:d+=
+Math.floor(a/1E3);break;case 116:d+="\t";break;case 117:f=c.getDay();d+=f===0?7:f;break;case 118:d+=g(h.formats.v,c,h,a);break;case 119:d+=c.getDay();break;case 120:d+=g(h.formats.x,c,h,a);break;case 121:d+=(""+c.getFullYear()).slice(2);break;case 122:k&&m===0?d+=j?"+00:00":"+0000":(f=m!==0?m/6E4:-c.getTimezoneOffset(),e=j?":":"",n=Math.abs(f%60),d+=(f<0?"-":"+")+l(Math.floor(Math.abs(f/60)))+e+l(n));break;default:d+=b[o]}f=null;e=!1}else n===37?e=!0:d+=b[o]}return d}var i=b||x,m=a||0,k=e||!1,j=0,
+q,b=function(b,c){var a;c?(a=c.getTime(),k&&(c=new Date(c.getTime()+(c.getTimezoneOffset()||0)*6E4+m))):(a=Date.now(),a>j?(j=a,q=new Date(j),a=j,k&&(q=new Date(j+(q.getTimezoneOffset()||0)*6E4+m))):a=j,c=q);return g(b,c,i,a)};b.localize=function(a){return new p(a||i,m,k)};b.timezone=function(a){var c=m,b=k,e=typeof a;if(e==="number"||e==="string")b=!0,e==="string"?(c=a[0]==="-"?-1:1,e=parseInt(a.slice(1,3),10),a=parseInt(a.slice(3,5),10),c=c*(60*e+a)*6E4):e==="number"&&(c=a*6E4);return new p(i,c,
+b)};b.utc=function(){return new p(i,m,!0)};return b}function l(b,a){if(a===""||b>9)return b;a==null&&(a="0");return a+b}function v(b){if(b===0)return 12;else if(b>12)return b-12;return b}function w(b,a){var a=a||"sunday",e=b.getDay();a==="monday"&&(e===0?e=6:e--);var g=Date.UTC(b.getFullYear(),0,1),i=Date.UTC(b.getFullYear(),b.getMonth(),b.getDate());return Math.floor((Math.floor((i-g)/864E5)+7-e)/7)}function A(b){var a=b%10;b%=100;if(b>=11&&b<=13||a===0||a>=4)return"th";switch(a){case 1:return"st";
+case 2:return"nd";case 3:return"rd"}}var x={days:["Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday"],shortDays:["Sun","Mon","Tue","Wed","Thu","Fri","Sat"],months:["January","February","March","April","May","June","July","August","September","October","November","December"],shortMonths:["Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"],AM:"AM",PM:"PM",am:"am",pm:"pm",formats:{D:"%m/%d/%y",F:"%Y-%m-%d",R:"%H:%M",T:"%H:%M:%S",X:"%T",c:"%a %b %d %X %Y",r:"%I:%M:%S %p",
+v:"%e-%b-%Y",x:"%D"}},i=new p(x,0,!1),y=typeof module!=="undefined",j;y?(j=module.exports=r,j.strftime=u):(j=function(){return this||(0,eval)("this")}(),j.strftime=r);var g=y?"require('strftime')":"strftime",s={};j.strftimeTZ=function(b,a,e,j){if((typeof e=="number"||typeof e=="string")&&j==null)j=e,e=void 0;e?k("`"+g+".strftimeTZ(format, date, locale, tz)`","var s = "+g+".localize(locale).timezone(tz); s(format, [date])` or `var s = "+g+".localize(locale); s.timezone(tz)(format, [date])"):k("`"+
+g+".strftimeTZ(format, date, tz)`","var s = "+g+".timezone(tz); s(format, [date])` or `"+g+".timezone(tz)(format, [date])");return(e?i.localize(e):i).timezone(j)(b,a)};j.strftimeUTC=function(b,a,e){e?k("`"+g+".strftimeUTC(format, date, locale)`","var s = "+g+".localize(locale).utc(); s(format, [date])"):k("`"+g+".strftimeUTC(format, [date])`","var s = "+g+".utc(); s(format, [date])");return(e?z.localize(e):z)(b,a)};j.localizedStrftime=function(b){k("`"+g+".localizedStrftime(locale)`",g+".localize(locale)");
+return i.localize(b)};t(r);t(u);var z=i.utc();if(typeof Date.now!=="function")Date.now=function(){return+new Date}})();

man/actionButton.Rd

@@ -1,23 +1,25 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R
+% Please edit documentation in R/input-action.R
 \name{actionButton}
 \alias{actionButton}
 \alias{actionLink}
 \title{Action button/link}
 \usage{
-actionButton(inputId, label, icon = NULL, ...)
+actionButton(inputId, label, icon = NULL, width = NULL, ...)
 
 actionLink(inputId, label, icon = NULL, ...)
 }
 \arguments{
-\item{inputId}{Specifies the input slot that will be used to access the
-value.}
+\item{inputId}{The \code{input} slot that will be used to access the value.}
 
 \item{label}{The contents of the button or link--usually a text label, but
 you could also use any other HTML, like an image.}
 
 \item{icon}{An optional \code{\link{icon}} to appear on the button.}
 
+\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
+see \code{\link{validateCssUnit}}.}
+
 \item{...}{Named attributes to be applied to the button or link.}
 }
 \description{

man/checkboxGroupInput.Rd

@@ -1,10 +1,11 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R
+% Please edit documentation in R/input-checkboxgroup.R
 \name{checkboxGroupInput}
 \alias{checkboxGroupInput}
 \title{Checkbox Group Input Control}
 \usage{
-checkboxGroupInput(inputId, label, choices, selected = NULL, inline = FALSE)
+checkboxGroupInput(inputId, label, choices, selected = NULL, inline = FALSE,
+  width = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -17,6 +18,9 @@ are named then that name rather than the value is displayed to the user.}
 \item{selected}{The values that should be initially selected, if any.}
 
 \item{inline}{If \code{TRUE}, render the choices inline (i.e. horizontally)}
+
+\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
+see \code{\link{validateCssUnit}}.}
 }
 \value{
 A list of HTML elements that can be added to a UI definition.

man/checkboxInput.Rd

@@ -1,10 +1,10 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R
+% Please edit documentation in R/input-checkbox.R
 \name{checkboxInput}
 \alias{checkboxInput}
 \title{Checkbox Input Control}
 \usage{
-checkboxInput(inputId, label, value = FALSE)
+checkboxInput(inputId, label, value = FALSE, width = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -12,6 +12,9 @@ checkboxInput(inputId, label, value = FALSE)
 \item{label}{Display label for the control, or \code{NULL} for no label.}
 
 \item{value}{Initial value (\code{TRUE} or \code{FALSE}).}
+
+\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
+see \code{\link{validateCssUnit}}.}
 }
 \value{
 A checkbox control that can be added to a UI definition.

man/dateInput.Rd

@@ -1,12 +1,12 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R
+% Please edit documentation in R/input-date.R
 \name{dateInput}
 \alias{dateInput}
 \title{Create date input}
 \usage{
 dateInput(inputId, label, value = NULL, min = NULL, max = NULL,
   format = "yyyy-mm-dd", startview = "month", weekstart = 0,
-  language = "en")
+  language = "en", width = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -37,6 +37,9 @@ from 0 (Sunday) to 6 (Saturday).}
   "fr", "he", "hr", "hu", "id", "is", "it", "ja", "kr", "lt", "lv", "ms",
   "nb", "nl", "pl", "pt", "pt-BR", "ro", "rs", "rs-latin", "ru", "sk", "sl",
   "sv", "sw", "th", "tr", "uk", "zh-CN", and "zh-TW".}
+
+\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
+see \code{\link{validateCssUnit}}.}
 }
 \description{
 Creates a text input which, when clicked on, brings up a calendar that

man/dateRangeInput.Rd

@@ -1,12 +1,12 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R
+% Please edit documentation in R/input-daterange.R
 \name{dateRangeInput}
 \alias{dateRangeInput}
 \title{Create date range input}
 \usage{
 dateRangeInput(inputId, label, start = NULL, end = NULL, min = NULL,
   max = NULL, format = "yyyy-mm-dd", startview = "month", weekstart = 0,
-  language = "en", separator = " to ")
+  language = "en", separator = " to ", width = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -43,6 +43,9 @@ from 0 (Sunday) to 6 (Saturday).}
   "sv", "sw", "th", "tr", "uk", "zh-CN", and "zh-TW".}
 
 \item{separator}{String to display between the start and end input boxes.}
+
+\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
+see \code{\link{validateCssUnit}}.}
 }
 \description{
 Creates a pair of text inputs which, when clicked on, bring up calendars that

man/fileInput.Rd

@@ -1,10 +1,10 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R
+% Please edit documentation in R/input-file.R
 \name{fileInput}
 \alias{fileInput}
 \title{File Upload Control}
 \usage{
-fileInput(inputId, label, multiple = FALSE, accept = NULL)
+fileInput(inputId, label, multiple = FALSE, accept = NULL, width = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -17,6 +17,9 @@ Internet Explorer 9 and earlier.}}
 
 \item{accept}{A character vector of MIME types; gives the browser a hint of
   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}}.}
 }
 \description{
 Create a file upload control that can be used to upload one or more files.

man/navbarPage.Rd

@@ -88,6 +88,7 @@ shinyUI(navbarPage("App Title",
 ))
 }
 \seealso{
-\code{\link{tabPanel}}, \code{\link{tabsetPanel}}
+\code{\link{tabPanel}}, \code{\link{tabsetPanel}},
+  \code{\link{updateNavbarPage}}
 }
 

man/navlistPanel.Rd

@@ -52,4 +52,7 @@ shinyUI(fluidPage(
   )
 ))
 }
+\seealso{
+\code{\link{tabPanel}}, \code{\link{updateNavlistPanel}}
+}
 

man/numericInput.Rd

@@ -1,10 +1,11 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R
+% Please edit documentation in R/input-numeric.R
 \name{numericInput}
 \alias{numericInput}
 \title{Create a numeric input control}
 \usage{
-numericInput(inputId, label, value, min = NA, max = NA, step = NA)
+numericInput(inputId, label, value, min = NA, max = NA, step = NA,
+  width = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -18,6 +19,9 @@ numericInput(inputId, label, value, min = NA, max = NA, step = NA)
 \item{max}{Maximum allowed value}
 
 \item{step}{Interval to use when stepping between min and max}
+
+\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
+see \code{\link{validateCssUnit}}.}
 }
 \value{
 A numeric input control that can be added to a UI definition.

man/passwordInput.Rd

@@ -1,10 +1,10 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R
+% Please edit documentation in R/input-password.R
 \name{passwordInput}
 \alias{passwordInput}
 \title{Create a password input control}
 \usage{
-passwordInput(inputId, label, value = "")
+passwordInput(inputId, label, value = "", width = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -12,6 +12,9 @@ passwordInput(inputId, label, value = "")
 \item{label}{Display label for the control, or \code{NULL} for no label.}
 
 \item{value}{Initial value.}
+
+\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
+see \code{\link{validateCssUnit}}.}
 }
 \value{
 A text input control that can be added to a UI definition.

man/radioButtons.Rd

@@ -1,10 +1,11 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R
+% Please edit documentation in R/input-radiobuttons.R
 \name{radioButtons}
 \alias{radioButtons}
 \title{Create radio buttons}
 \usage{
-radioButtons(inputId, label, choices, selected = NULL, inline = FALSE)
+radioButtons(inputId, label, choices, selected = NULL, inline = FALSE,
+  width = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -18,6 +19,9 @@ named then that name rather than the value is displayed to the user)}
 defaults to the first value)}
 
 \item{inline}{If \code{TRUE}, render the choices inline (i.e. horizontally)}
+
+\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
+see \code{\link{validateCssUnit}}.}
 }
 \value{
 A set of radio buttons that can be added to a UI definition.
@@ -25,6 +29,14 @@ A set of radio buttons that can be added to a UI definition.
 \description{
 Create a set of radio buttons used to select an item from a list.
 }
+\details{
+If you need to represent a "None selected" state, it's possible to default
+the radio buttons to have no options selected by using
+\code{selected = character(0)}. However, this is not recommended, as it gives
+the user no way to return to that state once they've made a selection.
+Instead, consider having the first of your choices be \code{c("None selected"
+= "")}.
+}
 \examples{
 radioButtons("dist", "Distribution type:",
              c("Normal" = "norm",

man/registerInputHandler.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/server.R
+% Please edit documentation in R/server-input-handlers.R
 \name{registerInputHandler}
 \alias{registerInputHandler}
 \title{Register an Input Handler}

man/removeInputHandler.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/server.R
+% Please edit documentation in R/server-input-handlers.R
 \name{removeInputHandler}
 \alias{removeInputHandler}
 \title{Deregister an Input Handler}

man/renderDataTable.Rd

@@ -52,10 +52,9 @@ elements in the list.
 This function only provides the server-side version of DataTables
   (using R to process the data object on the server side). There is a
   separate package \pkg{DT} (\url{https://github.com/rstudio/DT}) that allows
-  you to create both server-side and client-side DataTables. The functions
-  \code{renderDataTable()} and \code{dataTableOutput()} in \pkg{shiny} have
-  been deprecated since v0.11.1. Please use \code{DT::renderDataTable()} and
-  \code{DT::dataTableOutput()} (see
+  you to create both server-side and client-side DataTables, and supports
+  additional DataTables features. Consider using \code{DT::renderDataTable()}
+  and \code{DT::dataTableOutput()} (see
   \url{http://rstudio.github.io/DT/shiny.html} for more information).
 }
 \examples{

man/repeatable.Rd

@@ -4,7 +4,7 @@
 \alias{repeatable}
 \title{Make a random number generator repeatable}
 \usage{
-repeatable(rngfunc, seed = runif(1, 0, .Machine$integer.max))
+repeatable(rngfunc, seed = stats::runif(1, 0, .Machine$integer.max))
 }
 \arguments{
 \item{rngfunc}{The function that is affected by the R session's seed.}

man/selectInput.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R
+% Please edit documentation in R/input-select.R
 \name{selectInput}
 \alias{selectInput}
 \alias{selectizeInput}
@@ -54,6 +54,10 @@ JavaScript library \pkg{selectize.js}
 (\url{https://github.com/brianreavis/selectize.js}) to instead of the basic
 select input element. To use the standard HTML select input element, use
 \code{selectInput()} with \code{selectize=FALSE}.
+
+In selectize mode, if the first element in \code{choices} has a value of
+\code{""}, its name will be treated as a placeholder prompt. For example:
+\code{selectInput("letter", "Letter", c("Choose one" = "", LETTERS))}
 }
 \note{
 The selectize input created from \code{selectizeInput()} allows

man/shiny-options.Rd

@@ -35,6 +35,10 @@ be set with (for example) \code{options(shiny.trace=TRUE)}.
     \code{\link{runApp}} for more information.}
   \item{shiny.json.digits}{The number of digits to use when converting
     numbers to JSON format to send to the client web browser.}
+  \item{shiny.minified}{If this is \code{TRUE} or unset (the default), then
+    Shiny will use minified JavaScript (\code{shiny.min.js}). If
+    \code{FALSE}, then Shiny will use the un-minified JavaScript
+    (\code{shiny.js}); this can be useful during development.}
   \item{shiny.error}{This can be a function which is called when an error
     occurs. For example, \code{options(shiny.error=recover)} will result a
     the debugger prompt when an error occurs.}

man/sliderInput.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R, R/slider.R
+% Please edit documentation in R/input-slider.R
 \name{sliderInput}
 \alias{animationOptions}
 \alias{sliderInput}
@@ -7,7 +7,8 @@
 \usage{
 sliderInput(inputId, label, min, max, value, step = NULL, round = FALSE,
   format = NULL, locale = NULL, ticks = TRUE, animate = FALSE,
-  width = NULL, sep = ",", pre = NULL, post = NULL)
+  width = NULL, sep = ",", pre = NULL, post = NULL, timeFormat = NULL,
+  timezone = NULL, dragRange = TRUE)
 
 animationOptions(interval = 1000, loop = FALSE, playButton = NULL,
   pauseButton = NULL)
@@ -21,13 +22,15 @@ animationOptions(interval = 1000, loop = FALSE, playButton = NULL,
 
 \item{max}{The maximum value (inclusive) that can be selected.}
 
-\item{value}{The initial value of the slider. A numeric vector of length
-one will create a regular slider; a numeric vector of length two will
-create a double-ended range slider. A warning will be issued if the
-value doesn't fit between \code{min} and \code{max}.}
+\item{value}{The initial value of the slider. A numeric vector of length one
+will create a regular slider; a numeric vector of length two will create a
+double-ended range slider. A warning will be issued if the value doesn't
+fit between \code{min} and \code{max}.}
 
 \item{step}{Specifies the interval between each selectable value on the
-slider (if \code{NULL}, a heuristic is used to determine the step size).}
+slider (if \code{NULL}, a heuristic is used to determine the step size). If
+the values are dates, \code{step} is in days; if the values are times
+(POSIXt), \code{step} is in seconds.}
 
 \item{round}{\code{TRUE} to round all values to the nearest integer;
 \code{FALSE} if no rounding is desired; or an integer to round to that
@@ -55,6 +58,25 @@ see \code{\link{validateCssUnit}}.}
 
 \item{post}{A suffix string to put after the value.}
 
+\item{timeFormat}{Only used if the values are Date or POSIXt objects. A time
+format string, to be passed to the Javascript strftime library. See
+\url{https://github.com/samsonjs/strftime} for more details. The allowed
+format specifications are very similar, but not identical, to those for R's
+\code{\link{strftime}} function. For Dates, the default is \code{"\%F"}
+(like \code{"2015-07-01"}), and for POSIXt, the default is \code{"\%F \%T"}
+(like \code{"2015-07-01 15:32:10"}).}
+
+\item{timezone}{Only used if the values are POSIXt objects. A string
+specifying the time zone offset for the displayed times, in the format
+\code{"+HHMM"} or \code{"-HHMM"}. If \code{NULL} (the default), times will
+be displayed in the browser's time zone. The value \code{"+0000"} will
+result in UTC time.}
+
+\item{dragRange}{This option is used only if it is a range slider (with two
+values). If \code{TRUE} (the default), the range can be dragged. In other
+words, the min and max can be dragged together. If \code{FALSE}, the range
+cannot be dragged.}
+
 \item{interval}{The interval, in milliseconds, between each animation step.}
 
 \item{loop}{\code{TRUE} to automatically restart the animation when it

man/submitButton.Rd

@@ -1,15 +1,18 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R
+% Please edit documentation in R/input-submit.R
 \name{submitButton}
 \alias{submitButton}
 \title{Create a submit button}
 \usage{
-submitButton(text = "Apply Changes", icon = NULL)
+submitButton(text = "Apply Changes", icon = NULL, width = NULL)
 }
 \arguments{
 \item{text}{Button caption}
 
 \item{icon}{Optional \code{\link{icon}} to appear on the button}
+
+\item{width}{The width of the button, e.g. \code{'400px'}, or \code{'100\%'};
+see \code{\link{validateCssUnit}}.}
 }
 \value{
 A submit button that can be added to a UI definition.

man/textInput.Rd

@@ -1,10 +1,10 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
-% Please edit documentation in R/bootstrap.R
+% Please edit documentation in R/input-text.R
 \name{textInput}
 \alias{textInput}
 \title{Create a text input control}
 \usage{
-textInput(inputId, label, value = "")
+textInput(inputId, label, value = "", width = NULL)
 }
 \arguments{
 \item{inputId}{The \code{input} slot that will be used to access the value.}
@@ -12,6 +12,9 @@ textInput(inputId, label, value = "")
 \item{label}{Display label for the control, or \code{NULL} for no label.}
 
 \item{value}{Initial value.}
+
+\item{width}{The width of the input, e.g. \code{'400px'}, or \code{'100\%'};
+see \code{\link{validateCssUnit}}.}
 }
 \value{
 A text input control that can be added to a UI definition.

man/updateSliderInput.Rd

@@ -46,9 +46,9 @@ if (interactive()) {
       sidebarLayout(
         sidebarPanel(
           p("The first slider controls the second"),
-          slider2Input("control", "Controller:", min=0, max=20, value=10,
+          sliderInput("control", "Controller:", min=0, max=20, value=10,
                        step=1),
-          slider2Input("receive", "Receiver:", min=0, max=20, value=10,
+          sliderInput("receive", "Receiver:", min=0, max=20, value=10,
                        step=1)
         ),
         mainPanel()

man/updateTabsetPanel.Rd

@@ -1,10 +1,16 @@
 % Generated by roxygen2 (4.1.1): do not edit by hand
 % Please edit documentation in R/update-input.R
 \name{updateTabsetPanel}
+\alias{updateNavbarPage}
+\alias{updateNavlistPanel}
 \alias{updateTabsetPanel}
 \title{Change the selected tab on the client}
 \usage{
 updateTabsetPanel(session, inputId, selected = NULL)
+
+updateNavbarPage(session, inputId, selected = NULL)
+
+updateNavlistPanel(session, inputId, selected = NULL)
 }
 \arguments{
 \item{session}{The \code{session} object passed to function given to

srcjs/_start.js

@@ -7,6 +7,7 @@
   curly:false,
   indent:2
 */
+/* global strftime */
 
 (function() {
   var $ = jQuery;

srcjs/init_shiny.js

@@ -23,7 +23,7 @@ function initShiny() {
           continue;
 
         var $el = $(el);
-        if ($el.data('shiny-output-binding')) {
+        if ($el.hasClass('shiny-bound-output')) {
           // Already bound; can happen with nested uiOutput (bindAll
           // gets called on two ancestors)
           continue;
@@ -47,12 +47,14 @@ function initShiny() {
 
     var outputs = $(scope).find('.shiny-bound-output');
     for (var i = 0; i < outputs.length; i++) {
-      var bindingAdapter = $(outputs[i]).data('shiny-output-binding');
+      var $el = $(outputs[i]);
+      var bindingAdapter = $el.data('shiny-output-binding');
       if (!bindingAdapter)
         continue;
       var id = bindingAdapter.binding.getId(outputs[i]);
       shinyapp.unbindOutput(id, bindingAdapter);
-      $(outputs[i]).removeClass('shiny-bound-output');
+      $el.removeClass('shiny-bound-output');
+      $el.removeData('shiny-output-binding');
     }
 
     setTimeout(sendOutputHiddenState, 0);

srcjs/input_binding_date.js

@@ -10,7 +10,7 @@ $.extend(dateInputBinding, {
   // format like mm/dd/yyyy)
   getValue: function(el) {
     var date = $(el).find('input').data('datepicker').getUTCDate();
-    return this._formatDate(date);
+    return formatDateUTC(date);
   },
   // value must be an unambiguous string like '2001-01-01', or a Date object.
   setValue: function(el, value) {
@@ -30,8 +30,8 @@ $.extend(dateInputBinding, {
 
     // Stringify min and max. If min and max aren't set, they will be
     // -Infinity and Infinity; replace these with null.
-    min = (min === -Infinity) ? null : this._formatDate(min);
-    max = (max ===  Infinity) ? null : this._formatDate(max);
+    min = (min === -Infinity) ? null : formatDateUTC(min);
+    max = (max ===  Infinity) ? null : formatDateUTC(max);
 
     // startViewMode is stored as a number; convert to string
     var startview = $input.data('datepicker').startViewMode;
@@ -106,18 +106,6 @@ $.extend(dateInputBinding, {
     this._setMin($input[0], $input.data('min-date'));
     this._setMax($input[0], $input.data('max-date'));
   },
-  // Given a Date object, return a string in yyyy-mm-dd format, using the
-  // UTC date. This may be a day off from the date in the local time zone.
-  _formatDate: function(date) {
-    if (date instanceof Date) {
-      return date.getUTCFullYear() + '-' +
-             padZeros(date.getUTCMonth()+1, 2) + '-' +
-             padZeros(date.getUTCDate(), 2);
-
-    } else {
-      return null;
-    }
-  },
   // Given a format object from a date picker, return a string
   _formatToString: function(format) {
     // Format object has structure like:

srcjs/input_binding_daterange.js

@@ -10,7 +10,7 @@ $.extend(dateRangeInputBinding, dateInputBinding, {
     var start = $inputs.eq(0).data('datepicker').getUTCDate();
     var end   = $inputs.eq(1).data('datepicker').getUTCDate();
 
-    return [this._formatDate(start), this._formatDate(end)];
+    return [formatDateUTC(start), formatDateUTC(end)];
   },
   // value must be an array of unambiguous strings like '2001-01-01', or
   // Date objects.
@@ -44,8 +44,8 @@ $.extend(dateRangeInputBinding, dateInputBinding, {
 
     // Stringify min and max. If min and max aren't set, they will be
     // -Infinity and Infinity; replace these with null.
-    min = (min === -Infinity) ? null : this._formatDate(min);
-    max = (max ===  Infinity) ? null : this._formatDate(max);
+    min = (min === -Infinity) ? null : formatDateUTC(min);
+    max = (max ===  Infinity) ? null : formatDateUTC(max);
 
     // startViewMode is stored as a number; convert to string
     var startview = $startinput.data('datepicker').startViewMode;

srcjs/input_binding_slider.js

@@ -7,14 +7,42 @@ $.extend(sliderInputBinding, textInputBinding, {
 
     return $(scope).find('input.js-range-slider');
   },
+  getType: function(el) {
+    var dataType = $(el).data('data-type');
+    if (dataType === 'date')
+      return 'shiny.date';
+    else if (dataType === 'datetime')
+      return 'shiny.datetime';
+    else
+      return false;
+  },
   getValue: function(el) {
+    var $el = $(el);
     var result = $(el).data('ionRangeSlider').result;
+
+    // Function for converting numeric value from slider to appropriate type.
+    var convert;
+    var dataType = $el.data('data-type');
+    if (dataType === 'date') {
+      convert = function(val) {
+        return formatDateUTC(new Date(+val));
+      };
+    } else if (dataType === 'datetime') {
+      convert = function(val) {
+        // Convert ms to s
+        return +val / 1000;
+      };
+    } else {
+      convert = function(val) { return +val; };
+    }
+
     if (this._numValues(el) == 2) {
-      return [+result.from, +result.to];
+      return [convert(result.from), convert(result.to)];
     }
     else {
-      return +result.from;
+      return convert(result.from);
     }
+
   },
   setValue: function(el, value) {
     var slider = $(el).data('ionRangeSlider');
@@ -34,7 +62,8 @@ $.extend(sliderInputBinding, textInputBinding, {
     $(el).off('.sliderInputBinding');
   },
   receiveMessage: function(el, data) {
-    var slider = $(el).data('ionRangeSlider');
+    var $el = $(el);
+    var slider = $el.data('ionRangeSlider');
     var msg = {};
 
     if (data.hasOwnProperty('value')) {
@@ -43,8 +72,6 @@ $.extend(sliderInputBinding, textInputBinding, {
         msg.to = data.value[1];
       } else {
         msg.from = data.value;
-        // Workaround for ionRangeSlider issue #143
-        msg.to = data.value;
       }
     }
     if (data.hasOwnProperty('min'))  msg.min   = data.min;
@@ -52,13 +79,13 @@ $.extend(sliderInputBinding, textInputBinding, {
     if (data.hasOwnProperty('step')) msg.step  = data.step;
 
     if (data.hasOwnProperty('label'))
-      $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
+      $el.parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
 
-    $(el).data('updating', true);
+    $el.data('updating', true);
     try {
       slider.update(msg);
     } finally {
-      $(el).data('updating', false);
+      $el.data('updating', false);
     }
   },
   getRatePolicy: function() {
@@ -70,7 +97,32 @@ $.extend(sliderInputBinding, textInputBinding, {
   getState: function(el) {
   },
   initialize: function(el) {
-    $(el).ionRangeSlider();
+    var opts = {};
+    var $el = $(el);
+    var dataType = $el.data('data-type');
+    var timeFormat = $el.data('time-format');
+    var timeFormatter;
+
+    // Set up formatting functions
+    if (dataType === 'date') {
+      timeFormatter = strftime.utc();
+      opts.prettify = function(num) {
+        return timeFormatter(timeFormat, new Date(num));
+      };
+
+    } else if (dataType === 'datetime') {
+      var timezone = $el.data('timezone');
+      if (timezone)
+        timeFormatter = strftime.timezone(timezone);
+      else
+        timeFormatter = strftime;
+
+      opts.prettify = function(num) {
+        return timeFormatter(timeFormat, new Date(num));
+      };
+    }
+
+    $el.ionRangeSlider(opts);
   },
 
   // Number of values; 1 for single slider, 2 for range slider
@@ -127,14 +179,32 @@ $(document).on('click', '.slider-animate-button', function(evt) {
 
     } else {
       slider = target.data('ionRangeSlider');
+      // Single sliders have slider.options.type == "single", and only the
+      // `from` value is used. Double sliders have type == "double", and also
+      // use the `to` value for the right handle.
       var sliderCanStep = function() {
-        return slider.result.from < slider.result.max;
+        if (slider.options.type === "double")
+          return slider.result.to < slider.result.max;
+        else
+          return slider.result.from < slider.result.max;
       };
       var sliderReset = function() {
-        slider.update({from: slider.result.min});
+        var val = { from: slider.result.min };
+        // Preserve the current spacing for double sliders
+        if (slider.options.type === "double")
+          val.to = val.from + (slider.result.to - slider.result.from);
+
+        slider.update(val);
       };
       var sliderStep = function() {
-        slider.update({from: slider.result.from + slider.options.step});
+        // Don't overshoot the end
+        var val = {
+          from: Math.min(slider.result.max, slider.result.from + slider.options.step)
+        };
+        if (slider.options.type === "double")
+          val.to = Math.min(slider.result.max, slider.result.to + slider.options.step);
+
+        slider.update(val);
       };
 
       // If we're currently at the end, restart

srcjs/shinyapp.js

@@ -70,6 +70,10 @@ var ShinyApp = function() {
 
     var socket = createSocketFunc();
     socket.onopen = function() {
+      $(document).trigger({
+        type: 'shiny:connected',
+        socket: socket
+      });
       socket.send(JSON.stringify({
         method: 'init',
         data: self.$initialInput
@@ -84,6 +88,10 @@ var ShinyApp = function() {
       self.dispatchMessage(e.data);
     };
     socket.onclose = function() {
+      $(document).trigger({
+        type: 'shiny:disconnected',
+        socket: socket
+      });
       $(document.body).addClass('disconnected');
       self.$notifyDisconnected();
     };

srcjs/utils.js

@@ -59,6 +59,20 @@ function parseDate(dateString) {
   return date;
 }
 
+// Given a Date object, return a string in yyyy-mm-dd format, using the
+// UTC date. This may be a day off from the date in the local time zone.
+function formatDateUTC(date) {
+  if (date instanceof Date) {
+    return date.getUTCFullYear() + '-' +
+           padZeros(date.getUTCMonth()+1, 2) + '-' +
+           padZeros(date.getUTCDate(), 2);
+
+  } else {
+    return null;
+  }
+}
+
+
 // Given an element and a function(width, height), returns a function(). When
 // the output function is called, it calls the input function with the offset
 // width and height of the input element--but only if the size of the element

tools/updateStrftime.R

@@ -0,0 +1,28 @@
+#!/usr/bin/env Rscript
+
+# This script downloads strftime-min.js from its GitHub repository,
+# https://github.com/samsonjs/strftime
+
+# This script can be sourced from RStudio, or run with Rscript.
+
+# Returns the file currently being sourced or run with Rscript
+thisFile <- function() {
+  cmdArgs <- commandArgs(trailingOnly = FALSE)
+  needle <- "--file="
+  match <- grep(needle, cmdArgs)
+  if (length(match) > 0) {
+    # Rscript
+    return(normalizePath(sub(needle, "", cmdArgs[match])))
+  } else {
+    # 'source'd via R console
+    return(normalizePath(sys.frames()[[1]]$ofile))
+  }
+}
+
+ref <- "v0.9.2"
+destdir <- file.path(dirname(thisFile()), "../inst/www/shared/strftime/")
+
+download.file(
+  paste0("https://raw.githubusercontent.com/samsonjs/strftime/", ref, "/strftime-min.js"),
+  destfile = file.path(destdir, "strftime-min.js")
+)