Add worker id info to state parameter

Should allow Connect/SSP to reliably route oauth handshakes
among multiple R processes for the same app

.github/ISSUE_TEMPLATE/bug_report.md

@@ -0,0 +1,40 @@
+---
+name  : Bug report
+about : Report a bug in Shiny.
+---
+
+<!--
+This issue tracker is for bugs and feature requests in the Shiny package. If you're having trouble with Shiny Server or a related package, please file an issue in the appropriate repository. 
+
+If you're having trouble with shinyapps.io, and you have a paid account (Starter, Basic, Standard, or Pro), please file a support ticket via https://support.rstudio.com. If you have a Free account, please post to the RStudio Community with the shinyappsio tag: https://community.rstudio.com/tags/shinyappsio.
+
+Finally, if you are an RStudio customer and are having trouble with one of our Pro products, get in touch with our support team at support@rstudio.com.
+
+Before you file an issue, please upgrade to the latest version of Shiny from CRAN and confirm that the problem persists.
+
+# First, restart R.
+# To install latest shiny from CRAN:
+install.packages("shiny")
+
+See our guide to writing good bug reports for further guidance: https://github.com/rstudio/shiny/wiki/Writing-Good-Bug-Reports. The better your report is, the likelier we are to be able to reproduce and ultimately solve it.
+-->
+
+### System details
+
+Browser Version: <!-- If applicable -->
+
+Output of `sessionInfo()`:
+
+```
+# sessionInfo() output goes here
+```
+
+### Example application *or* steps to reproduce the problem
+
+<!-- If you're able to create one, a reproducible example is extremely helpful to us. For instructions on how to create one, please see: https://github.com/rstudio/shiny/wiki/Creating-a-Reproducible-Example --> 
+
+```R
+# Minimal, self-contained example app code goes here
+```
+
+### Describe the problem in detail

.github/ISSUE_TEMPLATE/feature_request.md

@@ -0,0 +1,17 @@
+---
+name  : Feature request
+about : Request a new feature.
+---
+
+<!--
+
+Thanks for taking the time to file a feature request! Please take the time to search for an existing feature request, to avoid creating duplicate requests. If you find an existing feature request, please give it a thumbs-up reaction, as we'll use these reactions to help prioritize the implementation of these features in the future.
+
+If the feature has not yet been filed, then please describe the feature you'd like to see become a part of Shiny. See:
+
+https://github.com/rstudio/shiny/wiki/Writing-Good-Feature-Requests
+
+for a guide on how to write good feature requests.
+
+-->
+

.github/ISSUE_TEMPLATE/question.md

