Build out clientData.

Makes testing more sensible instead of having to pad by 1 every time.

.github/CONTRIBUTING.md

@@ -2,13 +2,15 @@ We welcome contributions to the **shiny** package. To submit a contribution:
 
 1. [Fork](https://github.com/rstudio/shiny/fork) the repository and make your changes.
 
-2. Ensure that you have signed the [individual](https://rstudioblog.files.wordpress.com/2017/05/rstudio_individual_contributor_agreement.pdf) or [corporate](https://rstudioblog.files.wordpress.com/2017/05/rstudio_corporate_contributor_agreement.pdf) contributor agreement as appropriate. You can send the signed copy to jj@rstudio.com.
+2. Submit a [pull request](https://help.github.com/articles/using-pull-requests).
 
-3. Submit a [pull request](https://help.github.com/articles/using-pull-requests).
+3. Ensure that you have signed the contributor license agreement. It will appear as a "Check"
+   on your PR and a comment from "CLAassistant" will also appear explaining whether you have
+   yet to sign. After you sign, you can click the "Recheck" link in that comment and the check
+   will flip to reflect that you've signed.
 
 We generally do not merge pull requests that update included web libraries (such as Bootstrap or jQuery) because it is difficult for us to verify that the update is done correctly; we prefer to update these libraries ourselves.
 
-
 ## How to make changes
 
 Before you submit a pull request, please do the following:

.travis.yml

@@ -13,12 +13,13 @@ matrix:
       script: ./tools/checkJSCurrent.sh
       node_js:
         - "10"
-    - name: "Old Release Check"
-      r: oldrel
-    - name: "Current Release Check"
-      r: release
-    - name: "Development Release Check"
-      r: devel
+    - r: 3.2
+    - r: 3.3
+    - r: 3.4
+    - r: 3.5
+    - r: release
+    - r: devel
+
 sudo: false
 cache: packages
 notifications:
@@ -26,5 +27,6 @@ notifications:
     on_success: change
     on_failure: change
   slack:
+    on_success: change
     secure: QoM0+hliVC4l2HYv126AkljG/uFvgwayW9IpuB5QNqjSukM122MhMDL7ZuMB9a2vWP24juzOTXiNIymgEspfnvvAMnZwYRBNWkuot2m8HIR2B9UjQLiztFnN1EAT+P+thz8Qax9TV2SOfXb2S2ZOeZmRTVkJctxkL8heAZadIC4=
     on_pull_requests: false

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 1.3.2.9001
+Version: 1.4.0.9000
 Authors@R: c(
     person("Winston", "Chang", role = c("aut", "cre"), email = "winston@rstudio.com"),
     person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"),
@@ -65,16 +65,16 @@ Depends:
 Imports:
     utils,
     grDevices,
-    httpuv (>= 1.5.1.9002),
+    httpuv (>= 1.5.2),
     mime (>= 0.3),
     jsonlite (>= 0.9.16),
     xtable,
     digest,
-    htmltools (>= 0.3.6.9004),
+    htmltools (>= 0.4.0),
     R6 (>= 2.0),
     sourcetools,
-    later (>= 0.7.2),
-    promises (>= 1.0.1),
+    later (>= 1.0.0),
+    promises (>= 1.1.0),
     tools,
     crayon,
     rlang (>= 0.4.0),
@@ -88,10 +88,8 @@ Suggests:
     rmarkdown,
     ggplot2,
     reactlog (>= 1.0.0),
-    magrittr
-Remotes:
-    rstudio/htmltools,
-    rstudio/httpuv
+    magrittr,
+    yaml
 URL: http://shiny.rstudio.com
 BugReports: https://github.com/rstudio/shiny/issues
 Collate:
@@ -143,6 +141,8 @@ Collate:
     'jqueryui.R'
     'middleware-shiny.R'
     'middleware.R'
+    'timer.R'
+    'mock-session.R'
     'modal.R'
     'modules.R'
     'notifications.R'
@@ -164,7 +164,7 @@ Collate:
     'snapshot.R'
     'tar.R'
     'test-export.R'
-    'timer.R'
+    'test-module.R'
     'update-input.R'
 RoxygenNote: 6.1.1
 Encoding: UTF-8

NAMESPACE

@@ -1,15 +1,18 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("$",mockclientdata)
 S3method("$",reactivevalues)
 S3method("$",session_proxy)
 S3method("$",shinyoutput)
 S3method("$<-",reactivevalues)
 S3method("$<-",session_proxy)
 S3method("$<-",shinyoutput)
+S3method("[",mockclientdata)
 S3method("[",reactivevalues)
 S3method("[",shinyoutput)
 S3method("[<-",reactivevalues)
 S3method("[<-",shinyoutput)
+S3method("[[",mockclientdata)
 S3method("[[",reactivevalues)
 S3method("[[",session_proxy)
 S3method("[[",shinyoutput)
@@ -257,6 +260,8 @@ export(tagHasAttribute)
 export(tagList)
 export(tagSetChildren)
 export(tags)
+export(testModule)
+export(testServer)
 export(textAreaInput)
 export(textInput)
 export(textOutput)
@@ -306,3 +311,5 @@ importFrom(fastmap,is.key_missing)
 importFrom(fastmap,key_missing)
 importFrom(grDevices,dev.cur)
 importFrom(grDevices,dev.set)
+importFrom(promises,"%...!%")
+importFrom(promises,"%...>%")

NEWS.md

@@ -1,41 +1,64 @@
-shiny 1.3.2.9001
-=======
+shiny 1.4.0.9000
+===========
 
-## Changes
+## Full changelog
 
-* 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))
+### Breaking changes
+
+### New features
+
+### Minor new features and improvements
+
+### Bug fixes
+
+Fixed [#2653](https://github.com/rstudio/shiny/issues/2653): The `dataTableOutput()` could have incorrect output if certain characters were in the column names. ([#2658](https://github.com/rstudio/shiny/pull/2658))
+
+### Documentation Updates
+
+
+shiny 1.4.0
+===========
+
+## Full changelog
+
+### Breaking changes
+
+* Resolved [#2554](https://github.com/rstudio/shiny/issues/2554): Upgraded jQuery from v.1.12.4 to v3.4.1 and bootstrap from v3.3.7 to v3.4.1. ([#2557](https://github.com/rstudio/shiny/pull/2557)). Since the jQuery upgrade may introduce breaking changes to user code, there is an option to switch back to the old version by setting `options(shiny.jquery.version = 1)`. If you've hard-coded `shared/jquery[.min].js` in the HTML of your Shiny app, in order to downgrade, you'll have to change that filepath to `shared/legacy/jquery[.min].js`.
 
 ### Improvements
 
+* 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))
+
 * 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))
 
 * If the `shiny.autoload.r` option is set to `TRUE`, all files ending in `.r` or `.R` contained in a directory named `R/` adjacent to your application are sourced when your app is started. This will become the default Shiny behavior in a future release ([#2547](https://github.com/rstudio/shiny/pull/2547))
 
-
 * Resolved [#2442](https://github.com/rstudio/shiny/issues/2442): The `shiny:inputchanged` JavaScript event now triggers on the related input element instead of `document`. Existing event listeners bound to `document` will still detect the event due to event bubbling. ([#2446](https://github.com/rstudio/shiny/pull/2446))
 
 * Fixed [#1393](https://github.com/rstudio/shiny/issues/1393), [#2223](https://github.com/rstudio/shiny/issues/2223): For plots with any interactions enabled, the image is no longer draggable. ([#2460](https://github.com/rstudio/shiny/pull/2460))
 
+* Resolved [#2469](https://github.com/rstudio/shiny/issues/2469): `renderText` now takes a `sep` argument that is passed to `cat`. ([#2497](https://github.com/rstudio/shiny/pull/2497))
+
+* Added `resourcePaths()` and `removeResourcePaths()` functions. ([#2459](https://github.com/rstudio/shiny/pull/2459))
+
+* Resolved [#2433](https://github.com/rstudio/shiny/issues/2433): An informative warning is now thrown if subdirectories of the app's `www/` directory are masked by other resource prefixes and/or the same resource prefix is mapped to different local file paths. ([#2434](https://github.com/rstudio/shiny/pull/2434))
+
+* Resolved [#2478](https://github.com/rstudio/shiny/issues/2478): `cmd + shift + f3` and `ctrl + shift + f3` can now be used to add a reactlog mark. If reactlog keybindings are used and the reactlog is not enabled, an error page is displayed showing how to enable reactlog recordings. ([#2560](https://github.com/rstudio/shiny/pull/2560))
+
+### Bug fixes
+
 * Partially resolved [#2423](https://github.com/rstudio/shiny/issues/2423): Reactivity in Shiny leaked some memory, because R can leak memory whenever a new symbols is interned, which happens whenever a new name/key is used in an environment. R now uses the fastmap package, which avoids this problem. ([#2429](https://github.com/rstudio/shiny/pull/2429))
 
 * Fixed [#2267](https://github.com/rstudio/shiny/issues/2267): Fixed a memory leak with `invalidateLater`. ([#2555](https://github.com/rstudio/shiny/pull/2555))
 
 * Fixed [#1548](https://github.com/rstudio/shiny/issues/1548): The `reactivePoll` function leaked an observer; that is the observer would continue to exist even if the `reactivePoll` object was no longer accessible. [#2522](https://github.com/rstudio/shiny/pull/2522)
 
-* Resolved [#2469](https://github.com/rstudio/shiny/issues/2469): `renderText` now takes a `sep` argument that is passed to `cat`. ([#2497](https://github.com/rstudio/shiny/pull/2497))
+* Fixed [#2116](https://github.com/rstudio/shiny/issues/2116): Fixed an issue where dynamic tabs could not be added when on a hosted platform. ([#2545](https://github.com/rstudio/shiny/pull/2545))
 
-* Added `resourcePaths()` and `removeResourcePaths()` functions. ([#2459](https://github.com/rstudio/shiny/pull/2459))
-
-* Resolved [#2515](https://github.com/rstudio/shiny/issues/2515): `selectInput()` now deals appropriately with named factors. ([#2524](https://github.com/rstudio/shiny/pull/2524))
-
-* Resolved [#2433](https://github.com/rstudio/shiny/issues/2433): An informative warning is now thrown if subdirectories of the app's `www/` directory are masked by other resource prefixes and/or the same resource prefix is mapped to different local file paths. ([#2434](https://github.com/rstudio/shiny/pull/2434))
+* Resolved [#2515](https://github.com/rstudio/shiny/issues/2515): `selectInput()` and `selectizeInput()` now deal appropriately with named factors. Note that `updateSelectInput()` and `updateSelectizeInput()` **do not** yet handle factors; their behavior is unchanged. ([#2524](https://github.com/rstudio/shiny/pull/2524), [#2540](https://github.com/rstudio/shiny/pull/2540), [#2625](https://github.com/rstudio/shiny/pull/2625))
 
 * Resolved [#2471](https://github.com/rstudio/shiny/issues/2471): Large file uploads to a Windows computer were slow. ([#2579](https://github.com/rstudio/shiny/pull/2579))
 
-### Bug fixes
-
-* Fixed [#2116](https://github.com/rstudio/shiny/issues/2116): Fixed an issue where dynamic tabs could not be added when on a hosted platform. ([#2545](https://github.com/rstudio/shiny/pull/2545))
-
 * 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))
@@ -52,12 +75,10 @@ shiny 1.3.2.9001
 
 * 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 [#2598](https://github.com/rstudio/shiny/issues/2598): Showcase files don't appear with a wide window. ([#2582](https://github.com/rstudio/shiny/pull/2582))
+
 * 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.
 
-### Library updates
-
-* Resolved [#2554](https://github.com/rstudio/shiny/issues/2554): Upgraded bootstrap to v3.4.1 and jQuery to v3.4.1. ([#2557](https://github.com/rstudio/shiny/pull/2557))
-
 
 shiny 1.3.2
 ===========
@@ -628,7 +649,7 @@ There are many more minor features, small improvements, and bug fixes than we ca
 
 *    **Code Diagnostics**: if there is an error parsing `ui.R`, `server.R`, `app.R`, or `global.R`, Shiny will search the code for missing commas, extra commas, and unmatched braces, parens, and brackets, and will print out messages pointing out those problems. ([#1126](https://github.com/rstudio/shiny/pull/1126))
 
-*    **Reactlog visualization**: by default, the [`showReactLog()` function](http://shiny.rstudio.com/reference/shiny/latest/showReactLog.html) (which brings up the reactive graph) also displays the time that each reactive and observer were active for:
+*    **Reactlog visualization**: by default, the [`showReactLog()` function](http://shiny.rstudio.com/reference/shiny/latest/reactlog.html) (which brings up the reactive graph) also displays the time that each reactive and observer were active for:
 
       <p align="center">
       <img src="http://shiny.rstudio.com/images/reactlog.png" alt="modal-dialog" width="75%"/>

R/app.R

@@ -146,15 +146,13 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
   # Most of the complexity here comes from needing to hot-reload if the .R files
   # change on disk, or are created, or are removed.
 
-  # In an upcoming version of shiny, this option will go away and the new behavior will be used.
-  if (getOption("shiny.autoload.r", FALSE)) {
-    # new behavior
-
+  # In an upcoming version of shiny, this option will go away.
+  if (getOption("shiny.autoload.r", TRUE)) {
     # Create a child env which contains all the helpers and will be the shared parent
     # of the ui.R and server.R load.
     sharedEnv <- new.env(parent = globalenv())
   } else {
-    # old behavior, default
+    # old behavior
     sharedEnv <- globalenv()
   }
 
@@ -230,7 +228,7 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
     setwd(appDir)
     monitorHandle <<- initAutoReloadMonitor(appDir)
     # TODO: we should support hot reloading on global.R and R/*.R changes.
-    if (getOption("shiny.autoload.r", FALSE)) {
+    if (getOption("shiny.autoload.r", TRUE)) {
       loadSupport(appDir, renv=sharedEnv, globalrenv=globalenv())
     }  else {
       if (file.exists(file.path.ci(appDir, "global.R")))
@@ -314,8 +312,14 @@ initAutoReloadMonitor <- function(dir) {
 #' this function loads any top-level supporting `.R` files in the `R/` directory
 #' adjacent to the `app.R`/`server.R`/`ui.R` files.
 #'
-#' At the moment, this function is "opt-in" and only called if the option
-#' `shiny.autoload.r` is set to `TRUE`.
+#' Since Shiny 1.5.0, this function is called by default when running an
+#' application. If it causes problems, you can opt out by using
+#' `options(shiny.autoload.r=FALSE)`. Note that in a future version of Shiny,
+#' this option will no longer be available. If you set this option, it will
+#' affect any application that runs later in the same R session, potentially
+#' breaking it, so after running your application, you should unset option with
+#' `options(shiny.autoload.r=NULL)`
+#'
 #'
 #' @details The files are sourced in alphabetical order (as determined by
 #'   [list.files]). `global.R` is evaluated before the supporting R files in the
@@ -349,15 +353,12 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
 {
   fullpath <- file.path.ci(appDir, fileName)
 
-  # In an upcoming version of shiny, this option will go away and the new behavior will be used.
-  if (getOption("shiny.autoload.r", FALSE)) {
-    # new behavior
-
+  # In an upcoming version of shiny, this option will go away.
+  if (getOption("shiny.autoload.r", TRUE)) {
     # Create a child env which contains all the helpers and will be the shared parent
     # of the ui.R and server.R load.
     sharedEnv <- new.env(parent = globalenv())
   } else {
-    # old behavior, default
     sharedEnv <- globalenv()
   }
 
@@ -411,7 +412,7 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
     oldwd <<- getwd()
     setwd(appDir)
     # TODO: we should support hot reloading on R/*.R changes.
-    if (getOption("shiny.autoload.r", FALSE)) {
+    if (getOption("shiny.autoload.r", TRUE)) {
       loadSupport(appDir, renv=sharedEnv, globalrenv=NULL)
     }
     monitorHandle <<- initAutoReloadMonitor(appDir)

R/bootstrap-deprecated.R

@@ -45,47 +45,3 @@ headerPanel <- function(title, windowTitle=title) {
     )
   )
 }
-
-
-#' Create a Bootstrap page
-#'
-#' **DEPRECATED**: use [fluidPage()] instead.
-#'
-#' @param ... The contents of the document body.
-#' @param title The browser window title (defaults to the host URL of the page)
-#' @param responsive This option is deprecated; it is no longer optional with
-#'   Bootstrap 3.
-#' @param theme Alternative Bootstrap stylesheet (normally a css file within the
-#'   www directory, e.g. `www/bootstrap.css`)
-#'
-#' @return A UI defintion that can be passed to the [shinyUI] function.
-#'
-#' @keywords internal
-#' @seealso [fluidPage()], [fixedPage()]
-#' @export
-bootstrapPage <- function(..., title = NULL, responsive = NULL, theme = NULL) {
-
-  if (!is.null(responsive)) {
-    shinyDeprecated("The 'responsive' argument is no longer used with Bootstrap 3.")
-  }
-
-  attachDependencies(
-    tagList(
-      if (!is.null(title)) tags$head(tags$title(title)),
-      if (!is.null(theme)) {
-        tags$head(tags$link(rel="stylesheet", type="text/css", href = theme))
-      },
-
-      # remainder of tags passed to the function
-      list(...)
-    ),
-    bootstrapLib()
-  )
-}
-
-
-#' @rdname bootstrapPage
-#' @export
-basicPage <- function(...) {
-  bootstrapPage(div(class="container-fluid", list(...)))
-}

R/bootstrap-layout.R

@@ -28,7 +28,8 @@
 #'   Shiny-Application-Layout-Guide](http://shiny.rstudio.com/articles/layout-guide.html) for additional details on laying out fluid
 #'   pages.
 #'
-#' @seealso [column()], [sidebarLayout()]
+#' @family layout functions
+#' @seealso [column()]
 #'
 #' @examples
 #' ## Only run examples in interactive R sessions
@@ -130,6 +131,8 @@ fluidRow <- function(...) {
 #'   Shiny Application Layout Guide](http://shiny.rstudio.com/articles/layout-guide.html) for additional details on laying out fixed
 #'   pages.
 #'
+#' @family layout functions
+#'
 #' @seealso [column()]
 #'
 #' @examples
@@ -243,7 +246,6 @@ column <- function(width, ..., offset = 0) {
 #'   `title` tag within the head. You can also specify a page title
 #'   explicitly using the `title` parameter of the top-level page function.
 #'
-#'
 #' @examples
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {
@@ -279,6 +281,8 @@ titlePanel <- function(title, windowTitle=title) {
 #'   width must be 12 or less.
 #' @param ... Output elements to include in the sidebar/main panel.
 #'
+#' @family layout functions
+#'
 #' @examples
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {
@@ -369,7 +373,7 @@ mainPanel <- function(..., width = 8) {
 #' @param fluid `TRUE` to use fluid layout; `FALSE` to use fixed
 #'   layout.
 #'
-#' @seealso [fluidPage()], [flowLayout()]
+#' @family layout functions
 #'
 #' @examples
 #' ## Only run examples in interactive R sessions
@@ -407,7 +411,7 @@ verticalLayout <- function(..., fluid = TRUE) {
 #' @param cellArgs Any additional attributes that should be used for each cell
 #'   of the layout.
 #'
-#' @seealso [verticalLayout()]
+#' @family layout functions
 #'
 #' @examples
 #' ## Only run examples in interactive R sessions
@@ -463,6 +467,8 @@ inputPanel <- function(...) {
 #' @param cellArgs Any additional attributes that should be used for each cell
 #'   of the layout.
 #'
+#' @family layout functions
+#'
 #' @examples
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {

R/bootstrap.R

@@ -1,6 +1,51 @@
 #' @include utils.R
 NULL
 
+#' Create a Bootstrap page
+#'
+#' Create a Shiny UI page that loads the CSS and JavaScript for
+#' [Bootstrap](http://getbootstrap.com/), and has no content in the page
+#' body (other than what you provide).
+#'
+#' This function is primarily intended for users who are proficient in HTML/CSS,
+#' and know how to lay out pages in Bootstrap. Most applications should use
+#' [fluidPage()] along with layout functions like
+#' [fluidRow()] and [sidebarLayout()].
+#'
+#' @param ... The contents of the document body.
+#' @param title The browser window title (defaults to the host URL of the page)
+#' @param responsive This option is deprecated; it is no longer optional with
+#'   Bootstrap 3.
+#' @param theme Alternative Bootstrap stylesheet (normally a css file within the
+#'   www directory, e.g. `www/bootstrap.css`)
+#'
+#' @return A UI defintion that can be passed to the [shinyUI] function.
+#'
+#' @note The `basicPage` function is deprecated, you should use the
+#'   [fluidPage()] function instead.
+#'
+#' @seealso [fluidPage()], [fixedPage()]
+#' @export
+bootstrapPage <- function(..., title = NULL, responsive = NULL, theme = NULL) {
+
+  if (!is.null(responsive)) {
+    shinyDeprecated("The 'responsive' argument is no longer used with Bootstrap 3.")
+  }
+
+  attachDependencies(
+    tagList(
+      if (!is.null(title)) tags$head(tags$title(title)),
+      if (!is.null(theme)) {
+        tags$head(tags$link(rel="stylesheet", type="text/css", href = theme))
+      },
+
+      # remainder of tags passed to the function
+      list(...)
+    ),
+    bootstrapLib()
+  )
+}
+
 #' Bootstrap libraries
 #'
 #' This function returns a set of web dependencies necessary for using Bootstrap
@@ -31,6 +76,12 @@ bootstrapLib <- function(theme = NULL) {
   )
 }
 
+#' @rdname bootstrapPage
+#' @export
+basicPage <- function(...) {
+  bootstrapPage(div(class="container-fluid", list(...)))
+}
+
 
 #' Create a page that fills the window
 #'
@@ -79,6 +130,8 @@ bootstrapLib <- function(theme = NULL) {
 #' @param bootstrap If `TRUE`, load the Bootstrap CSS library.
 #' @param theme URL to alternative Bootstrap stylesheet.
 #'
+#' @family layout functions
+#'
 #' @examples
 #' fillPage(
 #'   tags$style(type = "text/css",
@@ -182,6 +235,8 @@ collapseSizes <- function(padding) {
 #'   [updateNavbarPage()], [insertTab()],
 #'   [showTab()]
 #'
+#' @family layout functions
+#'
 #' @examples
 #' navbarPage("App Title",
 #'   tabPanel("Plot"),

R/conditions.R

@@ -133,7 +133,7 @@ captureStackTraces <- function(expr) {
 createStackTracePromiseDomain <- function() {
   # These are actually stateless, we wouldn't have to create a new one each time
   # if we didn't want to. They're pretty cheap though.
-  
+
   d <- promises::new_promise_domain(
     wrapOnFulfilled = function(onFulfilled) {
       force(onFulfilled)
@@ -266,10 +266,10 @@ withLogErrors <- function(expr,
 printError <- function(cond,
   full = getOption("shiny.fullstacktrace", FALSE),
   offset = getOption("shiny.stacktraceoffset", TRUE)) {
-  
-  warning(call. = FALSE, immediate. = TRUE, sprintf("Error in %s: %s", 
+
+  warning(call. = FALSE, immediate. = TRUE, sprintf("Error in %s: %s",
     getCallNames(list(conditionCall(cond))), conditionMessage(cond)))
-  
+
   printStackTrace(cond, full = full, offset = offset)
 }
 
@@ -282,16 +282,16 @@ printStackTrace <- function(cond,
   should_drop <- !full
   should_strip <- !full
   should_prune <- !full
-  
+
   stackTraceCalls <- c(
     attr(cond, "deep.stack.trace", exact = TRUE),
     list(attr(cond, "stack.trace", exact = TRUE))
   )
-  
+
   stackTraceParents <- lapply(stackTraceCalls, attr, which = "parents", exact = TRUE)
   stackTraceCallNames <- lapply(stackTraceCalls, getCallNames)
   stackTraceCalls <- lapply(stackTraceCalls, offsetSrcrefs, offset = offset)
-  
+
   # Use dropTrivialFrames logic to remove trailing bits (.handleSimpleError, h)
   if (should_drop) {
     # toKeep is a list of logical vectors, of which elements (stack frames) to keep
@@ -301,7 +301,7 @@ printStackTrace <- function(cond,
     stackTraceCallNames <- mapply(stackTraceCallNames, FUN = `[`, toKeep, SIMPLIFY = FALSE)
     stackTraceParents <- mapply(stackTraceParents, FUN = `[`, toKeep, SIMPLIFY = FALSE)
   }
-  
+
   delayedAssign("all_true", {
     # List of logical vectors that are all TRUE, the same shape as
     # stackTraceCallNames. Delay the evaluation so we don't create it unless
@@ -310,7 +310,7 @@ printStackTrace <- function(cond,
       rep_len(TRUE, length(st))
     })
   })
-  
+
   # stripStackTraces and lapply(stackTraceParents, pruneStackTrace) return lists
   # of logical vectors. Use mapply(FUN = `&`) to boolean-and each pair of the
   # logical vectors.
@@ -320,7 +320,7 @@ printStackTrace <- function(cond,
     FUN = `&`,
     SIMPLIFY = FALSE
   )
-  
+
   dfs <- mapply(seq_along(stackTraceCalls), rev(stackTraceCalls), rev(stackTraceCallNames), rev(toShow), FUN = function(i, calls, nms, index) {
     st <- data.frame(
       num = rev(which(index)),
@@ -329,7 +329,7 @@ printStackTrace <- function(cond,
       category = rev(getCallCategories(calls[index])),
       stringsAsFactors = FALSE
     )
-    
+
     if (i != 1) {
       message("From earlier call:")
     }
@@ -357,7 +357,7 @@ printStackTrace <- function(cond,
 
     st
   }, SIMPLIFY = FALSE)
-  
+
   invisible()
 }
 
@@ -372,7 +372,7 @@ printStackTrace <- function(cond,
 extractStackTrace <- function(calls,
   full = getOption("shiny.fullstacktrace", FALSE),
   offset = getOption("shiny.stacktraceoffset", TRUE)) {
-  
+
   shinyDeprecated(NULL,
     "extractStackTrace is deprecated. Please contact the Shiny team if you were using this functionality.",
     version = "1.0.5")
@@ -459,19 +459,19 @@ stripOneStackTrace <- function(stackTrace, truncateFloor, startingScore) {
       prefix <- rep_len(FALSE, indexOfFloor)
     }
   }
-  
+
   if (length(stackTrace) == 0) {
     return(list(score = startingScore, character(0)))
   }
-  
+
   score <- rep.int(0L, length(stackTrace))
   score[stackTrace == "..stacktraceon.."] <- 1L
   score[stackTrace == "..stacktraceoff.."] <- -1L
   score <- startingScore + cumsum(score)
-  
+
   toShow <- score > 0 & !(stackTrace %in% c("..stacktraceon..", "..stacktraceoff..", "..stacktracefloor.."))
-  
-  
+
+
   list(score = utils::tail(score, 1), trace = c(prefix, toShow))
 }
 
@@ -486,11 +486,11 @@ pruneStackTrace <- function(parents) {
   # sufficient; we also need to drop nodes that are the last child, but one of
   # their ancestors is not.
   is_dupe <- duplicated(parents, fromLast = TRUE)
-  
+
   # The index of the most recently seen node that was actually kept instead of
   # dropped.
   current_node <- 0
-  
+
   # Loop over the parent indices. Anything that is not parented by current_node
   # (a.k.a. last-known-good node), or is a dupe, can be discarded. Anything that
   # is kept becomes the new current_node.
@@ -502,7 +502,7 @@ pruneStackTrace <- function(parents) {
       FALSE
     }
   }, FUN.VALUE = logical(1))
-  
+
   include
 }
 
@@ -515,7 +515,7 @@ dropTrivialFrames <- function(callnames) {
   # What's the last that *didn't* match stop/.handleSimpleError/h?
   lastGoodCall <- max(which(!hideable))
   toRemove <- length(callnames) - lastGoodCall
-  
+
   c(
     rep_len(TRUE, length(callnames) - toRemove),
     rep_len(FALSE, toRemove)
@@ -530,10 +530,10 @@ offsetSrcrefs <- function(calls, offset = TRUE) {
     # E.g. for "foo [bar.R:10]", line 10 of bar.R will be part of
     # the definition of foo().
     srcrefs <- c(utils::tail(srcrefs, -1), list(NULL))
-    
+
     calls <- setSrcRefs(calls, srcrefs)
   }
-  
+
   calls
 }
 
@@ -550,7 +550,7 @@ formatStackTrace <- function(calls, indent = "    ",
   shinyDeprecated(NULL,
     "extractStackTrace is deprecated. Please contact the Shiny team if you were using this functionality.",
     version = "1.0.5")
-  
+
   st <- extractStackTrace(calls, full = full, offset = offset)
   if (nrow(st) == 0) {
     return(character(0))

R/globals.R

@@ -16,7 +16,9 @@ register_s3_method <- function(pkg, generic, class, fun = NULL) {
     registerS3method(generic, class, fun, envir = asNamespace(pkg))
   }
 
-  # Always register hook in case package is later unloaded & reloaded
+  # Always register hook in case pkg is loaded at some
+  # point the future (or, potentially, but less commonly,
+  # unloaded & reloaded)
   setHook(
     packageEvent(pkg, "onLoad"),
     function(...) {
@@ -25,6 +27,37 @@ register_s3_method <- function(pkg, generic, class, fun = NULL) {
   )
 }
 
+register_upgrade_message <- function(pkg, version) {
+  # Is an out-dated version of this package installed?
+  needs_upgrade <- function() {
+    if (system.file(package = pkg) == "")
+      return(FALSE)
+    if (utils::packageVersion(pkg) >= version)
+      return(FALSE)
+    TRUE
+  }
+
+  msg <- sprintf(
+    "This version of Shiny is designed to work with '%s' >= %s.
+    Please upgrade via install.packages('%s').",
+    pkg, version, pkg
+  )
+
+  if (pkg %in% loadedNamespaces() && needs_upgrade()) {
+    packageStartupMessage(msg)
+  }
+
+  # Always register hook in case pkg is loaded at some
+  # point the future (or, potentially, but less commonly,
+  # unloaded & reloaded)
+  setHook(
+    packageEvent(pkg, "onLoad"),
+    function(...) {
+      if (needs_upgrade()) packageStartupMessage(msg)
+    }
+  )
+}
+
 .onLoad <- function(libname, pkgname) {
   # R's lazy-loading package scheme causes the private seed to be cached in the
   # package itself, making our PRNG completely deterministic. This line resets
@@ -36,18 +69,10 @@ register_s3_method <- function(pkg, generic, class, fun = NULL) {
   register_s3_method("knitr", "knit_print", "reactive")
   register_s3_method("knitr", "knit_print", "shiny.appobj")
   register_s3_method("knitr", "knit_print", "shiny.render.function")
-}
 
-.onAttach <- function(libname, pkgname) {
-  # Check for htmlwidgets version, if installed. As of Shiny 0.12.0 and
-  # htmlwidgets 0.4, both packages switched from RJSONIO to jsonlite. Because of
-  # this change, Shiny 0.12.0 will work only with htmlwidgets >= 0.4, and vice
-  # versa.
-  if (system.file(package = "htmlwidgets") != "" &&
-      utils::packageVersion("htmlwidgets") < "0.4") {
-    packageStartupMessage(
-      "This version of Shiny is designed to work with htmlwidgets >= 0.4. ",
-      "Please upgrade your version of htmlwidgets."
-    )
-  }
+  # Shiny 1.4.0 bumps jQuery 1.x to 3.x, which caused a problem
+  # with static-rendering of htmlwidgets, and htmlwidgets 1.5
+  # includes a fix for this problem
+  # https://github.com/rstudio/shiny/issues/2630
+  register_upgrade_message("htmlwidgets", 1.5)
 }

R/input-action.R

@@ -37,6 +37,13 @@
 #' }
 #'
 #' @seealso [observeEvent()] and [eventReactive()]
+#'
+#' @section Server value:
+#' An integer of class `"shinyActionButtonValue"`. This class differs from
+#' ordinary integers in that a value of 0 is considered "falsy".
+#' This implies two things:
+#'   * Event handlers (e.g., [observeEvent()], [eventReactive()]) won't execute on initial load.
+#'   * Input validation (e.g., [req()], [need()]) will fail on initial load.
 #' @export
 actionButton <- function(inputId, label, icon = NULL, width = NULL, ...) {
 

R/input-checkbox.R

@@ -22,6 +22,10 @@
 #' }
 #' shinyApp(ui, server)
 #' }
+#'
+#' @section Server value:
+#' `TRUE` if checked, `FALSE` otherwise.
+#'
 #' @export
 checkboxInput <- function(inputId, label, value = FALSE, width = NULL) {
 

R/input-checkboxgroup.R

@@ -67,6 +67,9 @@
 #'
 #' shinyApp(ui, server)
 #' }
+#' @section Server value:
+#' Character vector of values corresponding to the boxes that are checked.
+#'
 #' @export
 checkboxGroupInput <- function(inputId, label, choices = NULL, selected = NULL,
   inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL) {

R/input-date.R

@@ -86,6 +86,10 @@
 #'
 #' shinyApp(ui, server = function(input, output) { })
 #' }
+#'
+#' @section Server value:
+#' A [Date] vector of length 1.
+#'
 #' @export
 dateInput <- function(inputId, label, value = NULL, min = NULL, max = NULL,
   format = "yyyy-mm-dd", startview = "month", weekstart = 0,

R/input-daterange.R

@@ -70,6 +70,10 @@
 #'
 #' shinyApp(ui, server = function(input, output) { })
 #' }
+#'
+#' @section Server value:
+#' A [Date] vector of length 2.
+#'
 #' @export
 dateRangeInput <- function(inputId, label, start = NULL, end = NULL,
     min = NULL, max = NULL, format = "yyyy-mm-dd", startview = "month",

R/input-file.R

@@ -3,21 +3,7 @@
 #' 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{`name`}{The filename provided by the web browser. This is
-#'   **not** the path to read to get at the actual data that was uploaded
-#'   (see
-#'   `datapath` column).}
-#'   \item{`size`}{The size of the uploaded data, in
-#'   bytes.}
-#'   \item{`type`}{The MIME type reported by the browser (for example,
-#'   `text/plain`), or empty string if the browser didn't know.}
-#'   \item{`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.}
-#' }
+#' to a dataframe. See the `Server value` section.
 #'
 #' @family input elements
 #'
@@ -71,6 +57,23 @@
 #'
 #' shinyApp(ui, server)
 #' }
+#'
+#' @section Server value:
+#' A `data.frame` that contains one row for each selected file, and following columns:
+#' \describe{
+#'   \item{`name`}{The filename provided by the web browser. This is
+#'   **not** the path to read to get at the actual data that was uploaded
+#'   (see
+#'   `datapath` column).}
+#'   \item{`size`}{The size of the uploaded data, in
+#'   bytes.}
+#'   \item{`type`}{The MIME type reported by the browser (for example,
+#'   `text/plain`), or empty string if the browser didn't know.}
+#'   \item{`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.}
+#' }
+#'
 #' @export
 fileInput <- function(inputId, label, multiple = FALSE, accept = NULL,
   width = NULL, buttonLabel = "Browse...", placeholder = "No file selected") {

R/input-numeric.R

@@ -24,6 +24,10 @@
 #' }
 #' shinyApp(ui, server)
 #' }
+#'
+#' @section Server value:
+#' A numeric vector of length 1.
+#'
 #' @export
 numericInput <- function(inputId, label, value, min = NA, max = NA, step = NA,
   width = NULL) {

R/input-password.R

@@ -8,6 +8,10 @@
 #' @family input elements
 #' @seealso [updateTextInput()]
 #'
+#' @section Server value:
+#' A character string of the password input. The default value is `""`
+#' unless `value` is provided.
+#'
 #' @examples
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {

R/input-radiobuttons.R

@@ -80,6 +80,10 @@
 #'
 #' shinyApp(ui, server)
 #' }
+#'
+#' @section Server value:
+#' A character string containing the value of the selected button.
+#'
 #' @export
 radioButtons <- function(inputId, label, choices = NULL, selected = NULL,
   inline = FALSE, width = NULL, choiceNames = NULL, choiceValues = NULL) {

R/input-select.R

@@ -3,33 +3,32 @@
 #' Create a select list that can be used to choose a single or multiple items
 #' from a list of values.
 #'
-#' By default, `selectInput()` and `selectizeInput()` use the
-#' JavaScript library \pkg{selectize.js}
-#' (<https://github.com/selectize/selectize.js>) instead of the basic
-#' select input element. To use the standard HTML select input element, use
-#' `selectInput()` with `selectize=FALSE`.
+#' By default, `selectInput()` and `selectizeInput()` use the JavaScript library
+#' \pkg{selectize.js} (<https://github.com/selectize/selectize.js>) instead of
+#' the basic select input element. To use the standard HTML select input
+#' element, use `selectInput()` with `selectize=FALSE`.
 #'
-#' In selectize mode, if the first element in `choices` has a value of
-#' `""`, its name will be treated as a placeholder prompt. For example:
+#' In selectize mode, if the first element in `choices` has a value of `""`, its
+#' name will be treated as a placeholder prompt. For example:
 #' `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. It's also possible to group related inputs by providing a named list
-#'   whose elements are (either named or unnamed) lists, vectors, or factors. In this
-#'   case, the outermost names will be used as the group labels (leveraging the
-#'   `<optgroup>` HTML tag) for the elements in the respective sublist. See the
-#'   example section for a small demo of this feature.
-#' @param selected The initially selected value (or multiple values if
-#'   `multiple = TRUE`). If not specified then defaults to the first value
-#'   for single-select lists and no values for multiple select lists.
+#'   whose elements are (either named or unnamed) lists, vectors, or factors. In
+#'   this case, the outermost names will be used as the group labels (leveraging
+#'   the `<optgroup>` HTML tag) for the elements in the respective sublist. See
+#'   the example section for a small demo of this feature.
+#' @param selected The initially selected value (or multiple values if `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 `selectize=TRUE`.
-#'   Normally, when `multiple=FALSE`, a select input will be a drop-down
-#'   list, but when `size` is set, it will be a box instead.
+#'   Normally, when `multiple=FALSE`, a select input will be a drop-down list,
+#'   but when `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
@@ -72,6 +71,11 @@
 #'   }
 #' )
 #' }
+#'
+#' @section Server value: A vector of character strings, usually of length
+#'   1, with the value of the selected items. When `multiple=TRUE` and
+#'   nothing is selected, this value will be `NULL`.
+#'
 #' @export
 selectInput <- function(inputId, label, choices, selected = NULL,
   multiple = FALSE, selectize = TRUE, width = NULL,
@@ -225,18 +229,6 @@ selectizeIt <- function(inputId, select, options, nonempty = FALSE) {
 #' Create a select list that can be used to choose a single or multiple items
 #' from the column names of a data frame.
 #'
-#' The resulting server `input` value will be returned as:
-#' \itemize{
-#'   \item a symbol if `multiple = FALSE`.  The `input` value should be
-#'         used with rlang's [rlang::!!()]. For example,
-#'         `ggplot2::aes(!!input$variable)`.
-#'   \item a list of symbols if `multiple = TRUE`. The `input` value
-#'         should be used with rlang's [rlang::!!!()] to expand
-#'         the symbol list as individual arguments. For example,
-#'         `dplyr::select(mtcars, !!!input$variabls)` which is
-#'         equivalent to `dplyr::select(mtcars, !!input$variabls[[1]], !!input$variabls[[2]], ..., !!input$variabls[[length(input$variabls)]])`.
-#' }
-#'
 #' By default, `varSelectInput()` and `selectizeInput()` use the
 #' JavaScript library \pkg{selectize.js}
 #' (<https://github.com/selectize/selectize.js>) to instead of the basic
@@ -249,6 +241,19 @@ selectizeIt <- function(inputId, select, options, nonempty = FALSE) {
 #'
 #' @family input elements
 #' @seealso [updateSelectInput()]
+#'
+#' @section Server value:
+#' The resulting server `input` value will be returned as:
+#'
+#'  * A symbol if `multiple = FALSE`. The `input` value should be
+#'  used with rlang's [rlang::!!()]. For example,
+#'  `ggplot2::aes(!!input$variable)`.
+#'  * A list of symbols if `multiple = TRUE`. The `input` value
+#'  should be used with rlang's [rlang::!!!()] to expand
+#'  the symbol list as individual arguments. For example,
+#'  `dplyr::select(mtcars, !!!input$variabls)` which is
+#'  equivalent to `dplyr::select(mtcars, !!input$variabls[[1]], !!input$variabls[[2]], ..., !!input$variabls[[length(input$variabls)]])`.
+#'
 #' @examples
 #'
 #' ## Only run examples in interactive R sessions

R/input-slider.R

@@ -70,6 +70,10 @@
 #' # Complete app with UI and server components
 #' shinyApp(ui, server)
 #' }
+#'
+#' @section Server value:
+#' A number, or in the case of slider range, a vector of two numbers.
+#'
 #' @export
 sliderInput <- function(inputId, label, min, max, value, step = NULL,
                         round = FALSE, format = NULL, locale = NULL,

R/input-text.R

@@ -28,6 +28,11 @@
 #' }
 #' shinyApp(ui, server)
 #' }
+#'
+#' @section Server value:
+#' A character string of the text input. The default value is `""`
+#' unless `value` is provided.
+#'
 #' @export
 textInput <- function(inputId, label, value = "", width = NULL,
   placeholder = NULL) {

R/input-textarea.R

@@ -35,6 +35,11 @@
 #' shinyApp(ui, server)
 #'
 #' }
+#'
+#' @section Server value:
+#' A character string of the text input. The default value is `""`
+#' unless `value` is provided.
+#'
 #' @export
 textAreaInput <- function(inputId, label, value = "", width = NULL, height = NULL,
   cols = NULL, rows = NULL, placeholder = NULL, resize = NULL) {

R/input-utils.R

@@ -92,7 +92,10 @@ generateOptions <- function(inputId, selected, inline, type = 'checkbox',
 
 # True when a choice list item represents a group of related inputs.
 isGroup <- function(choice) {
-  length(choice) > 1 || !is.null(names(choice))
+  is.list(choice) ||
+    !is.null(names(choice)) ||
+    length(choice) > 1 ||
+    length(choice) == 0
 }
 
 # True when choices is a list and contains at least one group of related inputs.
@@ -131,6 +134,10 @@ processFlatChoices <- function(choices) {
 processGroupedChoices <- function(choices) {
   # We assert choices is a list, since only a list may contain a group.
   stopifnot(is.list(choices))
+  # The list might be unnamed by this point. We add default names of "" so that
+  # names(choices) is not zero-length and mapply can work. Within mapply, we
+  # error if any group's name is ""
+  choices <- asNamed(choices)
   choices <- mapply(function(name, choice) {
     choiceIsGroup <- isGroup(choice)
     if (choiceIsGroup && name == "") {

R/middleware-shiny.R

@@ -3,7 +3,27 @@ NULL
 
 reactLogHandler <- function(req) {
   if (! rLog$isLogging()) {
-    return(NULL)
+    if (
+      identical(req$PATH_INFO, "/reactlog/mark") ||
+      identical(req$PATH_INFO, "/reactlog")
+    ) {
+      # is not logging, but is a reactlog path...
+
+      return(
+        httpResponse(
+          # Not Implemented
+          # - The server either does not recognize the request method, or it lacks the ability to fulfil the request.
+          status = 501,
+          content_type = "text/plain; charset=utf-8",
+          content = "To enable reactlog, set the following option before running the application: \n\noptions(shiny.reactlog = TRUE)"
+        )
+      )
+
+    } else {
+      # continue on like normal
+      return(NULL)
+    }
+
   }
 
   if (identical(req$PATH_INFO, "/reactlog/mark")) {
@@ -37,6 +57,7 @@ reactLogHandler <- function(req) {
     ))
 
   } else {
+    # continue on like normal
     return(NULL)
   }
 }

R/mock-session.R

@@ -0,0 +1,284 @@
+# TODO: is there a way to get this behavior without exporting these functions? R6?
+# TODO: clientData is documented as a reactiveValues, which this is not. Is it possible that
+#   users are currently assigning into clientData? That would not work as expected here.
+#' @noRd
+#' @export
+`$.mockclientdata` <- function(x, name) {
+  if (name == "allowDataUriScheme") { return(TRUE) }
+  if (name == "pixelratio") { return(1) }
+  if (name == "url_protocol") { return("http:") }
+  if (name == "url_hostname") { return("mocksession") }
+  if (name == "url_port") { return(1234) }
+  if (name == "url_pathname") { return("/mockpath") }
+  if (name == "url_hash") { return("#mockhash") }
+  if (name == "url_hash_initial") { return("#mockhash") }
+  if (name == "url_search") { return("?mocksearch=1") }
+
+  clientRE <- "^output_(.+)_([^_]+)$"
+  if(grepl(clientRE, name)) {
+    # TODO: use proper regex group matching here instead of redundantly parsing
+    el <- sub(clientRE, "\\1", name)
+    att <- sub(clientRE, "\\2", name)
+
+    if (att == "width") {
+      return(600)
+    } else if (att == "height") {
+      return(400)
+    } else if (att == "hidden") {
+      return(FALSE)
+    }
+  }
+  warning("Unexpected clientdata attribute accessed: ", name)
+  return(NULL)
+}
+
+#' @noRd
+#' @export
+`[[.mockclientdata` <- `$.mockclientdata`
+
+#' @noRd
+#' @export
+`[.mockclientdata` <- function(values, name) {
+  stop("Single-bracket indexing of mockclientdata is not allowed.")
+}
+
+#' @include timer.R
+MockShinySession <- R6Class(
+  'MockShinySession',
+  portable = FALSE,
+  class = FALSE,
+  public = list(
+    env = NULL,
+    # Needed for rendering HTML (i.e. renderUI)
+    singletons = character(0),
+    # Define a mock client data that always returns a size for plots
+    clientData = structure(list(), class="mockclientdata"),
+    reactlog = function(logEntry){},
+    incrementBusyCount = function(){},
+    output = NULL,
+    input = NULL,
+    userData = NULL,
+
+    initialize = function() {
+      private$.input <- ReactiveValues$new(dedupe = FALSE, label = "input")
+      private$flushCBs <- Callbacks$new()
+      private$flushedCBs <- Callbacks$new()
+      private$endedCBs <- Callbacks$new()
+      private$timer <- MockableTimerCallbacks$new()
+
+      self$userData <- new.env(parent=emptyenv())
+
+      # create output
+      out <- .createOutputWriter(self)
+      class(out) <- "shinyoutput"
+      self$output <- out
+
+      # Create a read-only copy of the inputs reactive.
+      self$input <- .createReactiveValues(private$.input, readonly = TRUE)
+    },
+    onFlush = function(fun, once) {
+      if (!isTRUE(once)) {
+        return(private$flushCBs$register(fun))
+      } else {
+        dereg <- private$flushCBs$register(function() {
+          dereg()
+          fun()
+        })
+        return(dereg)
+      }
+    },
+    onFlushed = function(fun, once) {
+      if (!isTRUE(once)) {
+        return(private$flushedCBs$register(fun))
+      } else {
+        dereg <- private$flushedCBs$register(function() {
+          dereg()
+          fun()
+        })
+        return(dereg)
+      }
+    },
+    onEnded = function(sessionEndedCallback) {
+      private$endedCBs$register(sessionEndedCallback)
+    },
+
+    isEnded = function(){ private$closed },
+    isClosed = function(){ private$closed },
+    close = function(){ private$closed <- TRUE },
+
+    #FIXME: this is wrong. Will need to be more complex.
+    cycleStartAction = function(callback){ callback() },
+
+    # Needed for image rendering. Base64-encode the given file.
+    fileUrl = function(name, file, contentType='application/octet-stream') {
+      bytes <- file.info(file)$size
+      if (is.na(bytes))
+        return(NULL)
+
+      fileData <- readBin(file, 'raw', n=bytes)
+      b64 <- rawToBase64(fileData)
+      return(paste('data:', contentType, ';base64,', b64, sep=''))
+    },
+
+    setInputs = function(...) {
+      vals <- list(...)
+      # TODO: is there really not a way to access `names` from inside an lapply?
+      lapply(names(vals), function(k){
+        v <- vals[[k]]
+        private$.input$set(k, v)
+      })
+
+      private$flush()
+    },
+
+
+    scheduleTask = function(millis, callback) {
+      id <- private$timer$schedule(millis, callback)
+
+      # Return a deregistration callback
+      function() {
+        invisible(private$timer$unschedule(id))
+      }
+    },
+    elapse = function(millis) {
+      msLeft <- millis
+
+      while (msLeft > 0){
+        t <- private$timer$timeToNextEvent()
+
+        if (is.infinite(t) || t <= 0 || msLeft < t){
+          # Either there's no good upcoming event or we can't make it to it in the allotted time.
+          break
+        }
+        msLeft <- msLeft - t
+        private$timer$elapse(t)
+
+        # timerCallbacks must run before flushReact.
+        private$timer$executeElapsed()
+        private$flush()
+      }
+
+      private$timer$elapse(msLeft)
+
+      # TODO: needed? We're guaranteed to not have anything to run given the above loop, right?
+      private$timer$executeElapsed()
+      private$flush()
+    },
+
+    now = function() {
+      # Contract is to return Sys.time, which is seconds, not millis.
+      private$timer$getElapsed()/1000
+    },
+
+    defineOutput = function(name, value, label) {
+      obs <- observe({
+        # We could just stash the promise, but we get an "unhandled promise error". This bypasses
+        prom <- NULL
+        tryCatch({
+          v <- value(self, name) #TODO: I'm not clear what `name` is supposed to be
+          if (!promises::is.promise(v)){
+            # Make our sync value into a promise
+            prom <- promises::promise(function(resolve, reject){ resolve(v) })
+          } else {
+            prom <- v
+          }
+        }, error=function(e){
+          # Error running value()
+          prom <<- promises::promise(function(resolve, reject){ reject(e) })
+        })
+
+        private$outs[[name]]$promise <- hybrid_chain(
+          prom,
+          function(v){
+            list(val = v, err = NULL)
+          }, catch=function(e){
+            list(val = NULL, err = e)
+          })
+      })
+      private$outs[[name]] <- list(obs = obs, func = value, promise = NULL)
+    },
+
+    getOutput = function(name) {
+      # Unlike the real outputs, we're going to return the last value rather than the unevaluated function
+      if (is.null(private$outs[[name]]$promise)) {
+        stop("The test referenced an output that hasn't been defined yet: output$", name)
+      }
+      # Make promise return
+      v <- extract(private$outs[[name]]$promise)
+      if (!is.null(v$err)){
+        stop(v$err)
+      } else {
+        v$val
+      }
+    },
+
+    registerDataObj = function(name, data, filterFunc) {},
+    allowReconnect = function(value) {},
+    reload = function() {},
+    resetBrush = function(brushId) {
+      warning("session$brush isn't meaningfully mocked on the MockShinySession")
+    },
+    sendCustomMessage = function(type, message) {},
+    sendBinaryMessage = function(type, message) {},
+    sendInputMessage = function(inputId, message) {},
+    setBookmarkExclude = function(names) {
+      warning("Bookmarking isn't meaningfully mocked in MockShinySession")
+    },
+    getBookmarkExclude = function() {
+      warning("Bookmarking isn't meaningfully mocked in MockShinySession")
+    },
+    onBookmark = function(fun) {
+      warning("Bookmarking isn't meaningfully mocked in MockShinySession")
+    },
+    onBookmarked = function(fun) {
+      warning("Bookmarking isn't meaningfully mocked in MockShinySession")
+    },
+    doBookmark = function() {
+      warning("Bookmarking isn't meaningfully mocked in MockShinySession")
+    },
+    onRestore = function(fun) {},
+    onRestored = function(fun) {},
+    exportTestValues = function() {},
+    getTestSnapshotUrl = function(input=TRUE, output=TRUE, export=TRUE, format="json") {},
+    ns = function(id) {
+      paste0("mock-session-", id) # TODO: does this need to be more complex/intelligent?
+    }
+  ),
+  private = list(
+    .input = NULL,
+    flushCBs = NULL,
+    flushedCBs = NULL,
+    endedCBs = NULL,
+    timer = NULL,
+    closed = FALSE,
+    outs = list(),
+    returnedVal = NULL,
+
+    flush = function(){
+      isolate(private$flushCBs$invoke(..stacktraceon = TRUE))
+      flushReact()
+      isolate(private$flushedCBs$invoke(..stacktraceon = TRUE))
+      later::run_now()
+    }
+  ),
+  active = list(
+    # If assigning to `returned`, proactively flush
+    returned = function(value){
+      if(missing(value)){
+        return(private$returnedVal)
+      }
+      # When you assign to returned, that implies that you just ran
+      # the module. So we should proactively flush. We have to do this
+      # here since flush is private.
+      private$returnedVal <- value
+      private$flush()
+    },
+    request = function(value) {
+      if (!missing(value)){
+        stop("session$request can't be assigned to")
+      }
+      warning("session$request doesn't currently simulate a realistic request on MockShinySession")
+      new.env(parent=emptyenv())
+    }
+  )
+)

R/notifications.R

@@ -12,11 +12,13 @@
 #'   disappear.
 #' @param closeButton If `TRUE`, display a button which will make the
 #'   notification disappear when clicked. If `FALSE` do not display.
-#' @param id An ID string. This can be used to change the contents of an
-#'   existing message with `showNotification`, or to remove it with
-#'   `removeNotification`. If not provided, one will be generated
-#'   automatically. If an ID is provided and there does not currently exist a
-#'   notification with that ID, a new notification will be created with that ID.
+#' @param id A unique identifier for the notification.
+#'
+#'   `id` is optional for `showNotification()`: Shiny will automatically create
+#'   one if needed. If you do supply it, Shiny will update an existing
+#'   notification if it exists, otherwise it will create a new one.
+#'
+#'   `id` is required for `removeNotification()`.
 #' @param type A string which controls the color of the notification. One of
 #'   "default" (gray), "message" (blue), "warning" (yellow), or "error" (red).
 #' @param session Session object to send notification to.
@@ -97,10 +99,8 @@ showNotification <- function(ui, action = NULL, duration = 5,
 
 #' @rdname showNotification
 #' @export
-removeNotification <- function(id = NULL, session = getDefaultReactiveDomain()) {
-  if (is.null(id)) {
-    stop("id is required.")
-  }
+removeNotification <- function(id, session = getDefaultReactiveDomain()) {
+  force(id)
   session$sendNotification("remove", id)
   id
 }

R/reactives.R

@@ -1513,14 +1513,16 @@ reactiveTimer <- function(intervalMs=1000, session = getDefaultReactiveDomain())
   # reactId <- nextGlobalReactId()
   # rLog$define(reactId, paste0("timer(", intervalMs, ")"))
 
+  scheduler <- defineScheduler(session)
+
   dependents <- Map$new()
-  timerHandle <- scheduleTask(intervalMs, function() {
+  timerHandle <- scheduler(intervalMs, function() {
     # Quit if the session is closed
     if (!is.null(session) && session$isClosed()) {
       return(invisible())
     }
 
-    timerHandle <<- scheduleTask(intervalMs, sys.function())
+    timerHandle <<- scheduler(intervalMs, sys.function())
 
     doInvalidate <- function() {
       lapply(
@@ -1613,7 +1615,6 @@ reactiveTimer <- function(intervalMs=1000, session = getDefaultReactiveDomain())
 #' }
 #' @export
 invalidateLater <- function(millis, session = getDefaultReactiveDomain()) {
-
   force(session)
 
   ctx <- getCurrentContext()
@@ -1621,7 +1622,9 @@ invalidateLater <- function(millis, session = getDefaultReactiveDomain()) {
 
   clear_on_ended_callback <- function() {}
 
-  timerHandle <- scheduleTask(millis, function() {
+  scheduler <- defineScheduler(session)
+
+  timerHandle <- scheduler(millis, function() {
     if (is.null(session)) {
       ctx$invalidate()
       return(invisible())
@@ -2372,7 +2375,7 @@ debounce <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
     }
 
     # The value (or possibly millis) changed. Start or reset the timer.
-    v$when <- Sys.time() + millis()/1000
+    v$when <- getTime(domain) + millis()/1000
   }, label = "debounce tracker", domain = domain, priority = priority)
 
   # This observer is the timer. It rests until v$when elapses, then touches
@@ -2381,7 +2384,7 @@ debounce <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
     if (is.null(v$when))
       return()
 
-    now <- Sys.time()
+    now <- getTime(domain)
     if (now >= v$when) {
       # Mod by 999999999 to get predictable overflow behavior
       v$trigger <- isolate(v$trigger %OR% 0) %% 999999999 + 1
@@ -2432,12 +2435,12 @@ throttle <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
     if (is.null(v$lastTriggeredAt)) {
       0
     } else {
-      max(0, (v$lastTriggeredAt + millis()/1000) - Sys.time()) * 1000
+      max(0, (v$lastTriggeredAt + millis()/1000) - getTime(domain)) * 1000
     }
   }
 
   trigger <- function() {
-    v$lastTriggeredAt <- Sys.time()
+    v$lastTriggeredAt <- getTime(domain)
     # Mod by 999999999 to get predictable overflow behavior
     v$trigger <- isolate(v$trigger) %% 999999999 + 1
     v$pending <- FALSE

R/shiny-options.R

@@ -35,7 +35,7 @@ getShinyOption <- function(name, default = NULL) {
 #' `shinyOptions()`.
 #'
 #' \describe{
-#'   \item{shiny.autoreload}{If `TRUE` when a Shiny app is launched, the
+#'   \item{shiny.autoreload (defaults to `FALSE`)}{If `TRUE` when a Shiny app is launched, the
 #'     app directory will be continually monitored for changes to files that
 #'     have the extensions: r, htm, html, js, css, png, jpg, jpeg, gif. If any
 #'     changes are detected, all connected Shiny sessions are reloaded. This
@@ -51,62 +51,63 @@ getShinyOption <- function(name, default = NULL) {
 #'     The default polling interval is 500 milliseconds. You can change this
 #'     by setting e.g. `options(shiny.autoreload.interval = 2000)` (every
 #'     two seconds).}
-#'   \item{shiny.deprecation.messages}{This controls whether messages for
+#'   \item{shiny.deprecation.messages (defaults to `TRUE`)}{This controls whether messages for
 #'     deprecated functions in Shiny will be printed. See
 #'     [shinyDeprecated()] for more information.}
-#'   \item{shiny.error}{This can be a function which is called when an error
+#'   \item{shiny.error (defaults to `NULL`)}{This can be a function which is called when an error
 #'     occurs. For example, `options(shiny.error=recover)` will result a
 #'     the debugger prompt when an error occurs.}
-#'   \item{shiny.fullstacktrace}{Controls whether "pretty" or full stack traces
-#'     are dumped to the console when errors occur during Shiny app execution.
-#'     The default is `FALSE` (pretty stack traces).}
-#'   \item{shiny.host}{The IP address that Shiny should listen on. See
+#'   \item{shiny.fullstacktrace (defaults to `FALSE`)}{Controls whether "pretty" (`FALSE`) or full
+#'     stack traces (`TRUE`) are dumped to the console when errors occur during Shiny app execution.
+#'     Pretty stack traces attempt to only show user-supplied code, but this pruning can't always
+#'     be done 100\% correctly.}
+#'   \item{shiny.host (defaults to `"127.0.0.1"`)}{The IP address that Shiny should listen on. See
 #'     [runApp()] for more information.}
-#'   \item{shiny.json.digits}{The number of digits to use when converting
+#'   \item{shiny.jquery.version (defaults to `3`)}{The major version of jQuery to use.
+#'   Currently only values of `3` or `1` are supported. If `1`, then jQuery 1.12.4 is used. If `3`,
+#'   then jQuery 3.4.1 is used.}
+#'   \item{shiny.json.digits (defaults to `16`)}{The number of digits to use when converting
 #'     numbers to JSON format to send to the client web browser.}
-#'   \item{shiny.launch.browser}{A boolean which controls the default behavior
+#'   \item{shiny.launch.browser (defaults to `interactive()`)}{A boolean which controls the default behavior
 #'     when an app is run. See [runApp()] for more information.}
-#'   \item{shiny.maxRequestSize}{This is a number which specifies the maximum
-#'     web request size, which serves as a size limit for file uploads. If
-#'     unset, the maximum request size defaults to 5MB.}
-#'   \item{shiny.minified}{If this is `TRUE` or unset (the default), then
-#'     Shiny will use minified JavaScript (`shiny.min.js`). If
-#'     `FALSE`, then Shiny will use the un-minified JavaScript
-#'     (`shiny.js`); this can be useful during development.}
-#'   \item{shiny.port}{A port number that Shiny will listen on. See
+#'   \item{shiny.maxRequestSize (defaults to 5MB)}{This is a number which specifies the maximum
+#'     web request size, which serves as a size limit for file uploads.}
+#'   \item{shiny.minified (defaults to `TRUE`)}{By default
+#'     Whether or not to include Shiny's JavaScript as a minified (`shiny.min.js`)
+#'     or un-minified (`shiny.js`) file. The un-minified version is larger,
+#'     but can be helpful for development and debugging.}
+#'   \item{shiny.port (defaults to a random open port)}{A port number that Shiny will listen on. See
 #'     [runApp()] for more information.}
-#'   \item{shiny.reactlog}{If `TRUE`, enable logging of reactive events,
+#'   \item{shiny.reactlog (defaults to `FALSE`)}{If `TRUE`, enable logging of reactive events,
 #'     which can be viewed later with the [reactlogShow()] function.
 #'     This incurs a substantial performance penalty and should not be used in
 #'     production.}
-#'   \item{shiny.sanitize.errors}{If `TRUE`, then normal errors (i.e.
+#'   \item{shiny.sanitize.errors (defaults to `FALSE`)}{If `TRUE`, then normal errors (i.e.
 #'     errors not wrapped in `safeError`) won't show up in the app; a simple
 #'     generic error message is printed instead (the error and strack trace printed
-#'     to the console remain unchanged). The default is `FALSE` (unsanitized
-#'     errors).If you want to sanitize errors in general, but you DO want a
+#'     to the console remain unchanged). If you want to sanitize errors in general, but you DO want a
 #'     particular error `e` to get displayed to the user, then set this option
 #'     to `TRUE` and use `stop(safeError(e))` for errors you want the
 #'     user to see.}
-#'   \item{shiny.stacktraceoffset}{If `TRUE`, then Shiny's printed stack
+#'   \item{shiny.stacktraceoffset (defaults to `TRUE`)}{If `TRUE`, then Shiny's printed stack
 #'     traces will display srcrefs one line above their usual location. This is
 #'     an arguably more intuitive arrangement for casual R users, as the name
 #'     of a function appears next to the srcref where it is defined, rather than
 #'     where it is currently being called from.}
-#'   \item{shiny.suppressMissingContextError}{Normally, invoking a reactive
+#'   \item{shiny.suppressMissingContextError (defaults to `FALSE`)}{Normally, invoking a reactive
 #'     outside of a reactive context (or [isolate()]) results in
 #'     an error. If this is `TRUE`, don't error in these cases. This
 #'     should only be used for debugging or demonstrations of reactivity at the
 #'     console.}
-#'   \item{shiny.table.class}{CSS class names to use for tables.}
-#'   \item{shiny.testmode}{If `TRUE`, then enable features for testing Shiny
-#'     applications. If `FALSE` (the default), do not enable those features.}
-#'   \item{shiny.trace}{Print messages sent between the R server and the web
+#'   \item{shiny.testmode (defaults to `FALSE`)}{If `TRUE`, then various features for testing Shiny
+#'     applications are enabled.}
+#'   \item{shiny.trace (defaults to `FALSE`)}{Print messages sent between the R server and the web
 #'     browser client to the R console. This is useful for debugging. Possible
 #'     values are `"send"` (only print messages sent to the client),
 #'     `"recv"` (only print messages received by the server), `TRUE`
 #'     (print all messages), or `FALSE` (default; don't print any of these
 #'     messages).}
-#'   \item{shiny.usecairo}{This is used to disable graphical rendering by the
+#'   \item{shiny.usecairo (defaults to `TRUE`)}{This is used to disable graphical rendering by the
 #'     Cairo package, if it is installed. See [plotPNG()] for more
 #'     information.}
 #' }

R/shiny.R

@@ -723,6 +723,9 @@ ShinySession <- R6Class(
     requestFlush = function() {
       appsNeedingFlush$set(self$token, self)
     },
+    scheduleTask = function(millis, callback) {
+      scheduleTask(millis, callback)
+    },
     rootScope = function() {
       self
     },

R/shinyui.R

@@ -42,9 +42,28 @@ renderPage <- function(ui, connection, showcase=0, testMode=FALSE) {
     )
   }
 
+  jquery <- function() {
+    version <- getOption("shiny.jquery.version", 3)
+    if (version == 3) {
+      return(htmlDependency(
+        "jquery", "3.4.1",
+        c(href = "shared"),
+        script = "jquery.min.js"
+      ))
+    }
+    if (version == 1) {
+      return(htmlDependency(
+        "jquery", "1.12.4",
+        c(href = "shared/legacy"),
+        script = "jquery.min.js"
+      ))
+    }
+    stop("Unsupported version of jQuery: ", version)
+  }
+
   shiny_deps <- list(
     htmlDependency("json2", "2014.02.04", c(href="shared"), script = "json2-min.js"),
-    htmlDependency("jquery", "3.4.1", c(href="shared"), script = "jquery.min.js"),
+    jquery(),
     htmlDependency("shiny", utils::packageVersion("shiny"), c(href="shared"),
       script = if (getOption("shiny.minified", TRUE)) "shiny.min.js" else "shiny.js",
       stylesheet = "shiny.css")

R/test-module.R

@@ -0,0 +1,145 @@
+# Promise helpers taken from:
+#   https://github.com/rstudio/promises/blob/master/tests/testthat/common.R
+# Block until all pending later tasks have executed
+# FIXME: will this work with multiple promises pending in parallel?
+wait_for_it <- function() {
+  while (!later::loop_empty()) {
+    later::run_now()
+    Sys.sleep(0.1)
+  }
+}
+
+# Block until the promise is resolved/rejected. If resolved, return the value.
+# If rejected, throw (yes throw, not return) the error.
+#' @importFrom promises %...!%
+#' @importFrom promises %...>%
+extract <- function(promise) {
+  promise_value <- NULL
+  error <- NULL
+  promise %...>%
+    (function(value) promise_value <<- value) %...!%
+    (function(reason) error <<- reason)
+
+  wait_for_it()
+  if (!is.null(error))
+    stop(error)
+  else
+    promise_value
+}
+
+#' Test a shiny module
+#' @param module The module under test
+#' @param expr Test code containing expectations. The test expression will run
+#'   in the module's environment, meaning that the module's parameters (e.g.
+#'   `input`, `output`, and `session`) will be available along with any other
+#'   values created inside of the module.
+#' @param args A list of arguments to pass into the module beyond `input`,
+#'   `output`, and `session`.
+#' @param initialState A list describing the initial values for `input`. If no
+#'   initial state is given, `input` will initialize as an empty list.
+#' @param ... Additional named arguments to be passed on to the module function.
+#' @include mock-session.R
+#' @export
+testModule <- function(module, expr, args, ...) {
+  expr <- substitute(expr)
+  .testModule(module, expr, args, ...)
+}
+
+.testModule <- function(module, expr, args, ...) {
+  # Capture the environment from the module
+  # Inserts `session$env <- environment()` at the top of the function
+  fn_body <- body(module)
+  fn_body[seq(3, length(fn_body)+1)] <- fn_body[seq(2, length(fn_body))]
+  fn_body[[2]] <- quote(session$env <- environment())
+  body(module) <- fn_body
+
+  # Substitute expr for later evaluation
+  if (!is.call(expr)){
+    expr <- substitute(expr)
+  }
+
+  # Create a mock session
+  session <- MockShinySession$new()
+
+  # Parse the additional arguments
+  args <- list(...)
+  args[["input"]] <- session$input
+  args[["output"]] <- session$output
+  args[["session"]] <- session
+
+  # Initialize the module
+  isolate(
+    withReactiveDomain(
+      session,
+      withr::with_options(list(`shiny.allowoutputreads`=TRUE), {
+        # Remember that invoking this module implicitly assigns to `session$env`
+        # Also, assigning to `$returned` will cause a flush to happen automatically.
+        session$returned <- do.call(module, args)
+      })
+    )
+  )
+
+  # Run the test expression in a reactive context and in the module's environment.
+  # We don't need to flush before entering the loop because the first expr that we execute is `{`.
+  # So we'll already flush before we get to the good stuff.
+  isolate({
+    withReactiveDomain(
+      session,
+      withr::with_options(list(`shiny.allowoutputreads`=TRUE), {
+        eval(expr, session$env)
+      })
+    )
+  })
+
+  if (!session$isClosed()){
+    session$close()
+  }
+}
+
+#' Test an app's server-side logic
+#' @param expr Test code containing expectations
+#' @param appdir The directory root of the Shiny application. If `NULL`, this function
+#'   will work up the directory hierarchy --- starting with the current directory ---
+#'   looking for a directory that contains an `app.R` or `server.R` file.
+#' @export
+testServer <- function(expr, appDir=NULL) {
+  if (is.null(appDir)){
+    appDir <- findApp()
+  }
+
+  app <- shinyAppDir(appDir)
+  server <- app$serverFuncSource()
+
+  # Add `session` argument if not present
+  fn_formals <- formals(server)
+  if (! "session" %in% names(fn_formals)) {
+    fn_formals$session <- bquote()
+    formals(server) <- fn_formals
+  }
+
+  s3 <<- server
+  # Now test the server as we would a module
+  .testModule(server, expr=substitute(expr))
+}
+
+findApp <- function(startDir="."){
+  dir <- normalizePath(startDir)
+
+  # The loop will either return or stop() itself.
+  while (TRUE){
+    if(file.exists.ci(file.path(dir, "app.R")) || file.exists.ci(file.path(dir, "server.R"))){
+      return(dir)
+    }
+
+    # Move up a directory
+    origDir <- dir
+    dir <- dirname(dir)
+
+    # Testing for "root" path can be tricky. OSs differ and on Windows, network shares
+    # might have a \\ prefix. Easier to just see if we got stuck and abort.
+    if (dir == origDir){
+      # We can go no further.
+      stop("No shiny app was found in ", startDir, " or any of its parent directories")
+    }
+  }
+}

R/timer.R

@@ -1,10 +1,10 @@
 # Return the current time, in milliseconds from epoch, with
 # unspecified time zone.
-now <- function() {
+getNow <- function() {
   as.numeric(Sys.time()) * 1000
 }
 
-TimerCallbacks <- R6Class(
+BaseTimerCallbacks <- R6Class(
   'TimerCallbacks',
   portable = FALSE,
   class = FALSE,
@@ -12,9 +12,11 @@ TimerCallbacks <- R6Class(
     .nextId = 0L,
     .funcs = 'Map',
     .times = data.frame(),
+    .now = 'Function',
 
-    initialize = function() {
+    initialize = function(nowFn=getNow) {
       .funcs <<- Map$new()
+      .now <<- nowFn
     },
     clear = function() {
       .nextId <<- 0L
@@ -30,7 +32,7 @@ TimerCallbacks <- R6Class(
       id <- .nextId
       .nextId <<- .nextId + 1L
 
-      t <- now()
+      t <- .now()
 
       # TODO: Horribly inefficient, use a heap instead
       .times <<- rbind(.times, data.frame(time=t+millis,
@@ -56,17 +58,17 @@ TimerCallbacks <- R6Class(
     timeToNextEvent = function() {
       if (dim(.times)[1] == 0)
         return(Inf)
-      return(.times[1, 'time'] - now())
+      return(.times[1, 'time'] - .now())
     },
     takeElapsed = function() {
-      t <- now()
-      elapsed <- .times$time < now()
+      t <- .now()
+      elapsed <- .times$time <= t
       result <- .times[elapsed,]
       .times <<- .times[!elapsed,]
 
       # TODO: Examine scheduled column to check if any funny business
       #       has occurred with the system clock (e.g. if scheduled
-      #       is later than now())
+      #       is later than .now())
 
       return(result)
     },
@@ -86,6 +88,43 @@ TimerCallbacks <- R6Class(
   )
 )
 
+TimerCallbacks <- R6Class(
+  'TimerCallbacks',
+  inherit=BaseTimerCallbacks,
+  portable = FALSE,
+  class = FALSE,
+  public = list(
+    # Empty constructor defaults to the getNow implementation
+    initialize = function() {
+      super$initialize(getNow)
+    }
+  )
+)
+
+MockableTimerCallbacks <- R6Class(
+  'MockableTimerCallbacks',
+  inherit=BaseTimerCallbacks,
+  portable = FALSE,
+  class = FALSE,
+  public = list(
+    # Empty constructor defaults to the getNow implementation
+    initialize = function() {
+      super$initialize(self$now)
+    },
+    now = function(){
+      return(private$time)
+    },
+    elapse = function(millis){
+      private$time <<- private$time + millis
+    },
+    getElapsed = function(){
+      private$time
+    }
+  ), private = list(
+    time = 0L
+  )
+)
+
 timerCallbacks <- TimerCallbacks$new()
 
 scheduleTask <- function(millis, callback) {
@@ -96,3 +135,29 @@ scheduleTask <- function(millis, callback) {
     invisible(timerCallbacks$unschedule(id))
   }
 }
+
+#' Get a scheduler function for scheduling tasks. Give priority to the
+#' session scheduler, but if it doesn't exist, use the global one.
+#' @noRd
+defineScheduler <- function(session){
+  if (!is.null(session)){
+    if (!is.null(session$scheduleTask)){
+      return(session$scheduleTask)
+    }
+  }
+  scheduleTask
+}
+
+
+#' Get the current time a la `Sys.time()`. Prefer to get it via the
+#' `session$now()` function, but if that's not available, just return the
+#' current system time.
+#' @noRd
+getTime <- function(session){
+  if (!is.null(session)){
+    if (!is.null(session$now)){
+      return(session$now())
+    }
+  }
+  Sys.time()
+}

R/utils.R

@@ -800,7 +800,14 @@ dataTablesJSON <- function(data, req) {
 
   fdata <- unname(as.matrix(fdata))
   if (is.character(fdata) && q$escape != 'false') {
-    if (q$escape == 'true') fdata <- htmlEscape(fdata) else {
+    if (q$escape == 'true') {
+      # fdata must be a matrix at this point, and we need to preserve
+      # dimensions. Note that it could be a 1xn matrix.
+      dims <- dim(fdata)
+      fdata <- htmlEscape(fdata)
+      dim(fdata) <- dims
+
+    } else {
       k <- as.integer(strsplit(q$escape, ',')[[1]])
       # use seq_len() in case escape = negative indices, e.g. c(-1, -5)
       for (j in seq_len(ncol(fdata))[k]) fdata[, j] <- htmlEscape(fdata[, j])

README.md

@@ -61,7 +61,7 @@ The Javascript code in Shiny is minified using tools that run on Node.js. See th
 
 ## Guidelines for contributing
 
-We welcome contributions to the **shiny** package. Please see our [CONTRIBUTING.md](CONTRIBUTING.md) file for detailed guidelines of how to contribute.
+We welcome contributions to the **shiny** package. Please see our [CONTRIBUTING.md](https://github.com/rstudio/shiny/blob/master/.github/CONTRIBUTING.md) file for detailed guidelines of how to contribute.
 
 ## License
 

appveyor.yml

@@ -16,6 +16,9 @@ cache:
 # Adapt as necessary starting from here
 
 build_script:
+  - travis-tool.sh install_github rstudio/htmltools@rc-v0.4.0
+  - travis-tool.sh install_github rstudio/promises@rc-v1.1.0
+  - travis-tool.sh install_github r-lib/later@rc-v1.0.0
   - travis-tool.sh install_deps
 
 test_script:

inst/_pkgdown.yml

@@ -0,0 +1,222 @@
+# NOTE: The main Shiny site, https://shiny.rstudio.com/, is not a pkgdown site.
+# However, as part of the build process for that site
+# (rstudio/shiny-dev-center), we do use pkgdown to generate the function
+# reference index pages for each release. This file configures the look of
+# those pages for releases from 1.4 onward.  Prior to 1.4, staticdocs from
+# https://github.com/r-lib/pkgdown/releases/tag/old was used and
+# inst/staticdocs/index.r was its configuration.
+template:
+  # NOTE: These templates live in shiny-dev-center
+  path: _pkgdown_templates
+reference:
+  - title: UI Layout
+    desc: Functions for laying out the user interface for your application.
+    contents:
+      - absolutePanel
+      - bootstrapPage
+      - column
+      - conditionalPanel
+      - fillPage
+      - fillRow
+      - fixedPage
+      - fluidPage
+      - helpText
+      - icon
+      - navbarPage
+      - navlistPanel
+      - sidebarLayout
+      - tabPanel
+      - tabsetPanel
+      - titlePanel
+      - inputPanel
+      - flowLayout
+      - splitLayout
+      - verticalLayout
+      - wellPanel
+      - withMathJax
+  - title: UI Inputs
+    desc: Functions for creating user interface elements that prompt the user for input values or interaction.
+    contents:
+      - actionButton
+      - checkboxGroupInput
+      - checkboxInput
+      - dateInput
+      - dateRangeInput
+      - fileInput
+      - numericInput
+      - radioButtons
+      - selectInput
+      - varSelectInput
+      - sliderInput
+      - submitButton
+      - textInput
+      - textAreaInput
+      - passwordInput
+      - modalButton
+      - updateActionButton
+      - updateCheckboxGroupInput
+      - updateCheckboxInput
+      - updateDateInput
+      - updateDateRangeInput
+      - updateNumericInput
+      - updateRadioButtons
+      - updateSelectInput
+      - updateSliderInput
+      - updateTabsetPanel
+      - insertTab
+      - showTab
+      - updateTextInput
+      - updateTextAreaInput
+      - updateQueryString
+      - getQueryString
+  - title: UI Outputs
+    desc: Functions for creating user interface elements that, in conjunction with rendering functions, display different kinds of output from your application.
+    contents:
+      - htmlOutput
+      - plotOutput
+      - outputOptions
+      - tableOutput
+      - textOutput
+      - verbatimTextOutput
+      - downloadButton
+      - Progress
+      - withProgress
+      - modalDialog
+      - urlModal
+      - showModal
+      - showNotification
+  - title: Interface builder functions
+    desc: A sub-library for writing HTML using R functions. These functions form the foundation on which the higher level user interface functions are built, and can also be used in your Shiny UI to provide custom HTML, CSS, and JavaScript.
+    contents:
+      - builder
+      - HTML
+      - include
+      - singleton
+      - tag
+      - validateCssUnit
+      - withTags
+      - htmlTemplate
+      - bootstrapLib
+      - suppressDependencies
+      - insertUI
+      - removeUI
+  - title: Rendering functions
+    desc: Functions that you use in your application's server side code, assigning them to outputs that appear in your user interface.
+    contents:
+      - renderPlot
+      - renderCachedPlot
+      - renderText
+      - renderPrint
+      - renderDataTable
+      - renderImage
+      - renderTable
+      - renderUI
+      - downloadHandler
+      - createRenderFunction
+  - title: Reactive programming
+    desc: A sub-library that provides reactive programming facilities for R.
+    contents:
+      - reactive
+      - observe
+      - observeEvent
+      - reactiveVal
+      - reactiveValues
+      - reactiveValuesToList
+      - is.reactivevalues
+      - isolate
+      - invalidateLater
+      - debounce
+      - reactlog
+      - makeReactiveBinding
+      - reactiveFileReader
+      - reactivePoll
+      - reactiveTimer
+      - domains
+      - freezeReactiveValue
+  - title: Boilerplate
+    desc: Functions that are required boilerplate in ui.R and server.R.
+    contents:
+      - shinyUI
+      - shinyServer
+  - title: Running
+    desc: Functions that are used to run or stop Shiny applications.
+    contents:
+      - runApp
+      - runGadget
+      - runExample
+      - runGadget
+      - runUrl
+      - stopApp
+      - viewer
+      - isRunning
+      - loadSupport
+  - title: Bookmarking state
+    desc: Functions that are used for bookmarking and restoring state.
+    contents:
+      - bookmarkButton
+      - enableBookmarking
+      - setBookmarkExclude
+      - showBookmarkUrlModal
+      - onBookmark
+  - title: Extending Shiny
+    desc: Functions that are intended to be called by third-party packages that extend Shiny.
+    contents:
+      - createWebDependency
+      - resourcePaths
+      - registerInputHandler
+      - removeInputHandler
+      - markRenderFunction
+  - title: Utility functions
+    desc: Miscellaneous utilities that may be useful to advanced users or when extending Shiny.
+    contents:
+      - req
+      - validate
+      - session
+      - shinyOptions
+      - safeError
+      - onFlush
+      - restoreInput
+      - applyInputHandlers
+      - exprToFunction
+      - installExprFunction
+      - parseQueryString
+      - getCurrentOutputInfo
+      - plotPNG
+      - sizeGrowthRatio
+      - exportTestValues
+      - setSerializer
+      - snapshotExclude
+      - snapshotPreprocessInput
+      - snapshotPreprocessOutput
+      - markOutputAttrs
+      - repeatable
+      - shinyDeprecated
+      - serverInfo
+      - onStop
+      - diskCache
+      - memoryCache
+      - reexports
+  - title: Plot interaction
+    desc: Functions related to interactive plots
+    contents:
+      - brushedPoints
+      - brushOpts
+      - clickOpts
+      - dblclickOpts
+      - hoverOpts
+      - nearPoints
+  - title: Modules
+    desc: Functions for modularizing Shiny apps
+    contents:
+      - NS
+      - callModule
+  - title: Embedding
+    desc: Functions that are intended for third-party packages that embed Shiny applications.
+    contents:
+      - shinyApp
+      - maskReactiveContext
+  - title: Testing
+    desc: Functions intended for testing of Shiny components
+    contents:
+      - testModule
+      - testServer

inst/staticdocs/index.r

@@ -1,234 +0,0 @@
-sd_section("UI Layout",
-  "Functions for laying out the user interface for your application.",
-  c(
-    "absolutePanel",
-    "bootstrapPage",
-    "column",
-    "conditionalPanel",
-    "fillPage",
-    "fillRow",
-    "fixedPage",
-    "fluidPage",
-    "helpText",
-    "icon",
-    "navbarPage",
-    "navlistPanel",
-    "sidebarLayout",
-    "tabPanel",
-    "tabsetPanel",
-    "titlePanel",
-    "inputPanel",
-    "flowLayout",
-    "splitLayout",
-    "verticalLayout",
-    "wellPanel",
-    "withMathJax"
-  )
-)
-sd_section("UI Inputs",
-  "Functions for creating user interface elements that prompt the user for input values or interaction.",
-  c(
-    "actionButton",
-    "checkboxGroupInput",
-    "checkboxInput",
-    "dateInput",
-    "dateRangeInput",
-    "fileInput",
-    "numericInput",
-    "radioButtons",
-    "selectInput",
-    "varSelectInput",
-    "sliderInput",
-    "submitButton",
-    "textInput",
-    "textAreaInput",
-    "passwordInput",
-    "modalButton",
-    "updateActionButton",
-    "updateCheckboxGroupInput",
-    "updateCheckboxInput",
-    "updateDateInput",
-    "updateDateRangeInput",
-    "updateNumericInput",
-    "updateRadioButtons",
-    "updateSelectInput",
-    "updateSliderInput",
-    "updateTabsetPanel",
-    "insertTab",
-    "showTab",
-    "updateTextInput",
-    "updateTextAreaInput",
-    "updateQueryString",
-    "getQueryString"
-  )
-)
-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",
-    "plotOutput",
-    "outputOptions",
-    "tableOutput",
-    "textOutput",
-    "verbatimTextOutput",
-    "downloadButton",
-    "Progress",
-    "withProgress",
-    "modalDialog",
-    "urlModal",
-    "showModal",
-    "showNotification"
-  )
-)
-sd_section("Interface builder functions",
-  "A sub-library for writing HTML using R functions. These functions form the foundation on which the higher level user interface functions are built, and can also be used in your Shiny UI to provide custom HTML, CSS, and JavaScript.",
-  c(
-    "builder",
-    "HTML",
-    "include",
-    "singleton",
-    "tag",
-    "validateCssUnit",
-    "withTags",
-    "htmlTemplate",
-    "bootstrapLib",
-    "suppressDependencies",
-    "insertUI",
-    "removeUI"
-  )
-)
-sd_section("Rendering functions",
-  "Functions that you use in your application's server side code, assigning them to outputs that appear in your user interface.",
-  c(
-    "renderPlot",
-    "renderCachedPlot",
-    "renderText",
-    "renderPrint",
-    "renderDataTable",
-    "renderImage",
-    "renderTable",
-    "renderUI",
-    "downloadHandler",
-    "createRenderFunction"
-  )
-)
-sd_section("Reactive programming",
-  "A sub-library that provides reactive programming facilities for R.",
-  c(
-    "reactive",
-    "observe",
-    "observeEvent",
-    "reactiveVal",
-    "reactiveValues",
-    "reactiveValuesToList",
-    "is.reactivevalues",
-    "isolate",
-    "invalidateLater",
-    "debounce",
-    "reactlog",
-    "makeReactiveBinding",
-    "reactiveFileReader",
-    "reactivePoll",
-    "reactiveTimer",
-    "domains",
-    "freezeReactiveValue"
-  )
-)
-sd_section("Boilerplate",
-  "Functions that are required boilerplate in ui.R and server.R.",
-  c(
-    "shinyUI",
-    "shinyServer"
-  )
-)
-sd_section("Running",
-  "Functions that are used to run or stop Shiny applications.",
-  c(
-    "runApp",
-    "runGadget",
-    "runExample",
-    "runGadget",
-    "runUrl",
-    "stopApp",
-    "viewer",
-    "isRunning",
-    "loadSupport"
-  )
-)
-sd_section("Bookmarking state",
-  "Functions that are used for bookmarking and restoring state.",
-  c(
-    "bookmarkButton",
-    "enableBookmarking",
-    "setBookmarkExclude",
-    "showBookmarkUrlModal",
-    "onBookmark"
-  )
-)
-sd_section("Extending Shiny",
-  "Functions that are intended to be called by third-party packages that extend Shiny.",
-  c(
-    "createWebDependency",
-    "resourcePaths",
-    "registerInputHandler",
-    "removeInputHandler",
-    "markRenderFunction"
-  )
-)
-sd_section("Utility functions",
-  "Miscellaneous utilities that may be useful to advanced users or when extending Shiny.",
-  c(
-    "req",
-    "validate",
-    "session",
-    "shinyOptions",
-    "safeError",
-    "onFlush",
-    "restoreInput",
-    "applyInputHandlers",
-    "exprToFunction",
-    "installExprFunction",
-    "parseQueryString",
-    "getCurrentOutputInfo",
-    "plotPNG",
-    "sizeGrowthRatio",
-    "exportTestValues",
-    "setSerializer",
-    "snapshotExclude",
-    "snapshotPreprocessInput",
-    "snapshotPreprocessOutput",
-    "markOutputAttrs",
-    "repeatable",
-    "shinyDeprecated",
-    "serverInfo",
-    "onStop",
-    "diskCache",
-    "memoryCache",
-    "reexports"
-  )
-)
-sd_section("Plot interaction",
-  "Functions related to interactive plots",
-  c(
-    "brushedPoints",
-    "brushOpts",
-    "clickOpts",
-    "dblclickOpts",
-    "hoverOpts",
-    "nearPoints"
-  )
-)
-sd_section("Modules",
-  "Functions for modularizing Shiny apps",
-  c(
-    "NS",
-    "callModule"
-  )
-)
-sd_section("Embedding",
-  "Functions that are intended for third-party packages that embed Shiny applications.",
-  c(
-    "shinyApp",
-    "maskReactiveContext"
-  )
-)

inst/www/shared/legacy/jquery-AUTHORS.txt

@@ -0,0 +1,266 @@
+Authors ordered by first contribution.
+
+John Resig <jeresig@gmail.com>
+Gilles van den Hoven <gilles0181@gmail.com>
+Michael Geary <mike@geary.com>
+Stefan Petre <stefan.petre@gmail.com>
+Yehuda Katz <wycats@gmail.com>
+Corey Jewett <cj@syntheticplayground.com>
+Klaus Hartl <klaus.hartl@googlemail.com>
+Franck Marcia <franck.marcia@gmail.com>
+Jörn Zaefferer <joern.zaefferer@gmail.com>
+Paul Bakaus <paul.bakaus@googlemail.com>
+Brandon Aaron <brandon.aaron@gmail.com>
+Mike Alsup <malsup@gmail.com>
+Dave Methvin <dave.methvin@gmail.com>
+Ed Engelhardt <edengelhardt@gmail.com>
+Sean Catchpole <littlecooldude@gmail.com>
+Paul Mclanahan <pmclanahan@gmail.com>
+David Serduke <davidserduke@gmail.com>
+Richard D. Worth <rdworth@gmail.com>
+Scott González <scott.gonzalez@gmail.com>
+Ariel Flesler <aflesler@gmail.com>
+Jon Evans <jon@springyweb.com>
+TJ Holowaychuk <tj@vision-media.ca>
+Michael Bensoussan <mickey@seesmic.com>
+Robert Katić <robert.katic@gmail.com>
+Louis-Rémi Babé <lrbabe@gmail.com>
+Earle Castledine <mrspeaker@gmail.com>
+Damian Janowski <damian.janowski@gmail.com>
+Rich Dougherty <rich@rd.gen.nz>
+Kim Dalsgaard <kim@kimdalsgaard.com>
+Andrea Giammarchi <andrea.giammarchi@gmail.com>
+Mark Gibson <jollytoad@gmail.com>
+Karl Swedberg <kswedberg@gmail.com>
+Justin Meyer <justinbmeyer@gmail.com>
+Ben Alman <cowboy@rj3.net>
+James Padolsey <cla@padolsey.net>
+David Petersen <public@petersendidit.com>
+Batiste Bieler <batiste.bieler@gmail.com>
+Alexander Farkas <info@corrupt-system.de>
+Rick Waldron <waldron.rick@gmail.com>
+Filipe Fortes <filipe@fortes.com>
+Neeraj Singh <neerajdotname@gmail.com>
+Paul Irish <paul.irish@gmail.com>
+Iraê Carvalho <irae@irae.pro.br>
+Matt Curry <matt@pseudocoder.com>
+Michael Monteleone <michael@michaelmonteleone.net>
+Noah Sloan <noah.sloan@gmail.com>
+Tom Viner <github@viner.tv>
+Douglas Neiner <doug@pixelgraphics.us>
+Adam J. Sontag <ajpiano@ajpiano.com>
+Dave Reed <dareed@microsoft.com>
+Ralph Whitbeck <ralph.whitbeck@gmail.com>
+Carl Fürstenberg <azatoth@gmail.com>
+Jacob Wright <jacwright@gmail.com>
+J. Ryan Stinnett <jryans@gmail.com>
+unknown <Igen005@.upcorp.ad.uprr.com>
+temp01 <temp01irc@gmail.com>
+Heungsub Lee <h@subl.ee>
+Colin Snover <colin@alpha.zetafleet.com>
+Ryan W Tenney <ryan@10e.us>
+Pinhook <contact@pinhooklabs.com>
+Ron Otten <r.j.g.otten@gmail.com>
+Jephte Clain <Jephte.Clain@univ-reunion.fr>
+Anton Matzneller <obhvsbypqghgc@gmail.com>
+Alex Sexton <AlexSexton@gmail.com>
+Dan Heberden <danheberden@gmail.com>
+Henri Wiechers <hwiechers@gmail.com>
+Russell Holbrook <russell.holbrook@patch.com>
+Julian Aubourg <aubourg.julian@gmail.com>
+Gianni Alessandro Chiappetta <gianni@runlevel6.org>
+Scott Jehl <scott@scottjehl.com>
+James Burke <jrburke@gmail.com>
+Jonas Pfenniger <jonas@pfenniger.name>
+Xavi Ramirez <xavi.rmz@gmail.com>
+Jared Grippe <jared@deadlyicon.com>
+Sylvester Keil <sylvester@keil.or.at>
+Brandon Sterne <bsterne@mozilla.com>
+Mathias Bynens <mathias@qiwi.be>
+Timmy Willison <timmywillisn@gmail.com>
+Corey Frang <gnarf@gnarf.net>
+Digitalxero <digitalxero>
+Anton Kovalyov <anton@kovalyov.net>
+David Murdoch <musicisair@yahoo.com>
+Josh Varner <josh.varner@gmail.com>
+Charles McNulty <cmcnulty@kznf.com>
+Jordan Boesch <jboesch26@gmail.com>
+Jess Thrysoee <jess@thrysoee.dk>
+Michael Murray <m@murz.net>
+Lee Carpenter <elcarpie@gmail.com>
+Alexis Abril <me@alexisabril.com>
+Rob Morgan <robbym@gmail.com>
+John Firebaugh <john_firebaugh@bigfix.com>
+Sam Bisbee <sam@sbisbee.com>
+Gilmore Davidson <gilmoreorless@gmail.com>
+Brian Brennan <me@brianlovesthings.com>
+Xavier Montillet <xavierm02.net@gmail.com>
+Daniel Pihlstrom <sciolist.se@gmail.com>
+Sahab Yazdani <sahab.yazdani+github@gmail.com>
+avaly <github-com@agachi.name>
+Scott Hughes <hi@scott-hughes.me>
+Mike Sherov <mike.sherov@gmail.com>
+Greg Hazel <ghazel@gmail.com>
+Schalk Neethling <schalk@ossreleasefeed.com>
+Denis Knauf <Denis.Knauf@gmail.com>
+Timo Tijhof <krinklemail@gmail.com>
+Steen Nielsen <swinedk@gmail.com>
+Anton Ryzhov <anton@ryzhov.me>
+Shi Chuan <shichuanr@gmail.com>
+Berker Peksag <berker.peksag@gmail.com>
+Toby Brain <tobyb@freshview.com>
+Matt Mueller <mattmuelle@gmail.com>
+Justin <drakefjustin@gmail.com>
+Daniel Herman <daniel.c.herman@gmail.com>
+Oleg Gaidarenko <markelog@gmail.com>
+Richard Gibson <richard.gibson@gmail.com>
+Rafaël Blais Masson <rafbmasson@gmail.com>
+cmc3cn <59194618@qq.com>
+Joe Presbrey <presbrey@gmail.com>
+Sindre Sorhus <sindresorhus@gmail.com>
+Arne de Bree <arne@bukkie.nl>
+Vladislav Zarakovsky <vlad.zar@gmail.com>
+Andrew E Monat <amonat@gmail.com>
+Oskari <admin@o-programs.com>
+Joao Henrique de Andrade Bruni <joaohbruni@yahoo.com.br>
+tsinha <tsinha@Anthonys-MacBook-Pro.local>
+Matt Farmer <matt@frmr.me>
+Trey Hunner <treyhunner@gmail.com>
+Jason Moon <jmoon@socialcast.com>
+Jeffery To <jeffery.to@gmail.com>
+Kris Borchers <kris.borchers@gmail.com>
+Vladimir Zhuravlev <private.face@gmail.com>
+Jacob Thornton <jacobthornton@gmail.com>
+Chad Killingsworth <chadkillingsworth@missouristate.edu>
+Nowres Rafid <nowres.rafed@gmail.com>
+David Benjamin <davidben@mit.edu>
+Uri Gilad <antishok@gmail.com>
+Chris Faulkner <thefaulkner@gmail.com>
+Elijah Manor <elijah.manor@gmail.com>
+Daniel Chatfield <chatfielddaniel@gmail.com>
+Nikita Govorov <nikita.govorov@gmail.com>
+Wesley Walser <wwalser@atlassian.com>
+Mike Pennisi <mike@mikepennisi.com>
+Markus Staab <markus.staab@redaxo.de>
+Dave Riddle <david@joyvuu.com>
+Callum Macrae <callum@lynxphp.com>
+Benjamin Truyman <bentruyman@gmail.com>
+James Huston <james@jameshuston.net>
+Erick Ruiz de Chávez <erickrdch@gmail.com>
+David Bonner <dbonner@cogolabs.com>
+Akintayo Akinwunmi <aakinwunmi@judge.com>
+MORGAN <morgan@morgangraphics.com>
+Ismail Khair <ismail.khair@gmail.com>
+Carl Danley <carldanley@gmail.com>
+Mike Petrovich <michael.c.petrovich@gmail.com>
+Greg Lavallee <greglavallee@wapolabs.com>
+Daniel Gálvez <dgalvez@editablething.com>
+Sai Lung Wong <sai.wong@huffingtonpost.com>
+Tom H Fuertes <TomFuertes@gmail.com>
+Roland Eckl <eckl.roland@googlemail.com>
+Jay Merrifield <fracmak@gmail.com>
+Allen J Schmidt Jr <cobrasoft@gmail.com>
+Jonathan Sampson <jjdsampson@gmail.com>
+Marcel Greter <marcel.greter@ocbnet.ch>
+Matthias Jäggli <matthias.jaeggli@gmail.com>
+David Fox <dfoxinator@gmail.com>
+Yiming He <yiminghe@gmail.com>
+Devin Cooper <cooper.semantics@gmail.com>
+Paul Ramos <paul.b.ramos@gmail.com>
+Rod Vagg <rod@vagg.org>
+Bennett Sorbo <bsorbo@gmail.com>
+Sebastian Burkhard <sebi.burkhard@gmail.com>
+nanto <nanto@moon.email.ne.jp>
+Danil Somsikov <danilasomsikov@gmail.com>
+Ryunosuke SATO <tricknotes.rs@gmail.com>
+Jean Boussier <jean.boussier@gmail.com>
+Adam Coulombe <me@adam.co>
+Andrew Plummer <plummer.andrew@gmail.com>
+Mark Raddatz <mraddatz@gmail.com>
+Dmitry Gusev <dmitry.gusev@gmail.com>
+Michał Gołębiowski <m.goleb@gmail.com>
+Nguyen Phuc Lam <ruado1987@gmail.com>
+Tom H Fuertes <tomfuertes@gmail.com>
+Brandon Johnson <bjohn465+github@gmail.com>
+Jason Bedard <jason+jquery@jbedard.ca>
+Kyle Robinson Young <kyle@dontkry.com>
+Renato Oliveira dos Santos <ros3@cin.ufpe.br>
+Chris Talkington <chris@talkingtontech.com>
+Eddie Monge <eddie@eddiemonge.com>
+Terry Jones <terry@jon.es>
+Jason Merino <jasonmerino@gmail.com>
+Jeremy Dunck <jdunck@gmail.com>
+Chris Price <price.c@gmail.com>
+Amey Sakhadeo <me@ameyms.com>
+Anthony Ryan <anthonyryan1@gmail.com>
+Dominik D. Geyer <dominik.geyer@gmail.com>
+George Kats <katsgeorgeek@gmail.com>
+Lihan Li <frankieteardrop@gmail.com>
+Ronny Springer <springer.ronny@gmail.com>
+Marian Sollmann <marian.sollmann@cargomedia.ch>
+Corey Frang <gnarf37@gmail.com>
+Chris Antaki <ChrisAntaki@gmail.com>
+Noah Hamann <njhamann@gmail.com>
+David Hong <d.hong@me.com>
+Jakob Stoeck <jakob@pokermania.de>
+Christopher Jones <christopherjonesqed@gmail.com>
+Forbes Lindesay <forbes@lindesay.co.uk>
+John Paul <john@johnkpaul.com>
+S. Andrew Sheppard <andrew@wq.io>
+Leonardo Balter <leonardo.balter@gmail.com>
+Roman Reiß <me@silverwind.io>
+Benjy Cui <benjytrys@gmail.com>
+Rodrigo Rosenfeld Rosas <rr.rosas@gmail.com>
+John Hoven <hovenj@gmail.com>
+Christian Kosmowski <ksmwsk@gmail.com>
+Liang Peng <poppinlp@gmail.com>
+TJ VanToll <tj.vantoll@gmail.com>
+Senya Pugach <upisfree@outlook.com>
+Aurelio De Rosa <aurelioderosa@gmail.com>
+Nazar Mokrynskyi <nazar@mokrynskyi.com>
+Arthur Verschaeve <contact@arthurverschaeve.be>
+Dan Hart <danhart@notonthehighstreet.com>
+Scott González <scott.gonzalez@gmail.com>
+Zheming Sun <mescodasun@gmail.com>
+Bin Xin <rhyzix@gmail.com>
+David Corbacho <davidcorbacho@gmail.com>
+Veaceslav Grimalschi <grimalschi@yandex.ru>
+Daniel Husar <dano.husar@gmail.com>
+Jason Bedard <jason+github@jbedard.ca>
+Ben Toews <mastahyeti@gmail.com>
+Aditya Raghavan <araghavan3@gmail.com>
+Nicolas HENRY <icewil@gmail.com>
+Norman Xu <homyu.shinn@gmail.com>
+Anne-Gaelle Colom <coloma@westminster.ac.uk>
+Victor Homyakov <vkhomyackov@gmail.com>
+George Mauer <gmauer@gmail.com>
+Leonardo Braga <leonardo.braga@gmail.com>
+Stephen Edgar <stephen@netweb.com.au>
+Thomas Tortorini <thomastortorini@gmail.com>
+Winston Howes <winstonhowes@gmail.com>
+Jon Hester <jon.d.hester@gmail.com>
+Alexander O'Mara <me@alexomara.com>
+Bastian Buchholz <buchholz.bastian@googlemail.com>
+Arthur Stolyar <nekr.fabula@gmail.com>
+Calvin Metcalf <calvin.metcalf@gmail.com>
+Mu Haibao <mhbseal@163.com>
+Richard McDaniel <rm0026@uah.edu>
+Chris Rebert <github@rebertia.com>
+Gilad Peleg <giladp007@gmail.com>
+Martin Naumann <martin@geekonaut.de>
+Bruno Pérel <brunoperel@gmail.com>
+Reed Loden <reed@reedloden.com>
+Daniel Nill <daniellnill@gmail.com>
+Yongwoo Jeon <yongwoo.jeon@navercorp.com>
+Sean Henderson <seanh.za@gmail.com>
+Adrian Olek <adrianolek@gmail.com>
+Richard Kraaijenhagen <stdin+git@riichard.com>
+Gary Ye <garysye@gmail.com>
+Christian Grete <webmaster@christiangrete.com>
+Liza Ramo <liza.h.ramo@gmail.com>
+Joelle Fleurantin <joasqueeniebee@gmail.com>
+Julian Alexander Murillo <julian.alexander.murillo@gmail.com>
+Jun Sun <klsforever@gmail.com>
+Devin Wilson <dwilson6.github@gmail.com>
+Todor Prikumov <tono_pr@abv.bg>
+Zack Hall <zackhall@outlook.com>

inst/www/shared/shiny-showcase.js

@@ -83,6 +83,8 @@
       el.id = "srcref_" + srcref;
       var ref = srcref;
       var code = document.getElementById(srcfile.replace(/\./g, "_") + "_code");
+      // if there is no code file (might be a shiny file), quit early
+      if (!code) return;
       var start = findTextPoint(code, ref[0], ref[4]);
       var end = findTextPoint(code, ref[2], ref[5]);
 
@@ -148,6 +150,8 @@
       }
     }
 
+    // hide the new element before doing anything to it
+    $(newHostElement).hide();
     $(currentHostElement).fadeOut(animateCodeMs, function() {
       var tabs = document.getElementById("showcase-code-tabs");
       currentHostElement.removeChild(tabs);
@@ -160,7 +164,7 @@
         document.getElementById("showcase-code-content").removeAttribute("style");
       }
 
-      $(newHostElement).fadeIn();
+      $(newHostElement).fadeIn(animateCodeMs);
       if (!above) {
         // remove the applied width and zoom on the app container, and
         // scroll smoothly down to the code's new home
@@ -189,7 +193,6 @@
     if (above) {
       $(document.body).animate({ scrollTop: 0 }, animateCodeMs);
     }
-    $(newHostElement).hide();
     isCodeAbove = above;
     setAppCodeSxsWidths(above && animate);
     $(window).trigger("resize");

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.9001"; // Version number inserted by Grunt
+  exports.version = "1.4.0.9000"; // Version number inserted by Grunt
 
   var origPushState = window.history.pushState;
   window.history.pushState = function () {
@@ -611,7 +611,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
         return;
       }
       this.lastSentValues[inputName] = { jsonValue: jsonValue, inputType: inputType };
-      this.target.setInput(name, value, opts);
+      this.target.setInput(nameType, value, opts);
     };
     this.reset = function () {
       var values = arguments.length > 0 && arguments[0] !== undefined ? arguments[0] : {};
@@ -626,10 +626,10 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
       for (var inputName in values) {
         if (values.hasOwnProperty(inputName)) {
           var _splitInputNameType2 = splitInputNameType(inputName),
-              _name = _splitInputNameType2.name,
+              name = _splitInputNameType2.name,
               inputType = _splitInputNameType2.inputType;
 
-          cacheValues[_name] = {
+          cacheValues[name] = {
             jsonValue: JSON.stringify(values[inputName]),
             inputType: inputType
           };
@@ -658,7 +658,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
       $(opts.el).trigger(evt);
 
       if (!evt.isDefaultPrevented()) {
-        name = evt.name;
+        var name = evt.name;
         if (evt.inputType !== '') name += ':' + evt.inputType;
 
         // Most opts aren't passed along to lower levels in the input decorator
@@ -713,13 +713,16 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
   };
   (function () {
     this.setInput = function (nameType, value, opts) {
-      if (/^\./.test(nameType)) this.target.setInput(nameType, value, opts);else this.pendingInput[name] = { value: value, opts: opts };
+      if (/^\./.test(nameType)) this.target.setInput(nameType, value, opts);else this.pendingInput[nameType] = { value: value, opts: opts };
     };
     this.submit = function () {
-      for (var name in this.pendingInput) {
-        if (this.pendingInput.hasOwnProperty(name)) {
-          var input = this.pendingInput[name];
-          this.target.setInput(name, input.value, input.opts);
+      for (var nameType in this.pendingInput) {
+        if (this.pendingInput.hasOwnProperty(nameType)) {
+          var _pendingInput$nameTyp = this.pendingInput[nameType],
+              value = _pendingInput$nameTyp.value,
+              opts = _pendingInput$nameTyp.opts;
+
+          this.target.setInput(nameType, value, opts);
         }
       }
     };
@@ -2999,9 +3002,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
       var e2 = $.Event(newEventType, {
         which: e.which,
         pageX: e.pageX,
-        pageY: e.pageY,
-        offsetX: e.offsetX,
-        offsetY: e.offsetY
+        pageY: e.pageY
       });
 
       $el.trigger(e2);
@@ -3048,7 +3049,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
         // If second click is too far away, it doesn't count as a double
         // click. Instead, immediately trigger a mousedown2 for the previous
         // click, and set this click as a new first click.
-        if (pending_e && Math.abs(pending_e.offsetX - e.offsetX) > 2 || Math.abs(pending_e.offsetY - e.offsetY) > 2) {
+        if (pending_e && Math.abs(pending_e.pageX - e.pageX) > 2 || Math.abs(pending_e.pageY - e.pageY) > 2) {
 
           triggerPendingMousedown2();
           scheduleMousedown2(e);
@@ -6593,7 +6594,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
     initialValues['.clientdata_url_hash'] = window.location.hash;
 
     $(window).on('hashchange', function (e) {
-      inputs.setInput('.clientdata_url_hash', location.hash);
+      inputs.setInput('.clientdata_url_hash', window.location.hash);
     });
 
     // The server needs to know what singletons were rendered as part of
@@ -6659,7 +6660,16 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
   });
 
   $(document).on('keydown', function (e) {
-    if (e.which !== 115 || !e.ctrlKey && !e.metaKey || e.shiftKey || e.altKey) return;
+    if (
+    // if not one of the key combos below
+    !(
+    // cmd/ctrl + fn + f4
+    e.which === 115 && (e.ctrlKey || e.metaKey) && !e.shiftKey && !e.altKey ||
+    // cmd/ctrl + shift + fn + f3
+    e.which === 114 && (e.ctrlKey || e.metaKey) && e.shiftKey && !e.altKey)) {
+      return;
+    }
+
     var url = 'reactlog/mark?w=' + window.escape(exports.shinyapp.config.workerId) + "&s=" + window.escape(exports.shinyapp.config.sessionId);
 
     // send notification
@@ -6672,6 +6682,9 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
         html: html,
         closeButton: true
       });
+    }).fail(function () {
+      // found returned error while marking, should open webpage
+      window.open(url);
     });
 
     e.preventDefault();

man/actionButton.Rd

@@ -26,6 +26,17 @@ see \code{\link[=validateCssUnit]{validateCssUnit()}}.}
 Creates an action button or link whose value is initially zero, and increments by one
 each time it is pressed.
 }
+\section{Server value}{
+
+An integer of class \code{"shinyActionButtonValue"}. This class differs from
+ordinary integers in that a value of 0 is considered "falsy".
+This implies two things:
+\itemize{
+\item Event handlers (e.g., \code{\link[=observeEvent]{observeEvent()}}, \code{\link[=eventReactive]{eventReactive()}}) won't execute on initial load.
+\item Input validation (e.g., \code{\link[=req]{req()}}, \code{\link[=need]{need()}}) will fail on initial load.
+}
+}
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {

man/bootstrapPage.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/bootstrap-deprecated.R
+% Please edit documentation in R/bootstrap.R
 \name{bootstrapPage}
 \alias{bootstrapPage}
 \alias{basicPage}
@@ -24,9 +24,20 @@ www directory, e.g. \code{www/bootstrap.css})}
 A UI defintion that can be passed to the \link{shinyUI} function.
 }
 \description{
-\strong{DEPRECATED}: use \code{\link[=fluidPage]{fluidPage()}} instead.
+Create a Shiny UI page that loads the CSS and JavaScript for
+\href{http://getbootstrap.com/}{Bootstrap}, and has no content in the page
+body (other than what you provide).
+}
+\details{
+This function is primarily intended for users who are proficient in HTML/CSS,
+and know how to lay out pages in Bootstrap. Most applications should use
+\code{\link[=fluidPage]{fluidPage()}} along with layout functions like
+\code{\link[=fluidRow]{fluidRow()}} and \code{\link[=sidebarLayout]{sidebarLayout()}}.
+}
+\note{
+The \code{basicPage} function is deprecated, you should use the
+\code{\link[=fluidPage]{fluidPage()}} function instead.
 }
 \seealso{
 \code{\link[=fluidPage]{fluidPage()}}, \code{\link[=fixedPage]{fixedPage()}}
 }
-\keyword{internal}

man/checkboxGroupInput.Rd

@@ -44,6 +44,11 @@ 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.
 }
+\section{Server value}{
+
+Character vector of values corresponding to the boxes that are checked.
+}
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {

man/checkboxInput.Rd

@@ -22,6 +22,11 @@ A checkbox control that can be added to a UI definition.
 \description{
 Create a checkbox that can be used to specify logical values.
 }
+\section{Server value}{
+
+\code{TRUE} if checked, \code{FALSE} otherwise.
+}
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {
@@ -35,6 +40,7 @@ server <- function(input, output) {
 }
 shinyApp(ui, server)
 }
+
 }
 \seealso{
 \code{\link[=checkboxGroupInput]{checkboxGroupInput()}}, \code{\link[=updateCheckboxInput]{updateCheckboxInput()}}

man/dateInput.Rd

@@ -75,6 +75,11 @@ the browser. It allows the following values:
 \item \code{DD} Full weekday name
 }
 }
+\section{Server value}{
+
+A \link{Date} vector of length 1.
+}
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {
@@ -110,6 +115,7 @@ ui <- fluidPage(
 
 shinyApp(ui, server = function(input, output) { })
 }
+
 }
 \seealso{
 \code{\link[=dateRangeInput]{dateRangeInput()}}, \code{\link[=updateDateInput]{updateDateInput()}}

man/dateRangeInput.Rd

@@ -75,6 +75,11 @@ the browser. It allows the following values:
 \item \code{DD} Full weekday name
 }
 }
+\section{Server value}{
+
+A \link{Date} vector of length 2.
+}
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {
@@ -114,6 +119,7 @@ ui <- fluidPage(
 
 shinyApp(ui, server = function(input, output) { })
 }
+
 }
 \seealso{
 \code{\link[=dateInput]{dateInput()}}, \code{\link[=updateDateRangeInput]{updateDateRangeInput()}}

man/fileInput.Rd

@@ -33,8 +33,11 @@ Create a file upload control that can be used to upload one or more files.
 }
 \details{
 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:
+to a dataframe. See the \code{Server value} section.
+}
+\section{Server value}{
+
+A \code{data.frame} that contains one row for each selected file, and 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
@@ -49,6 +52,7 @@ uploaded. This file may be deleted if the user performs another upload
 operation.}
 }
 }
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {
@@ -89,6 +93,7 @@ server <- function(input, output) {
 
 shinyApp(ui, server)
 }
+
 }
 \seealso{
 Other input elements: \code{\link{actionButton}},

man/fillPage.Rd

@@ -82,3 +82,10 @@ fillPage(
   )
 )
 }
+\seealso{
+Other layout functions: \code{\link{fixedPage}},
+  \code{\link{flowLayout}}, \code{\link{fluidPage}},
+  \code{\link{navbarPage}}, \code{\link{sidebarLayout}},
+  \code{\link{splitLayout}}, \code{\link{verticalLayout}}
+}
+\concept{layout functions}

man/fixedPage.Rd

@@ -66,4 +66,10 @@ shinyApp(ui, server = function(input, output) { })
 }
 \seealso{
 \code{\link[=column]{column()}}
+
+Other layout functions: \code{\link{fillPage}},
+  \code{\link{flowLayout}}, \code{\link{fluidPage}},
+  \code{\link{navbarPage}}, \code{\link{sidebarLayout}},
+  \code{\link{splitLayout}}, \code{\link{verticalLayout}}
 }
+\concept{layout functions}

man/flowLayout.Rd

@@ -32,5 +32,9 @@ shinyApp(ui, server = function(input, output) { })
 }
 }
 \seealso{
-\code{\link[=verticalLayout]{verticalLayout()}}
+Other layout functions: \code{\link{fillPage}},
+  \code{\link{fixedPage}}, \code{\link{fluidPage}},
+  \code{\link{navbarPage}}, \code{\link{sidebarLayout}},
+  \code{\link{splitLayout}}, \code{\link{verticalLayout}}
 }
+\concept{layout functions}

man/fluidPage.Rd

@@ -99,5 +99,11 @@ shinyApp(ui, server = function(input, output) { })
 }
 }
 \seealso{
-\code{\link[=column]{column()}}, \code{\link[=sidebarLayout]{sidebarLayout()}}
+\code{\link[=column]{column()}}
+
+Other layout functions: \code{\link{fillPage}},
+  \code{\link{fixedPage}}, \code{\link{flowLayout}},
+  \code{\link{navbarPage}}, \code{\link{sidebarLayout}},
+  \code{\link{splitLayout}}, \code{\link{verticalLayout}}
 }
+\concept{layout functions}

man/loadSupport.Rd

@@ -22,8 +22,13 @@ this function loads any top-level supporting \code{.R} files in the \code{R/} di
 adjacent to the \code{app.R}/\code{server.R}/\code{ui.R} files.
 }
 \details{
-At the moment, this function is "opt-in" and only called if the option
-\code{shiny.autoload.r} is set to \code{TRUE}.
+Since Shiny 1.5.0, this function is called by default when running an
+application. If it causes problems, you can opt out by using
+\code{options(shiny.autoload.r=FALSE)}. Note that in a future version of Shiny,
+this option will no longer be available. If you set this option, it will
+affect any application that runs later in the same R session, potentially
+breaking it, so after running your application, you should unset option with
+\code{options(shiny.autoload.r=NULL)}
 
 The files are sourced in alphabetical order (as determined by
 \link{list.files}). \code{global.R} is evaluated before the supporting R files in the

man/navbarPage.Rd

@@ -105,4 +105,10 @@ navbarPage("App Title",
 \code{\link[=tabPanel]{tabPanel()}}, \code{\link[=tabsetPanel]{tabsetPanel()}},
 \code{\link[=updateNavbarPage]{updateNavbarPage()}}, \code{\link[=insertTab]{insertTab()}},
 \code{\link[=showTab]{showTab()}}
+
+Other layout functions: \code{\link{fillPage}},
+  \code{\link{fixedPage}}, \code{\link{flowLayout}},
+  \code{\link{fluidPage}}, \code{\link{sidebarLayout}},
+  \code{\link{splitLayout}}, \code{\link{verticalLayout}}
 }
+\concept{layout functions}

man/numericInput.Rd

@@ -29,6 +29,11 @@ A numeric input control that can be added to a UI definition.
 \description{
 Create an input control for entry of numeric values
 }
+\section{Server value}{
+
+A numeric vector of length 1.
+}
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {
@@ -42,6 +47,7 @@ server <- function(input, output) {
 }
 shinyApp(ui, server)
 }
+
 }
 \seealso{
 \code{\link[=updateNumericInput]{updateNumericInput()}}

man/passwordInput.Rd

@@ -27,6 +27,12 @@ A text input control that can be added to a UI definition.
 \description{
 Create an password control for entry of passwords.
 }
+\section{Server value}{
+
+A character string of the password input. The default value is \code{""}
+unless \code{value} is provided.
+}
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {

man/radioButtons.Rd

@@ -49,6 +49,11 @@ the radio buttons to have no options selected by using \code{selected = characte
 to return to that state once they've made a selection. Instead, consider
 having the first of your choices be \code{c("None selected" = "")}.
 }
+\section{Server value}{
+
+A character string containing the value of the selected button.
+}
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {
@@ -98,6 +103,7 @@ server <- function(input, output) {
 
 shinyApp(ui, server)
 }
+
 }
 \seealso{
 \code{\link[=updateRadioButtons]{updateRadioButtons()}}

man/selectInput.Rd

@@ -18,14 +18,13 @@ selectizeInput(inputId, ..., options = NULL, width = NULL)
 \item{choices}{List of values to select from. If elements of the list are
 named, then that name --- rather than the value --- is displayed to the
 user. It's also possible to group related inputs by providing a named list
-whose elements are (either named or unnamed) lists, vectors, or factors. In this
-case, the outermost names will be used as the group labels (leveraging the
-\code{<optgroup>} HTML tag) for the elements in the respective sublist. See the
-example section for a small demo of this feature.}
+whose elements are (either named or unnamed) lists, vectors, or factors. In
+this case, the outermost names will be used as the group labels (leveraging
+the \code{<optgroup>} HTML tag) for the elements in the respective sublist. See
+the example section for a small demo of this feature.}
 
-\item{selected}{The initially selected value (or multiple values if
-\code{multiple = TRUE}). If not specified then defaults to the first value
-for single-select lists and no values for multiple select lists.}
+\item{selected}{The initially selected value (or multiple values if \code{multiple = TRUE}). If not specified then defaults to the first value for
+single-select lists and no values for multiple select lists.}
 
 \item{multiple}{Is selection of multiple items allowed?}
 
@@ -36,8 +35,8 @@ see \code{\link[=validateCssUnit]{validateCssUnit()}}.}
 
 \item{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.}
+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.}
 
 \item{...}{Arguments passed to \code{selectInput()}.}
 
@@ -54,14 +53,13 @@ Create a select list that can be used to choose a single or multiple items
 from a list of values.
 }
 \details{
-By default, \code{selectInput()} and \code{selectizeInput()} use the
-JavaScript library \pkg{selectize.js}
-(\url{https://github.com/selectize/selectize.js}) instead of the basic
-select input element. To use the standard HTML select input element, use
-\code{selectInput()} with \code{selectize=FALSE}.
+By default, \code{selectInput()} and \code{selectizeInput()} use the JavaScript library
+\pkg{selectize.js} (\url{https://github.com/selectize/selectize.js}) 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:
+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{
@@ -74,6 +72,12 @@ 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)}.
 }
+\section{Server value}{
+ A vector of character strings, usually of length
+1, with the value of the selected items. When \code{multiple=TRUE} and
+nothing is selected, this value will be \code{NULL}.
+}
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {
@@ -111,6 +115,7 @@ shinyApp(
   }
 )
 }
+
 }
 \seealso{
 \code{\link[=updateSelectInput]{updateSelectInput()}} \code{\link[=varSelectInput]{varSelectInput()}}

man/shinyOptions.Rd

@@ -40,7 +40,7 @@ be set globally with \code{options()} or locally (for a single app) with
 \code{shinyOptions()}.
 
 \describe{
-\item{shiny.autoreload}{If \code{TRUE} when a Shiny app is launched, the
+\item{shiny.autoreload (defaults to \code{FALSE})}{If \code{TRUE} when a Shiny app is launched, the
 app directory will be continually monitored for changes to files that
 have the extensions: r, htm, html, js, css, png, jpg, jpeg, gif. If any
 changes are detected, all connected Shiny sessions are reloaded. This
@@ -56,62 +56,63 @@ by setting e.g. `options(shiny.autoreload.interval = 2000)` (every
 two seconds).}
 }
 
-\item{shiny.deprecation.messages}{This controls whether messages for
+\item{shiny.deprecation.messages (defaults to \code{TRUE})}{This controls whether messages for
 deprecated functions in Shiny will be printed. See
 \code{\link[=shinyDeprecated]{shinyDeprecated()}} for more information.}
-\item{shiny.error}{This can be a function which is called when an error
+\item{shiny.error (defaults to \code{NULL})}{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.}
-\item{shiny.fullstacktrace}{Controls whether "pretty" or full stack traces
-are dumped to the console when errors occur during Shiny app execution.
-The default is \code{FALSE} (pretty stack traces).}
-\item{shiny.host}{The IP address that Shiny should listen on. See
+\item{shiny.fullstacktrace (defaults to \code{FALSE})}{Controls whether "pretty" (\code{FALSE}) or full
+stack traces (\code{TRUE}) are dumped to the console when errors occur during Shiny app execution.
+Pretty stack traces attempt to only show user-supplied code, but this pruning can't always
+be done 100\% correctly.}
+\item{shiny.host (defaults to \code{"127.0.0.1"})}{The IP address that Shiny should listen on. See
 \code{\link[=runApp]{runApp()}} for more information.}
-\item{shiny.json.digits}{The number of digits to use when converting
+\item{shiny.jquery.version (defaults to \code{3})}{The major version of jQuery to use.
+Currently only values of \code{3} or \code{1} are supported. If \code{1}, then jQuery 1.12.4 is used. If \code{3},
+then jQuery 3.4.1 is used.}
+\item{shiny.json.digits (defaults to \code{16})}{The number of digits to use when converting
 numbers to JSON format to send to the client web browser.}
-\item{shiny.launch.browser}{A boolean which controls the default behavior
+\item{shiny.launch.browser (defaults to \code{interactive()})}{A boolean which controls the default behavior
 when an app is run. See \code{\link[=runApp]{runApp()}} for more information.}
-\item{shiny.maxRequestSize}{This is a number which specifies the maximum
-web request size, which serves as a size limit for file uploads. If
-unset, the maximum request size defaults to 5MB.}
-\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.port}{A port number that Shiny will listen on. See
+\item{shiny.maxRequestSize (defaults to 5MB)}{This is a number which specifies the maximum
+web request size, which serves as a size limit for file uploads.}
+\item{shiny.minified (defaults to \code{TRUE})}{By default
+Whether or not to include Shiny's JavaScript as a minified (\code{shiny.min.js})
+or un-minified (\code{shiny.js}) file. The un-minified version is larger,
+but can be helpful for development and debugging.}
+\item{shiny.port (defaults to a random open port)}{A port number that Shiny will listen on. See
 \code{\link[=runApp]{runApp()}} for more information.}
-\item{shiny.reactlog}{If \code{TRUE}, enable logging of reactive events,
+\item{shiny.reactlog (defaults to \code{FALSE})}{If \code{TRUE}, enable logging of reactive events,
 which can be viewed later with the \code{\link[=reactlogShow]{reactlogShow()}} function.
 This incurs a substantial performance penalty and should not be used in
 production.}
-\item{shiny.sanitize.errors}{If \code{TRUE}, then normal errors (i.e.
+\item{shiny.sanitize.errors (defaults to \code{FALSE})}{If \code{TRUE}, then normal errors (i.e.
 errors not wrapped in \code{safeError}) won't show up in the app; a simple
 generic error message is printed instead (the error and strack trace printed
-to the console remain unchanged). The default is \code{FALSE} (unsanitized
-errors).If you want to sanitize errors in general, but you DO want a
+to the console remain unchanged). If you want to sanitize errors in general, but you DO want a
 particular error \code{e} to get displayed to the user, then set this option
 to \code{TRUE} and use \code{stop(safeError(e))} for errors you want the
 user to see.}
-\item{shiny.stacktraceoffset}{If \code{TRUE}, then Shiny's printed stack
+\item{shiny.stacktraceoffset (defaults to \code{TRUE})}{If \code{TRUE}, then Shiny's printed stack
 traces will display srcrefs one line above their usual location. This is
 an arguably more intuitive arrangement for casual R users, as the name
 of a function appears next to the srcref where it is defined, rather than
 where it is currently being called from.}
-\item{shiny.suppressMissingContextError}{Normally, invoking a reactive
+\item{shiny.suppressMissingContextError (defaults to \code{FALSE})}{Normally, invoking a reactive
 outside of a reactive context (or \code{\link[=isolate]{isolate()}}) results in
 an error. If this is \code{TRUE}, don't error in these cases. This
 should only be used for debugging or demonstrations of reactivity at the
 console.}
-\item{shiny.table.class}{CSS class names to use for tables.}
-\item{shiny.testmode}{If \code{TRUE}, then enable features for testing Shiny
-applications. If \code{FALSE} (the default), do not enable those features.}
-\item{shiny.trace}{Print messages sent between the R server and the web
+\item{shiny.testmode (defaults to \code{FALSE})}{If \code{TRUE}, then various features for testing Shiny
+applications are enabled.}
+\item{shiny.trace (defaults to \code{FALSE})}{Print messages sent between the R server and the web
 browser client to the R console. This is useful for debugging. Possible
 values are \code{"send"} (only print messages sent to the client),
 \code{"recv"} (only print messages received by the server), \code{TRUE}
 (print all messages), or \code{FALSE} (default; don't print any of these
 messages).}
-\item{shiny.usecairo}{This is used to disable graphical rendering by the
+\item{shiny.usecairo (defaults to \code{TRUE})}{This is used to disable graphical rendering by the
 Cairo package, if it is installed. See \code{\link[=plotPNG]{plotPNG()}} for more
 information.}
 }

man/showNotification.Rd

@@ -9,7 +9,7 @@ showNotification(ui, action = NULL, duration = 5, closeButton = TRUE,
   id = NULL, type = c("default", "message", "warning", "error"),
   session = getDefaultReactiveDomain())
 
-removeNotification(id = NULL, session = getDefaultReactiveDomain())
+removeNotification(id, session = getDefaultReactiveDomain())
 }
 \arguments{
 \item{ui}{Content of message.}
@@ -26,11 +26,13 @@ disappear.}
 \item{closeButton}{If \code{TRUE}, display a button which will make the
 notification disappear when clicked. If \code{FALSE} do not display.}
 
-\item{id}{An ID string. This can be used to change the contents of an
-existing message with \code{showNotification}, or to remove it with
-\code{removeNotification}. If not provided, one will be generated
-automatically. If an ID is provided and there does not currently exist a
-notification with that ID, a new notification will be created with that ID.}
+\item{id}{A unique identifier for the notification.
+
+\code{id} is optional for \code{showNotification()}: Shiny will automatically create
+one if needed. If you do supply it, Shiny will update an existing
+notification if it exists, otherwise it will create a new one.
+
+\code{id} is required for \code{removeNotification()}.}
 
 \item{type}{A string which controls the color of the notification. One of
 "default" (gray), "message" (blue), "warning" (yellow), or "error" (red).}

man/sidebarLayout.Rd

@@ -76,3 +76,10 @@ server <- function(input, output) {
 shinyApp(ui, server)
 }
 }
+\seealso{
+Other layout functions: \code{\link{fillPage}},
+  \code{\link{fixedPage}}, \code{\link{flowLayout}},
+  \code{\link{fluidPage}}, \code{\link{navbarPage}},
+  \code{\link{splitLayout}}, \code{\link{verticalLayout}}
+}
+\concept{layout functions}

man/sliderInput.Rd

@@ -93,6 +93,11 @@ or list of tags (using \code{\link[=tag]{tag()}} and friends), or raw HTML (usin
 \description{
 Constructs a slider widget to select a numeric value from a range.
 }
+\section{Server value}{
+
+A number, or in the case of slider range, a vector of two numbers.
+}
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {
@@ -115,6 +120,7 @@ server <- function(input, output) {
 # Complete app with UI and server components
 shinyApp(ui, server)
 }
+
 }
 \seealso{
 \code{\link[=updateSliderInput]{updateSliderInput()}}

man/splitLayout.Rd

@@ -61,3 +61,10 @@ ui <- splitLayout(
 shinyApp(ui, server)
 }
 }
+\seealso{
+Other layout functions: \code{\link{fillPage}},
+  \code{\link{fixedPage}}, \code{\link{flowLayout}},
+  \code{\link{fluidPage}}, \code{\link{navbarPage}},
+  \code{\link{sidebarLayout}}, \code{\link{verticalLayout}}
+}
+\concept{layout functions}

man/testModule.Rd

@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/test-module.R
+\name{testModule}
+\alias{testModule}
+\title{Test a shiny module}
+\usage{
+testModule(module, expr, args, ...)
+}
+\arguments{
+\item{module}{The module under test}
+
+\item{expr}{Test code containing expectations. The test expression will run
+in the module's environment, meaning that the module's parameters (e.g.
+\code{input}, \code{output}, and \code{session}) will be available along with any other
+values created inside of the module.}
+
+\item{args}{A list of arguments to pass into the module beyond \code{input},
+\code{output}, and \code{session}.}
+
+\item{...}{Additional named arguments to be passed on to the module function.}
+
+\item{initialState}{A list describing the initial values for \code{input}. If no
+initial state is given, \code{input} will initialize as an empty list.}
+}
+\description{
+Test a shiny module
+}

man/testServer.Rd

@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/test-module.R
+\name{testServer}
+\alias{testServer}
+\title{Test an app's server-side logic}
+\usage{
+testServer(expr, appDir = NULL)
+}
+\arguments{
+\item{expr}{Test code containing expectations}
+
+\item{appdir}{The directory root of the Shiny application. If \code{NULL}, this function
+will work up the directory hierarchy --- starting with the current directory ---
+looking for a directory that contains an \code{app.R} or \code{server.R} file.}
+}
+\description{
+Test an app's server-side logic
+}

man/textAreaInput.Rd

@@ -45,6 +45,12 @@ A textarea input control that can be added to a UI definition.
 \description{
 Create a textarea input control for entry of unstructured text values.
 }
+\section{Server value}{
+
+A character string of the text input. The default value is \code{""}
+unless \code{value} is provided.
+}
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {
@@ -59,6 +65,7 @@ server <- function(input, output) {
 shinyApp(ui, server)
 
 }
+
 }
 \seealso{
 \code{\link[=updateTextAreaInput]{updateTextAreaInput()}}

man/textInput.Rd

@@ -27,6 +27,12 @@ A text input control that can be added to a UI definition.
 \description{
 Create an input control for entry of unstructured text values
 }
+\section{Server value}{
+
+A character string of the text input. The default value is \code{""}
+unless \code{value} is provided.
+}
+
 \examples{
 ## Only run examples in interactive R sessions
 if (interactive()) {
@@ -40,6 +46,7 @@ server <- function(input, output) {
 }
 shinyApp(ui, server)
 }
+
 }
 \seealso{
 \code{\link[=updateTextInput]{updateTextInput()}}

man/updateSelectInput.Rd

@@ -30,14 +30,13 @@ updateVarSelectizeInput(session, inputId, label = NULL, data = NULL,
 \item{choices}{List of values to select from. If elements of the list are
 named, then that name --- rather than the value --- is displayed to the
 user. It's also possible to group related inputs by providing a named list
-whose elements are (either named or unnamed) lists, vectors, or factors. In this
-case, the outermost names will be used as the group labels (leveraging the
-\code{<optgroup>} HTML tag) for the elements in the respective sublist. See the
-example section for a small demo of this feature.}
+whose elements are (either named or unnamed) lists, vectors, or factors. In
+this case, the outermost names will be used as the group labels (leveraging
+the \code{<optgroup>} HTML tag) for the elements in the respective sublist. See
+the example section for a small demo of this feature.}
 
-\item{selected}{The initially selected value (or multiple values if
-\code{multiple = TRUE}). If not specified then defaults to the first value
-for single-select lists and no values for multiple select lists.}
+\item{selected}{The initially selected value (or multiple values if \code{multiple = TRUE}). If not specified then defaults to the first value for
+single-select lists and no values for multiple select lists.}
 
 \item{options}{A list of options. See the documentation of \pkg{selectize.js}
 for possible options (character option values inside \code{\link[base:I]{base::I()}} will

man/varSelectInput.Rd

@@ -17,9 +17,8 @@ varSelectizeInput(inputId, ..., options = NULL, width = NULL)
 
 \item{data}{A data frame. Used to retrieve the column names as choices for a \code{\link[=selectInput]{selectInput()}}}
 
-\item{selected}{The initially selected value (or multiple values if
-\code{multiple = TRUE}). If not specified then defaults to the first value
-for single-select lists and no values for multiple select lists.}
+\item{selected}{The initially selected value (or multiple values if \code{multiple = TRUE}). If not specified then defaults to the first value for
+single-select lists and no values for multiple select lists.}
 
 \item{multiple}{Is selection of multiple items allowed?}
 
@@ -30,8 +29,8 @@ see \code{\link[=validateCssUnit]{validateCssUnit()}}.}
 
 \item{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.}
+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.}
 
 \item{...}{Arguments passed to \code{varSelectInput()}.}
 
@@ -48,18 +47,6 @@ Create a select list that can be used to choose a single or multiple items
 from the column names of a data frame.
 }
 \details{
-The resulting server \code{input} value will be returned as:
-\itemize{
-\item a symbol if \code{multiple = FALSE}.  The \code{input} value should be
-used with rlang's \code{\link[rlang:!!]{rlang::!!()}}. For example,
-\code{ggplot2::aes(!!input$variable)}.
-\item a list of symbols if \code{multiple = TRUE}. The \code{input} value
-should be used with rlang's \code{\link[rlang:!!!]{rlang::!!!()}} to expand
-the symbol list as individual arguments. For example,
-\code{dplyr::select(mtcars, !!!input$variabls)} which is
-equivalent to \code{dplyr::select(mtcars, !!input$variabls[[1]], !!input$variabls[[2]], ..., !!input$variabls[[length(input$variabls)]])}.
-}
-
 By default, \code{varSelectInput()} and \code{selectizeInput()} use the
 JavaScript library \pkg{selectize.js}
 (\url{https://github.com/selectize/selectize.js}) to instead of the basic
@@ -76,6 +63,21 @@ 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)}.
 }
+\section{Server value}{
+
+The resulting server \code{input} value will be returned as:
+\itemize{
+\item A symbol if \code{multiple = FALSE}. The \code{input} value should be
+used with rlang's \code{\link[rlang:!!]{rlang::!!()}}. For example,
+\code{ggplot2::aes(!!input$variable)}.
+\item A list of symbols if \code{multiple = TRUE}. The \code{input} value
+should be used with rlang's \code{\link[rlang:!!!]{rlang::!!!()}} to expand
+the symbol list as individual arguments. For example,
+\code{dplyr::select(mtcars, !!!input$variabls)} which is
+equivalent to \code{dplyr::select(mtcars, !!input$variabls[[1]], !!input$variabls[[2]], ..., !!input$variabls[[length(input$variabls)]])}.
+}
+}
+
 \examples{
 
 ## Only run examples in interactive R sessions

man/verticalLayout.Rd

@@ -31,5 +31,9 @@ shinyApp(ui, server = function(input, output) { })
 }
 }
 \seealso{
-\code{\link[=fluidPage]{fluidPage()}}, \code{\link[=flowLayout]{flowLayout()}}
+Other layout functions: \code{\link{fillPage}},
+  \code{\link{fixedPage}}, \code{\link{flowLayout}},
+  \code{\link{fluidPage}}, \code{\link{navbarPage}},
+  \code{\link{sidebarLayout}}, \code{\link{splitLayout}}
 }
+\concept{layout functions}

srcjs/init_shiny.js

@@ -457,7 +457,7 @@ function initShiny() {
   initialValues['.clientdata_url_hash'] = window.location.hash;
 
   $(window).on('hashchange', function(e) {
-    inputs.setInput('.clientdata_url_hash', location.hash);
+    inputs.setInput('.clientdata_url_hash', window.location.hash);
   });
 
   // The server needs to know what singletons were rendered as part of

srcjs/input_rate.js

@@ -238,7 +238,7 @@ var InputNoResendDecorator = function(target, initialValues) {
       return;
     }
     this.lastSentValues[inputName] = { jsonValue, inputType };
-    this.target.setInput(name, value, opts);
+    this.target.setInput(nameType, value, opts);
   };
   this.reset = function(values = {}) {
     // Given an object with flat name-value format:
@@ -281,7 +281,7 @@ var InputEventDecorator = function(target) {
     $(opts.el).trigger(evt);
 
     if (!evt.isDefaultPrevented()) {
-      name = evt.name;
+      let name = evt.name;
       if (evt.inputType !== '') name += ':' + evt.inputType;
 
       // Most opts aren't passed along to lower levels in the input decorator
@@ -345,13 +345,13 @@ var InputDeferDecorator = function(target) {
     if (/^\./.test(nameType))
       this.target.setInput(nameType, value, opts);
     else
-      this.pendingInput[name] = { value, opts };
+      this.pendingInput[nameType] = { value, opts };
   };
   this.submit = function() {
-    for (var name in this.pendingInput) {
-      if (this.pendingInput.hasOwnProperty(name)) {
-        let input = this.pendingInput[name];
-        this.target.setInput(name, input.value, input.opts);
+    for (var nameType in this.pendingInput) {
+      if (this.pendingInput.hasOwnProperty(nameType)) {
+        let { value, opts } = this.pendingInput[nameType];
+        this.target.setInput(nameType, value, opts);
       }
     }
   };

srcjs/output_binding_image.js

@@ -656,9 +656,7 @@ imageutils.createClickInfo = function($el, dblclickId, dblclickDelay) {
     var e2 = $.Event(newEventType, {
       which:   e.which,
       pageX:   e.pageX,
-      pageY:   e.pageY,
-      offsetX: e.offsetX,
-      offsetY: e.offsetY
+      pageY:   e.pageY
     });
 
     $el.trigger(e2);
@@ -707,8 +705,8 @@ imageutils.createClickInfo = function($el, dblclickId, dblclickDelay) {
       // click. Instead, immediately trigger a mousedown2 for the previous
       // click, and set this click as a new first click.
       if (pending_e &&
-          Math.abs(pending_e.offsetX - e.offsetX) > 2 ||
-          Math.abs(pending_e.offsetY - e.offsetY) > 2) {
+          Math.abs(pending_e.pageX - e.pageX) > 2 ||
+          Math.abs(pending_e.pageY - e.pageY) > 2) {
 
         triggerPendingMousedown2();
         scheduleMousedown2(e);

srcjs/reactlog.js

@@ -9,8 +9,18 @@ $(document).on('keydown', function(e) {
 
 
 $(document).on('keydown', function(e) {
-  if (e.which !== 115 || (!e.ctrlKey && !e.metaKey) || (e.shiftKey || e.altKey))
+  if (
+    // if not one of the key combos below
+    !(
+      // cmd/ctrl + fn + f4
+      (e.which === 115 && (e.ctrlKey || e.metaKey) && !e.shiftKey && !e.altKey) ||
+      // cmd/ctrl + shift + fn + f3
+      (e.which === 114 && (e.ctrlKey || e.metaKey) && e.shiftKey && !e.altKey)
+    )
+  ) {
     return;
+  }
+
   var url = 'reactlog/mark?w=' + window.escape(exports.shinyapp.config.workerId) +
     "&s=" + window.escape(exports.shinyapp.config.sessionId);
 
@@ -24,6 +34,9 @@ $(document).on('keydown', function(e) {
       html: html,
       closeButton: true,
     });
+  }).fail(function() {
+    // found returned error while marking, should open webpage
+    window.open(url);
   });
 
   e.preventDefault();

tests/testthat/test-app.R

@@ -99,7 +99,7 @@ test_that("With ui/server.R, global.R is loaded before R/ helpers and into the r
 })
 
 
-test_that("Loading supporting R fils is opt-in", {
+test_that("Loading supporting R fils is opt-out", {
   calls <- list()
   sourceStub <- function(...){
     calls[[length(calls)+1]] <<- list(...)
@@ -122,12 +122,40 @@ test_that("Loading supporting R fils is opt-in", {
   sa$onStart()
   sa$onStop() # Close down to free up resources
 
-  # Should have seen one call from global.R -- helpers are disabled
-  expect_length(calls, 1)
+  # Should have seen three calls from global.R -- helpers are enabled
+  expect_length(calls, 3)
   expect_match(calls[[1]][[1]], "/global\\.R$", perl=TRUE)
 })
 
 
+test_that("Disabling supporting R fils works", {
+  calls <- list()
+  sourceStub <- function(...){
+    calls[[length(calls)+1]] <<- list(...)
+    NULL
+  }
+
+  # Temporarily unset autoloading option
+  orig <- getOption("shiny.autoload.r", NULL)
+  options(shiny.autoload.r=FALSE)
+  on.exit({options(shiny.autoload.r=orig)}, add=TRUE)
+
+  # + shinyAppDir_serverR
+  # +--- sourceUTF8
+  # +--+ loadSupport
+  # |  +--- sourceUTF8
+  loadSpy <- rewire(loadSupport, sourceUTF8 = sourceStub)
+  sad <- rewire(shinyAppDir_serverR, sourceUTF8 = sourceStub, loadSupport = loadSpy)
+
+  sa <- sad(normalizePath("../test-helpers/app1-standard"))
+  sa$onStart()
+  sa$onStop() # Close down to free up resources
+
+  # Should have seen one calls from global.R -- helpers are disabled
+  expect_length(calls, 1)
+  expect_match(calls[[1]][[1]], "/global\\.R$", perl=TRUE)
+})
+
 test_that("app.R is loaded after R/ helpers and into the right envs", {
   calls <- list()
   sourceSpy <- function(...){

tests/testthat/test-bootstrap.r

@@ -69,7 +69,7 @@ test_that("Repeated names for selectInput and radioButtons choices", {
 
 
 test_that("Choices are correctly assigned names", {
-  # Empty non-list comes back with names
+  # Empty non-list comes back as a list with names
   expect_identical(
     choicesWithNames(numeric(0)),
     stats::setNames(list(), character(0))
@@ -79,6 +79,16 @@ test_that("Choices are correctly assigned names", {
     choicesWithNames(list()),
     stats::setNames(list(), character(0))
   )
+  # NULL comes back as an empty list with names
+  expect_identical(
+    choicesWithNames(NULL),
+    stats::setNames(list(), character(0))
+  )
+  # NA is processed as a leaf, not a group
+  expect_identical(
+    choicesWithNames(NA),
+    as.list(stats::setNames(as.character(NA), NA))
+  )
   # Empty character vector
   # An empty character vector isn't a sensical input, but we preserved this test
   # in the off chance that somebody relies on the existing behavior.
@@ -151,8 +161,19 @@ test_that("Choices are correctly assigned names", {
     choicesWithNames(list(A="a", "b", C=list("d", E="e"))),
     list(A="a", b="b", C=list(d="d", E="e"))
   )
+  # List, with a single-item unnamed group list
+  expect_identical(
+    choicesWithNames(list(C=list(123))),
+    list(C=list("123"="123"))
+  )
   # Error when sublist is unnamed
   expect_error(choicesWithNames(list(A="a", "b", list(1,2))))
+  # Error when list is unnamed and contains a group
+  # NULL, list(1,2), and anything of length() == 0 is considered a group.
+  # NA is NOT a group.
+  expect_error(choicesWithNames(list(NULL)), regexp = "must be named")
+  expect_error(choicesWithNames(list(list(1,2))), regexp = "must be named")
+  expect_error(choicesWithNames(list(character(0))), regexp = "must be named")
   # Unnamed factor
   expect_identical(
     choicesWithNames(factor(c("a","b","3"))),
@@ -173,6 +194,16 @@ test_that("Choices are correctly assigned names", {
     choicesWithNames(list(A="a", B="b", C=structure(factor(c("d", "e")), names = c("d", "e")))),
     list(A="a", B="b", C=list(d="d", e="e"))
   )
+  # List, named, with an empty group as an unnamed empty list
+  expect_identical(
+    choicesWithNames(list(C=list())),
+    list(C=stats::setNames(list(), character()))
+  )
+  # List, named, with an empty group as an unnamed empty vector
+  expect_identical(
+    choicesWithNames(list(C=c())),
+    list(C=stats::setNames(list(), character()))
+  )
 })
 
 

tests/testthat/test-cache.R

@@ -33,7 +33,7 @@ test_that("DiskCache: handling missing values", {
   expect_identical(d$get("a"), 100)
   expect_identical(d$get("y", missing = NULL, exec_missing = FALSE), NULL)
   expect_true(is.key_missing(d$get("y", missing = key_missing(), exec_missing = FALSE)))
-  expect_identical(d$get("y", exec_missing = FALSE), function(key) stop("Missing key: ", key))
+  expect_equal(d$get("y", exec_missing = FALSE), function(key) stop("Missing key: ", key))
   expect_error(
     d$get("y", missing = function(key) stop("Missing key 2: ", key), exec_missing = TRUE),
     "^Missing key 2: y$",

tests/testthat/test-mock-session.R

@@ -0,0 +1,283 @@
+context("MockShinySession")
+
+test_that("invalidateLater supported", {
+  session <- MockShinySession$new()
+  i <- 0
+  isolate({
+    observe({
+      invalidateLater(10, session)
+      i <<- i + 1
+    })
+  })
+  flushReact()
+  expect_equal(i, 1)
+  session$elapse(10)
+  expect_equal(i, 2)
+})
+
+test_that("reactiveTimer supported", {
+  session <- MockShinySession$new()
+  i <- 0
+  isolate({
+    rt <- reactiveTimer(10, session)
+    observe({
+      rt()
+      i <<- i + 1
+    })
+  })
+  flushReact()
+  expect_equal(i, 1)
+  session$elapse(10)
+  expect_equal(i, 2)
+})
+
+test_that("reactivePoll supported", {
+  session <- MockShinySession$new()
+  i <- 0
+  isolate({
+    rp <- reactivePoll(10, session, Sys.time, function(){ i <<- i + 1 })
+    observe({
+      # Sys.time as the check function will cause it to always run the update.
+      rp()
+    })
+  })
+  flushReact()
+  expect_equal(i, 1)
+  session$elapse(10)
+  flushReact()
+  expect_equal(i, 2)
+})
+
+test_that("renderCachedPlot supported", {
+  session <- MockShinySession$new()
+  isolate({
+    # renderCachedPlot is sensitive to having the cache set for it before entering.
+    origCache <- getShinyOption("cache")
+    shinyOptions(cache = MemoryCache$new())
+    on.exit(shinyOptions(cache = origCache), add=TRUE)
+
+    p <- renderCachedPlot({ plot(1,1) }, { Sys.time() })
+    plt <- p(session, "name")
+
+    # Should have a size defined
+    expect_equal(plt$coordmap$dims$width, 692) #FIXME: why isn't this respecting the clientdata sizes?
+    expect_equal(plt$coordmap$dims$height, 400)
+  })
+})
+
+test_that("renderDataTable supported", {
+  session <- MockShinySession$new()
+  isolate({
+    rt <- renderDataTable({
+      head(iris)
+    })
+    res <- rt(session, "name")
+    expect_equal(res$colnames, colnames(iris))
+  })
+})
+
+test_that("renderImage supported", {
+  session <- MockShinySession$new()
+  isolate({
+    ri <- renderImage({
+      # A temp file to save the output. It will be deleted after renderImage
+      # sends it, because deleteFile=TRUE.
+      outfile <- tempfile(fileext='.png')
+
+      # Generate a png
+      png(outfile, width=400, height=400)
+      plot(1,1)
+      dev.off()
+
+      # Return a list
+      list(src = outfile,
+           alt = "Alt text here")
+    }, deleteFile = TRUE)
+    img <- ri(session, "name")
+    expect_match(img$src, "^data:image/png;base64,")
+    expect_equal(img$alt, "Alt text here")
+  })
+})
+
+test_that("renderPlot supported", {
+  session <- MockShinySession$new()
+  isolate({
+    p <- renderPlot({ plot(1,1) })
+    plt <- p(session, "name")
+
+    # Should have a size defined
+    expect_equal(plt$width, 600)
+    expect_equal(plt$height, 400)
+  })
+})
+
+test_that("renderPrint supported", {
+  session <- MockShinySession$new()
+  isolate({
+    p <- renderPrint({ print("hi") })
+    pt <- p(session, "name")
+
+    expect_equal(pt, "[1] \"hi\"")
+  })
+})
+
+test_that("renderTable supported", {
+  session <- MockShinySession$new()
+  isolate({
+    rt <- renderTable({
+      head(iris)
+    })
+    ren <- rt(session, "name")
+    expect_match(ren, "^<table")
+  })
+})
+
+test_that("renderText supported", {
+  session <- MockShinySession$new()
+  isolate({
+    rt <- renderText({
+      "text here"
+    })
+    ren <- rt(session, "name")
+    expect_equal(ren, "text here")
+  })
+})
+
+test_that("renderUI supported", {
+  session <- MockShinySession$new()
+  isolate({
+    ui <- renderUI({
+      tags$a(href="https://rstudio.com", "link")
+    })
+    ren <- ui(session, "name")
+    expect_equal(ren$deps, list())
+    expect_equal(as.character(ren$html), "<a href=\"https://rstudio.com\">link</a>")
+  })
+})
+
+test_that("session supports allowReconnect", {
+  session <- MockShinySession$new()
+  session$allowReconnect(TRUE)
+  expect_true(TRUE) # testthat insists that every test must have an expectation
+})
+
+test_that("session supports clientData", {
+  session <- MockShinySession$new()
+  expect_equal(session$clientData$allowDataUriScheme, TRUE)
+  expect_equal(session$clientData$pixelratio, 1)
+  expect_equal(session$clientData$url_protocol, "http:")
+  expect_equal(session$clientData$url_hostname, "mocksession")
+  expect_equal(session$clientData$url_port, 1234)
+  expect_equal(session$clientData$url_pathname, "/mockpath")
+  expect_equal(session$clientData$url_hash, "#mockhash")
+  expect_equal(session$clientData$url_hash_initial, "#mockhash")
+  expect_equal(session$clientData$url_search, "?mocksearch=1")
+
+  # Arbitrary names have width, height, and hidden
+  expect_equal(session$clientData$output_arbitrary_width, 600)
+  expect_equal(session$clientData$output_arbitrary_height, 400)
+  expect_equal(session$clientData$output_arbitrary_hidden, FALSE)
+})
+
+test_that("session supports ns", {
+  session <- MockShinySession$new()
+  expect_equal(session$ns("hi"), "mock-session-hi")
+})
+
+test_that("session supports reload", {
+  session <- MockShinySession$new()
+  session$reload()
+  expect_true(TRUE) # testthat insists that every test must have an expectation
+})
+
+test_that("session supports close", {
+  session <- MockShinySession$new()
+  session$close()
+  expect_true(TRUE) # testthat insists that every test must have an expectation
+})
+
+test_that("session supports request", {
+  session <- MockShinySession$new()
+  expect_warning(session$request, "doesn't currently simulate a realistic request")
+  expect_error(session$request <- "blah", "can't be assigned to")
+})
+
+test_that("session supports userData", {
+  session <- MockShinySession$new()
+  expect_length(ls(session$userData), 0)
+  session$userData$x <- 123
+  expect_length(ls(session$userData), 1)
+  expect_equal(session$userData$x, 123)
+})
+
+test_that("session supports resetBrush", {
+  session <- MockShinySession$new()
+  expect_warning(session$resetBrush(1), "isn't meaningfully mocked")
+})
+
+test_that("session supports sendCustomMessage", {
+  session <- MockShinySession$new()
+  session$sendCustomMessage(type=1, message=2)
+  expect_true(TRUE) # testthat insists that every test must have an expectation
+})
+
+test_that("session supports sendBinaryMessage", {
+  session <- MockShinySession$new()
+  session$sendBinaryMessage(type=1, message=2)
+  expect_true(TRUE) # testthat insists that every test must have an expectation
+})
+
+test_that("session supports sendInputMessage", {
+  session <- MockShinySession$new()
+  session$sendInputMessage(inputId=1, message=2)
+  expect_true(TRUE) # testthat insists that every test must have an expectation
+})
+
+test_that("session supports setBookmarkExclude", {
+  session <- MockShinySession$new()
+  expect_warning(session$setBookmarkExclude(names=1), "Bookmarking isn't meaningfully mocked")
+})
+
+test_that("session supports getBookmarkExclude", {
+  session <- MockShinySession$new()
+  expect_warning(session$getBookmarkExclude(), "Bookmarking isn't meaningfully mocked")
+})
+
+test_that("session supports onBookmark", {
+  session <- MockShinySession$new()
+  expect_warning(session$onBookmark(fun=1), "Bookmarking isn't meaningfully mocked")
+})
+
+test_that("session supports onBookmarked", {
+  session <- MockShinySession$new()
+  expect_warning(session$onBookmarked(fun=1), "Bookmarking isn't meaningfully mocked")
+})
+
+test_that("session supports doBookmark", {
+  session <- MockShinySession$new()
+  expect_warning(session$doBookmark(), "Bookmarking isn't meaningfully mocked")
+})
+
+test_that("session supports onRestore", {
+  session <- MockShinySession$new()
+  session$onRestore(fun=1)
+  expect_true(TRUE) # testthat insists that every test must have an expectation
+})
+
+test_that("session supports onRestored", {
+  session <- MockShinySession$new()
+  session$onRestored(fun=1)
+  expect_true(TRUE) # testthat insists that every test must have an expectation
+})
+
+test_that("session supports exportTestValues", {
+  session <- MockShinySession$new()
+  session$exportTestValues()
+  expect_true(TRUE) # testthat insists that every test must have an expectation
+})
+
+test_that("session supports getTestSnapshotUrl", {
+  session <- MockShinySession$new()
+  session$getTestSnapshotUrl(input=1, output=1, export=1, format=1)
+  expect_true(TRUE) # testthat insists that every test must have an expectation
+})

tests/testthat/test-pkgdown.R

@@ -0,0 +1,40 @@
+context("pkgdown")
+
+get_exported <- function() {
+  if (all(file.exists(c('../../inst/_pkgdown.yml', '../../man')))) {
+    # We're running tests on a source tree, likely by devtools::test()
+    sub("\\.Rd", "", list.files("../../man", pattern = "*.Rd"))
+  } else {
+    # We're testing an installed package, possibly for R CMD check
+    unique(unname(readRDS("../../shiny/help/aliases.rds")))
+  }
+}
+
+get_indexed <- function(f = system.file('_pkgdown.yml', package = 'shiny')) {
+  unlist(lapply(yaml::yaml.load_file(f)$reference, function(x) x$contents))
+}
+
+test_that("All man pages have an entry in _pkgdown.yml", {
+  skip_on_cran()
+  indexed_topics <- get_indexed()
+  all_topics     <- get_exported()
+
+  ## Known not to be indexed
+  known_unindexed <- c("shiny-package", "stacktrace", "knitr_methods",
+                       "pageWithSidebar", "headerPanel", "shiny.appobj",
+                       "deprecatedReactives")
+
+  ## This test ensures that every documented topic is included in
+  ## staticdocs/index.r, unless explicitly waived by specifying it
+  ## in the known_unindexed variable above.
+  missing <- setdiff(all_topics, c(known_unindexed, indexed_topics))
+  unknown <- setdiff(c(known_unindexed, indexed_topics), all_topics)
+  expect_equal(length(missing), 0,
+    info = paste("Functions missing from _pkgdown.yml:\n",
+      paste("  ", missing, sep = "", collapse = "\n"),
+      sep = ""))
+  expect_equal(length(unknown), 0,
+    info = paste("Unrecognized functions in _pkgdown.yml:\n",
+      paste("  ", unknown, sep = "", collapse = "\n"),
+      sep = ""))
+})

tests/testthat/test-reactivity.r

@@ -1366,3 +1366,59 @@ test_that("reactivePoll doesn't leak observer (#1548)", {
 
   expect_equal(i, 3L)
 })
+
+test_that("reactivePoll prefers session$scheduleTask", {
+  called <- 0
+  session <- list(reactlog = function(...){}, onEnded = function(...){}, scheduleTask = function(millis, cb){
+    expect_equal(millis, 50)
+    called <<- called + 1
+  })
+
+  count <- reactivePoll(50, session, function(){}, function(){})
+  observe({
+    count()
+  })
+
+  for (i in 1:4) {
+    Sys.sleep(0.05)
+    shiny:::flushReact()
+  }
+  expect_gt(called, 0)
+})
+
+test_that("invalidateLater prefers session$scheduleTask", {
+  called <- 0
+  session <- list(reactlog = function(...){}, onEnded = function(...){}, scheduleTask = function(millis, cb){
+    expect_equal(millis, 10)
+    called <<- called + 1
+  })
+
+  observe({
+    invalidateLater(10, session)
+  })
+
+  for (i in 1:4) {
+    Sys.sleep(0.05)
+    shiny:::flushReact()
+  }
+  expect_gt(called, 0)
+})
+
+test_that("reactiveTimer prefers session$scheduleTask", {
+  called <- 0
+  session <- list(reactlog = function(...){}, onEnded = function(...){}, scheduleTask = function(millis, cb){
+    expect_equal(millis, 10)
+    called <<- called + 1
+  })
+
+  rt <- reactiveTimer(10, session)
+  observe({
+    rt()
+  })
+
+  for (i in 1:4) {
+    Sys.sleep(0.05)
+    shiny:::flushReact()
+  }
+  expect_gt(called, 0)
+})

tests/testthat/test-stacks.R

@@ -48,50 +48,59 @@ dumpTests <- function(df) {
 }
 
 test_that("integration tests", {
+  # The expected call stack can be changed by other packages (namely, promises).
+  # If promises changes its internals, it can break this test on CRAN. Because
+  # CRAN package releases are generally not synchronized (that is, promises and
+  # shiny can't be updated at the same time, unless there is manual intervention
+  # from CRAN maintaineres), these specific test expectations make it impossible
+  # to release a version of promises that will not break this test and cause
+  # problems on CRAN.
+  skip_on_cran()
+
   df <- causeError(full = FALSE)
   # dumpTests(df)
 
-  expect_equal(df$num, c(56L, 55L, 54L, 38L, 37L, 36L, 35L, 
+  expect_equal(df$num, c(56L, 55L, 54L, 38L, 37L, 36L, 35L,
     34L, 33L, 32L, 31L, 30L))
-  expect_equal(df$call, c("A", "B", "<reactive:C>", "C", "renderTable", 
-    "func", "force", "withVisible", "withCallingHandlers", "globals$domain$wrapSync", 
+  expect_equal(df$call, c("A", "B", "<reactive:C>", "C", "renderTable",
+    "func", "force", "withVisible", "withCallingHandlers", "domain$wrapSync",
     "promises::with_promise_domain", "captureStackTraces"))
-  expect_equal(nzchar(df$loc), c(TRUE, TRUE, TRUE, FALSE, TRUE, 
+  expect_equal(nzchar(df$loc), c(TRUE, TRUE, TRUE, FALSE, TRUE,
     FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE))
-  
+
   df <- causeError(full = TRUE)
   # dumpTests(df)
 
-  expect_equal(df$num, c(59L, 58L, 57L, 56L, 55L, 54L, 53L, 
-    52L, 51L, 50L, 49L, 48L, 47L, 46L, 45L, 44L, 43L, 42L, 41L, 
-    40L, 39L, 38L, 37L, 36L, 35L, 34L, 33L, 32L, 31L, 30L, 29L, 
-    28L, 27L, 26L, 25L, 24L, 23L, 22L, 21L, 20L, 19L, 18L, 17L, 
-    16L, 15L, 14L, 13L, 12L, 11L, 10L, 9L, 8L, 7L, 6L, 5L, 4L, 
+  expect_equal(df$num, c(59L, 58L, 57L, 56L, 55L, 54L, 53L,
+    52L, 51L, 50L, 49L, 48L, 47L, 46L, 45L, 44L, 43L, 42L, 41L,
+    40L, 39L, 38L, 37L, 36L, 35L, 34L, 33L, 32L, 31L, 30L, 29L,
+    28L, 27L, 26L, 25L, 24L, 23L, 22L, 21L, 20L, 19L, 18L, 17L,
+    16L, 15L, 14L, 13L, 12L, 11L, 10L, 9L, 8L, 7L, 6L, 5L, 4L,
     3L, 2L, 1L))
-  expect_equal(df$call, c("h", ".handleSimpleError", "stop", 
-    "A", "B", "<reactive:C>", "..stacktraceon..", ".func", "withVisible", 
-    "withCallingHandlers", "contextFunc", "env$runWith", "force", 
-    "globals$domain$wrapSync", "promises::with_promise_domain", 
-    "withReactiveDomain", "globals$domain$wrapSync", "promises::with_promise_domain", 
-    "ctx$run", "self$.updateValue", "..stacktraceoff..", "C", 
-    "renderTable", "func", "force", "withVisible", "withCallingHandlers", 
-    "globals$domain$wrapSync", "promises::with_promise_domain", 
-    "captureStackTraces", "doTryCatch", "tryCatchOne", "tryCatchList", 
-    "tryCatch", "do", "hybrid_chain", "origRenderFunc", "renderTable({     C() }, server = FALSE)", 
-    "..stacktraceon..", "contextFunc", "env$runWith", "force", 
-    "globals$domain$wrapSync", "promises::with_promise_domain", 
-    "withReactiveDomain", "globals$domain$wrapSync", "promises::with_promise_domain", 
-    "ctx$run", "..stacktraceoff..", "isolate", "withCallingHandlers", 
-    "globals$domain$wrapSync", "promises::with_promise_domain", 
-    "captureStackTraces", "doTryCatch", "tryCatchOne", "tryCatchList", 
+  expect_equal(df$call, c("h", ".handleSimpleError", "stop",
+    "A", "B", "<reactive:C>", "..stacktraceon..", ".func", "withVisible",
+    "withCallingHandlers", "contextFunc", "env$runWith", "force",
+    "domain$wrapSync", "promises::with_promise_domain",
+    "withReactiveDomain", "domain$wrapSync", "promises::with_promise_domain",
+    "ctx$run", "self$.updateValue", "..stacktraceoff..", "C",
+    "renderTable", "func", "force", "withVisible", "withCallingHandlers",
+    "domain$wrapSync", "promises::with_promise_domain",
+    "captureStackTraces", "doTryCatch", "tryCatchOne", "tryCatchList",
+    "tryCatch", "do", "hybrid_chain", "origRenderFunc", "renderTable({     C() }, server = FALSE)",
+    "..stacktraceon..", "contextFunc", "env$runWith", "force",
+    "domain$wrapSync", "promises::with_promise_domain",
+    "withReactiveDomain", "domain$wrapSync", "promises::with_promise_domain",
+    "ctx$run", "..stacktraceoff..", "isolate", "withCallingHandlers",
+    "domain$wrapSync", "promises::with_promise_domain",
+    "captureStackTraces", "doTryCatch", "tryCatchOne", "tryCatchList",
     "tryCatch", "try"))
-  expect_equal(nzchar(df$loc), c(FALSE, FALSE, FALSE, TRUE, 
-    TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
-    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
-    TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
-    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, 
-    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, 
-    FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, 
+  expect_equal(nzchar(df$loc), c(FALSE, FALSE, FALSE, TRUE,
+    TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+    TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE,
+    FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
+    FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE,
     FALSE))
 })
 

tests/testthat/test-staticdocs.R

@@ -1,52 +0,0 @@
-context("staticdocs")
-
-test_that("All man pages have an entry in staticdocs/index.r", {
-  if (all(file.exists(c('../../inst/staticdocs', '../../man')))) {
-    # We're running tests on a source tree
-    mode <- "source"
-  } else if (all(file.exists(c('../../shiny/staticdocs', '../../shiny/html')))) {
-    # We're testing an installed package, possibly for R CMD check
-    mode <- "bundle"
-  } else {
-    cat("Unknown testing environment for test-staticdocs.R.\n", file = stderr())
-    return()
-  }
-
-  # Known not to be indexed
-  known_unindexed <- c("shiny-package", "stacktrace", "knitr_methods",
-                       "pageWithSidebar", "headerPanel", "shiny.appobj",
-                       "deprecatedReactives")
-
-  # Read in topics from a staticdocs/index.r file
-  get_indexed_topics <- function(index_path) {
-    result <- character(0)
-    sd_section <- function(dummy1, dummy2, section_topics) {
-      result <<- c(result, section_topics)
-    }
-    source(index_path, local = TRUE)
-    result
-  }
-
-  if (mode == "source") {
-    indexed_topics <- get_indexed_topics("../../inst/staticdocs/index.r")
-    all_topics <- sub("\\.Rd", "", list.files("../../man", pattern = "*.Rd"))
-
-  } else if (mode == "bundle") {
-    indexed_topics <- get_indexed_topics("../../shiny/staticdocs/index.r")
-    all_topics <- unique(unname(readRDS("../../shiny/help/aliases.rds")))
-  }
-
-  # This test ensures that every documented topic is included in
-  # staticdocs/index.r, unless explicitly waived by specifying it
-  # in the known_unindexed variable above.
-  missing <- setdiff(sort(all_topics), sort(c(known_unindexed, indexed_topics)))
-  unknown <- setdiff(sort(c(known_unindexed, indexed_topics)), sort(all_topics))
-  expect_equal(length(missing), 0,
-    info = paste("Functions missing from index:\n",
-      paste("  ", missing, sep = "", collapse = "\n"),
-      sep = ""))
-  expect_equal(length(unknown), 0,
-    info = paste("Unrecognized functions in index.r:\n",
-      paste("  ", unknown, sep = "", collapse = "\n"),
-      sep = ""))
-})

tests/testthat/test-test-module.R

@@ -0,0 +1,618 @@
+context("testModule")
+
+library(promises)
+library(future)
+plan(multisession)
+
+test_that("testModule handles observers", {
+  module <- function(input, output, session) {
+    rv <- reactiveValues(x = 0, y = 0)
+    observe({
+      rv$x <- input$x * 2
+    })
+    observe({
+      rv$y <- rv$x
+    })
+    output$txt <- renderText({
+      paste0("Value: ", rv$x)
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(x=1)
+    expect_equal(rv$y, 2)
+    expect_equal(rv$x, 2)
+    expect_equal(output$txt, "Value: 2")
+
+    session$setInputs(x=2)
+    expect_equal(rv$x, 4)
+    expect_equal(rv$y, 4)
+    expect_equal(output$txt, "Value: 4")
+  })
+})
+
+test_that("inputs aren't directly assignable", {
+  module <- function(input, output, session) {
+  }
+
+  testModule(module, {
+    session$setInputs(x = 0)
+    expect_error({ input$x <- 1 }, "Attempted to assign value to a read-only")
+    expect_error({ input$y <- 1 }, "Attempted to assign value to a read-only")
+  })
+})
+
+test_that("testModule handles more complex expressions", {
+  module <- function(input, output, session){
+    output$txt <- renderText({
+      input$x
+    })
+  }
+
+  testModule(module, {
+    for (i in 1:5){
+      session$setInputs(x=i)
+      expect_equal(output$txt, as.character(i))
+    }
+    expect_equal(output$txt, "5")
+
+    if(TRUE){
+      session$setInputs(x="abc")
+      expect_equal(output$txt, "abc")
+    }
+  })
+})
+
+test_that("testModule handles reactiveVal", {
+  module <- function(input, output, session) {
+    x <- reactiveVal(0)
+    observe({
+      x(input$y + input$z)
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(y=1, z=2)
+
+    expect_equal(x(), 3)
+
+    session$setInputs(z=3)
+    expect_equal(x(), 4)
+
+    session$setInputs(y=5)
+    expect_equal(x(), 8)
+  })
+})
+
+test_that("testModule handles reactives with complex dependency tree", {
+  module <- function(input, output, session) {
+    x <- reactiveValues(x=1)
+    r <- reactive({
+      x$x + input$a + input$b
+    })
+    r2 <- reactive({
+      r() + input$c
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(a=1, b=2, c=3)
+    expect_equal(r(), 4)
+    expect_equal(r2(), 7)
+
+    session$setInputs(a=2)
+    expect_equal(r(), 5)
+    expect_equal(r2(), 8)
+
+    session$setInputs(b=0)
+    expect_equal(r2(), 6)
+    expect_equal(r(), 3)
+
+    session$setInputs(c=4)
+    expect_equal(r(), 3)
+    expect_equal(r2(), 7)
+  })
+})
+
+test_that("testModule handles reactivePoll", {
+  module <- function(input, output, session) {
+    rv <- reactiveValues(x = 0)
+    rp <- reactivePoll(50, session, function(){ as.numeric(Sys.time()) }, function(){
+      isolate(rv$x <- rv$x + 1)
+      as.numeric(Sys.time())
+    })
+
+    observe({rp()})
+  }
+
+  testModule(module, {
+    expect_equal(rv$x, 1)
+
+    for (i in 1:4){
+      session$elapse(50)
+    }
+
+    expect_equal(rv$x, 5)
+  })
+})
+
+test_that("testModule handles reactiveTimer", {
+  module <- function(input, output, session) {
+    rv <- reactiveValues(x = 0)
+
+    rp <- reactiveTimer(50)
+    observe({
+      rp()
+      isolate(rv$x <- rv$x + 1)
+    })
+  }
+
+  testModule(module, {
+    expect_equal(rv$x, 1)
+
+    session$elapse(200)
+
+    expect_equal(rv$x, 5)
+  })
+})
+
+test_that("testModule handles debounce/throttle", {
+  module <- function(input, output, session) {
+    rv <- reactiveValues(t = 0, d = 0)
+    react <- reactive({
+      input$y
+    })
+    rt <- throttle(react, 100)
+    rd <- debounce(react, 100)
+
+    observe({
+      rt() # Invalidate this block on the timer
+      isolate(rv$t <- rv$t + 1)
+    })
+
+    observe({
+      rd()
+      isolate(rv$d <- rv$d + 1)
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(y = TRUE)
+    expect_equal(rv$d, 1)
+    for (i in 2:5){
+      session$setInputs(y = FALSE)
+      session$elapse(51)
+      session$setInputs(y = TRUE)
+      expect_equal(rv$t, i-1)
+      session$elapse(51) # TODO: we usually don't have to pad by a ms, but here we do. Investigate.
+      expect_equal(rv$t, i)
+    }
+    # Never sufficient time to debounce. Not incremented
+    expect_equal(rv$d, 1)
+    session$elapse(50)
+
+    # Now that 100ms has passed since the last update, debounce should have triggered
+    expect_equal(rv$d, 2)
+  })
+})
+
+test_that("testModule wraps output in an observer", {
+  testthat::skip("I'm not sure of a great way to test this without timers.")
+  # And honestly it's so foundational in what we're doing now that it might not be necessary to test?
+
+
+  module <- function(input, output, session) {
+    rv <- reactiveValues(x=0)
+    rp <- reactiveTimer(50)
+    output$txt <- renderText({
+      rp()
+      isolate(rv$x <- rv$x + 1)
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(x=1)
+    # Timers only tick if they're being observed. If the output weren't being
+    # wrapped in an observer, we'd see the value of rv$x initialize to zero and
+    # only increment when we evaluated the output. e.g.:
+    #
+    # expect_equal(rv$x, 0)
+    # Sys.sleep(1)
+    # expect_equal(rv$x, 0)
+    # output$txt()
+    # expect_equal(rv$x, 1)
+
+    expect_equal(rv$x, 1)
+    expect_equal(output$txt, "1")
+    Sys.sleep(.05)
+    Sys.sleep(.05)
+    expect_gt(rv$x, 1)
+    expect_equal(output$txt, as.character(rv$x))
+  })
+
+  # FIXME:
+  #  - Do we want the output to be accessible natively, or some $get() on the output? If we do a get() we could
+  #    do more helpful spy-type things around exec count.
+  #  - plots and such?
+})
+
+test_that("testModule works with async", {
+  module <- function(input, output, session) {
+    output$txt <- renderText({
+      val <- input$x
+      future({ val })
+    })
+
+    output$error <- renderText({
+      future({ stop("error here") })
+    })
+
+    output$sync <- renderText({
+      # No promises here
+      "abc"
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(x=1)
+    expect_equal(output$txt, "1")
+    expect_equal(output$sync, "abc")
+
+    # Error gets thrown repeatedly
+    expect_error(output$error, "error here")
+    expect_error(output$error, "error here")
+
+    # Responds reactively
+    session$setInputs(x=2)
+    expect_equal(output$txt, "2")
+    # Error still thrown
+    expect_error(output$error, "error here")
+  })
+})
+
+test_that("testModule works with multiple promises in parallel", {
+  module <- function(input, output, session) {
+    output$txt1 <- renderText({
+      future({
+        Sys.sleep(1)
+        1
+      })
+    })
+
+    output$txt2 <- renderText({
+      future({
+        Sys.sleep(1)
+        2
+      })
+    })
+  }
+
+  testModule(module, {
+    # As we enter this test code, the promises will still be running in the background.
+    # We'll need to give them ~2s (plus overhead) to complete
+    startMS <- as.numeric(Sys.time()) * 1000
+    expect_equal(output$txt1, "1") # This first call will block waiting for the promise to return
+    expect_equal(output$txt2, "2")
+    expect_equal(output$txt2, "2") # Now that we have the values, access should not incur a 1s delay.
+    expect_equal(output$txt1, "1")
+    expect_equal(output$txt1, "1")
+    expect_equal(output$txt2, "2")
+    endMS <- as.numeric(Sys.time()) * 1000
+
+    # We'll pad quite a bit because promises can introduce some lag. But the point we're trying
+    # to prove is that we're not hitting a 1s delay for each output access, which = 6000ms. If we're
+    # under that, then things are likely working.
+    expect_lt(endMS - startMS, 4000)
+  })
+})
+
+test_that("testModule handles async errors", {
+  module <- function(input, output, session, arg1, arg2){
+    output$err <- renderText({
+      future({ "my error"}) %...>%
+        stop() %...>%
+        print() # Extra steps after the error
+    })
+
+    output$safe <- renderText({
+      future({ safeError("my safe error") }) %...>%
+        stop()
+    })
+  }
+
+  testModule(module, {
+    expect_error(output$err, "my error")
+    # TODO: helper for safe errors so users don't have to learn "shiny.custom.error"?
+    expect_error(output$safe, "my safe error", class="shiny.custom.error")
+  })
+})
+
+test_that("testModule handles modules with additional arguments", {
+  module <- function(input, output, session, arg1, arg2){
+    output$txt1 <- renderText({
+      arg1
+    })
+
+    output$txt2 <- renderText({
+      arg2
+    })
+
+    output$inp <- renderText({
+      input$x
+    })
+  }
+
+  testModule(module, {
+    expect_equal(output$txt1, "val1")
+    expect_equal(output$txt2, "val2")
+  }, arg1="val1", arg2="val2")
+})
+
+test_that("testModule captures htmlwidgets", {
+  # TODO: use a simple built-in htmlwidget instead of something complex like dygraph
+  if (!requireNamespace("dygraphs")){
+    testthat::skip("dygraphs not available to test htmlwidgets")
+  }
+
+  if (!requireNamespace("jsonlite")){
+    testthat::skip("jsonlite not available to test htmlwidgets")
+  }
+
+  module <- function(input, output, session){
+    output$dy <- dygraphs::renderDygraph({
+      dygraphs::dygraph(data.frame(outcome=0:5, year=2000:2005))
+    })
+  }
+
+  testModule(module, {
+    # Really, this test should be specific to each htmlwidget. Here, we don't want to bind ourselves
+    # to the current JSON structure of dygraphs, so we'll just check one element to see that the raw
+    # JSON was exposed and is accessible in tests.
+    d <- jsonlite::fromJSON(output$dy)$x$data
+    expect_equal(d[1,], 0:5)
+    expect_equal(d[2,], 2000:2005)
+  })
+})
+
+test_that("testModule captures renderUI", {
+  module <- function(input, output, session){
+    output$ui <- renderUI({
+      tags$a(href="https://rstudio.com", "hello!")
+    })
+  }
+
+  testModule(module, {
+    expect_equal(output$ui$deps, list())
+    expect_equal(as.character(output$ui$html), "<a href=\"https://rstudio.com\">hello!</a>")
+  })
+})
+
+test_that("testModule captures base graphics outputs", {
+  module <- function(input, output, session){
+    output$fixed <- renderPlot({
+      plot(1,1)
+    }, width=300, height=350)
+
+    output$dynamic <- renderPlot({
+      plot(1,1)
+    })
+  }
+
+  testModule(module, {
+    # We aren't yet able to create reproducible graphics, so this test is intentionally pretty
+    # limited.
+    expect_equal(output$fixed$width, 300)
+    expect_equal(output$fixed$height, 350)
+    expect_match(output$fixed$src, "^data:image/png;base64,")
+
+    # Ensure that the plot defaults to a reasonable size.
+    expect_equal(output$dynamic$width, 600)
+    expect_equal(output$dynamic$height, 400)
+    expect_match(output$dynamic$src, "^data:image/png;base64,")
+
+    # TODO: how do you customize automatically inferred plot sizes?
+    # session$setPlotMeta("dynamic", width=600, height=300) ?
+  })
+})
+
+test_that("testModule captures ggplot2 outputs", {
+  if (!requireNamespace("ggplot2")){
+    testthat::skip("ggplot2 not available")
+  }
+
+  module <- function(input, output, session){
+    output$fixed <- renderPlot({
+      ggplot2::qplot(iris$Sepal.Length, iris$Sepal.Width)
+    }, width=300, height=350)
+
+    output$dynamic <- renderPlot({
+      ggplot2::qplot(iris$Sepal.Length, iris$Sepal.Width)
+    })
+  }
+
+  testModule(module, {
+    expect_equal(output$fixed$width, 300)
+    expect_equal(output$fixed$height, 350)
+    expect_match(output$fixed$src, "^data:image/png;base64,")
+
+    # Ensure that the plot defaults to a reasonable size.
+    expect_equal(output$dynamic$width, 600)
+    expect_equal(output$dynamic$height, 400)
+    expect_match(output$dynamic$src, "^data:image/png;base64,")
+  })
+})
+
+test_that("testModule exposes the returned value from the module", {
+  module <- function(input, output, session){
+    reactive({
+      return(input$a + input$b)
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(a=1, b=2)
+    expect_equal(session$returned(), 3)
+
+    # And retains reactivity
+    session$setInputs(a=2)
+    expect_equal(session$returned(), 4)
+  })
+})
+
+test_that("testModule handles synchronous errors", {
+  module <- function(input, output, session, arg1, arg2){
+    output$err <- renderText({
+      stop("my error")
+    })
+
+    output$safe <- renderText({
+      stop(safeError("my safe error"))
+    })
+  }
+
+  testModule(module, {
+    expect_error(output$err, "my error")
+    # TODO: helper for safe errors so users don't have to learn "shiny.custom.error"?
+    expect_error(output$safe, "my safe error", class="shiny.custom.error")
+  })
+})
+
+test_that("accessing a non-existant output gives an informative message", {
+  module <- function(input, output, session){}
+
+  testModule(module, {
+    expect_error(output$dontexist, "hasn't been defined yet: output\\$dontexist")
+  })
+})
+
+test_that("testServer works", {
+  # app.R
+  testServer({
+    session$setInputs(dist="norm", n=5)
+    expect_length(d(), 5)
+
+    session$setInputs(dist="unif", n=6)
+    expect_length(d(), 6)
+  }, appDir=test_path("../../inst/examples/06_tabsets"))
+
+  # TODO: test with server.R
+})
+
+test_that("testServer works when referencing external globals", {
+  # If global is defined at the top of app.R outside of the server function.
+  testthat::skip("NYI")
+})
+
+test_that("testModule handles invalidateLater", {
+  module <- function(input, output, session) {
+    rv <- reactiveValues(x = 0)
+    observe({
+      isolate(rv$x <- rv$x + 1)
+      # We're only testing one invalidation
+      if (isolate(rv$x) <= 1){
+        invalidateLater(50)
+      }
+    })
+  }
+
+  testModule(module, {
+    # Should have run once
+    expect_equal(rv$x, 1)
+
+    session$elapse(49)
+    expect_equal(rv$x, 1)
+
+    session$elapse(1)
+    # Should have been incremented now
+    expect_equal(rv$x, 2)
+  })
+})
+
+test_that("session ended handlers work", {
+  module <- function(input, output, session){}
+
+  testModule(module, {
+    rv <- reactiveValues(closed = FALSE)
+    session$onEnded(function(){
+      rv$closed <- TRUE
+    })
+
+    expect_equal(session$isEnded(), FALSE)
+    expect_equal(session$isClosed(), FALSE)
+    expect_false(rv$closed, FALSE)
+
+    session$close()
+
+    expect_equal(session$isEnded(), TRUE)
+    expect_equal(session$isClosed(), TRUE)
+    expect_false(rv$closed, TRUE)
+  })
+})
+
+test_that("session flush handlers work", {
+  module <- function(input, output, session) {
+    rv <- reactiveValues(x = 0, flushCounter = 0, flushedCounter = 0,
+                         flushOnceCounter = 0, flushedOnceCounter = 0)
+
+    onFlush(function(){rv$flushCounter <- rv$flushCounter + 1}, once=FALSE)
+    onFlushed(function(){rv$flushedCounter <- rv$flushedCounter + 1}, once=FALSE)
+    onFlushed(function(){rv$flushOnceCounter <- rv$flushOnceCounter + 1}, once=TRUE)
+    onFlushed(function(){rv$flushedOnceCounter <- rv$flushedOnceCounter + 1}, once=TRUE)
+
+    observe({
+      rv$x <- input$x * 2
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(x=1)
+    expect_equal(rv$x, 2)
+    # We're not concerned with the exact values here -- only that they increase
+    fc <- rv$flushCounter
+    fdc <- rv$flushedCounter
+
+    session$setInputs(x=2)
+    expect_gt(rv$flushCounter, fc)
+    expect_gt(rv$flushedCounter, fdc)
+
+    # These should have only run once
+    expect_equal(rv$flushOnceCounter, 1)
+    expect_equal(rv$flushedOnceCounter, 1)
+
+  })
+})
+
+test_that("findApp errors with no app", {
+  calls <- 0
+  nothingExists <- function(path){
+    calls <<- calls + 1
+    FALSE
+  }
+  fa <- rewire(findApp, file.exists.ci=nothingExists)
+  expect_error(
+    expect_warning(fa("/some/path/here"), "No such file or directory"), # since we just made up a path
+    "No shiny app was found in ")
+  expect_equal(calls, 4 * 2) # Checks here, path, some, and / -- looking for app.R and server.R for each
+})
+
+test_that("findApp works with app in current or parent dir", {
+  calls <- 0
+  cd <- normalizePath(".")
+  mockExists <- function(path){
+    # Only TRUE if looking for server.R or app.R in current Dir
+    calls <<- calls + 1
+
+    appPath <- file.path(cd, "app.R")
+    serverPath <- file.path(cd, "server.R")
+    return(path %in% c(appPath, serverPath))
+  }
+  fa <- rewire(findApp, file.exists.ci=mockExists)
+  expect_equal(fa(), cd)
+  expect_equal(calls, 1) # Should get a hit on the first call and stop
+
+  # Reset and point to the parent dir
+  calls <- 0
+  cd <- normalizePath("../") # TODO: won't work if running tests in the root dir.
+  expect_equal(fa(), cd)
+  expect_equal(calls, 3) # Two for current dir and hit on the first in the parent
+})

tests/testthat/test-timer.R

@@ -27,13 +27,13 @@ test_that("Scheduling works", {
 test_that("Unscheduling works", {
   origTimes <- timerCallbacks$.times
   origFuncKeys <- timerCallbacks$.funcs$keys()
-  
+
   taskHandle <- scheduleTask(1000, function() {
     message("Whatever")
   })
   # Unregister
   taskHandle()
-  
+
   expect_identical(timerCallbacks$.times, origTimes)
   expect_identical(timerCallbacks$.funcs$keys(), origFuncKeys)
 })
@@ -42,7 +42,46 @@ test_that("Vectorized unscheduling works", {
   key1 <- timerCallbacks$schedule(1000, function() {})
   key2 <- timerCallbacks$schedule(1000, function() {})
   key3 <- timerCallbacks$schedule(1000, function() {})
-  
+
   expect_identical(timerCallbacks$unschedule(key2), TRUE)
   expect_identical(timerCallbacks$unschedule(c(key1, key2, key3)), c(TRUE, FALSE, TRUE))
 })
+
+test_that("defineScheduler works", {
+  expect_identical(defineScheduler(NULL), scheduleTask)
+  expect_identical(defineScheduler(list()), scheduleTask)
+  expect_identical(defineScheduler(list(scheduleTask=123)), 123)
+})
+
+test_that("mockableTimer works", {
+  mt <- MockableTimerCallbacks$new()
+  called <- FALSE
+  mt$schedule(50, function(){
+    called <<- TRUE
+  })
+  expect_false(mt$executeElapsed())
+
+  # Prove that we're not bound to a real clock
+  Sys.sleep(.1)
+  expect_false(mt$executeElapsed())
+  expect_false(called)
+
+  mt$elapse(51)
+  expect_true(mt$executeElapsed())
+  expect_true(called)
+})
+
+test_that("getTime works", {
+  start <- Sys.time()
+  t1 <- getTime(NULL)
+  t2 <- getTime(list())
+  t3 <- getTime(list(now = function(){456}))
+  end <- Sys.time()
+
+  expect_gte(t1, start)
+  expect_gte(t2, start)
+  expect_lte(t1, end)
+  expect_lte(t2, end)
+
+  expect_equal(t3, 456)
+})

tools/Gruntfile.js

@@ -110,6 +110,9 @@ module.exports = function(grunt) {
           "dot-location": [1, "property"],
           "eqeqeq": 1,
           // "no-shadow": 1,
+          "no-implicit-globals": 1,
+          "no-restricted-globals": ["error", "name", "length", "top", "location", "parent", "status"],
+          "no-global-assign": 1,
           "no-undef": 1,
           "no-unused-vars": [1, {"args": "none"}],
           "guard-for-in": 1,

vignettes/integration-testing.Rmd

@@ -0,0 +1,296 @@
+---
+title: "Integration Testing in Shiny"
+output: rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{Your Vignette Title}
+  %\VignetteEncoding{UTF-8}
+  %\VignetteEngine{knitr::rmarkdown}
+editor_options: 
+  chunk_output_type: console
+---
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+## Introduction to Inspecting Modules
+
+First, we'll define a simple Shiny module:
+
+```{r}
+library(shiny)
+module <- function(input, output, session) {
+  rv <- reactiveValues(x = 0)
+  observe({
+    rv$x <- input$x * 2
+  })
+  output$txt <- renderText({
+    paste0("Value: ", rv$x)
+  })
+}
+```
+
+This module
+
+  - depends on one input (`x`),
+  - has an intermediate, internal `reactiveValues` (`rv`) which updates reactively,
+  - and updates an output (`txt`) reactively. 
+  
+It would be nice to write tests that confirm that the module behaves the way we expect. We can do so using the `testModule` function.
+
+```{r}
+testModule(module, {
+  cat("Initially, input$x is NULL, right?", is.null(input$x), "\n")
+  
+  # Give input$x a value.
+  session$setInputs(x = 1)
+  
+  cat("Now that x is set to 1, rv$x is: ", rv$x, "\n")
+  cat("\tand output$txt is: ", output$txt, "\n")
+
+  # Now update input$x to a new value
+  session$setInputs(x = 2)
+  
+  cat("After updating x to 2, rv$x is: ", rv$x, "\n")
+  cat("\tand output$txt is: ", output$txt, "\n")
+})
+```
+
+There are a few things to notice in this example. 
+
+First, the test expression provided here assumes the existence of some variables -- specifically, `input`, `output`, and `r`. This is safe because the test code provided to `testModule` is run in the module's environment. This means that any parameters passed in to your module (such as `input`, `output`, and `session`) are readily available, as are any intermediate objects or reactives that you define in the module (such as `r`).
+
+Second, you'll need to give values to any inputs that you want to be defined; by default, they're all `NULL`. We do that using the `session$setInputs()` method. The `session` object used in `testModule` differs from the real `session` object Shiny uses; this allows us to tailor it to be more suitable for testing purposes by modifying or creating new methods such as `setInputs()`.
+
+Last, you're likely used to assigning to `output`, but here we're reading from `output$txt` in order to check its value. When running inside `testModule`, you can simply reference an output and it will give the value produced by the `render` function.
+
+## Automated Tests
+
+Realistically, we don't want to just print the values for manual inspection; we'll want to leverage them in automated tests. That way, we'll be able to build up a collection of tests that we can run against our module in the future to confirm that it always behaves correctly. You can use whatever testing framework you'd like (or none a all!), but we'll use the `expect_*` functions from the testthat package in this example.
+
+```{r}
+# Bring in testthat just for its expectations
+suppressWarnings(library(testthat))
+
+testModule(module, {
+  session$setInputs(x = 1)
+  expect_equal(rv$x, 2)
+  expect_equal(output$txt, "Value: 2")
+
+  session$setInputs(x = 2)
+  expect_equal(rv$x, 4)
+  expect_equal(output$txt, "Value: 4")
+})
+```
+
+If there's no error, then we know our tests ran successfully. If there were a bug, we'd see an error printed. For example:
+
+```{r}
+tryCatch({
+  testModule(module, {
+    session$setInputs(x = 1)
+    
+    # This expectation will fail
+    expect_equal(rv$x, 99)
+  })
+}, error=function(e){
+  print("There was an error!")
+  print(e)
+})
+```
+
+## Promises
+
+`testModule` can handle promises inside of render functions.
+
+```{r}
+library(promises)
+library(future)
+plan(multisession)
+
+module <- function(input, output, session){
+  output$async <- renderText({
+    # Stash the value since you can't do reactivity inside of a promise. See 
+    # https://rstudio.github.io/promises/articles/shiny.html#shiny-specific-caveats-and-limitations
+    t <- input$times
+    
+    # A promise chain that repeats the letter A and then collapses it into a string.
+    future({ rep("A", times=t) }) %...>%
+      paste(collapse="")
+  })
+}
+
+testModule(module, {
+  session$setInputs(times = 3)
+  expect_equal(output$async, "AAA")
+  
+  session$setInputs(times = 5)
+  expect_equal(output$async, "AAAAA")
+})
+```
+
+As you can see, no special precautions were required for a `render` function that uses promises. Behind-the-scenes, the code in `testModule` will block when trying to read from an `output` that returned a promise. This allows you to interact with the outputs in your tests as if they were synchronous.
+
+TODO: What about internal reactives that are promise-based? We don't do anything special for them...
+
+## Modules with additional inputs
+
+`testModule` can also handle modules that accept additional arguments such as this one.
+
+```{r}
+module <- function(input, output, session, arg1, arg2){
+  output$txt1 <- renderText({ arg1 })
+  
+  output$txt2 <- renderText({ arg2 })
+}
+```
+
+Additional arguments should be passed after the test expression as named parameters.
+
+```{r}
+testModule(module, {
+  expect_equal(output$txt1, "val1")
+  expect_equal(output$txt2, "val2")
+}, arg1="val1", arg2="val2")
+```
+
+## Accessing a module's returned value
+
+Some modules return reactive data as an output. For such modules, it can be helpful to test the returned value, as well. The returned value from the module is made available as a property on the mock `session` object as demonstrated in this example.
+
+```{r}
+module <- function(input, output, session){
+    reactive({
+      return(input$a + input$b)
+    })
+  }
+
+  testModule(module, {
+    session$setInputs(a = 1, b = 2)
+    expect_equal(session$returned(), 3)
+
+    # And retains reactivity
+    session$setInputs(a = 2)
+    expect_equal(session$returned(), 4)
+  })
+```
+
+## Timer and Polling
+
+Testing behavior that relies on timing is notoriously difficult. Modules will behave differently on different machines and under different conditions. In order to make testing with time more deterministic, `testModule` uses simulated time that you control, rather than the actual computer time. Let's look at what happens when you try to use "real" time in your testing.
+
+```{r}
+module <- function(input, output, session){
+  rv <- reactiveValues(x=0)
+  
+  observe({
+    invalidateLater(100)
+    isolate(rv$x <- rv$x + 1)
+  })
+}
+
+testModule(module, {
+  expect_equal(rv$x, 1) # The observer runs once at initialization
+  
+  Sys.sleep(1) # Sleep for a second
+  
+  expect_equal(rv$x, 1) # The value hasn't changed
+})
+```
+
+This behavior may be surprising. It seems like `rv$x` should have been incremented 10 times (or perhaps 9, due to computational overhead). But in truth, it hasn't changed at all. This is because `testModule` doesn't consider the actual time on your computer -- only its simulated understanding of time.
+
+In order to cause `testModule` to progress through time, instead of `Sys.sleep`, we'll use `session$elapse` -- another method that exists only on our mocked session object. Using the same module object as above...
+
+```{r}
+testModule(module, {
+  expect_equal(rv$x, 1) # The observer runs once at initialization
+  
+  session$elapse(100) # Simulate the passing of 100ms
+  
+  expect_equal(rv$x, 2) # The observer was invalidated and the value updated!
+  
+  # You can even simulate multiple events in a single elapse
+  session$elapse(300)
+  expect_equal(rv$x, 5)
+})
+```
+
+As you can see, using `session$elapse` caused `testModule` to recognize that (simulted) time had passed which triggered the reactivity as we'd expect. This approach allows you to deterministically control time in your tests while avoiding expensive pauses that would slow down your tests. Using this approach, this test can complete in only a fraction of the 100ms that it simulates.
+
+## Complex Outputs (plots, htmlwidgets)
+
+**Work in progress** -- We intend to add more helpers to make it easier to inspect and validate the raw HTML/JSON content. But for now, validating the output is an exercise left to the user.
+
+Thus far, we've seen how to validate simple outputs like numeric or text values. Real Shiny modules applications often use more complex outputs such as plots or htmlwidgets. Validating the correctness of these is not as simple, but is doable.
+
+You can access the data for even complex outputs in `testModule`, but the structure of the output may initially be foreign to you.
+
+```{r}
+module <- function(input, output, session){
+  output$plot <- renderPlot({
+    df <- data.frame(length = iris$Petal.Length, width = iris$Petal.Width)
+    plot(df)
+  })
+}
+
+testModule(module, {
+  print(str(output$plot))
+})
+```
+
+As you can see, there are a lot of internal details that go into a plot. Behind-the-scenes, these are all the details that Shiny will use to correctly display a plot in a user's browser. You don't need to learn about all of these properties -- and they're all subject to change. 
+
+In terms of your testing strategy, you shouldn't bother yourself with "is Shiny generating the correct structure so that the plot will generate in the browser?" That's a question that the Shiny package itself needs to answer (and one for which we have our own tests). The goal for your tests should be to ask: "is the code that I wrote producing the plot I want?" There are two components to that question:
+
+1. Does the plot generate without producing an error?
+2. Is the plot visually correct?
+
+`testModule` is great for assessing the first component here. By merely referencing `output$plot` in your test, you'll confirm that the plot was generated without an error. The second component is better suited for a shinytest test which actually loads the Shiny app in a headless browser and confirms that the content visually appears the same as it did previously. Doing this kind of test in `testModule` would be complex and may not be reliable as graphics devices differ slightly from platform to platform; i.e. the exact bits in the `src` field of your plot will not necessarily be reproducible between different versions of R or different operating systems.
+
+For htmlwidgets, you can adopt a similar strategy. The goal is not to confirm that the htmlwidget's render function is behaving properly -- but rather that the data that you intend to render is indeed getting rendered properly.
+
+We could modify the above example to better represent this approach.
+
+```{r}
+module <- function(input, output, session){
+  # Move any complex logic into a separate reactive which can be tested comprehensively
+  plotData <- reactive({
+    data.frame(length = iris$Petal.Length, width = iris$Petal.Width)
+  })
+  
+  # And leave the `render` function to be as simple as possible to lessen the need for 
+  # integration tests.
+  output$plot <- renderPlot({
+    plot(plotData())
+  })
+}
+
+testModule(module, {
+  # Confirm that the data reactive is behaving as expected
+  expect_equal(nrow(plotData()), 150)
+  expect_equal(ncol(plotData()), 2)
+  expect_equal(colnames(plotData()), c("length", "width"))
+  
+  # And now the plot function is so simple that there's not much need for 
+  # automated testing. If we did wish to evaluate the plot visually, we could
+  # do so using the shinytest package.
+  output$plot # Just confirming that the plot can be accessed without an error
+})
+```
+
+You could adopt a similar strategy with other plots or htmlwidgets: move the complexity into reactives that can be tested, and leave the complex `render` functions as simple as possible.
+
+## Testing Shiny Applications
+
+In addition to testing Shiny modules, you can also test Shiny applications. The `testServer` function will automatically extract the server portion given an application's directory and you can test it just like you do any other module.
+
+```{r}
+appdir <- system.file("examples/06_tabsets", package="shiny")
+testServer({
+  session$setInputs(dist="norm", n=10)
+  expect_equal(length(d()), 10)
+}, appdir)
+```
+
+As you can see, the test expression can be run for Shiny servers just like it was run for modules.