@@ -0,0 +1,7 @@
+---
+name  : Ask a Question
+about : The issue tracker is not for questions -- please ask questions at https://community.rstudio.com/c/shiny.
+---
+
+The issue tracker is not for questions. If you have a question, please feel free to ask it on our community site, at https://community.rstudio.com/c/shiny.
+

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 1.3.2
+Version: 1.3.2.9000
 Authors@R: c(
     person("Winston", "Chang", role = c("aut", "cre"), email = "winston@rstudio.com"),
     person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"),

NAMESPACE

@@ -40,6 +40,7 @@ export(absolutePanel)
 export(actionButton)
 export(actionLink)
 export(addResourcePath)
+export(addRouteHandler)
 export(animationOptions)
 export(appendTab)
 export(as.shiny.appobj)

NEWS.md

@@ -1,3 +1,30 @@
+shiny 1.3.2.9000
+=======
+
+## Changes
+
+* Resolved ([#1433](https://github.com/rstudio/shiny/issues/1433)): `plotOutput()`'s coordmap info now includes discrete axis limits for **ggplot2** plots. As a result, any **shinytest** tests that contain **ggplot2** plots with discrete axes (that were recorded before this change) will now report differences that can safely be updated. This new coordmap info was added to correctly infer what data points are within an input brush and/or near input click/hover in scenarios where a non-trivial discrete axis scale is involved (e.g., whenever `scale_[x/y]_discrete(limits = ...)` and/or free scales across multiple discrete axes are used). ([#2410](https://github.com/rstudio/shiny/pull/2410))
+
+### Improvements
+
+* Resolved ([#2402](https://github.com/rstudio/shiny/issues/2402)): An informative warning is now thrown for mis-specified (date) strings in `dateInput()`, `updateDateInput()`, `dateRangeInput()`, and `updateDateRangeInput()`. ([#2403](https://github.com/rstudio/shiny/pull/2403))
+
+### Bug fixes
+
+* Fixed [#2387](https://github.com/rstudio/shiny/issues/2387): Updating a `sliderInput()`'s type from numeric to date no longer changes the rate policy from debounced to immediate. More generally, updating an input binding with a new type should (no longer) incorrectly alter the input rate policy. ([#2404](https://github.com/rstudio/shiny/pull/2404))
+
+* Fixed [#868](https://github.com/rstudio/shiny/issues/868): If an input is initialized with a `NULL` label, it can now be updated with a string. Moreover, if an input label is initialized with a string, it can now be removed by updating with `label=character(0)` (similar to how `choices` and `selected` can be cleared in `updateSelectInput()`). ([#2406](https://github.com/rstudio/shiny/pull/2406))
+
+* Fixed [#2250](https://github.com/rstudio/shiny/issues/2250): `updateSliderInput()` now works with un-specified (or zero-length) `min`, `max`, and `value`. ([#2416](https://github.com/rstudio/shiny/pull/2416))
+
+* Fixed [#2396](https://github.com/rstudio/shiny/issues/2396): `selectInput("myID", ...)` resulting in an extra `myID-selectized` input (introduced in v1.2.0). ([#2418](https://github.com/rstudio/shiny/pull/2418))
+
+* Fixed [#2233](https://github.com/rstudio/shiny/issues/2233): `verbatimTextOutput()` produced wrapped text on Safari, but the text should not be wrapped. ([#2353](https://github.com/rstudio/shiny/pull/2353))
+
+* Fixed [rstudio/reactlog#36](https://github.com/rstudio/reactlog/issues/36): Changes to reactive values not displaying accurately in reactlog. ([#2424](https://github.com/rstudio/shiny/pull/2424))
+
+* Fixed [#2329](https://github.com/rstudio/shiny/issues/2329), [#1817](https://github.com/rstudio/shiny/issues/1817): These bugs were reported as fixed in Shiny 1.3.0 but were not actually fixed because some JavaScript changes were accidentally not included in the release. The fix resolves issues that occur when `withProgressBar()` or bookmarking are combined with the [networkD3](https://christophergandrud.github.io/networkD3/) package's Sankey plot.
+
 shiny 1.3.2
 ===========
 
@@ -11,6 +38,8 @@ shiny 1.3.2
 shiny 1.3.1
 ===========
 
+## Full changelog
+
 ### Bug fixes
 
 * Fixed a performance issue introduced in v1.3.0 when using large nested lists within Shiny. ([#2377](https://github.com/rstudio/shiny/pull/2377))

R/image-interact.R

@@ -88,17 +88,14 @@ brushedPoints <- function(df, brush, xvar = NULL, yvar = NULL,
       stop("brushedPoints: not able to automatically infer `xvar` from brush")
     if (!(xvar %in% names(df)))
       stop("brushedPoints: `xvar` ('", xvar ,"')  not in names of input")
-    # Extract data values from the data frame
-    x <- asNumber(df[[xvar]])
-    keep_rows <- keep_rows & (x >= brush$xmin & x <= brush$xmax)
+    keep_rows <- keep_rows & within_brush(df[[xvar]], brush, "x")
   }
   if (use_y) {
     if (is.null(yvar))
       stop("brushedPoints: not able to automatically infer `yvar` from brush")
     if (!(yvar %in% names(df)))
       stop("brushedPoints: `yvar` ('", yvar ,"') not in names of input")
-    y <- asNumber(df[[yvar]])
-    keep_rows <- keep_rows & (y >= brush$ymin & y <= brush$ymax)
+    keep_rows <- keep_rows & within_brush(df[[yvar]], brush, "y")
   }
 
   # Find which rows are matches for the panel vars (if present)
@@ -281,8 +278,8 @@ nearPoints <- function(df, coordinfo, xvar = NULL, yvar = NULL,
     stop("nearPoints: `yvar` ('", yvar ,"')  not in names of input")
 
   # Extract data values from the data frame
-  x <- asNumber(df[[xvar]])
-  y <- asNumber(df[[yvar]])
+  x <- asNumber(df[[xvar]], coordinfo$domain$discrete_limits$x)
+  y <- asNumber(df[[yvar]], coordinfo$domain$discrete_limits$y)
 
   # Get the coordinates of the point (in img pixel coordinates)
   point_img <- coordinfo$coords_img
@@ -402,11 +399,27 @@ nearPoints <- function(df, coordinfo, xvar = NULL, yvar = NULL,
 #   ..$ y: NULL
 #  $ .nonce    : num 0.603
 
-
+# Helper to determine if data values are within the limits of
+# an input brush
+within_brush <- function(vals, brush, var = "x") {
+  var <- match.arg(var, c("x", "y"))
+  vals <- asNumber(vals, brush$domain$discrete_limits[[var]])
+  # It's possible for a non-missing data values to not
+  # map to the axis limits, for example:
+  # https://github.com/rstudio/shiny/pull/2410#issuecomment-488100881
+  !is.na(vals) &
+    vals >= brush[[paste0(var, "min")]] &
+    vals <= brush[[paste0(var, "max")]]
+}
 
 # Coerce various types of variables to numbers. This works for Date, POSIXt,
 # characters, and factors. Used because the mouse coords are numeric.
-asNumber <- function(x) {
+# The `levels` argument should be used when mapping this variable to
+# a known set of discrete levels, which is needed for ggplot2 since
+# it allows you to control ordering and possible values of a discrete
+# positional scale (#2410)
+asNumber <- function(x, levels = NULL) {
+  if (length(levels)) return(match(x, levels))
   if (is.character(x)) x <- as.factor(x)
   if (is.factor(x)) x <- as.integer(x)
   as.numeric(x)

R/input-checkboxgroup.R

@@ -94,7 +94,7 @@ checkboxGroupInput <- function(inputId, label, choices = NULL, selected = NULL,
   tags$div(id = inputId,
     style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
     class = divClass,
-    controlLabel(inputId, label),
+    shinyInputLabel(inputId, label),
     options
   )
 }

R/input-date.R

@@ -78,7 +78,7 @@
 #'
 #'   # Disable Mondays and Tuesdays.
 #'   dateInput("date7", "Date:", daysofweekdisabled = c(1,2)),
-#'   
+#'
 #'   # Disable specific dates.
 #'   dateInput("date8", "Date:", value = "2012-02-29",
 #'             datesdisabled = c("2012-03-01", "2012-03-02"))
@@ -92,14 +92,10 @@ dateInput <- function(inputId, label, value = NULL, min = NULL, max = NULL,
   language = "en", width = NULL, autoclose = TRUE,
   datesdisabled = NULL, daysofweekdisabled = 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")
-  if (inherits(datesdisabled, "Date")) {
-      datesdisabled <- format(datesdisabled,   "%Y-%m-%d")
-  }
+  value <- dateYMD(value, "value")
+  min <- dateYMD(min, "min")
+  max <- dateYMD(max, "max")
+  datesdisabled <- dateYMD(datesdisabled, "datesdisabled")
 
   value <- restoreInput(id = inputId, default = value)
 
@@ -107,7 +103,7 @@ dateInput <- function(inputId, label, value = NULL, min = NULL, max = NULL,
     class = "shiny-date-input form-group shiny-input-container",
     style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
 
-    controlLabel(inputId, label),
+    shinyInputLabel(inputId, label),
     tags$input(type = "text",
                class = "form-control",
                `data-date-language` = language,

R/input-daterange.R

@@ -76,12 +76,10 @@ dateRangeInput <- function(inputId, label, start = NULL, end = NULL,
     weekstart = 0, language = "en", separator = " to ", width = NULL,
     autoclose = TRUE) {
 
-  # 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")
+  start <- dateYMD(start, "start")
+  end   <- dateYMD(end, "end")
+  min   <- dateYMD(min, "min")
+  max   <- dateYMD(max, "max")
 
   restored <- restoreInput(id = inputId, default = list(start, end))
   start <- restored[[1]]
@@ -92,7 +90,7 @@ dateRangeInput <- function(inputId, label, start = NULL, end = NULL,
       class = "shiny-date-range-input form-group shiny-input-container",
       style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
 
-      controlLabel(inputId, label),
+      shinyInputLabel(inputId, label),
       # input-daterange class is needed for dropdown behavior
       div(class = "input-daterange input-group",
         tags$input(

R/input-file.R

@@ -103,7 +103,7 @@ fileInput <- function(inputId, label, multiple = FALSE, accept = NULL,
 
   div(class = "form-group shiny-input-container",
     style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
-    label %AND% tags$label(label),
+    shinyInputLabel(inputId, label),
 
     div(class = "input-group",
       tags$label(class = "input-group-btn",

R/input-numeric.R

@@ -42,7 +42,7 @@ numericInput <- function(inputId, label, value, min = NA, max = NA, step = NA,
 
   div(class = "form-group shiny-input-container",
     style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
-    label %AND% tags$label(label, `for` = inputId),
+    shinyInputLabel(inputId, label),
     inputTag
   )
 }

R/input-password.R

@@ -30,7 +30,7 @@ passwordInput <- function(inputId, label, value = "", width = NULL,
                           placeholder = NULL) {
   div(class = "form-group shiny-input-container",
     style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
-    label %AND% tags$label(label, `for` = inputId),
+    shinyInputLabel(inputId, label),
     tags$input(id = inputId, type="password", class="form-control", value=value,
                placeholder = placeholder)
   )

R/input-radiobuttons.R

@@ -102,7 +102,7 @@ radioButtons <- function(inputId, label, choices = NULL, selected = NULL,
   tags$div(id = inputId,
     style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
     class = divClass,
-    controlLabel(inputId, label),
+    shinyInputLabel(inputId, label),
     options
   )
 }

R/input-select.R

@@ -105,7 +105,7 @@ selectInput <- function(inputId, label, choices, selected = NULL,
   res <- div(
     class = "form-group shiny-input-container",
     style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
-    controlLabel(inputId, label),
+    shinyInputLabel(inputId, label),
     div(selectTag)
   )
 

R/input-slider.R

@@ -172,7 +172,7 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
 
   sliderTag <- div(class = "form-group shiny-input-container",
     style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
-    if (!is.null(label)) controlLabel(inputId, label),
+    shinyInputLabel(inputId, label),
     do.call(tags$input, sliderProps)
   )
 

R/input-text.R

@@ -36,7 +36,7 @@ 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),
+    shinyInputLabel(inputId, label),
     tags$input(id = inputId, type="text", class="form-control", value=value,
       placeholder = placeholder)
   )

R/input-textarea.R

@@ -55,7 +55,7 @@ textAreaInput <- function(inputId, label, value = "", width = NULL, height = NUL
   if (length(style) == 0) style <- NULL
 
   div(class = "form-group shiny-input-container",
-    label %AND% tags$label(label, `for` = inputId),
+    shinyInputLabel(inputId, label),
     tags$textarea(
       id = inputId,
       class = "form-control",

R/input-utils.R

@@ -1,5 +1,10 @@
-controlLabel <- function(controlName, label) {
-  label %AND% tags$label(class = "control-label", `for` = controlName, label)
+shinyInputLabel <- function(inputId, label = NULL) {
+  tags$label(
+    label,
+    class = "control-label",
+    class = if (is.null(label)) "shiny-label-null",
+    `for` = inputId
+  )
 }
 
 # This function takes in either a list or vector for `choices` (and

R/reactives.R

@@ -395,24 +395,21 @@ ReactiveValues <- R6Class(
       # set the value for better logging
       .values[[key]] <- value
 
-      if (key_exists) {
-        # key has been depended upon (can not happen if the key is being set)
-        if (isTRUE(.hasRetrieved$keys[[key]])) {
-          rLog$valueChangeKey(.reactId, key, value, domain)
-          keyReactId <- rLog$keyIdStr(.reactId, key)
-          rLog$invalidateStart(keyReactId, NULL, "other", domain)
-          on.exit(
-            rLog$invalidateEnd(keyReactId, NULL, "other", domain),
-            add = TRUE
-          )
-        }
+      # key has been depended upon
+      if (isTRUE(.hasRetrieved$keys[[key]])) {
+        rLog$valueChangeKey(.reactId, key, value, domain)
+        keyReactId <- rLog$keyIdStr(.reactId, key)
+        rLog$invalidateStart(keyReactId, NULL, "other", domain)
+        on.exit(
+          rLog$invalidateEnd(keyReactId, NULL, "other", domain),
+          add = TRUE
+        )
+      }
 
-      } else {
-        # only invalidate if there are deps
-        if (isTRUE(.hasRetrieved$names)) {
-          rLog$valueChangeNames(.reactId, ls(.values, all.names = TRUE), domain)
-          .namesDeps$invalidate()
-        }
+      # only invalidate if there are deps
+      if (!key_exists && isTRUE(.hasRetrieved$names)) {
+        rLog$valueChangeNames(.reactId, ls(.values, all.names = TRUE), domain)
+        .namesDeps$invalidate()
       }
 
       if (hidden) {

R/render-plot.R

@@ -353,62 +353,88 @@ custom_print.ggplot <- function(x) {
 # With a faceted ggplot2 plot, the outer list contains two objects, each of
 # which represents one panel. In this example, there is one panelvar, but there
 # can be up to two of them.
-# mtc <- mtcars
-# mtc$am <- factor(mtc$am)
-# p <- print(ggplot(mtc, aes(wt, mpg)) + geom_point() + facet_wrap(~ am))
-# str(getGgplotCoordmap(p, 400, 300, 72))
+# p <- print(ggplot(mpg) + geom_point(aes(fl, cty), alpha = 0.2) + facet_wrap(~drv, scales = "free_x"))
+# str(getGgplotCoordmap(p, 500, 400, 72))
 # List of 2
-#  $ panels:List of 2
+#  $ panels:List of 3
 #   ..$ :List of 8
 #   .. ..$ panel     : num 1
 #   .. ..$ row       : int 1
 #   .. ..$ col       : int 1
 #   .. ..$ panel_vars:List of 1
-#   .. .. ..$ panelvar1: Factor w/ 2 levels "0","1": 1
+#   .. .. ..$ panelvar1: chr "4"
 #   .. ..$ log       :List of 2
 #   .. .. ..$ x: NULL
 #   .. .. ..$ y: NULL
-#   .. ..$ domain    :List of 4
-#   .. .. ..$ left  : num 1.32
-#   .. .. ..$ right : num 5.62
-#   .. .. ..$ bottom: num 9.22
-#   .. .. ..$ top   : num 35.1
+#   .. ..$ domain    :List of 5
+#   .. .. ..$ left           : num 0.4
+#   .. .. ..$ right          : num 4.6
+#   .. .. ..$ bottom         : num 7.7
+#   .. .. ..$ top            : num 36.3
+#   .. .. ..$ discrete_limits:List of 1
+#   .. .. .. ..$ x: chr [1:4] "d" "e" "p" "r"
 #   .. ..$ mapping   :List of 3
-#   .. .. ..$ x        : chr "wt"
-#   .. .. ..$ y        : chr "mpg"
-#   .. .. ..$ panelvar1: chr "am"
+#   .. .. ..$ x        : chr "fl"
+#   .. .. ..$ y        : chr "cty"
+#   .. .. ..$ panelvar1: chr "drv"
 #   .. ..$ range     :List of 4
 #   .. .. ..$ left  : num 33.3
-#   .. .. ..$ right : num 191
-#   .. .. ..$ bottom: num 328
+#   .. .. ..$ right : num 177
+#   .. .. ..$ bottom: num 448
 #   .. .. ..$ top   : num 23.1
 #   ..$ :List of 8
 #   .. ..$ panel     : num 2
 #   .. ..$ row       : int 1
 #   .. ..$ col       : int 2
 #   .. ..$ panel_vars:List of 1
-#   .. .. ..$ panelvar1: Factor w/ 2 levels "0","1": 2
+#   .. .. ..$ panelvar1: chr "f"
 #   .. ..$ log       :List of 2
 #   .. .. ..$ x: NULL
 #   .. .. ..$ y: NULL
-#   .. ..$ domain    :List of 4
-#   .. .. ..$ left  : num 1.32
-#   .. .. ..$ right : num 5.62
-#   .. .. ..$ bottom: num 9.22
-#   .. .. ..$ top   : num 35.1
+#   .. ..$ domain    :List of 5
+#   .. .. ..$ left           : num 0.4
+#   .. .. ..$ right          : num 5.6
+#   .. .. ..$ bottom         : num 7.7
+#   .. .. ..$ top            : num 36.3
+#   .. .. ..$ discrete_limits:List of 1
+#   .. .. .. ..$ x: chr [1:5] "c" "d" "e" "p" ...
 #   .. ..$ mapping   :List of 3
-#   .. .. ..$ x        : chr "wt"
-#   .. .. ..$ y        : chr "mpg"
-#   .. .. ..$ panelvar1: chr "am"
+#   .. .. ..$ x        : chr "fl"
+#   .. .. ..$ y        : chr "cty"
+#   .. .. ..$ panelvar1: chr "drv"
 #   .. ..$ range     :List of 4
-#   .. .. ..$ left  : num 197
-#   .. .. ..$ right : num 355
-#   .. .. ..$ bottom: num 328
+#   .. .. ..$ left  : num 182
+#   .. .. ..$ right : num 326
+#   .. .. ..$ bottom: num 448
+#   .. .. ..$ top   : num 23.1
+#   ..$ :List of 8
+#   .. ..$ panel     : num 3
+#   .. ..$ row       : int 1
+#   .. ..$ col       : int 3
+#   .. ..$ panel_vars:List of 1
+#   .. .. ..$ panelvar1: chr "r"
+#   .. ..$ log       :List of 2
+#   .. .. ..$ x: NULL
+#   .. .. ..$ y: NULL
+#   .. ..$ domain    :List of 5
+#   .. .. ..$ left           : num 0.4
+#   .. .. ..$ right          : num 3.6
+#   .. .. ..$ bottom         : num 7.7
+#   .. .. ..$ top            : num 36.3
+#   .. .. ..$ discrete_limits:List of 1
+#   .. .. .. ..$ x: chr [1:3] "e" "p" "r"
+#   .. ..$ mapping   :List of 3
+#   .. .. ..$ x        : chr "fl"
+#   .. .. ..$ y        : chr "cty"
+#   .. .. ..$ panelvar1: chr "drv"
+#   .. ..$ range     :List of 4
+#   .. .. ..$ left  : num 331
+#   .. .. ..$ right : num 475
+#   .. .. ..$ bottom: num 448
 #   .. .. ..$ top   : num 23.1
 #  $ dims  :List of 2
-#   ..$ width : num 400
-#   ..$ height: num 300
-
+#   ..$ width : num 500
+#   ..$ height: num 400
 
 getCoordmap <- function(x, width, height, res) {
   if (inherits(x, "ggplot_build_gtable")) {
@@ -570,6 +596,9 @@ find_panel_info_api <- function(b) {
       domain$bottom <- -domain$bottom
     }
 
+    domain <- add_discrete_limits(domain, xscale, "x")
+    domain <- add_discrete_limits(domain, yscale, "y")
+
     domain
   }
 
@@ -689,6 +718,9 @@ find_panel_info_non_api <- function(b, ggplot_format) {
       domain$bottom <- -domain$bottom
     }
 
+    domain <- add_discrete_limits(domain, xscale, "x")
+    domain <- add_discrete_limits(domain, yscale, "y")
+
     domain
   }
 
@@ -995,3 +1027,23 @@ find_panel_ranges <- function(g, res) {
     )
   })
 }
+
+# Remember the x/y limits of discrete axes. This info is
+# necessary to properly inverse map the numeric (i.e., trained)
+# positions back to the data scale, for example:
+# https://github.com/rstudio/shiny/pull/2410#issuecomment-487783828
+# https://github.com/rstudio/shiny/pull/2410#issuecomment-488100881
+#
+# Eventually, we may want to consider storing the entire ggplot2
+# object server-side and querying information from that object
+# as we need it...that's the only way we'll ever be able to
+# faithfully brush examples like this:
+# https://github.com/rstudio/shiny/issues/2411
+add_discrete_limits <- function(domain, scale, var = "x") {
+  var <- match.arg(var, c("x", "y"))
+  if (!is.function(scale$is_discrete) || !is.function(scale$get_limits)) return(domain)
+  if (scale$is_discrete()) {
+    domain$discrete_limits[[var]] <- scale$get_limits()
+  }
+  domain
+}

R/server.R

@@ -82,6 +82,16 @@ addResourcePath <- function(prefix, directoryPath) {
   )
 }
 
+#' @export
+addRouteHandler <- function(urlPath, handler) {
+  if (!is.function(handler)) {
+    stop("addHandlerPath handler must be a function")
+  }
+  .globals$userHandlers[[urlPath]] <- handler
+  invisible()
+}
+.globals$userHandlers <- list()
+
 # This function handles any GET request with two or more path elements where the
 # first path element matches a prefix that was previously added using
 # addResourcePath().
@@ -128,6 +138,17 @@ resourcePathHandler <- function(req) {
   return(resInfo$func(subreq))
 }
 
+userHandlersHandler <- function(req) {
+  # e.g. "/foo/one/two.html"
+  path <- req$PATH_INFO
+
+  handler <- .globals$userHandlers[[path]]
+  if (is.null(handler))
+    return(NULL)
+
+  return(..stacktraceon..(handler(req)))
+}
+
 #' Define Server Functionality
 #'
 #' Defines the server-side logic of the Shiny application. This generally
@@ -226,6 +247,7 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
       httpHandlers,
       sys.www.root,
       resourcePathHandler,
+      userHandlersHandler,
       reactLogHandler
     )),
     ws = function(ws) {

R/update-input.R

@@ -205,18 +205,9 @@ updateActionButton <- function(session, inputId, label = NULL, icon = NULL) {
 updateDateInput <- function(session, inputId, label = NULL, value = NULL,
                             min = NULL, max = NULL) {
 
-  # Make sure values are NULL or Date objects. This is so we can ensure that
-  # they will be formatted correctly. For example, the string "2016-08-9" is not
-  # correctly formatted, but the conversion to Date and back to string will fix
-  # it.
-  formatDate <- function(x) {
-    if (is.null(x))
-      return(NULL)
-    format(as.Date(x), "%Y-%m-%d")
-  }
-  value <- formatDate(value)
-  min   <- formatDate(min)
-  max   <- formatDate(max)
+  value <- dateYMD(value, "value")
+  min   <- dateYMD(min, "min")
+  max   <- dateYMD(max, "max")
 
   message <- dropNulls(list(label=label, value=value, min=min, max=max))
   session$sendInputMessage(inputId, message)
@@ -266,12 +257,11 @@ updateDateInput <- function(session, inputId, label = NULL, value = NULL,
 updateDateRangeInput <- function(session, inputId, label = NULL,
                                  start = NULL, end = NULL, min = NULL,
                                  max = NULL) {
-  # Make sure start and end are strings, not date objects. This is for
-  # consistency across different locales.
-  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')
+
+  start <- dateYMD(start, "start")
+  end <- dateYMD(end, "end")
+  min <- dateYMD(min, "min")
+  max <- dateYMD(max, "max")
 
   message <- dropNulls(list(
     label = label,
@@ -428,13 +418,15 @@ updateNumericInput <- function(session, inputId, label = NULL, value = NULL,
 updateSliderInput <- function(session, inputId, label = NULL, value = NULL,
   min = NULL, max = NULL, step = NULL, timeFormat = NULL, timezone = NULL)
 {
+  # If no min/max/value is provided, we won't know the
+  # type, and this will return an empty string
   dataType <- getSliderType(min, max, value)
 
   if (is.null(timeFormat)) {
     timeFormat <- switch(dataType, date = "%F", datetime = "%F %T", number = NULL)
   }
 
-  if (dataType == "date" || dataType == "datetime") {
+  if (isTRUE(dataType %in% c("date", "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)

R/utils.R

@@ -1560,6 +1560,25 @@ URLencode <- function(value, reserved = FALSE) {
   if (reserved) encodeURIComponent(value) else encodeURI(value)
 }
 
+# Make user-supplied dates are either NULL or can be coerced
+# to a yyyy-mm-dd formatted string. If a date is specified, this
+# function returns a string for consistency across locales.
+# Also, `as.Date()` is used to coerce strings to date objects
+# so that strings like "2016-08-9" are expanded to "2016-08-09"
+dateYMD <- function(date = NULL, argName = "value") {
+  if (!length(date)) return(NULL)
+  if (length(date) > 1) warning("Expected `", argName, "` to be of length 1.")
+  tryCatch(date <- format(as.Date(date), "%Y-%m-%d"),
+    error = function(e) {
+      warning(
+        "Couldn't coerce the `", argName,
+        "` argument to a date string with format yyyy-mm-dd",
+        call. = FALSE
+      )
+    }
+  )
+  date
+}
 
 # This function takes a name and function, and it wraps that function in a new
 # function which calls the original function using the specified name. This can
@@ -1730,6 +1749,7 @@ createVarPromiseDomain <- function(env, name, value) {
 
 getSliderType <- function(min, max, value) {
   vals <- dropNulls(list(value, min, max))
+  if (length(vals) == 0) return("")
   type <- unique(lapply(vals, function(x) {
     if      (inherits(x, "Date"))   "date"
     else if (inherits(x, "POSIXt")) "datetime"

examples/oauth/app.R

@@ -0,0 +1,81 @@
+library(shiny)
+
+options(shiny.port=8100)
+
+# TODO: Figure out how not to require shiny.port to be set in advance
+# TODO: Verify that cookies work in Connect/SSP
+# TODO: Whole-page protection behind oauth
+
+source("oauth.R")
+
+github_oauth_config <- oauth_config(
+  oauth_endpoint_uri = "https://github.com/login/oauth/authorize",
+  token_endpoint_uri = "https://github.com/login/oauth/access_token",
+  app_uri = "http://127.0.0.1:8100/",
+
+  # Store client_id and client_secret however you want--just hardcoded for this example
+  client_id = "700d40c400de637d9780",
+  client_secret = "e6383430779d9df9b253e7d6b1fb53308033873d",
+
+  scope = ""
+)
+
+google_oauth_config <- oauth_config(
+  oauth_endpoint_uri = "https://accounts.google.com/o/oauth2/v2/auth",
+  token_endpoint_uri = "https://www.googleapis.com/oauth2/v4/token",
+  app_uri = "http://127.0.0.1:8100/",
+
+  # Store client_id and client_secret however you want--just hardcoded for this example
+  client_id = "350280321053-7bq89pep4da46df2g66ddjnj6e3qrnie.apps.googleusercontent.com",
+  client_secret = "8_AHVNXyKyO3tBAZFAy-2y0B",
+
+  scope = "https://www.googleapis.com/auth/drive.metadata.readonly"
+)
+
+
+ui <- fluidPage(
+  textOutput("username", inline = TRUE),
+  p(
+    oauth_login_ui("oauth_login")
+  )
+)
+
+server <- function(input, output, session) {
+
+  ### GITHUB
+
+  token <- callModule(oauth_login, id = "oauth_login", github_oauth_config)
+
+  output$username <- renderText({
+    if (is.null(token())) {
+      "Not logged in"
+    } else {
+      resp <- httr::GET("https://api.github.com/user",
+        httr::add_headers("Authorization" = paste("token", token()))
+      )
+
+      paste0("Logged in as ", httr::content(resp)$login)
+    }
+  })
+
+
+
+  ## GOOGLE
+
+  # token <- callModule(oauth_login, id = "oauth_login", google_oauth_config)
+  #
+  # output$username <- renderText({
+  #   if (is.null(token())) {
+  #     # Not logged in
+  #     "(nobody)"
+  #   } else {
+  #     req <- gargle::request_build(method = "GET", path = "oauth2/v3/tokeninfo",
+  #       params = list(access_token=token()),
+  #       base_url = "https://www.googleapis.com")
+  #     resp <- gargle::request_make(req)
+  #     gargle::response_process(resp)$email
+  #   }
+  # })
+}
+
+shinyApp(ui, server, options = list(port = 8100))

examples/oauth/oauth.R

@@ -0,0 +1,293 @@
+# remotes::install_github("r-lib/fastmap")
+
+# Include in your Shiny UI wherever you want OAuth login UI to appear
+oauth_login_ui <- function(id) {
+  ns <- NS(id)
+  tagList(
+    uiOutput(ns("container")),
+    htmltools::singleton(tags$head(clear_cookie_custom_handler))
+  )
+}
+
+# A simple Bootstrap OAuth login button
+oauth_login_button <- function(login_url) {
+  #tags$a(href=login_url, target="_blank", class="btn btn-default", "Login")
+  tags$a(href=sprintf("javascript:window.open('%s');", login_url), class = "btn btn-default", "Login")
+}
+
+oauth_logout_button <- function(input_id) {
+  actionLink(input_id, "Logout")
+}
+
+oauth_do_logout <- function(rv, session = getDefaultReactiveDomain()) {
+  xsrf_token <- shiny:::createUniqueId(16)
+  clear_cookie_xsrf$set(xsrf_token, TRUE)
+
+  session$sendCustomMessage("oauth-clear-cookie-handler", list(
+    xsrf_token = xsrf_token
+  ))
+  rv(NULL)
+}
+
+oauth_config <- function(oauth_endpoint_uri, token_endpoint_uri, app_uri,
+  client_id, client_secret, scope, login_ui = oauth_login_button,
+  logout_ui = oauth_logout_button) {
+
+  list(
+    oauth_endpoint_uri = oauth_endpoint_uri,
+    token_endpoint_uri = token_endpoint_uri,
+    app_uri = app_uri,
+    client_id = client_id,
+    client_secret = client_secret,
+    scope = scope,
+    login_ui = login_ui,
+    logout_ui = logout_ui
+  )
+}
+
+# Server module for initializing oauth
+oauth_login <- function(input, output, session, oauth_config) {
+
+  force(oauth_config)
+
+  token <- reactiveVal(NULL)
+
+  # TODO: make parsing robust (escaping)
+  cookie <- session$request$HTTP_COOKIE
+  if (!is.null(cookie)) {
+    m <- regmatches(cookie, regexec("shinyoauthaccesstoken=([^;]+)", cookie, perl = TRUE))[[1]]
+    if (length(m) > 0) {
+      token(m[[2]])
+    }
+  }
+
+  redirect_uri <- sub("/?$", "/oauth_callback", oauth_config$app_uri)
+
+  state <- store_oauth_request_state(token,
+    redirect_uri,
+    oauth_config$token_endpoint_uri,
+    oauth_config$client_id,
+    oauth_config$client_secret,
+    session)
+
+  # Prepend the worker ID onto the state parameter. Servers like
+  # Connect and SSP use the `w` query string parameter to determine
+  # what R process needs to handle a request. But we can't add a
+  # `w` parameter to our callback URI; the only part of the path or
+  # query string we can safely influence is `state`.
+  #
+  # When this state parameter is read by our callback handler, then
+  # this worker id information will be unpacked, and the browser
+  # will redirect back to the same page but with `w` extracted from
+  # state and added as its own standalone query string param.
+  state <- paste0(
+    "_w_", shiny:::workerId(), "_",
+    state
+  )
+
+  output$container <- renderUI({
+    if (is.null(token())) {
+      # login button
+      url <- make_authorization_url(oauth_config, redirect_uri, state, session)
+
+      oauth_config$login_ui(url)
+    } else {
+      oauth_config$logout_ui(session$ns("btn_logout"))
+    }
+  })
+
+  observeEvent(input$btn_logout, {
+    oauth_do_logout(token)
+  })
+
+  return(token)
+}
+
+oauth_request_state <- fastmap::fastmap()
+
+store_oauth_request_state <- function(rv, redirect_uri, token_endpoint_uri, client_id, client_secret, session = getDefaultReactiveDomain()) {
+  state <- shiny:::createUniqueId(16)
+  oauth_request_state$set(state, list(
+    rv = rv,
+    redirect_uri = redirect_uri,
+    token_endpoint_uri = token_endpoint_uri,
+    client_id = client_id,
+    client_secret = client_secret
+  ))
+
+  # In case the session ends, clean out the state so we don't leak memory
+  shiny::onSessionEnded(function() {
+    oauth_request_state$remove(state)
+  })
+
+  state
+}
+
+
+make_authorization_url <- function(oauth_config, redirect_uri, state, session = getDefaultReactiveDomain()) {
+  # TODO: Implement for real
+  #
+  # The req object is a Rook request. This is just an environment object that
+  # gives you access to the request URL, HTTP headers, etc. The documentation
+  # for this object is here:
+  # https://github.com/jeffreyhorner/Rook#the-environment
+  url_template <- "%s?client_id=%s&redirect_uri=%s&response_type=code&state=%s&access_type=offline&include_granted_scopes=true&scope=%s"
+  auth_url <- sprintf(url_template,
+    oauth_config$oauth_endpoint_uri,
+    utils::URLencode(oauth_config$client_id, reserved = TRUE, repeated = TRUE),
+    utils::URLencode(redirect_uri, reserved = TRUE, repeated = TRUE),
+    utils::URLencode(state, reserved = TRUE, repeated = TRUE),
+    utils::URLencode(oauth_config$scope, reserved = TRUE, repeated = TRUE)
+  )
+
+  auth_url
+}
+
+# This is the Rook handler that is invoked when the browser returns
+# from authenticating with the OAuth provider. Based on the `code`
+# and `state` in the query string, we'll look up oauth_request_state
+# and retrieve the oauth token.
+oauth_callback_handler <- function(req) {
+  if (!identical(req$REQUEST_METHOD, 'GET'))
+    return(NULL)
+
+  qs_info <- parseQueryString(req$QUERY_STRING)
+  err <- qs_info$error
+  code <- qs_info$code
+
+  # TODO: state should be signed/verified
+  state <- qs_info$state
+  if (!is.null(err)) {
+    # TODO: Report error to user
+    message(jsonlite::toJSON(qs_info, pretty = TRUE, auto_unbox = TRUE))
+    return(list(
+      status = 500L,
+      headers = list("Content-Type" = "text/plain"),
+      body = "Authorization failure"
+    ))
+  } else if (!is.null(code) && !is.null(state)) {
+
+    # See if state has worker information in it that we need to extract.
+    # If so, we need to redirect the browser with a `w=` parameter, so
+    # that server environments can ensure we end up at the right R
+    # process
+
+    if (is.null(qs_info$w)) {
+      m <- regexec("^_w_([a-fA-F0-9]*)_([a-fA-f0-9]+)$", state)
+      m <- regmatches(qs_info$state, m)[[1]]
+      if (length(m) > 0) {
+        worker_id <- m[[2]]
+        new_state <- m[[3]]
+        new_qs <- sub(
+          "([&?])state=.*?(&|$)",
+          sprintf("\\1state=%s&w=%s\\2",
+            utils::URLencode(new_state, reserved = TRUE, repeated = TRUE),
+            utils::URLencode(worker_id, reserved = TRUE, repeated = TRUE)
+          ),
+          req$QUERY_STRING
+        )
+        return(list(
+          status = 307L,
+          headers = list(
+            "Content-Type" = "text/plain",
+            "Location" = new_qs
+          ),
+          body = ""
+        ))
+      }
+    }
+
+    req_info <- oauth_request_state$get(state)
+    if (is.null(req_info)) {
+      # TODO: Report error to user
+      stop("OAuth authentication request not recognized")
+    }
+
+    redirect_uri <- req_info$redirect_uri
+    token_endpoint_uri <- req_info$token_endpoint_uri
+    client_id <- req_info$client_id
+    client_secret <- req_info$client_secret
+    rv <- req_info$rv
+
+    resp <- httr::POST(token_endpoint_uri,
+      body = list(
+        client_id = client_id,
+        code = code,
+        redirect_uri = redirect_uri,
+        grant_type = "authorization_code",
+        client_secret = client_secret
+      )
+    )
+    respObj <- httr::content(resp, as = "parsed")
+
+    rv(respObj$access_token)
+
+    return(list(
+      status = 200L,
+      headers = list(
+        "Content-Type" = "text/html",
+        # TODO: encrypt
+        # TODO: expiration
+        # TODO: secure (optionally)
+        # TODO: escaping
+        # TODO: path/samesite
+        "Set-Cookie" = sprintf("shinyoauthaccesstoken=%s; HttpOnly; Path=/", respObj$access_token)
+      ),
+      body = as.character(
+        tags$html(
+          HTML("<head><script>window.close();</script></head>"),
+          tags$body(
+            "You can close this window now"
+          )
+        )
+      )
+    ))
+  } else {
+    # TODO: Report malformed request
+  }
+}
+
+addRouteHandler("/oauth_callback", oauth_callback_handler)
+
+
+clear_cookie_xsrf <- fastmap::fastmap()
+
+oauth_clear_cookie_handler <- function(req) {
+  if (req$REQUEST_METHOD != "POST") {
+    return(NULL)
+  }
+
+  xsrf_token <- req$rook.input$read_lines(1)
+  if (is.null(clear_cookie_xsrf$get(xsrf_token))) {
+    return(list(
+      status = 403L,
+      headers = list(
+        "Content-Type" = "text/plain"
+      ),
+      body = "Unrecognized XSRF token"
+    ))
+  }
+  clear_cookie_xsrf$remove(xsrf_token)
+
+  return(list(
+    status = 200L,
+    headers = list(
+      "Content-Type" = "text/plain",
+      "Set-Cookie" = "shinyoauthaccesstoken=; HttpOnly; Path=/; expires=Thu, 01 Jan 1970 00:00:00 GMT"
+    ),
+    body = ""
+  ))
+}
+
+addRouteHandler("/oauth_clear_cookie", oauth_clear_cookie_handler)
+
+clear_cookie_custom_handler <- tags$script(
+  "
+    Shiny.addCustomMessageHandler('oauth-clear-cookie-handler', function(msg) {
+      var req = new XMLHttpRequest();
+      req.open('POST', 'oauth_clear_cookie');
+      req.setRequestHeader('Content-Type', 'text/plain');
+      req.send(msg.xsrf_token);
+    });
+  "
+)

inst/www/shared/shiny.css

@@ -12,6 +12,13 @@ pre.shiny-text-output.noplaceholder:empty {
   height: 0;
 }
 
+/* Some browsers (like Safari) will wrap text in <pre> tags with Bootstrap's
+   CSS. This changes the behavior to not wrap.
+*/
+pre.shiny-text-output {
+  word-wrap: normal;
+}
+
 .shiny-image-output img.shiny-scalable, .shiny-plot-output img.shiny-scalable {
   max-width: 100%;
   max-height: 100%;
@@ -209,6 +216,10 @@ pre.shiny-text-output.noplaceholder:empty {
   font-size: 80%;
 }
 
+.shiny-label-null {
+  display: none;
+}
+
 .crosshair {
   cursor: crosshair;
 }

inst/www/shared/shiny.js

@@ -12,7 +12,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
 
   var exports = window.Shiny = window.Shiny || {};
 
-  exports.version = "1.3.2"; // Version number inserted by Grunt
+  exports.version = "1.3.2.9000"; // Version number inserted by Grunt
 
   var origPushState = window.history.pushState;
   window.history.pushState = function () {
@@ -321,6 +321,24 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     if (op === "==") return diff === 0;else if (op === ">=") return diff >= 0;else if (op === ">") return diff > 0;else if (op === "<=") return diff <= 0;else if (op === "<") return diff < 0;else throw "Unknown operator: " + op;
   };
 
+  function updateLabel(labelTxt, labelNode) {
+    // Only update if label was specified in the update method
+    if (typeof labelTxt === "undefined") return;
+    if (labelNode.length !== 1) {
+      throw new Error("labelNode must be of length 1");
+    }
+
+    // Should the label be empty?
+    var emptyLabel = $.isArray(labelTxt) && labelTxt.length === 0;
+
+    if (emptyLabel) {
+      labelNode.addClass("shiny-label-null");
+    } else {
+      labelNode.text(labelTxt);
+      labelNode.removeClass("shiny-label-null");
+    }
+  }
+
   //---------------------------------------------------------------------
   // Source file: ../srcjs/browser.js
 
@@ -545,8 +563,8 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     this.lastChanceCallback = [];
   };
   (function () {
-    this.setInput = function (name, value, opts) {
-      this.pendingData[name] = value;
+    this.setInput = function (nameType, value, opts) {
+      this.pendingData[nameType] = value;
 
       if (!this.reentrant) {
         if (opts.priority === "event") {
@@ -582,8 +600,8 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     this.lastSentValues = this.reset(initialValues);
   };
   (function () {
-    this.setInput = function (name, value, opts) {
-      var _splitInputNameType = splitInputNameType(name);
+    this.setInput = function (nameType, value, opts) {
+      var _splitInputNameType = splitInputNameType(nameType);
 
       var inputName = _splitInputNameType.name;
       var inputType = _splitInputNameType.inputType;
@@ -610,10 +628,10 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
         if (values.hasOwnProperty(inputName)) {
           var _splitInputNameType2 = splitInputNameType(inputName);
 
-          var name = _splitInputNameType2.name;
+          var _name = _splitInputNameType2.name;
           var inputType = _splitInputNameType2.inputType;
 
-          cacheValues[name] = {
+          cacheValues[_name] = {
             jsonValue: JSON.stringify(values[inputName]),
             inputType: inputType
           };
@@ -628,10 +646,10 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     this.target = target;
   };
   (function () {
-    this.setInput = function (name, value, opts) {
+    this.setInput = function (nameType, value, opts) {
       var evt = jQuery.Event("shiny:inputchanged");
 
-      var input = splitInputNameType(name);
+      var input = splitInputNameType(nameType);
       evt.name = input.name;
       evt.inputType = input.inputType;
       evt.value = value;
@@ -657,25 +675,41 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     this.inputRatePolicies = {};
   };
   (function () {
-    this.setInput = function (name, value, opts) {
-      this.$ensureInit(name);
+    // Note that the first argument of setInput() and setRatePolicy()
+    // are passed both the input name (i.e., inputId) and type.
+    // https://github.com/rstudio/shiny/blob/67d3a/srcjs/init_shiny.js#L111-L126
+    // However, $ensureInit() and $doSetInput() are meant to be passed just
+    // the input name (i.e., inputId), which is why we distinguish between
+    // nameType and name.
+    this.setInput = function (nameType, value, opts) {
+      var _splitInputNameType3 = splitInputNameType(nameType);
 
-      if (opts.priority !== "deferred") this.inputRatePolicies[name].immediateCall(name, value, opts);else this.inputRatePolicies[name].normalCall(name, value, opts);
+      var inputName = _splitInputNameType3.name;
+
+
+      this.$ensureInit(inputName);
+
+      if (opts.priority !== "deferred") this.inputRatePolicies[inputName].immediateCall(nameType, value, opts);else this.inputRatePolicies[inputName].normalCall(nameType, value, opts);
     };
-    this.setRatePolicy = function (name, mode, millis) {
+    this.setRatePolicy = function (nameType, mode, millis) {
+      var _splitInputNameType4 = splitInputNameType(nameType);
+
+      var inputName = _splitInputNameType4.name;
+
+
       if (mode === 'direct') {
-        this.inputRatePolicies[name] = new Invoker(this, this.$doSetInput);
+        this.inputRatePolicies[inputName] = new Invoker(this, this.$doSetInput);
       } else if (mode === 'debounce') {
-        this.inputRatePolicies[name] = new Debouncer(this, this.$doSetInput, millis);
+        this.inputRatePolicies[inputName] = new Debouncer(this, this.$doSetInput, millis);
       } else if (mode === 'throttle') {
-        this.inputRatePolicies[name] = new Throttler(this, this.$doSetInput, millis);
+        this.inputRatePolicies[inputName] = new Throttler(this, this.$doSetInput, millis);
       }
     };
     this.$ensureInit = function (name) {
       if (!(name in this.inputRatePolicies)) this.setRatePolicy(name, 'direct');
     };
-    this.$doSetInput = function (name, value, opts) {
-      this.target.setInput(name, value, opts);
+    this.$doSetInput = function (nameType, value, opts) {
+      this.target.setInput(nameType, value, opts);
     };
   }).call(InputRateDecorator.prototype);
 
@@ -684,8 +718,8 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     this.pendingInput = {};
   };
   (function () {
-    this.setInput = function (name, value, opts) {
-      if (/^\./.test(name)) this.target.setInput(name, value, opts);else this.pendingInput[name] = { value: value, opts: opts };
+    this.setInput = function (nameType, value, opts) {
+      if (/^\./.test(nameType)) this.target.setInput(nameType, value, opts);else this.pendingInput[name] = { value: value, opts: opts };
     };
     this.submit = function () {
       for (var name in this.pendingInput) {
@@ -701,12 +735,12 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     this.target = target;
   };
   (function () {
-    this.setInput = function (name, value, opts) {
-      if (!name) throw "Can't set input with empty name.";
+    this.setInput = function (nameType, value, opts) {
+      if (!nameType) throw "Can't set input with empty name.";
 
       opts = addDefaultInputOpts(opts);
 
-      this.target.setInput(name, value, opts);
+      this.target.setInput(nameType, value, opts);
     };
   }).call(InputValidateDecorator.prototype);
 
@@ -733,8 +767,8 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     return opts;
   }
 
-  function splitInputNameType(name) {
-    var name2 = name.split(':');
+  function splitInputNameType(nameType) {
+    var name2 = nameType.split(':');
     return {
       name: name2[0],
       inputType: name2.length > 1 ? name2[1] : ''
@@ -1771,7 +1805,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
           var $container = $('.shiny-progress-container');
           if ($container.length === 0) {
             $container = $('<div class="shiny-progress-container"></div>');
-            $('body').append($container);
+            $(document.body).append($container);
           }
 
           // Add div for just this progress ID
@@ -2025,7 +2059,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
 
       if ($panel.length > 0) return $panel;
 
-      $('body').append('<div id="shiny-notification-panel">');
+      $(document.body).append('<div id="shiny-notification-panel">');
 
       return $panel;
     }
@@ -2105,7 +2139,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
       var $modal = $('#shiny-modal-wrapper');
       if ($modal.length === 0) {
         $modal = $('<div id="shiny-modal-wrapper"></div>');
-        $('body').append($modal);
+        $(document.body).append($modal);
 
         // If the wrapper's content is a Bootstrap modal, then when the inner
         // modal is hidden, remove the entire thing, including wrapper.
@@ -4301,7 +4335,12 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
   var textInputBinding = new InputBinding();
   $.extend(textInputBinding, {
     find: function find(scope) {
-      return $(scope).find('input[type="text"], input[type="search"], input[type="url"], input[type="email"]');
+      var $inputs = $(scope).find('input[type="text"], input[type="search"], input[type="url"], input[type="email"]');
+      // selectize.js 0.12.4 inserts a hidden text input with an
+      // id that ends in '-selectized'. The .not() selector below
+      // is to prevent textInputBinding from accidentally picking up
+      // this hidden element as a shiny input (#2396)
+      return $inputs.not('input[type="text"][id$="-selectized"]');
     },
     getId: function getId(el) {
       return InputBinding.prototype.getId.call(this, el) || el.name;
@@ -4326,7 +4365,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     receiveMessage: function receiveMessage(el, data) {
       if (data.hasOwnProperty('value')) this.setValue(el, data.value);
 
-      if (data.hasOwnProperty('label')) $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
+      updateLabel(data.label, this._getLabelNode(el));
 
       if (data.hasOwnProperty('placeholder')) el.placeholder = data.placeholder;
 
@@ -4334,7 +4373,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     },
     getState: function getState(el) {
       return {
-        label: $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(),
+        label: this._getLabelNode(el).text(),
         value: el.value,
         placeholder: el.placeholder
       };
@@ -4344,6 +4383,9 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
         policy: 'debounce',
         delay: 250
       };
+    },
+    _getLabelNode: function _getLabelNode(el) {
+      return $(el).parent().find('label[for="' + $escape(el.id) + '"]');
     }
   });
   inputBindings.register(textInputBinding, 'shiny.textInput');
@@ -4399,16 +4441,19 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
       if (data.hasOwnProperty('max')) el.max = data.max;
       if (data.hasOwnProperty('step')) el.step = data.step;
 
-      if (data.hasOwnProperty('label')) $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
+      updateLabel(data.label, this._getLabelNode(el));
 
       $(el).trigger('change');
     },
     getState: function getState(el) {
-      return { label: $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(),
+      return { label: this._getLabelNode(el).text(),
         value: this.getValue(el),
         min: Number(el.min),
         max: Number(el.max),
         step: Number(el.step) };
+    },
+    _getLabelNode: function _getLabelNode(el) {
+      return $(el).parent().find('label[for="' + $escape(el.id) + '"]');
     }
   });
   inputBindings.register(numberInputBinding, 'shiny.numberInput');
@@ -4444,6 +4489,8 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     receiveMessage: function receiveMessage(el, data) {
       if (data.hasOwnProperty('value')) el.checked = data.value;
 
+      // checkboxInput()'s label works different from other
+      // input labels...the label container should always exist
       if (data.hasOwnProperty('label')) $(el).parent().find('span').text(data.label);
 
       $(el).trigger('change');
@@ -4572,7 +4619,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
         }
       }
 
-      if (data.hasOwnProperty('label')) $el.parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
+      updateLabel(data.label, this._getLabelNode(el));
 
       var domElements = ['data-type', 'time-format', 'timezone'];
       for (var i = 0; i < domElements.length; i++) {
@@ -4614,7 +4661,9 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
 
       $el.ionRangeSlider(opts);
     },
-
+    _getLabelNode: function _getLabelNode(el) {
+      return $(el).parent().find('label[for="' + $escape(el.id) + '"]');
+    },
     // Number of values; 1 for single slider, 2 for range slider
     _numValues: function _numValues(el) {
       if ($(el).data('ionRangeSlider').options.type === 'double') return 2;else return 1;
@@ -4776,7 +4825,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
       if (startview === 2) startview = 'decade';else if (startview === 1) startview = 'year';else if (startview === 0) startview = 'month';
 
       return {
-        label: $el.find('label[for="' + $escape(el.id) + '"]').text(),
+        label: this._getLabelNode(el).text(),
         value: this.getValue(el),
         valueString: $input.val(),
         min: min,
@@ -4790,7 +4839,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     receiveMessage: function receiveMessage(el, data) {
       var $input = $(el).find('input');
 
-      if (data.hasOwnProperty('label')) $(el).find('label[for="' + $escape(el.id) + '"]').text(data.label);
+      updateLabel(data.label, this._getLabelNode(el));
 
       if (data.hasOwnProperty('min')) this._setMin($input[0], data.min);
 
@@ -4845,6 +4894,9 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
         this._setMax($input[0], $input.data('max-date'));
       }
     },
+    _getLabelNode: function _getLabelNode(el) {
+      return $(el).find('label[for="' + $escape(el.id) + '"]');
+    },
     // Given a format object from a date picker, return a string
     _formatToString: function _formatToString(format) {
       // Format object has structure like:
@@ -4991,7 +5043,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
       if (startview === 2) startview = 'decade';else if (startview === 1) startview = 'year';else if (startview === 0) startview = 'month';
 
       return {
-        label: $el.find('label[for="' + $escape(el.id) + '"]').text(),
+        label: this._getLabelNode(el).text(),
         value: this.getValue(el),
         valueString: [$startinput.val(), $endinput.val()],
         min: min,
@@ -5008,7 +5060,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
       var $startinput = $inputs.eq(0);
       var $endinput = $inputs.eq(1);
 
-      if (data.hasOwnProperty('label')) $el.find('label[for="' + $escape(el.id) + '"]').text(data.label);
+      updateLabel(data.label, this._getLabelNode(el));
 
       if (data.hasOwnProperty('min')) {
         this._setMin($startinput[0], data.min);
@@ -5064,6 +5116,9 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     },
     unsubscribe: function unsubscribe(el) {
       $(el).off('.dateRangeInputBinding');
+    },
+    _getLabelNode: function _getLabelNode(el) {
+      return $(el).find('label[for="' + $escape(el.id) + '"]');
     }
   });
   inputBindings.register(dateRangeInputBinding, 'shiny.dateRangeInput');
@@ -5113,7 +5168,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
       }
 
       return {
-        label: $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(),
+        label: this._getLabelNode(el),
         value: this.getValue(el),
         options: options
       };
@@ -5195,13 +5250,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
         this.setValue(el, data.value);
       }
 
-      if (data.hasOwnProperty('label')) {
-        var escaped_id = $escape(el.id);
-        if (this._is_selectize(el)) {
-          escaped_id += "-selectized";
-        }
-        $(el).parent().parent().find('label[for="' + escaped_id + '"]').text(data.label);
-      }
+      updateLabel(data.label, this._getLabelNode(el));
 
       $(el).trigger('change');
     },
@@ -5224,6 +5273,13 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     initialize: function initialize(el) {
       this._selectize(el);
     },
+    _getLabelNode: function _getLabelNode(el) {
+      var escaped_id = $escape(el.id);
+      if (this._is_selectize(el)) {
+        escaped_id += "-selectized";
+      }
+      return $(el).parent().parent().find('label[for="' + escaped_id + '"]');
+    },
     // Return true if it's a selectize input, false if it's a regular select input.
     _is_selectize: function _is_selectize(el) {
       var config = $(el).parent().find('script[data-for="' + $escape(el.id) + '"]');
@@ -5301,7 +5357,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
       }
 
       return {
-        label: $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(),
+        label: this._getLabelNode(el).text(),
         value: this.getValue(el),
         options: options
       };
@@ -5320,7 +5376,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
 
       if (data.hasOwnProperty('value')) this.setValue(el, data.value);
 
-      if (data.hasOwnProperty('label')) $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
+      updateLabel(data.label, this._getLabelNode(el));
 
       $(el).trigger('change');
     },
@@ -5332,6 +5388,10 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     unsubscribe: function unsubscribe(el) {
       $(el).off('.radioInputBinding');
     },
+    // Get the DOM element that contains the top-level label
+    _getLabelNode: function _getLabelNode(el) {
+      return $(el).parent().find('label[for="' + $escape(el.id) + '"]');
+    },
     // Given an input DOM object, get the associated label. Handles labels
     // that wrap the input as well as labels associated with 'for' attribute.
     _getLabel: function _getLabel(obj) {
@@ -5397,7 +5457,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
           label: this._getLabel($objs[i]) };
       }
 
-      return { label: $(el).find('label[for="' + $escape(el.id) + '"]').text(),
+      return { label: this._getLabelNode(el).text(),
         value: this.getValue(el),
         options: options
       };
@@ -5416,7 +5476,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
 
       if (data.hasOwnProperty('value')) this.setValue(el, data.value);
 
-      if (data.hasOwnProperty('label')) $el.find('label[for="' + $escape(el.id) + '"]').text(data.label);
+      updateLabel(data.label, this._getLabelNode(el));
 
       $(el).trigger('change');
     },
@@ -5428,6 +5488,10 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     unsubscribe: function unsubscribe(el) {
       $(el).off('.checkboxGroupInputBinding');
     },
+    // Get the DOM element that contains the top-level label
+    _getLabelNode: function _getLabelNode(el) {
+      return $(el).find('label[for="' + $escape(el.id) + '"]');
+    },
     // Given an input DOM object, get the associated label. Handles labels
     // that wrap the input as well as labels associated with 'for' attribute.
     _getLabel: function _getLabel(obj) {
@@ -5593,7 +5657,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
       this.iframe.id = iframeId;
       this.iframe.name = iframeId;
       this.iframe.setAttribute('style', 'position: fixed; top: 0; left: 0; width: 0; height: 0; border: none');
-      $('body').append(this.iframe);
+      $(document.body).append(this.iframe);
       var iframeDestroy = function iframeDestroy() {
         // Forces Shiny to flushReact, flush outputs, etc. Without this we get
         // invalidated reactives, but observers don't actually execute.
@@ -6457,14 +6521,14 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     // Need to register callbacks for each Bootstrap 3 class.
     var bs3classes = ['modal', 'dropdown', 'tab', 'tooltip', 'popover', 'collapse'];
     $.each(bs3classes, function (idx, classname) {
-      $('body').on('shown.bs.' + classname + '.sendImageSize', '*', filterEventsByNamespace('bs', sendImageSize));
-      $('body').on('shown.bs.' + classname + '.sendOutputHiddenState ' + 'hidden.bs.' + classname + '.sendOutputHiddenState', '*', filterEventsByNamespace('bs', sendOutputHiddenState));
+      $(document.body).on('shown.bs.' + classname + '.sendImageSize', '*', filterEventsByNamespace('bs', sendImageSize));
+      $(document.body).on('shown.bs.' + classname + '.sendOutputHiddenState ' + 'hidden.bs.' + classname + '.sendOutputHiddenState', '*', filterEventsByNamespace('bs', sendOutputHiddenState));
     });
 
     // This is needed for Bootstrap 2 compatibility and for non-Bootstrap
     // related shown/hidden events (like conditionalPanel)
-    $('body').on('shown.sendImageSize', '*', sendImageSize);
-    $('body').on('shown.sendOutputHiddenState hidden.sendOutputHiddenState', '*', sendOutputHiddenState);
+    $(document.body).on('shown.sendImageSize', '*', sendImageSize);
+    $(document.body).on('shown.sendOutputHiddenState hidden.sendOutputHiddenState', '*', sendOutputHiddenState);
 
     // Send initial pixel ratio, and update it if it changes
     initialValues['.clientdata_pixelratio'] = pixelRatio();

srcjs/input_binding_checkbox.js

@@ -27,6 +27,8 @@ $.extend(checkboxInputBinding, {
     if (data.hasOwnProperty('value'))
       el.checked = data.value;
 
+    // checkboxInput()'s label works different from other
+    // input labels...the label container should always exist
     if (data.hasOwnProperty('label'))
       $(el).parent().find('span').text(data.label);
 

srcjs/input_binding_checkboxgroup.js

@@ -39,7 +39,7 @@ $.extend(checkboxGroupInputBinding, {
                      label:   this._getLabel($objs[i]) };
     }
 
-    return { label:    $(el).find('label[for="' + $escape(el.id) + '"]').text(),
+    return { label:    this._getLabelNode(el).text(),
              value:    this.getValue(el),
              options:  options
            };
@@ -59,8 +59,7 @@ $.extend(checkboxGroupInputBinding, {
     if (data.hasOwnProperty('value'))
       this.setValue(el, data.value);
 
-    if (data.hasOwnProperty('label'))
-      $el.find('label[for="' + $escape(el.id) + '"]').text(data.label);
+    updateLabel(data.label, this._getLabelNode(el));
 
     $(el).trigger('change');
   },
@@ -72,6 +71,10 @@ $.extend(checkboxGroupInputBinding, {
   unsubscribe: function(el) {
     $(el).off('.checkboxGroupInputBinding');
   },
+  // Get the DOM element that contains the top-level label
+  _getLabelNode: function(el) {
+      return $(el).find('label[for="' + $escape(el.id) + '"]');
+  },
   // Given an input DOM object, get the associated label. Handles labels
   // that wrap the input as well as labels associated with 'for' attribute.
   _getLabel: function(obj) {

srcjs/input_binding_date.js

@@ -46,7 +46,7 @@ $.extend(dateInputBinding, {
     else if (startview === 0)  startview = 'month';
 
     return {
-      label:       $el.find('label[for="' + $escape(el.id) + '"]').text(),
+      label:       this._getLabelNode(el).text(),
       value:       this.getValue(el),
       valueString: $input.val(),
       min:         min,
@@ -60,8 +60,7 @@ $.extend(dateInputBinding, {
   receiveMessage: function(el, data) {
     var $input = $(el).find('input');
 
-    if (data.hasOwnProperty('label'))
-      $(el).find('label[for="' + $escape(el.id) + '"]').text(data.label);
+    updateLabel(data.label, this._getLabelNode(el));
 
     if (data.hasOwnProperty('min'))
       this._setMin($input[0], data.min);
@@ -119,6 +118,9 @@ $.extend(dateInputBinding, {
       this._setMax($input[0], $input.data('max-date'));
     }
   },
+  _getLabelNode: function(el) {
+    return $(el).find('label[for="' + $escape(el.id) + '"]');
+  },
   // Given a format object from a date picker, return a string
   _formatToString: function(format) {
     // Format object has structure like:

srcjs/input_binding_daterange.js

@@ -63,7 +63,7 @@ $.extend(dateRangeInputBinding, dateInputBinding, {
     else if (startview === 0)  startview = 'month';
 
     return {
-      label:       $el.find('label[for="' + $escape(el.id) + '"]').text(),
+      label:       this._getLabelNode(el).text(),
       value:       this.getValue(el),
       valueString: [ $startinput.val(), $endinput.val() ],
       min:         min,
@@ -80,8 +80,7 @@ $.extend(dateRangeInputBinding, dateInputBinding, {
     var $startinput = $inputs.eq(0);
     var $endinput   = $inputs.eq(1);
 
-    if (data.hasOwnProperty('label'))
-      $el.find('label[for="' + $escape(el.id) + '"]').text(data.label);
+    updateLabel(data.label, this._getLabelNode(el));
 
     if (data.hasOwnProperty('min')) {
       this._setMin($startinput[0], data.min);
@@ -140,6 +139,9 @@ $.extend(dateRangeInputBinding, dateInputBinding, {
   },
   unsubscribe: function(el) {
     $(el).off('.dateRangeInputBinding');
-  }
+  },
+  _getLabelNode: function(el) {
+    return $(el).find('label[for="' + $escape(el.id) + '"]');
+  },
 });
 inputBindings.register(dateRangeInputBinding, 'shiny.dateRangeInput');

srcjs/input_binding_number.js

@@ -24,17 +24,19 @@ $.extend(numberInputBinding, textInputBinding, {
     if (data.hasOwnProperty('max'))    el.max   = data.max;
     if (data.hasOwnProperty('step'))   el.step  = data.step;
 
-    if (data.hasOwnProperty('label'))
-      $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
+    updateLabel(data.label, this._getLabelNode(el));
 
     $(el).trigger('change');
   },
   getState: function(el) {
-    return { label: $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(),
+    return { label: this._getLabelNode(el).text(),
              value: this.getValue(el),
              min:   Number(el.min),
              max:   Number(el.max),
              step:  Number(el.step) };
+  },
+  _getLabelNode: function(el) {
+    return $(el).parent().find('label[for="' + $escape(el.id) + '"]');
   }
 });
 inputBindings.register(numberInputBinding, 'shiny.numberInput');

srcjs/input_binding_radio.js

@@ -21,7 +21,7 @@ $.extend(radioInputBinding, {
     }
 
     return {
-      label:    $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(),
+      label:    this._getLabelNode(el).text(),
       value:    this.getValue(el),
       options:  options
     };
@@ -41,8 +41,7 @@ $.extend(radioInputBinding, {
     if (data.hasOwnProperty('value'))
       this.setValue(el, data.value);
 
-    if (data.hasOwnProperty('label'))
-      $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
+    updateLabel(data.label, this._getLabelNode(el));
 
     $(el).trigger('change');
   },
@@ -54,6 +53,10 @@ $.extend(radioInputBinding, {
   unsubscribe: function(el) {
     $(el).off('.radioInputBinding');
   },
+  // Get the DOM element that contains the top-level label
+  _getLabelNode: function(el) {
+      return $(el).parent().find('label[for="' + $escape(el.id) + '"]');
+  },
   // Given an input DOM object, get the associated label. Handles labels
   // that wrap the input as well as labels associated with 'for' attribute.
   _getLabel: function(obj) {

srcjs/input_binding_select.js

@@ -40,7 +40,7 @@ $.extend(selectInputBinding, {
     }
 
     return {
-      label: $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(),
+      label:    this._getLabelNode(el),
       value:    this.getValue(el),
       options:  options
     };
@@ -123,15 +123,7 @@ $.extend(selectInputBinding, {
       this.setValue(el, data.value);
     }
 
-    if (data.hasOwnProperty('label')) {
-      let escaped_id = $escape(el.id);
-      if (this._is_selectize(el)) {
-        escaped_id += "-selectized";
-      }
-      $(el).parent().parent()
-        .find('label[for="' + escaped_id + '"]')
-        .text(data.label);
-    }
+    updateLabel(data.label, this._getLabelNode(el));
 
     $(el).trigger('change');
   },
@@ -152,6 +144,13 @@ $.extend(selectInputBinding, {
   initialize: function(el) {
     this._selectize(el);
   },
+  _getLabelNode: function(el) {
+    let escaped_id = $escape(el.id);
+    if (this._is_selectize(el)) {
+      escaped_id += "-selectized";
+    }
+    return $(el).parent().parent().find('label[for="' + escaped_id + '"]');
+  },
   // Return true if it's a selectize input, false if it's a regular select input.
   _is_selectize: function(el) {
     var config = $(el).parent().find('script[data-for="' + $escape(el.id) + '"]');

srcjs/input_binding_slider.js

@@ -130,8 +130,7 @@ $.extend(sliderInputBinding, textInputBinding, {
       }
     }
 
-    if (data.hasOwnProperty('label'))
-      $el.parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
+    updateLabel(data.label, this._getLabelNode(el));
 
     var domElements = ['data-type', 'time-format', 'timezone'];
     for (var i = 0; i < domElements.length; i++) {
@@ -174,7 +173,9 @@ $.extend(sliderInputBinding, textInputBinding, {
 
     $el.ionRangeSlider(opts);
   },
-
+  _getLabelNode: function(el) {
+    return $(el).parent().find('label[for="' + $escape(el.id) + '"]');
+  },
   // Number of values; 1 for single slider, 2 for range slider
   _numValues: function(el) {
     if ($(el).data('ionRangeSlider').options.type === 'double')

srcjs/input_binding_text.js

@@ -1,7 +1,12 @@
 var textInputBinding = new InputBinding();
 $.extend(textInputBinding, {
   find: function(scope) {
-    return $(scope).find('input[type="text"], input[type="search"], input[type="url"], input[type="email"]');
+    var $inputs = $(scope).find('input[type="text"], input[type="search"], input[type="url"], input[type="email"]');
+    // selectize.js 0.12.4 inserts a hidden text input with an
+    // id that ends in '-selectized'. The .not() selector below
+    // is to prevent textInputBinding from accidentally picking up
+    // this hidden element as a shiny input (#2396)
+    return $inputs.not('input[type="text"][id$="-selectized"]');
   },
   getId: function(el) {
     return InputBinding.prototype.getId.call(this, el) || el.name;
@@ -27,8 +32,7 @@ $.extend(textInputBinding, {
     if (data.hasOwnProperty('value'))
       this.setValue(el, data.value);
 
-    if (data.hasOwnProperty('label'))
-      $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(data.label);
+    updateLabel(data.label, this._getLabelNode(el));
 
     if (data.hasOwnProperty('placeholder'))
       el.placeholder = data.placeholder;
@@ -37,7 +41,7 @@ $.extend(textInputBinding, {
   },
   getState: function(el) {
     return {
-      label: $(el).parent().find('label[for="' + $escape(el.id) + '"]').text(),
+      label: this._getLabelNode(el).text(),
       value: el.value,
       placeholder: el.placeholder
     };
@@ -47,6 +51,9 @@ $.extend(textInputBinding, {
       policy: 'debounce',
       delay: 250
     };
+  },
+  _getLabelNode: function(el) {
+    return $(el).parent().find('label[for="' + $escape(el.id) + '"]');
   }
 });
 inputBindings.register(textInputBinding, 'shiny.textInput');

srcjs/input_rate.js

@@ -189,8 +189,8 @@ var InputBatchSender = function(shinyapp) {
   this.lastChanceCallback = [];
 };
 (function() {
-  this.setInput = function(name, value, opts) {
-    this.pendingData[name] = value;
+  this.setInput = function(nameType, value, opts) {
+    this.pendingData[nameType] = value;
 
     if (!this.reentrant) {
       if (opts.priority === "event") {
@@ -227,8 +227,8 @@ var InputNoResendDecorator = function(target, initialValues) {
   this.lastSentValues = this.reset(initialValues);
 };
 (function() {
-  this.setInput = function(name, value, opts) {
-    const { name: inputName, inputType: inputType } = splitInputNameType(name);
+  this.setInput = function(nameType, value, opts) {
+    const { name: inputName, inputType: inputType } = splitInputNameType(nameType);
     const jsonValue = JSON.stringify(value);
 
     if (opts.priority !== "event" &&
@@ -267,10 +267,10 @@ var InputEventDecorator = function(target) {
   this.target = target;
 };
 (function() {
-  this.setInput = function(name, value, opts) {
+  this.setInput = function(nameType, value, opts) {
     var evt = jQuery.Event("shiny:inputchanged");
 
-    const input = splitInputNameType(name);
+    const input = splitInputNameType(nameType);
     evt.name      = input.name;
     evt.inputType = input.inputType;
     evt.value     = value;
@@ -297,31 +297,41 @@ var InputRateDecorator = function(target) {
   this.inputRatePolicies = {};
 };
 (function() {
-  this.setInput = function(name, value, opts) {
-    this.$ensureInit(name);
+  // Note that the first argument of setInput() and setRatePolicy()
+  // are passed both the input name (i.e., inputId) and type.
+  // https://github.com/rstudio/shiny/blob/67d3a/srcjs/init_shiny.js#L111-L126
+  // However, $ensureInit() and $doSetInput() are meant to be passed just
+  // the input name (i.e., inputId), which is why we distinguish between
+  // nameType and name.
+  this.setInput = function(nameType, value, opts) {
+    const {name: inputName} = splitInputNameType(nameType);
+
+    this.$ensureInit(inputName);
 
     if (opts.priority !== "deferred")
-      this.inputRatePolicies[name].immediateCall(name, value, opts);
+      this.inputRatePolicies[inputName].immediateCall(nameType, value, opts);
     else
-      this.inputRatePolicies[name].normalCall(name, value, opts);
+      this.inputRatePolicies[inputName].normalCall(nameType, value, opts);
   };
-  this.setRatePolicy = function(name, mode, millis) {
+  this.setRatePolicy = function(nameType, mode, millis) {
+    const {name: inputName} = splitInputNameType(nameType);
+
     if (mode === 'direct') {
-      this.inputRatePolicies[name] = new Invoker(this, this.$doSetInput);
+      this.inputRatePolicies[inputName] = new Invoker(this, this.$doSetInput);
     }
     else if (mode === 'debounce') {
-      this.inputRatePolicies[name] = new Debouncer(this, this.$doSetInput, millis);
+      this.inputRatePolicies[inputName] = new Debouncer(this, this.$doSetInput, millis);
     }
     else if (mode === 'throttle') {
-      this.inputRatePolicies[name] = new Throttler(this, this.$doSetInput, millis);
+      this.inputRatePolicies[inputName] = new Throttler(this, this.$doSetInput, millis);
     }
   };
   this.$ensureInit = function(name) {
     if (!(name in this.inputRatePolicies))
       this.setRatePolicy(name, 'direct');
   };
-  this.$doSetInput = function(name, value, opts) {
-    this.target.setInput(name, value, opts);
+  this.$doSetInput = function(nameType, value, opts) {
+    this.target.setInput(nameType, value, opts);
   };
 }).call(InputRateDecorator.prototype);
 
@@ -331,9 +341,9 @@ var InputDeferDecorator = function(target) {
   this.pendingInput = {};
 };
 (function() {
-  this.setInput = function(name, value, opts) {
-    if (/^\./.test(name))
-      this.target.setInput(name, value, opts);
+  this.setInput = function(nameType, value, opts) {
+    if (/^\./.test(nameType))
+      this.target.setInput(nameType, value, opts);
     else
       this.pendingInput[name] = { value, opts };
   };
@@ -352,13 +362,13 @@ const InputValidateDecorator = function(target) {
   this.target = target;
 };
 (function() {
-  this.setInput = function(name, value, opts) {
-    if (!name)
+  this.setInput = function(nameType, value, opts) {
+    if (!nameType)
       throw "Can't set input with empty name.";
 
     opts = addDefaultInputOpts(opts);
 
-    this.target.setInput(name, value, opts);
+    this.target.setInput(nameType, value, opts);
   };
 }).call(InputValidateDecorator.prototype);
 
@@ -387,8 +397,8 @@ function addDefaultInputOpts(opts) {
 }
 
 
-function splitInputNameType(name) {
-  const name2 = name.split(':');
+function splitInputNameType(nameType) {
+  const name2 = nameType.split(':');
   return {
     name:      name2[0],
     inputType: name2.length > 1 ? name2[1] : ''

srcjs/utils.js

@@ -326,3 +326,23 @@ exports.compareVersion = function(a, op, b) {
   else if (op === "<")  return (diff <   0);
   else                  throw `Unknown operator: ${op}`;
 };
+
+
+function updateLabel(labelTxt, labelNode) {
+  // Only update if label was specified in the update method
+  if (typeof labelTxt === "undefined") return;
+  if (labelNode.length !== 1) {
+    throw new Error("labelNode must be of length 1");
+  }
+
+  // Should the label be empty?
+  var emptyLabel = $.isArray(labelTxt) && labelTxt.length === 0;
+
+  if (emptyLabel) {
+    labelNode.addClass("shiny-label-null");
+  } else {
+    labelNode.text(labelTxt);
+    labelNode.removeClass("shiny-label-null");
+  }
+
+}

tests/testthat/test-plot-coordmap.R

@@ -14,7 +14,7 @@ test_that("ggplot coordmap", {
   dat <- data.frame(xvar = c(0, 5), yvar = c(10, 20))
 
   tmpfile <- tempfile("test-shiny", fileext = ".png")
-  on.exit(rm(tmpfile))
+  on.exit(unlink(tmpfile))
 
   # Basic scatterplot
   p <- ggplot(dat, aes(xvar, yvar)) + geom_point() +
@@ -75,7 +75,7 @@ test_that("ggplot coordmap with facet_wrap", {
                     g = c("a", "b", "c"))
 
   tmpfile <- tempfile("test-shiny", fileext = ".png")
-  on.exit(rm(tmpfile))
+  on.exit(unlink(tmpfile))
 
   # facet_wrap
   p <- ggplot(dat, aes(xvar, yvar)) + geom_point() +
@@ -123,7 +123,7 @@ test_that("ggplot coordmap with facet_grid", {
                     g = c("a", "b", "c"))
 
   tmpfile <- tempfile("test-shiny", fileext = ".png")
-  on.exit(rm(tmpfile))
+  on.exit(unlink(tmpfile))
 
   p <- ggplot(dat, aes(xvar, yvar)) + geom_point() +
     scale_x_continuous(expand = c(0, 0)) +
@@ -209,7 +209,7 @@ test_that("ggplot coordmap with 2D facet_grid", {
                     g = c("a", "b"), h = c("i", "j"))
 
   tmpfile <- tempfile("test-shiny", fileext = ".png")
-  on.exit(rm(tmpfile))
+  on.exit(unlink(tmpfile))
 
   p <- ggplot(dat, aes(xvar, yvar)) + geom_point() +
     scale_x_continuous(expand = c(0, 0)) +
@@ -259,7 +259,7 @@ test_that("ggplot coordmap with 2D facet_grid", {
 
 test_that("ggplot coordmap with various data types", {
   tmpfile <- tempfile("test-shiny", fileext = ".png")
-  on.exit(rm(tmpfile))
+  on.exit(unlink(tmpfile))
 
   # Factors
   dat <- expand.grid(xvar = letters[1:3], yvar = LETTERS[1:4])
@@ -271,9 +271,20 @@ test_that("ggplot coordmap with various data types", {
   dev.off()
 
   # Check domain
+  expectation <- list(
+    left = 1,
+    right = 3,
+    bottom = 1,
+    top = 4,
+    discrete_limits = list(
+      x = letters[1:3],
+      y = LETTERS[1:4]
+    )
+  )
+
   expect_equal(
     sortList(m$panels[[1]]$domain),
-    sortList(list(left=1, right=3, bottom=1, top=4))
+    sortList(expectation)
   )
 
   # Dates and date-times
@@ -302,7 +313,7 @@ test_that("ggplot coordmap with various data types", {
 
 test_that("ggplot coordmap with various scales and coords", {
   tmpfile <- tempfile("test-shiny", fileext = ".png")
-  on.exit(rm(tmpfile))
+  on.exit(unlink(tmpfile))
 
   # Reversed scales
   dat <- data.frame(xvar = c(0, 5), yvar = c(10, 20))
@@ -357,3 +368,103 @@ test_that("ggplot coordmap with various scales and coords", {
     sortList(list(left=-1, right=3, bottom=-2, top=4))
   )
 })
+
+
+test_that("ggplot coordmap maintains discrete limits", {
+  tmpfile <- tempfile("test-shiny", fileext = ".png")
+  on.exit(unlink(tmpfile))
+
+  # check discrete limits are correct for free x scales
+  p <- ggplot(mpg) +
+    geom_point(aes(fl, cty), alpha = 0.2) +
+    facet_wrap(~drv, scales = "free_x")
+  png(tmpfile)
+  m <- getGgplotCoordmap(print(p), 500, 400, 72)
+  dev.off()
+
+  expect_length(m$panels, 3)
+  expect_equal(
+    m$panels[[1]]$domain$discrete_limits,
+    list(x = c("d", "e", "p", "r"))
+  )
+  expect_equal(
+    m$panels[[2]]$domain$discrete_limits,
+    list(x = c("c", "d", "e", "p", "r"))
+  )
+  expect_equal(
+    m$panels[[3]]$domain$discrete_limits,
+    list(x = c("e", "p", "r"))
+  )
+
+  # same for free y
+  p2 <- ggplot(mpg) +
+    geom_point(aes(cty, fl), alpha = 0.2) +
+    facet_wrap(~drv, scales = "free_y")
+  png(tmpfile)
+  m2 <- getGgplotCoordmap(print(p2), 500, 400, 72)
+  dev.off()
+
+  expect_length(m2$panels, 3)
+  expect_equal(
+    m2$panels[[1]]$domain$discrete_limits,
+    list(y = c("d", "e", "p", "r"))
+  )
+  expect_equal(
+    m2$panels[[2]]$domain$discrete_limits,
+    list(y = c("c", "d", "e", "p", "r"))
+  )
+  expect_equal(
+    m2$panels[[3]]$domain$discrete_limits,
+    list(y = c("e", "p", "r"))
+  )
+
+  # check that specifying x limits is captured
+  p3 <- ggplot(mpg) +
+    geom_point(aes(fl, cty), alpha = 0.2) +
+    scale_x_discrete(limits = c("c", "d", "e"))
+
+  png(tmpfile)
+  m3 <- getGgplotCoordmap(suppressWarnings(print(p3)), 500, 400, 72)
+  dev.off()
+
+  expect_length(m3$panels, 1)
+  expect_equal(
+    m3$panels[[1]]$domain$discrete_limits,
+    list(x = c("c", "d", "e"))
+  )
+
+  # same for y
+  p4 <- ggplot(mpg) +
+    geom_point(aes(cty, fl), alpha = 0.2) +
+    scale_y_discrete(limits = c("e", "f"))
+
+  png(tmpfile)
+  m4 <- getGgplotCoordmap(suppressWarnings(print(p4)), 500, 400, 72)
+  dev.off()
+
+  expect_length(m4$panels, 1)
+  expect_equal(
+    m4$panels[[1]]$domain$discrete_limits,
+    list(y = c("e", "f"))
+  )
+
+  # make sure that when labels are specified, where
+  # still relaying the input data
+  p5 <- ggplot(mpg) +
+    geom_point(aes(fl, cty), alpha = 0.2) +
+    scale_x_discrete(
+      limits = c("e", "f"),
+      labels = c("foo", "bar")
+    )
+
+  png(tmpfile)
+  m5 <- getGgplotCoordmap(suppressWarnings(print(p5)), 500, 400, 72)
+  dev.off()
+
+  expect_length(m5$panels, 1)
+  expect_equal(
+    m5$panels[[1]]$domain$discrete_limits,
+    list(x = c("e", "f"))
+  )
+
+})