testServer(): Properly capture module return values

* MockShinySession: add $click()

* Fix return value of MockShinySession$click()

* session$click() test w/ observeEvent

* session$click() test w/ observeEvent

* $click() examples

* $click, $setInputs: add \\dontrun

* $setInputs(): make dots dynamic

* document

* rm $click()

.travis.yml

@@ -6,7 +6,11 @@ matrix:
       r_packages:
         - devtools
         - rprojroot
-      script: ./tools/checkDocsCurrent.sh
+      script: ./tools/documentation/checkDocsCurrent.sh
+      env:
+        # GITHUB_PAT for gh::gh calls
+        - secure: "Hk4piVNtDobLT1dQPnCOcM7sOlwNGJOU5cpvbRvOxYSgxP+Bj2MyRZMe825rdHkHbFez0h8w3tJOBf9DDBH7PC1BhhNll2+WM/WxGlkNleg8vsoH/Xopffl+2YgtWbAYZjQ2j0QYdgNn0e/TY86/ggk9qit6+gpsZ7z/HmWQuVY="
+
     - name: "Javascript check"
       language: node_js
       cache: yarn

DESCRIPTION

@@ -79,7 +79,9 @@ Imports:
     crayon,
     rlang (>= 0.4.0),
     fastmap (>= 1.0.0),
-    withr
+    withr,
+    commonmark (>= 1.7),
+    glue (>= 1.3.2)
 Suggests:
     datasets,
     Cairo (>= 1.5-5),
@@ -95,11 +97,13 @@ Suggests:
     future,
     dygraphs
 Remotes:
-    rstudio/htmltools
+    rstudio/htmltools,
+    rstudio/shinytest
 URL: http://shiny.rstudio.com
 BugReports: https://github.com/rstudio/shiny/issues
 Collate:
     'app.R'
+    'app_template.R'
     'bookmark-state-local.R'
     'stack.R'
     'bookmark-state.R'
@@ -155,6 +159,7 @@ Collate:
     'priorityqueue.R'
     'progress.R'
     'react.R'
+    'reexports.R'
     'render-cached-plot.R'
     'render-plot.R'
     'render-table.R'
@@ -170,7 +175,7 @@ Collate:
     'snapshot.R'
     'tar.R'
     'test-export.R'
-    'test-module.R'
+    'test-server.R'
     'test.R'
     'update-input.R'
 RoxygenNote: 7.1.0

NAMESPACE

@@ -142,8 +142,10 @@ export(loadSupport)
 export(mainPanel)
 export(makeReactiveBinding)
 export(markRenderFunction)
+export(markdown)
 export(maskReactiveContext)
 export(memoryCache)
+export(migrateLegacyShinytest)
 export(modalButton)
 export(modalDialog)
 export(moduleServer)
@@ -229,6 +231,7 @@ export(setSerializer)
 export(shinyApp)
 export(shinyAppDir)
 export(shinyAppFile)
+export(shinyAppTemplate)
 export(shinyOptions)
 export(shinyServer)
 export(shinyUI)
@@ -252,6 +255,7 @@ export(strong)
 export(submitButton)
 export(suppressDependencies)
 export(tabPanel)
+export(tabPanelBody)
 export(tableOutput)
 export(tabsetPanel)
 export(tag)
@@ -263,7 +267,6 @@ export(tagHasAttribute)
 export(tagList)
 export(tagSetChildren)
 export(tags)
-export(testModule)
 export(testServer)
 export(textAreaInput)
 export(textInput)
@@ -272,6 +275,7 @@ export(throttle)
 export(titlePanel)
 export(uiOutput)
 export(updateActionButton)
+export(updateActionLink)
 export(updateCheckboxGroupInput)
 export(updateCheckboxInput)
 export(updateDateInput)
@@ -314,6 +318,43 @@ importFrom(fastmap,is.key_missing)
 importFrom(fastmap,key_missing)
 importFrom(grDevices,dev.cur)
 importFrom(grDevices,dev.set)
+importFrom(htmltools,HTML)
+importFrom(htmltools,a)
+importFrom(htmltools,br)
+importFrom(htmltools,code)
+importFrom(htmltools,div)
+importFrom(htmltools,em)
+importFrom(htmltools,h1)
+importFrom(htmltools,h2)
+importFrom(htmltools,h3)
+importFrom(htmltools,h4)
+importFrom(htmltools,h5)
+importFrom(htmltools,h6)
+importFrom(htmltools,hr)
+importFrom(htmltools,htmlTemplate)
+importFrom(htmltools,img)
+importFrom(htmltools,includeCSS)
+importFrom(htmltools,includeHTML)
+importFrom(htmltools,includeMarkdown)
+importFrom(htmltools,includeScript)
+importFrom(htmltools,includeText)
+importFrom(htmltools,is.singleton)
+importFrom(htmltools,p)
+importFrom(htmltools,pre)
+importFrom(htmltools,singleton)
+importFrom(htmltools,span)
+importFrom(htmltools,strong)
+importFrom(htmltools,suppressDependencies)
+importFrom(htmltools,tag)
+importFrom(htmltools,tagAppendAttributes)
+importFrom(htmltools,tagAppendChild)
+importFrom(htmltools,tagAppendChildren)
+importFrom(htmltools,tagGetAttribute)
+importFrom(htmltools,tagHasAttribute)
+importFrom(htmltools,tagList)
+importFrom(htmltools,tagSetChildren)
+importFrom(htmltools,tags)
+importFrom(htmltools,validateCssUnit)
+importFrom(htmltools,withTags)
 importFrom(promises,"%...!%")
 importFrom(promises,"%...>%")
-importFrom(withr,with_options)

NEWS.md

@@ -7,8 +7,16 @@ shiny 1.4.0.9001
 
 ### New features
 
+* The new `shinyAppTemplate()` function creates a new template Shiny application, where components are optional, such as helper files in an R/ subdirectory, a module, and various kinds of tests. ([#2704](https://github.com/rstudio/shiny/pull/2704))
+
+* `runTests()` is a new function that behaves much like R CMD check. `runTests()` invokes all of the top-level R files in the tests/ directory inside an application, in that application's environment. ([#2585](https://github.com/rstudio/shiny/pull/2585))
+
+* `testServer()` and `testModule()` are two new functions for testing reactive behavior inside server functions and modules, respectively. ([#2682](https://github.com/rstudio/shiny/pull/2682), [#2764](https://github.com/rstudio/shiny/pull/2764))
+
 * The new `moduleServer` function provides a simpler interface for creating and using modules. ([#2773](https://github.com/rstudio/shiny/pull/2773))
 
+* Resolved [#2732](https://github.com/rstudio/shiny/issues/2732): `markdown()` is a new function for writing Markdown with Github extensions directly in Shiny UIs. Markdown rendering is performed by the [commonmark](https://github.com/jeroen/commonmark) package. ([#2737](https://github.com/rstudio/shiny/pull/2737))
+
 ### Minor new features and improvements
 
 * Fixed [#2042](https://github.com/rstudio/shiny/issues/2042), [#2628](https://github.com/rstudio/shiny/issues/2628): In a `dateInput` and `dateRangeInput`, disabled months and years are now a lighter gray, to make it easier to see that they are disabled. ([#2690](https://github.com/rstudio/shiny/pull/2690))
@@ -21,6 +29,10 @@ shiny 1.4.0.9001
 
 * Added a `'function'` class to `reactive()` and `reactiveVal()` objects. ([#2793](https://github.com/rstudio/shiny/pull/2793))
 
+* Added a new option (`type = "hidden"`) to `tabsetPanel()`, making it easier to set the active tab via other input controls (e.g., `radioButtons()`) rather than tabs or pills. Use this option in conjunction with `updateTabsetPanel()` and the new `tabsetPanelBody()` function (see `help(tabsetPanel)` for an example and more details).  ([#2814](https://github.com/rstudio/shiny/pull/2814))
+
+* Added function `updateActionLink()` to update an `actionLink()` label and/or icon value. ([#2811](https://github.com/rstudio/shiny/pull/2811))
+
 ### Bug fixes
 
 * Fixed [#2606](https://github.com/rstudio/shiny/issues/2606): `debounce()` would not work properly if the code in the reactive expression threw an error on the first run. ([#2652](https://github.com/rstudio/shiny/pull/2652))
@@ -30,6 +42,12 @@ shiny 1.4.0.9001
 ### Documentation Updates
 
 
+shiny 1.4.0.2
+===========
+
+Minor patch release: fixed some timing-dependent tests failed intermittently on CRAN build machines.
+
+
 shiny 1.4.0.1
 ===========
 

R/app.R

@@ -227,7 +227,6 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
   onStart <- function() {
     oldwd <<- getwd()
     setwd(appDir)
-    monitorHandle <<- initAutoReloadMonitor(appDir)
     # TODO: we should support hot reloading on global.R and R/*.R changes.
     if (getOption("shiny.autoload.r", TRUE)) {
       loadSupport(appDir, renv=sharedEnv, globalrenv=globalenv())
@@ -235,11 +234,17 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
       if (file.exists(file.path.ci(appDir, "global.R")))
         sourceUTF8(file.path.ci(appDir, "global.R"))
     }
+    monitorHandle <<- initAutoReloadMonitor(appDir)
   }
   onStop <- function() {
     setwd(oldwd)
-    monitorHandle()
-    monitorHandle <<- NULL
+    # It is possible that while calling appObj()$onStart() or loadingSupport, an error occured
+    # This will cause `onStop` to be called.
+    #   The `oldwd` will exist, but `monitorHandle` is not a function yet.
+    if (is.function(monitorHandle)) {
+      monitorHandle()
+      monitorHandle <<- NULL
+    }
   }
 
   structure(
@@ -297,14 +302,14 @@ initAutoReloadMonitor <- function(dir) {
     } else if (!identical(lastValue, times)) {
       # We've changed!
       lastValue <<- times
-      for (session in appsByToken$values()) {
-        session$reload()
-      }
+      autoReloadCallbacks$invoke()
     }
 
     invalidateLater(getOption("shiny.autoreload.interval", 500))
   })
 
+  onStop(obs$destroy)
+
   obs$destroy
 }
 
@@ -325,37 +330,49 @@ initAutoReloadMonitor <- function(dir) {
 #' @details The files are sourced in alphabetical order (as determined by
 #'   [list.files]). `global.R` is evaluated before the supporting R files in the
 #'   `R/` directory.
-#' @param appDir The application directory
+#' @param appDir The application directory. If `appDir` is `NULL` or
+#'   not supplied, the nearest enclosing directory that is a Shiny app, starting
+#'   with the current directory, is used.
 #' @param renv The environmeny in which the files in the `R/` directory should
 #'   be evaluated.
 #' @param globalrenv The environment in which `global.R` should be evaluated. If
 #'   `NULL`, `global.R` will not be evaluated at all.
 #' @export
-loadSupport <- function(appDir, renv=new.env(parent=globalenv()), globalrenv=globalenv()){
+loadSupport <- function(appDir=NULL, renv=new.env(parent=globalenv()), globalrenv=globalenv()){
+  require(shiny)
+
+  if (is.null(appDir)) {
+    appDir <- findEnclosingApp(".")
+  }
+
   if (!is.null(globalrenv)){
     # Evaluate global.R, if it exists.
-    if (file.exists(file.path.ci(appDir, "global.R"))){
-      sourceUTF8(file.path.ci(appDir, "global.R"), envir=globalrenv)
+    globalPath <- file.path.ci(appDir, "global.R")
+    if (file.exists(globalPath)){
+      withr::with_dir(appDir, {
+        sourceUTF8(basename(globalPath), envir=globalrenv)
+      })
     }
   }
 
+
   helpersDir <- file.path(appDir, "R")
 
   disabled <- list.files(helpersDir, pattern="^_disable_autoload\\.r$", recursive=FALSE, ignore.case=TRUE)
   if (length(disabled) > 0){
-    message("R/_disable_autoload.R detected; not loading the R/ directory automatically")
     return(invisible(renv))
   }
 
   helpers <- list.files(helpersDir, pattern="\\.[rR]$", recursive=FALSE, full.names=TRUE)
+  # Ensure files in R/ are sorted according to the 'C' locale before sourcing.
+  # This convention is based on the default for packages. For details, see:
+  # https://cran.r-project.org/doc/manuals/r-release/R-exts.html#The-DESCRIPTION-file
+  helpers <- sort(helpers, method = "radix")
+  helpers <- normalizePath(helpers)
 
-  if (length(helpers) > 0){
-    message("Automatically loading ", length(helpers), " .R file",
-            ifelse(length(helpers) != 1, "s", ""),
-            " found in the R/ directory.\nSee https://rstd.io/shiny-autoload for more info.")
-  }
-
-  lapply(helpers, sourceUTF8, envir=renv)
+  withr::with_dir(appDir, {
+    lapply(helpers, sourceUTF8, envir=renv)
+  })
 
   invisible(renv)
 }
@@ -429,13 +446,19 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
     if (getOption("shiny.autoload.r", TRUE)) {
       loadSupport(appDir, renv=sharedEnv, globalrenv=NULL)
     }
-    monitorHandle <<- initAutoReloadMonitor(appDir)
     if (!is.null(appObj()$onStart)) appObj()$onStart()
+    monitorHandle <<- initAutoReloadMonitor(appDir)
+    invisible()
   }
   onStop <- function() {
     setwd(oldwd)
-    monitorHandle()
-    monitorHandle <<- NULL
+    # It is possible that while calling appObj()$onStart() or loadingSupport, an error occured
+    # This will cause `onStop` to be called.
+    #   The `oldwd` will exist, but `monitorHandle` is not a function yet.
+    if (is.function(monitorHandle)) {
+      monitorHandle()
+      monitorHandle <<- NULL
+    }
   }
 
   structure(

R/app_template.R

@@ -0,0 +1,283 @@
+#' Generate a Shiny application from a template
+#'
+#' This function populates a directory with files for a Shiny application.
+#'
+#' In an interactive R session, this function will, by default, prompt the user
+#' which components to add to the application.
+#'
+#' The full example application includes the following files and directories:
+#'
+#' ```
+#' appdir/
+#' |- app.R
+#' |- R
+#' |   |- my-module.R
+#' |   `- sort.R
+#' `- tests
+#'     |- shinytest.R
+#'     |- shinytest
+#'     |   `- mytest.R
+#'     |- testthat.R
+#'     `- testthat
+#'         |- helper-load.R
+#'         |- test-mymodule.R
+#'         |- test-server.R
+#'         `- test-sort.R
+#' ```
+#'
+#' Some notes about these files:
+#' * `app.R` is the main application file.
+#' * All files in the `R/` subdirectory are automatically sourced when the
+#'   application is run.
+#' * `R/sort.R` and `R/my-module.R` are automatically sourced when
+#'   the application is run. The first contains a function `lexical_sort()`,
+#'   and the second contains code for a [Shiny module](moduleServer()) which
+#'   is used in the application.
+#' * `tests/` contains various tests for the application. You may
+#'   choose to use or remove any of them. They can be executed by the
+#'   [runTests()] function.
+#' * `tests/shinytest.R` is a test runner for test files in the
+#'   `tests/shinytest/` directory.
+#' * `tests/shinytest/mytest.R` is a test that uses the
+#'   [shinytest](https://rstudio.github.io/shinytest/) package to do
+#'   snapshot-based testing.
+#' * `tests/testthat.R` is a test runner for test files in the
+#'   `tests/testthat/` directory using the [testthat](https://testthat.r-lib.org/) package.
+#' * `tests/testthat/test-mymodule.R` is a test for an application's module server function.
+#' * `tests/testthat/test-server.R` is a test for the application's server code
+#' * `tests/testthat/test-sort.R` is a test for a supporting function in the `R/` directory.
+#'
+#' @param path Path to create new shiny application template.
+#' @param examples Either one of "default", "ask", "all", or any combination of
+#'   "app", "rdir", "module", "shinytest", and "testthat". In an
+#'   interactive session, "default" falls back to "ask"; in a non-interactive
+#'   session, "default" falls back to "all". With "ask", this function will
+#'   prompt the user to select which template items will be added to the new app
+#'   directory. With "all", all template items will be added to the app
+#'   directory.
+#' @param dryrun If `TRUE`, don't actually write any files; just print out which
+#'   files would be written.
+#'
+#' @export
+shinyAppTemplate <- function(path = NULL, examples = "default", dryrun = FALSE)
+{
+  if (is.null(path)) {
+    stop("Please provide a `path`.")
+  }
+
+  # =======================================================
+  # Option handling
+  # =======================================================
+
+  choices <- c(
+    app       = "app.R            : Main application file",
+    rdir      = "R/sort.R         : Helper file with R code",
+    module    = "R/my-module.R    : Example module",
+    shinytest = "tests/shinytest/ : Tests using shinytest package",
+    testthat  = "tests/testthat/  : Tests using testthat"
+  )
+
+  if (identical(examples, "default")) {
+    if (interactive()) {
+      examples <- "ask"
+    } else {
+      examples <- "all"
+    }
+  }
+
+  if (!identical(examples, "ask") &&
+      !identical(examples, "all") &&
+      any(! examples %in% names(choices)))
+  {
+    stop('`examples` must be one of "default", "ask", "all", or any combination of "',
+      paste(names(choices), collapse = '", "'), '".')
+  }
+
+  if (identical(examples, "ask")) {
+    response <- select_menu(
+      c(all = "All", choices),
+      title = paste0(
+        "Select which of the following to add at ", path, "/ :"
+      ),
+      msg = "Enter one or more numbers (with spaces), or an empty line to exit: \n"
+    )
+
+    examples <- names(response)
+  }
+
+  examples <- unique(examples)
+
+  if ("all" %in% examples) {
+    examples <- names(choices)
+  }
+
+  if (length(examples) == 0) {
+    return(invisible())
+  }
+
+  if ("shinytest" %in% examples) {
+    if (system.file(package = "shinytest") != "" &&
+        utils::packageVersion("shinytest") <= "1.3.1.9000")
+    {
+      message(
+        "The tests/shinytest directory needs shinytest 1.4.0 or later to work properly.\n",
+      )
+      if (system.file(package = "shinytest") != "") {
+        message("You currently have shinytest ",
+                utils::packageVersion("shinytest"), " installed.")
+      }
+
+    }
+  }
+
+  # =======================================================
+  # Utility functions
+  # =======================================================
+
+  # Check if a directory is empty, ignoring certain files
+  dir_is_empty <- function(path) {
+    files <- list.files(path, all.files = TRUE, no.. = TRUE)
+    # Ignore .DS_Store files, which are sometimes automatically created on macOS
+    files <- setdiff(files, ".DS_Store")
+    return(length(files) != 0)
+  }
+
+  # Helper to resolve paths relative to our template
+  template_path <- function(...) {
+    system.file("app_template", ..., package = "shiny")
+  }
+
+  # Resolve path relative to destination
+  dest_path <- function(...) {
+    file.path(path, ...)
+  }
+
+  mkdir <- function(path) {
+    if (!dirExists(path)) {
+      message("Creating ", ensure_trailing_slash(path))
+      if (!dryrun) {
+        dir.create(path, recursive = TRUE)
+      }
+    }
+  }
+
+  # Copy a file from the template directory to the destination directory. If the
+  # file has templating code (it contains `{{` in the text), then run it through
+  # the htmlTemplate().
+  copy_file_one <- function(name) {
+    from <- template_path(name)
+    to <- dest_path(name)
+
+    message("Creating ", to)
+    if (file.exists(to)) {
+      stop(to, " already exists. Please remove it and try again.", call. = FALSE)
+    }
+
+    if (!dryrun) {
+      is_template <- any(grepl("{{", readLines(from), fixed = TRUE))
+
+      if (is_template) {
+        writeChar(
+          as.character(htmlTemplate(
+            from,
+            rdir = "rdir" %in% examples,
+            module = "module" %in% examples
+          )),
+          con = to,
+          eos = NULL
+        )
+      } else {
+        file.copy(from, to)
+      }
+    }
+  }
+
+  # Copy multiple files from template to destination.
+  copy_file <- function(names) {
+    for (name in names) {
+      copy_file_one(name)
+    }
+  }
+
+  # Copy the files for a tests/ subdirectory
+  copy_test_dir <- function(name) {
+    files <- dir(template_path("tests"), recursive = TRUE)
+    # Note: This is not the same as using dir(pattern = "^shinytest"), since
+    # that will not match files inside of shinytest/.
+    files <- files[grepl(paste0("^", name), files)]
+
+    # Filter out files that are not module files in the R directory.
+    if (! "rdir" %in% examples) {
+      # find all files in the testthat folder that are not module or server files
+      is_r_folder_file <- (!grepl("module|server", basename(files))) & (dirname(files) == "testthat")
+      files <- files[!is_r_folder_file]
+    }
+
+    # Filter out module files, if applicable.
+    if (! "module" %in% examples) {
+      files <- files[!grepl("module", files)]
+    }
+
+    mkdir(dest_path("tests"))
+
+    # Create any subdirectories if needed
+    dirs <- setdiff(unique(dirname(files)), ".")
+    for (dir in dirs) {
+      mkdir(dest_path("tests", dir))
+    }
+
+    copy_file(file.path("tests", files))
+  }
+
+  # =======================================================
+  # Main function
+  # =======================================================
+
+  if (is.null(path)) {
+    stop("`path` is missing.")
+  }
+  if (file.exists(path) && !dirExists(path)) {
+    stop(path, " exists but is not a directory.")
+  }
+
+  if (dirExists(path) && dir_is_empty(path)) {
+    if (interactive()) {
+      response <- readline(paste0(
+        ensure_trailing_slash(path),
+        " is not empty. Do you want to create a Shiny app in this directory anyway? [y/n] "
+      ))
+      if (tolower(response) != "y") {
+        return(invisible())
+      }
+    }
+  } else {
+    mkdir(path)
+  }
+
+  if ("app" %in% examples) {
+    copy_file("app.R")
+  }
+
+  # R/ dir with non-module files
+  if ("rdir" %in% examples) {
+    non_module_files <- dir(template_path("R"), pattern = "[^(module)].R$")
+    mkdir(dest_path("R"))
+    copy_file(file.path("R", non_module_files))
+  }
+
+  # R/ dir with module files
+  if ("module" %in% examples) {
+    module_files <- dir(template_path("R"), pattern = "module.R$")
+    mkdir(dest_path("R"))
+    copy_file(file.path("R", module_files))
+  }
+
+  # tests/ dir
+  if ("shinytest" %in% examples) {
+    copy_test_dir("shinytest")
+  }
+  if ("testthat" %in% examples) {
+    copy_test_dir("testthat")
+  }
+  invisible()
+}

R/bootstrap.R

@@ -464,8 +464,6 @@ helpText <- function(...) {
 
 #' Create a tab panel
 #'
-#' Create a tab panel that can be included within a [tabsetPanel()] or
-#' a [navbarPage()].
 #'
 #' @param title Display title for tab
 #' @param ... UI elements to include within the tab
@@ -489,12 +487,21 @@ helpText <- function(...) {
 #'   )
 #' )
 #' @export
+#' @describeIn tabPanel Create a tab panel that can be included within a [tabsetPanel()] or a [navbarPage()].
 tabPanel <- function(title, ..., value = title, icon = NULL) {
-  divTag <- div(class="tab-pane",
-                title=title,
-                `data-value`=value,
-                `data-icon-class` = iconClass(icon),
-                ...)
+  div(
+    class = "tab-pane",
+    title = title,
+    `data-value` = value,
+    `data-icon-class` = iconClass(icon),
+    ...
+  )
+}
+#' @export
+#' @describeIn tabPanel Create a tab panel that drops the title argument.
+#'   This function should be used within `tabsetPanel(type = "hidden")`. See [tabsetPanel()] for example usage.
+tabPanelBody <- function(..., value = NULL, icon = NULL) {
+  tabPanel(title = NULL, ..., value = value, icon = icon)
 }
 
 #' Create a tabset panel
@@ -510,8 +517,13 @@ tabPanel <- function(title, ..., value = title, icon = NULL) {
 #' @param selected The `value` (or, if none was supplied, the `title`)
 #'   of the tab that should be selected by default. If `NULL`, the first
 #'   tab will be selected.
-#' @param type Use "tabs" for the standard look; Use "pills" for a more plain
-#'   look where tabs are selected using a background fill color.
+#' @param type  \describe{
+#'   \item{`"tabs"`}{Standard tab look}
+#'   \item{`"pills"`}{Selected tabs use the background fill color}
+#'   \item{`"hidden"`}{Hides the selectable tabs. Use `type = "hidden"` in
+#'   conjunction with [tabPanelBody()] and [updateTabsetPanel()] to control the
+#'   active tab via other input controls. (See example below)}
+#' }
 #' @param position This argument is deprecated; it has been discontinued in
 #'   Bootstrap 3.
 #' @return A tabset that can be passed to [mainPanel()]
@@ -529,11 +541,40 @@ tabPanel <- function(title, ..., value = title, icon = NULL) {
 #'     tabPanel("Table", tableOutput("table"))
 #'   )
 #' )
+#'
+#' ui <- fluidPage(
+#'   sidebarLayout(
+#'     sidebarPanel(
+#'       radioButtons("controller", "Controller", 1:3, 1)
+#'     ),
+#'     mainPanel(
+#'       tabsetPanel(
+#'         id = "hidden_tabs",
+#'         # Hide the tab values.
+#'         # Can only switch tabs by using `updateTabsetPanel()`
+#'         type = "hidden",
+#'         tabPanelBody(value = "panel1", "Panel 1 content"),
+#'         tabPanelBody(value = "panel2", "Panel 2 content"),
+#'         tabPanelBody(value = "panel3", "Panel 3 content")
+#'       )
+#'     )
+#'   )
+#' )
+#'
+#' server <- function(input, output, session) {
+#'   observeEvent(input$controller, {
+#'     updateTabsetPanel(session, "hidden_tabs", selected = paste0("panel", input$controller))
+#'   })
+#' }
+#'
+#' if (interactive()) {
+#'   shinyApp(ui, server)
+#' }
 #' @export
 tabsetPanel <- function(...,
                         id = NULL,
                         selected = NULL,
-                        type = c("tabs", "pills"),
+                        type = c("tabs", "pills", "hidden"),
                         position = NULL) {
   if (!is.null(position)) {
     shinyDeprecated(msg = paste("tabsetPanel: argument 'position' is deprecated;",
@@ -842,42 +883,9 @@ verbatimTextOutput <- function(outputId, placeholder = FALSE) {
 #' @rdname plotOutput
 #' @export
 imageOutput <- function(outputId, width = "100%", height="400px",
-                        click = NULL, dblclick = NULL,
-                        hover = NULL, hoverDelay = NULL, hoverDelayType = NULL,
-                        brush = NULL,
-                        clickId = NULL, hoverId = NULL,
+                        click = NULL, dblclick = NULL, hover = NULL, brush = NULL,
                         inline = FALSE) {
 
-  if (!is.null(clickId)) {
-    shinyDeprecated(
-      msg = paste("The 'clickId' argument is deprecated. ",
-                  "Please use 'click' instead. ",
-                  "See ?imageOutput or ?plotOutput for more information."),
-      version = "0.11.1"
-    )
-    click <- clickId
-  }
-
-  if (!is.null(hoverId)) {
-    shinyDeprecated(
-      msg = paste("The 'hoverId' argument is deprecated. ",
-                  "Please use 'hover' instead. ",
-                  "See ?imageOutput or ?plotOutput for more information."),
-      version = "0.11.1"
-    )
-    hover <- hoverId
-  }
-
-  if (!is.null(hoverDelay) || !is.null(hoverDelayType)) {
-    shinyDeprecated(
-      msg = paste("The 'hoverDelay'and 'hoverDelayType' arguments are deprecated. ",
-                  "Please use 'hoverOpts' instead. ",
-                  "See ?imageOutput or ?plotOutput for more information."),
-      version = "0.11.1"
-    )
-    hover <- hoverOpts(id = hover, delay = hoverDelay, delayType = hoverDelayType)
-  }
-
   style <- if (!inline) {
     paste("width:", validateCssUnit(width), ";", "height:", validateCssUnit(height))
   }
@@ -984,14 +992,6 @@ imageOutput <- function(outputId, width = "100%", height="400px",
 #'   named list with `x` and `y` elements indicating the mouse
 #'   position. To control the hover time or hover delay type, you must use
 #'   [hoverOpts()].
-#' @param clickId Deprecated; use `click` instead. Also see the
-#'   [clickOpts()] function.
-#' @param hoverId Deprecated; use `hover` instead. Also see the
-#'   [hoverOpts()] function.
-#' @param hoverDelay Deprecated; use `hover` instead. Also see the
-#'   [hoverOpts()] function.
-#' @param hoverDelayType Deprecated; use `hover` instead. Also see the
-#'   [hoverOpts()] function.
 #' @param brush Similar to the `click` argument, this can be `NULL`
 #'   (the default), a string, or an object created by the
 #'   [brushOpts()] function. If you use a value like
@@ -1175,16 +1175,12 @@ imageOutput <- function(outputId, width = "100%", height="400px",
 #' }
 #' @export
 plotOutput <- function(outputId, width = "100%", height="400px",
-                       click = NULL, dblclick = NULL,
-                       hover = NULL, hoverDelay = NULL, hoverDelayType = NULL,
-                       brush = NULL,
-                       clickId = NULL, hoverId = NULL,
+                       click = NULL, dblclick = NULL, hover = NULL, brush = NULL,
                        inline = FALSE) {
 
   # Result is the same as imageOutput, except for HTML class
   res <- imageOutput(outputId, width, height, click, dblclick,
-                     hover, hoverDelay, hoverDelayType, brush,
-                     clickId, hoverId, inline)
+                     hover, brush, inline)
 
   res$attribs$class <- "shiny-plot-output"
   res

R/cache-utils.R

@@ -1,11 +1,3 @@
-#' @importFrom fastmap key_missing
-#' @export
-fastmap::key_missing
-
-#' @importFrom fastmap is.key_missing
-#' @export
-fastmap::is.key_missing
-
 
 validate_key <- function(key) {
   if (!is.character(key) || length(key) != 1 || nchar(key) == 0) {
@@ -15,4 +7,3 @@ validate_key <- function(key) {
     stop("Invalid key: ", key, ". Only lowercase letters and numbers are allowed.")
   }
 }
-

R/image-interact-opts.R

@@ -10,7 +10,7 @@
 #'   then the server will receive click events even when the mouse is outside
 #'   the plotting area, as long as it is still inside the image.
 #' @export
-clickOpts <- function(id = NULL, clip = TRUE) {
+clickOpts <- function(id, clip = TRUE) {
   if (is.null(id))
     stop("id must not be NULL")
 
@@ -36,7 +36,7 @@ clickOpts <- function(id = NULL, clip = TRUE) {
 #' @param delay Maximum delay (in ms) between a pair clicks for them to be
 #'   counted as a double-click.
 #' @export
-dblclickOpts <- function(id = NULL, clip = TRUE, delay = 400) {
+dblclickOpts <- function(id, clip = TRUE, delay = 400) {
   if (is.null(id))
     stop("id must not be NULL")
 
@@ -69,7 +69,7 @@ dblclickOpts <- function(id = NULL, clip = TRUE, delay = 400) {
 #'   `NULL` when the mouse exits the plotting area. If `FALSE`, the
 #'   value will stop changing when the cursor exits the plotting area.
 #' @export
-hoverOpts <- function(id = NULL, delay = 300,
+hoverOpts <- function(id, delay = 300,
                       delayType = c("debounce", "throttle"), clip = TRUE,
                       nullOutside = TRUE) {
   if (is.null(id))
@@ -117,7 +117,7 @@ hoverOpts <- function(id = NULL, delay = 300,
 #'   brush. Using `TRUE` is useful if you want to clear the brush whenever
 #'   the plot is updated.
 #' @export
-brushOpts <- function(id = NULL, fill = "#9cf", stroke = "#036",
+brushOpts <- function(id, fill = "#9cf", stroke = "#036",
                       opacity = 0.25, delay = 300,
                       delayType = c("debounce", "throttle"), clip = TRUE,
                       direction = c("xy", "x", "y"),

R/image-interact.R

@@ -1,59 +1,76 @@
-#' Find rows of data that are selected by a brush
+#' Find rows of data selected on an interactive plot.
 #'
-#' This function returns rows from a data frame which are under a brush used
-#' with [plotOutput()].
+#' @description
+#' `brushedPoints()` returns rows from a data frame which are under a brush.
+#' `nearPoints()` returns rows from a data frame which are near a click, hover,
+#' or double-click. Alternatively, set `allRows = TRUE` to return all rows from
+#' the input data with an additional column `selected_` that indicates which
+#' rows of the would be selected.
 #'
-#' It is also possible for this function to return all rows from the input data
-#' frame, but with an additional column `selected_`, which indicates which
-#' rows of the input data frame are selected by the brush (`TRUE` for
-#' selected, `FALSE` for not-selected). This is enabled by setting
-#' `allRows=TRUE` option.
+#' @section ggplot2:
+#' For plots created with ggplot2, it is not necessary to specify the
+#' column names to `xvar`, `yvar`, `panelvar1`, and `panelvar2` as that
+#' information can be automatically derived from the plot specification.
 #'
-#' The `xvar`, `yvar`, `panelvar1`, and `panelvar2`
-#' arguments specify which columns in the data correspond to the x variable, y
-#' variable, and panel variables of the plot. For example, if your plot is
-#' `plot(x=cars$speed, y=cars$dist)`, and your brush is named
-#' `"cars_brush"`, then you would use `brushedPoints(cars,
-#' input$cars_brush, "speed", "dist")`.
-#'
-#' For plots created with ggplot2, it should not be necessary to specify the
-#' column names; that information will already be contained in the brush,
-#' provided that variables are in the original data, and not computed. For
-#' example, with `ggplot(cars, aes(x=speed, y=dist)) + geom_point()`, you
-#' could use `brushedPoints(cars, input$cars_brush)`. If, however, you use
-#' a computed column, like `ggplot(cars, aes(x=speed/2, y=dist)) +
-#' geom_point()`, then it will not be able to automatically extract column names
-#' and filter on them. If you want to use this function to filter data, it is
-#' recommended that you not use computed columns; instead, modify the data
+#' Note, however, that this will not work if you use a computed column, like
+#' `aes(speed/2, dist))`. Instead, we recommend that you modify the data
 #' first, and then make the plot with "raw" columns in the modified data.
 #'
-#' If a specified x or y column is a factor, then it will be coerced to an
-#' integer vector. If it is a character vector, then it will be coerced to a
-#' factor and then integer vector. This means that the brush will be considered
-#' to cover a given character/factor value when it covers the center value.
+#' @section Brushing:
+#' If x or y column is a factor, then it will be coerced to an integer vector.
+#' If it is a character vector, then it will be coerced to a factor and then
+#' integer vector. This means that the brush will be considered to cover a
+#' given character/factor value when it covers the center value.
 #'
 #' If the brush is operating in just the x or y directions (e.g., with
 #' `brushOpts(direction = "x")`, then this function will filter out points
 #' using just the x or y variable, whichever is appropriate.
 #'
-#' @param brush The data from a brush, such as `input$plot_brush`.
+#' @returns
+#' A data frame based on `df`, containing the observations selected by the
+#' brush or near the click event. For `nearPoints()`, the rows will be sorted
+#' by distance to the event.
+#'
+#' If `allRows = TRUE`, then all rows will returned, along with a new
+#' `selected_` column that indicates whether or not the point was selected.
+#' The output from `nearPoints()` will no longer be sorted, but you can
+#' set `addDist = TRUE` to get an additional column that gives the pixel
+#' distance to the pointer.
+#'
 #' @param df A data frame from which to select rows.
-#' @param xvar,yvar A string with the name of the variable on the x or y axis.
-#'   This must also be the name of a column in `df`. If absent, then this
-#'   function will try to infer the variable from the brush (only works for
-#'   ggplot2).
-#' @param panelvar1,panelvar2 Each of these is a string with the name of a panel
-#'   variable. For example, if with ggplot2, you facet on a variable called
-#'   `cyl`, then you can use `"cyl"` here. However, specifying the
-#'   panel variable should not be necessary with ggplot2; Shiny should be able
-#'   to auto-detect the panel variable.
+#' @param brush,coordinfo The data from a brush or click/dblclick/hover event
+#'   e.g. `input$plot_brush`, `input$plot_click`.
+#' @param xvar,yvar A string giving the name of the variable on the x or y axis.
+#'   These are only required for base graphics, and must be the name of
+#'   a column in `df`.
+#' @param panelvar1,panelvar2 A string giving the name of a panel variable.
+#'   For expert use only; in most cases these will be automatically
+#'   derived from the ggplot2 spec.
 #' @param allRows If `FALSE` (the default) return a data frame containing
 #'   the selected rows. If `TRUE`, the input data frame will have a new
-#'   column, `selected_`, which indicates whether the row was inside the
-#'   brush (`TRUE`) or outside the brush (`FALSE`).
-#'
+#'   column, `selected_`, which indicates whether the row was selected or not.
+#' @param threshold A maximum distance (in pixels) to the pointer location.
+#'   Rows in the data frame will be selected if the distance to the pointer is
+#'   less than `threshold`.
+#' @param maxpoints Maximum number of rows to return. If `NULL` (the default),
+#'   will return all rows within the threshold distance.
+#' @param addDist If TRUE, add a column named `dist_` that contains the
+#'   distance from the coordinate to the point, in pixels. When no pointer
+#'   event has yet occurred, the value of `dist_` will be `NA`.
 #' @seealso [plotOutput()] for example usage.
 #' @export
+#' @examples
+#' \dontrun{
+#' # Note that in practice, these examples would need to go in reactives
+#' # or observers.
+#'
+#' # This would select all points within 5 pixels of the click
+#' nearPoints(mtcars, input$plot_click)
+#'
+#' # Select just the nearest point within 10 pixels of the click
+#' nearPoints(mtcars, input$plot_click, threshold = 10, maxpoints = 1)
+#'
+#' }
 brushedPoints <- function(df, brush, xvar = NULL, yvar = NULL,
                           panelvar1 = NULL, panelvar2 = NULL,
                           allRows = FALSE) {
@@ -191,56 +208,8 @@ brushedPoints <- function(df, brush, xvar = NULL, yvar = NULL,
 #  $ direction: chr "y"
 
 
-#'Find rows of data that are near a click/hover/double-click
-#'
-#'This function returns rows from a data frame which are near a click, hover, or
-#'double-click, when used with [plotOutput()]. The rows will be sorted
-#'by their distance to the mouse event.
-#'
-#'It is also possible for this function to return all rows from the input data
-#'frame, but with an additional column `selected_`, which indicates which
-#'rows of the input data frame are selected by the brush (`TRUE` for
-#'selected, `FALSE` for not-selected). This is enabled by setting
-#'`allRows=TRUE` option. If this is used, the resulting data frame will not
-#'be sorted by distance to the mouse event.
-#'
-#'The `xvar`, `yvar`, `panelvar1`, and `panelvar2` arguments
-#'specify which columns in the data correspond to the x variable, y variable,
-#'and panel variables of the plot. For example, if your plot is
-#'`plot(x=cars$speed, y=cars$dist)`, and your click variable is named
-#'`"cars_click"`, then you would use `nearPoints(cars,
-#'input$cars_brush, "speed", "dist")`.
-#'
-#'@inheritParams brushedPoints
-#'@param coordinfo The data from a mouse event, such as `input$plot_click`.
-#'@param threshold A maxmimum distance to the click point; rows in the data
-#'  frame where the distance to the click is less than `threshold` will be
-#'  returned.
-#'@param maxpoints Maximum number of rows to return. If NULL (the default),
-#'  return all rows that are within the threshold distance.
-#'@param addDist If TRUE, add a column named `dist_` that contains the
-#'  distance from the coordinate to the point, in pixels. When no mouse event
-#'  has yet occured, the value of `dist_` will be `NA`.
-#'@param allRows If `FALSE` (the default) return a data frame containing
-#'  the selected rows. If `TRUE`, the input data frame will have a new
-#'  column, `selected_`, which indicates whether the row was inside the
-#'  selected by the mouse event (`TRUE`) or not (`FALSE`).
-#'
-#'@seealso [plotOutput()] for more examples.
-#'
-#' @examples
-#' \dontrun{
-#' # Note that in practice, these examples would need to go in reactives
-#' # or observers.
-#'
-#' # This would select all points within 5 pixels of the click
-#' nearPoints(mtcars, input$plot_click)
-#'
-#' # Select just the nearest point within 10 pixels of the click
-#' nearPoints(mtcars, input$plot_click, threshold = 10, maxpoints = 1)
-#'
-#' }
-#'@export
+#' @export
+#' @rdname brushedPoints
 nearPoints <- function(df, coordinfo, xvar = NULL, yvar = NULL,
                        panelvar1 = NULL, panelvar2 = NULL,
                        threshold = 5, maxpoints = NULL, addDist = FALSE,

R/input-action.R

@@ -16,7 +16,7 @@
 #'
 #' ui <- fluidPage(
 #'   sliderInput("obs", "Number of observations", 0, 1000, 500),
-#'   actionButton("goButton", "Go!"),
+#'   actionButton("goButton", "Go!", class = "btn-success"),
 #'   plotOutput("distPlot")
 #' )
 #'
@@ -36,6 +36,10 @@
 #'
 #' }
 #'
+#' ## Example of adding extra class values
+#' actionButton("largeButton", "Large Primary Button", class = "btn-primary btn-lg")
+#' actionLink("infoLink", "Information Link", class = "btn-info")
+#'
 #' @seealso [observeEvent()] and [eventReactive()]
 #'
 #' @section Server value:

R/middleware.R

@@ -311,16 +311,32 @@ HandlerManager <- R6Class("HandlerManager",
         },
         call = .httpServer(
           function (req) {
-            withCallingHandlers(withLogErrors(handlers$invoke(req)),
-              error = function(cond) {
-                sanitizeErrors <- getOption('shiny.sanitize.errors', FALSE)
-                if (inherits(cond, 'shiny.custom.error') || !sanitizeErrors) {
-                  stop(cond$message, call. = FALSE)
-                } else {
-                  stop(paste("An error has occurred. Check your logs or",
-                             "contact the app author for clarification."),
-                       call. = FALSE)
+            hybrid_chain(
+              hybrid_chain(
+                withCallingHandlers(withLogErrors(handlers$invoke(req)),
+                  error = function(cond) {
+                    sanitizeErrors <- getOption('shiny.sanitize.errors', FALSE)
+                    if (inherits(cond, 'shiny.custom.error') || !sanitizeErrors) {
+                      stop(cond$message, call. = FALSE)
+                    } else {
+                      stop(paste("An error has occurred. Check your logs or",
+                                 "contact the app author for clarification."),
+                           call. = FALSE)
+                    }
+                  }
+                ),
+                catch = function(err) {
+                  httpResponse(status = 500L,
+                    content_type = "text/html",
+                    content = as.character(htmltools::htmlTemplate(
+                      system.file("template", "error.html", package = "shiny"),
+                      message = conditionMessage(err)
+                    ))
+                  )
                 }
+              ),
+              function(resp) {
+                maybeInjectAutoreload(resp)
               }
             )
           },
@@ -390,6 +406,22 @@ HandlerManager <- R6Class("HandlerManager",
   )
 )
 
+maybeInjectAutoreload <- function(resp) {
+  if (getOption("shiny.autoreload", FALSE) &&
+      isTRUE(grepl("^text/html($|;)", resp$content_type)) &&
+      is.character(resp$content)) {
+
+    resp$content <- gsub(
+      "</head>",
+      "<script src=\"shared/shiny-autoreload.js\"></script>\n</head>",
+      resp$content,
+      fixed = TRUE
+    )
+  }
+
+  resp
+}
+
 # Safely get the Content-Length of a Rook response, or NULL if the length cannot
 # be determined for whatever reason (probably malformed response$content).
 # If deleteOwnedContent is TRUE, then the function should delete response

R/mock-session.R

@@ -69,6 +69,12 @@ extract <- function(promise) {
   stop("Single-bracket indexing of mockclientdata is not allowed.")
 }
 
+#' @noRd
+mapNames <- function(func, vals) {
+  names(vals) <- vapply(names(vals), func, character(1))
+  vals
+}
+
 #' Mock Shiny Session
 #'
 #' @description
@@ -83,6 +89,8 @@ MockShinySession <- R6Class(
   public = list(
     #' @field env The environment associated with the session.
     env = NULL,
+    #' @field returned The value returned by the module.
+    returned = NULL,
     #' @field singletons Hardcoded as empty. Needed for rendering HTML (i.e. renderUI)
     singletons = character(0),
     #' @field clientData Mock client data that always returns a size for plots
@@ -181,14 +189,17 @@ MockShinySession <- R6Class(
       return(paste('data:', contentType, ';base64,', b64, sep=''))
     },
 
-    #' @description Sets reactive values associated with the `session$inputs` object
-    #'   and flushes the reactives.
-    #' @param ... The inputs to set.
+    #' @description Sets reactive values associated with the `session$inputs`
+    #'   object and flushes the reactives.
+    #' @param ... The inputs to set. These arguments are processed with
+    #'   [rlang::list2()] and so are _[dynamic][rlang::dyn-dots]_. Input names
+    #'   may not be duplicated.
     #' @examples
-    #' s <- MockShinySession$new()
-    #' s$setInputs(x=1, y=2)
+    #' \dontrun{
+    #' session$setInputs(x=1, y=2)
+    #' }
     setInputs = function(...) {
-      vals <- list(...)
+      vals <- rlang::dots_list(..., .homonyms = "error")
       mapply(names(vals), vals, FUN = function(name, value) {
         private$.input$set(name, value)
       })
@@ -371,10 +382,10 @@ MockShinySession <- R6Class(
     #' @param export Not used
     #' @param format Not used
     getTestSnapshotUrl = function(input=TRUE, output=TRUE, export=TRUE, format="json") {},
-    #' @description Returns the given id prefixed by `mock-session-`.
+    #' @description Returns the given id prefixed by this namespace's id.
     #' @param id The id to modify.
     ns = function(id) {
-      paste0("mock-session-", id) # TODO: does this need to be more complex/intelligent?
+      NS(private$nsPrefix, id)
     },
     #' @description Trigger a reactive flush right now.
     flushReact = function(){
@@ -388,8 +399,40 @@ MockShinySession <- R6Class(
         self,
         input = .createReactiveValues(private$.input, readonly = TRUE, ns = ns),
         output = structure(.createOutputWriter(self, ns = ns), class = "shinyoutput"),
-        makeScope = function(namespace) self$makeScope(ns(namespace))
+        makeScope = function(namespace) self$makeScope(ns(namespace)),
+        ns = function(namespace) ns(namespace),
+        setInputs = function(...) {
+          self$setInputs(!!!mapNames(ns, rlang::dots_list(..., .homonyms = "error")))
+        }
       )
+    },
+    #' @description Set the environment associated with a testServer() call, but
+    #'   only if it has not previously been set. This ensures that only the
+    #'   environment of the outermost module under test is the one retained. In
+    #'   other words, the first assignment wins.
+    #' @param env The environment to retain.
+    setEnv = function(env) {
+      if (is.null(self$env)) {
+        stopifnot(all(c("input", "output", "session") %in% ls(env)))
+        self$env <- env
+      }
+    },
+    #' @description Set the value returned by the module call and proactively
+    #'   flush. Note that this method may be called multiple times if modules
+    #'   are nested. The last assignment, corresponding to an invocation of
+    #'   setReturned() in the outermost module, wins.
+    #' @param value The value returned from the module
+    setReturned = function(value) {
+      self$returned <- value
+      value
+    },
+    #' @description Get the value returned by the module call.
+    getReturned = function() self$returned,
+    #' @description Return a distinct character identifier for use as a proxy
+    #'   namespace.
+    genId = function() {
+      private$idCounter <- private$idCounter + 1
+      paste0("proxy", private$idCounter)
     }
   ),
   private = list(
@@ -400,7 +443,8 @@ MockShinySession <- R6Class(
     timer = NULL,
     closed = FALSE,
     outs = list(),
-    returnedVal = NULL,
+    nsPrefix = "mock-session",
+    idCounter = 0,
 
     flush = function(){
       isolate(private$flushCBs$invoke(..stacktraceon = TRUE))
@@ -410,18 +454,6 @@ MockShinySession <- R6Class(
     }
   ),
   active = list(
-    # If assigning to `returned`, proactively flush
-    #' @field returned The value returned from the module
-    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()
-    },
     #' @field request An empty environment where the request should be. The request isn't meaningfully mocked currently.
     request = function(value) {
       if (!missing(value)){
@@ -432,4 +464,3 @@ MockShinySession <- R6Class(
     }
   )
 )
-

R/modules.R

@@ -36,7 +36,6 @@ createSessionProxy <- function(parentSession, ...) {
 
 `[[<-.session_proxy` <- `$<-.session_proxy`
 
-
 #' Shiny modules
 #'
 #' Shiny's module feature lets you break complicated UI and server logic into
@@ -44,8 +43,9 @@ createSessionProxy <- function(parentSession, ...) {
 #' modules are easier to reuse and easier to reason about. See the article at
 #' <http://shiny.rstudio.com/articles/modules.html> to learn more.
 #'
-#' Starting in Shiny 1.5.0, we recommend using `moduleFunction` instead of
-#' `callModule`, because syntax is a little easier to understand.
+#' Starting in Shiny 1.5.0, we recommend using `moduleServer` instead of
+#' `callModule`, because the syntax is a little easier to understand, and
+#' modules created with `moduleServer` can be tested with [`testServer()`].
 #'
 #' @param module A Shiny module server function.
 #' @param id An ID string that corresponds with the ID used to call the module's
@@ -70,16 +70,19 @@ createSessionProxy <- function(parentSession, ...) {
 #'
 #' # Define the server logic for a module
 #' counterServer <- function(id) {
-#'   moduleServer(id, function(input, output, session) {
-#'     count <- reactiveVal(0)
-#'     observeEvent(input$button, {
-#'       count(count() + 1)
-#'     })
-#'     output$out <- renderText({
-#'       count()
-#'     })
-#'     count
-#'   })
+#'   moduleServer(
+#'     id,
+#'     function(input, output, session) {
+#'       count <- reactiveVal(0)
+#'       observeEvent(input$button, {
+#'         count(count() + 1)
+#'       })
+#'       output$out <- renderText({
+#'         count()
+#'       })
+#'       count
+#'     }
+#'   )
 #' }
 #'
 #' # Use the module in an app
@@ -101,16 +104,19 @@ createSessionProxy <- function(parentSession, ...) {
 #' # add them to your function. In this case `prefix` is text that will be
 #' # printed before the count.
 #' counterServer2 <- function(id, prefix = NULL) {
-#'   moduleServer(id, function(input, output, session) {
-#'     count <- reactiveVal(0)
-#'     observeEvent(input$button, {
-#'       count(count() + 1)
-#'     })
-#'     output$out <- renderText({
-#'       paste0(prefix, count())
-#'     })
-#'     count
-#'   })
+#'   moduleServer(
+#'     id,
+#'     function(input, output, session) {
+#'       count <- reactiveVal(0)
+#'       observeEvent(input$button, {
+#'         count(count() + 1)
+#'       })
+#'       output$out <- renderText({
+#'         paste0(prefix, count())
+#'       })
+#'       count
+#'     }
+#'   )
 #' }
 #'
 #' ui <- fluidPage(
@@ -125,7 +131,15 @@ createSessionProxy <- function(parentSession, ...) {
 #'
 #' @export
 moduleServer <- function(id, module, session = getDefaultReactiveDomain()) {
-  callModule(module, id, session = session)
+  if (inherits(session, "MockShinySession")) {
+    body(module) <- rlang::expr({
+      session$setEnv(base::environment())
+      !!body(module)
+    })
+    session$setReturned(callModule(module, id, session = session))
+  } else {
+    callModule(module, id, session = session)
+  }
 }
 
 

R/reexports.R

@@ -0,0 +1,195 @@
+####
+# Generated by `./tools/updateReexports.R`: do not edit by hand
+# Please call `source('tools/updateReexports.R') from the root folder to update`
+####
+
+
+# fastmap key_missing.Rd -------------------------------------------------------
+
+#' @importFrom fastmap key_missing
+#' @export
+fastmap::key_missing
+
+#' @importFrom fastmap is.key_missing
+#' @export
+fastmap::is.key_missing
+
+
+
+# htmltools builder.Rd ---------------------------------------------------------
+
+#' @importFrom htmltools tags
+#' @export
+htmltools::tags
+
+#' @importFrom htmltools p
+#' @export
+htmltools::p
+
+#' @importFrom htmltools h1
+#' @export
+htmltools::h1
+
+#' @importFrom htmltools h2
+#' @export
+htmltools::h2
+
+#' @importFrom htmltools h3
+#' @export
+htmltools::h3
+
+#' @importFrom htmltools h4
+#' @export
+htmltools::h4
+
+#' @importFrom htmltools h5
+#' @export
+htmltools::h5
+
+#' @importFrom htmltools h6
+#' @export
+htmltools::h6
+
+#' @importFrom htmltools a
+#' @export
+htmltools::a
+
+#' @importFrom htmltools br
+#' @export
+htmltools::br
+
+#' @importFrom htmltools div
+#' @export
+htmltools::div
+
+#' @importFrom htmltools span
+#' @export
+htmltools::span
+
+#' @importFrom htmltools pre
+#' @export
+htmltools::pre
+
+#' @importFrom htmltools code
+#' @export
+htmltools::code
+
+#' @importFrom htmltools img
+#' @export
+htmltools::img
+
+#' @importFrom htmltools strong
+#' @export
+htmltools::strong
+
+#' @importFrom htmltools em
+#' @export
+htmltools::em
+
+#' @importFrom htmltools hr
+#' @export
+htmltools::hr
+
+
+# htmltools tag.Rd -------------------------------------------------------------
+
+#' @importFrom htmltools tag
+#' @export
+htmltools::tag
+
+#' @importFrom htmltools tagList
+#' @export
+htmltools::tagList
+
+#' @importFrom htmltools tagAppendAttributes
+#' @export
+htmltools::tagAppendAttributes
+
+#' @importFrom htmltools tagHasAttribute
+#' @export
+htmltools::tagHasAttribute
+
+#' @importFrom htmltools tagGetAttribute
+#' @export
+htmltools::tagGetAttribute
+
+#' @importFrom htmltools tagAppendChild
+#' @export
+htmltools::tagAppendChild
+
+#' @importFrom htmltools tagAppendChildren
+#' @export
+htmltools::tagAppendChildren
+
+#' @importFrom htmltools tagSetChildren
+#' @export
+htmltools::tagSetChildren
+
+
+# htmltools HTML.Rd ------------------------------------------------------------
+
+#' @importFrom htmltools HTML
+#' @export
+htmltools::HTML
+
+
+# htmltools include.Rd ---------------------------------------------------------
+
+#' @importFrom htmltools includeHTML
+#' @export
+htmltools::includeHTML
+
+#' @importFrom htmltools includeText
+#' @export
+htmltools::includeText
+
+#' @importFrom htmltools includeMarkdown
+#' @export
+htmltools::includeMarkdown
+
+#' @importFrom htmltools includeCSS
+#' @export
+htmltools::includeCSS
+
+#' @importFrom htmltools includeScript
+#' @export
+htmltools::includeScript
+
+
+# htmltools singleton.Rd -------------------------------------------------------
+
+#' @importFrom htmltools singleton
+#' @export
+htmltools::singleton
+
+#' @importFrom htmltools is.singleton
+#' @export
+htmltools::is.singleton
+
+
+# htmltools validateCssUnit.Rd -------------------------------------------------
+
+#' @importFrom htmltools validateCssUnit
+#' @export
+htmltools::validateCssUnit
+
+
+# htmltools htmlTemplate.Rd ----------------------------------------------------
+
+#' @importFrom htmltools htmlTemplate
+#' @export
+htmltools::htmlTemplate
+
+
+# htmltools suppressDependencies.Rd --------------------------------------------
+
+#' @importFrom htmltools suppressDependencies
+#' @export
+htmltools::suppressDependencies
+
+
+# htmltools withTags.Rd --------------------------------------------------------
+
+#' @importFrom htmltools withTags
+#' @export
+htmltools::withTags

R/server.R

@@ -279,6 +279,8 @@ decodeMessage <- function(data) {
   return(mainMessage)
 }
 
+autoReloadCallbacks <- Callbacks$new()
+
 createAppHandlers <- function(httpHandlers, serverFuncSource) {
   appvars <- new.env()
   appvars$server <- NULL
@@ -304,6 +306,22 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
         return(TRUE)
       }
 
+      if (identical(ws$request$PATH_INFO, "/autoreload/")) {
+        if (!getOption("shiny.autoreload", FALSE)) {
+          ws$close()
+          return(TRUE)
+        }
+
+        callbackHandle <- autoReloadCallbacks$register(function() {
+          ws$send("autoreload")
+          ws$close()
+        })
+        ws$onClose(function() {
+          callbackHandle()
+        })
+        return(TRUE)
+      }
+
       if (!is.null(getOption("shiny.observer.error", NULL))) {
         warning(
           call. = FALSE,

R/shiny.R

@@ -2296,3 +2296,56 @@ ShinyServerTimingRecorder <- R6Class("ShinyServerTimingRecorder",
 )
 
 missingOutput <- function(...) req(FALSE)
+
+#' Insert inline Markdown
+#'
+#' This function accepts
+#' [Markdown](https://en.wikipedia.org/wiki/Markdown)-syntax text and returns
+#' HTML that may be included in Shiny UIs.
+#'
+#' Leading whitespace is trimmed from Markdown text with [glue::trim()].
+#' Whitespace trimming ensures Markdown is processed correctly even when the
+#' call to `markdown()` is indented within surrounding R code.
+#'
+#' By default, [Github extensions][commonmark::extensions] are enabled, but this
+#' can be disabled by passing `extensions = FALSE`.
+#'
+#' Markdown rendering is performed by [commonmark::markdown_html()]. Additional
+#' arguments to `markdown()` are passed as arguments to `markdown_html()`
+#'
+#' @param mds A character vector of Markdown source to convert to HTML. If the
+#'   vector has more than one element, a single-element character vector of
+#'   concatenated HTML is returned.
+#' @param extensions Enable Github syntax extensions; defaults to `TRUE`.
+#' @param .noWS Character vector used to omit some of the whitespace that would
+#'   normally be written around generated HTML. Valid options include `before`,
+#'   `after`, and `outside` (equivalent to `before` and `end`).
+#' @param ... Additional arguments to pass to [commonmark::markdown_html()].
+#'   These arguments are _[dynamic][rlang::dyn-dots]_.
+#'
+#' @return a character vector marked as HTML.
+#' @export
+#' @examples
+#' ui <- fluidPage(
+#'   markdown("
+#'     # Markdown Example
+#'
+#'     This is a markdown paragraph, and will be contained within a `<p>` tag
+#'     in the UI.
+#'
+#'     The following is an unordered list, which will be represented in the UI as
+#'     a `<ul>` with `<li>` children:
+#'
+#'     * a bullet
+#'     * another
+#'
+#'     [Links](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/a) work;
+#'     so does *emphasis*.
+#'
+#'     To see more of what's possible, check out [commonmark.org/help](https://commonmark.org/help).
+#'     ")
+#' )
+markdown <- function(mds, extensions = TRUE, .noWS = NULL, ...) {
+  html <- rlang::exec(commonmark::markdown_html, glue::trim(mds), extensions = extensions, ...)
+  htmltools::HTML(html, .noWS = .noWS)
+}

R/showcase.R

@@ -104,20 +104,18 @@ navTabsDropdown <- function(files) {
 
 tabContentHelper <- function(files, path, language) {
   lapply(files, function(file) {
-    with(tags,
-      div(class=paste("tab-pane",
+      tags$div(class=paste("tab-pane",
                       if (tolower(file) %in% c("app.r", "server.r")) " active"
                       else "",
                       sep=""),
           id=paste(gsub(".", "_", file, fixed=TRUE),
                    "_code", sep=""),
-          pre(class="shiny-code",
+          tags$pre(class="shiny-code",
               # we need to prevent the indentation of <code> ... </code>
               HTML(format(tags$code(
                 class=paste0("language-", language),
                 paste(readUTF8(file.path.ci(path, file)), collapse="\n")
               ), indent = FALSE))))
-    )
   })
 }
 

R/test-module.R

@@ -1,169 +0,0 @@
-
-
-#' Integration testing for Shiny modules or server functions
-#'
-#' Offer a way to test the reactive interactions in Shiny --- either in Shiny
-#' modules or in the server portion of a Shiny application. For more
-#' information, visit [the Shiny Dev Center article on integration
-#' testing](https://shiny.rstudio.com/articles/integration-testing.html).
-#' @param module The module to 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 ... Additional arguments to pass to the module function. These
-#'   arguments are processed with [rlang::list2()] and so are
-#'   _[dynamic][rlang::dyn-dots]_.
-#' @return The result of evaluating `expr`.
-#' @include mock-session.R
-#' @rdname testModule
-#' @examples
-#' module <- function(input, output, session, multiplier = 2, prefix = "I am ") {
-#'   myreactive <- reactive({
-#'     input$x * multiplier
-#'   })
-#'   output$txt <- renderText({
-#'     paste0(prefix, myreactive())
-#'   })
-#' }
-#'
-#' # Basic Usage
-#' # -----------
-#' testModule(module, {
-#'   session$setInputs(x = 1)
-#'   # You're also free to use third-party
-#'   # testing packages like testthat:
-#'   #   expect_equal(myreactive(), 2)
-#'   stopifnot(myreactive() == 2)
-#'   stopifnot(output$txt == "I am 2")
-#'
-#'   session$setInputs(x = 2)
-#'   stopifnot(myreactive() == 4)
-#'   stopifnot(output$txt == "I am 4")
-#'   # Any additional arguments, below, are passed along to the module.
-#' }, multiplier = 2)
-#'
-#' # Advanced Usage
-#' # --------------
-#' multiplier_arg_name = "multiplier"
-#' more_args <- list(prefix = "I am ")
-#' testModule(module, {
-#'   session$setInputs(x = 1)
-#'   stopifnot(myreactive() == 2)
-#'   stopifnot(output$txt == "I am 2")
-#'   # !!/:= and !!! from rlang are used below to splice computed arguments
-#'   # into the testModule() argument list.
-#' }, !!multiplier_arg_name := 2, !!!more_args)
-#' @export
-testModule <- function(module, expr, ...) {
-  .testModule(
-    module,
-    quosure = rlang::enquo(expr),
-    dots = rlang::list2(...),
-    env = rlang::caller_env()
-  )
-}
-
-#' @noRd
-#' @importFrom withr with_options
-.testModule <- function(module, quosure, dots, env) {
-  # Modify the module function locally by inserting `session$env <-
-  # environment()` at the beginning of its body. The dynamic environment of the
-  # module function is saved so that it may be referenced after the module
-  # function has returned. The saved dynamic environment is the basis for the
-  # `data` argument of tidy_eval() when used below to evaluate `quosure`, the
-  # test code expression.
-  body(module) <- rlang::expr({
-    session$env <- base::environment()
-    !!!body(module)
-  })
-
-  session <- MockShinySession$new()
-  on.exit(if (!session$isClosed()) session$close())
-  args <- append(dots, list(input = session$input, output = session$output, session = session))
-
-  isolate(
-    withReactiveDomain(
-      session,
-      withr::with_options(list(`shiny.allowoutputreads`=TRUE), {
-        # Assigning to `$returned` causes a flush to happen automatically.
-        session$returned <- do.call(module, args)
-      })
-    )
-  )
-
-  # Evaluate `quosure` in a reactive context, and in the provided `env`, but
-  # with `env` masked by a shallow view of `session$env`, the environment that
-  # was saved when the module function was invoked. flush is not needed before
-  # entering the loop because the first expr executed is `{`.
-  isolate({
-    withReactiveDomain(
-      session,
-      withr::with_options(list(`shiny.allowoutputreads`=TRUE), {
-        rlang::eval_tidy(
-          quosure,
-          data = rlang::as_data_mask(as.list(session$env)),
-          env = env
-        )
-      })
-    )
-  })
-}
-
-#' Test an app's server-side logic
-#' @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.
-#' @rdname testModule
-#' @export
-testServer <- function(expr, appDir=NULL) {
-  if (is.null(appDir)){
-    appDir <- findApp()
-  }
-
-  app <- shinyAppDir(appDir)
-  message("Testing application found in: ", appDir)
-  server <- app$serverFuncSource()
-
-  origwd <- getwd()
-  setwd(appDir)
-  on.exit({ setwd(origwd) }, add=TRUE)
-
-  # Add `session` argument if not present
-  fn_formals <- formals(server)
-  if (! "session" %in% names(fn_formals)) {
-    fn_formals$session <- bquote()
-    formals(server) <- fn_formals
-  }
-
-  # Test the server function almost as if it were a module. `dots` is empty
-  # because server functions never take additional arguments.
-  .testModule(
-    server,
-    quosure = rlang::enquo(expr),
-    dots = list(),
-    env = rlang::caller_env()
-  )
-}
-
-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/test-server.R

@@ -0,0 +1,145 @@
+#' @noRd
+isModuleServer <- function(x) {
+  is.function(x) && names(formals(x))[1] == "id"
+}
+
+#' Reactive testing for Shiny server functions and modules
+#'
+#' A way to test the reactive interactions in Shiny applications. Reactive
+#' interactions are defined in the server function of applications and in
+#' modules.
+#' @param app The path to an application or module to test. In addition to
+#'   paths, applications may be represented by any object suitable for coercion
+#'   to an `appObj` by `as.shiny.appobj`. Application server functions must
+#'   include a `session` argument in order to be tested. If `app` is `NULL` or
+#'   not supplied, the nearest enclosing directory that is a Shiny app, starting
+#'   with the current directory, is used.
+#' @param expr Test code containing expectations. The test expression will run
+#'   in the server function environment, meaning that the parameters of the
+#'   server function (e.g. `input`, `output`, and `session`) will be available
+#'   along with any other values created inside of the server function.
+#' @param args Additional arguments to pass to the module function.
+#'   If `app` is a module, and no `id` argument is provided, one will be
+#'   generated and supplied automatically.
+#' @return The result of evaluating `expr`.
+#' @include mock-session.R
+#' @rdname testServer
+#' @examples
+#' server <- function(id, multiplier = 2, prefix = "I am ") {
+#'   moduleServer(id, function(input, output, session) {
+#'     myreactive <- reactive({
+#'       input$x * multiplier
+#'     })
+#'     output$txt <- renderText({
+#'       paste0(prefix, myreactive())
+#'     })
+#'   })
+#' }
+#'
+#' testServer(server, args = list(multiplier = 2), {
+#'   session$setInputs(x = 1)
+#'   # You're also free to use third-party
+#'   # testing packages like testthat:
+#'   #   expect_equal(myreactive(), 2)
+#'   stopifnot(myreactive() == 2)
+#'   stopifnot(output$txt == "I am 2")
+#'
+#'   session$setInputs(x = 2)
+#'   stopifnot(myreactive() == 4)
+#'   stopifnot(output$txt == "I am 4")
+#'   # Any additional arguments, below, are passed along to the module.
+#' })
+#' @export
+testServer <- function(app = NULL, expr, args = list()) {
+
+  require(shiny)
+
+  quosure <- rlang::enquo(expr)
+  session <- getDefaultReactiveDomain()
+
+  if (inherits(session, "MockShinySession"))
+    stop("Test expressions may not call testServer()")
+  if (inherits(session, "session_proxy")
+      && inherits(get("parent", envir = session), "MockShinySession"))
+    stop("Modules may not call testServer()")
+
+  session <- MockShinySession$new()
+  on.exit(if (!session$isClosed()) session$close())
+
+  if (isModuleServer(app)) {
+    if (!("id" %in% names(args)))
+      args[["id"]] <- session$genId()
+    # app is presumed to be a module, and modules may take additional arguments,
+    # so splice in any args.
+    isolate(
+      withReactiveDomain(
+        session,
+        withr::with_options(list(`shiny.allowoutputreads` = TRUE), {
+          rlang::exec(app, !!!args)
+        })
+      )
+    )
+
+    # If app is a module, then we must use both the module function's immediate
+    # environment and also its enclosing environment to construct the mask.
+    parent_clone <- rlang::env_clone(parent.env(session$env))
+    clone <- rlang::env_clone(session$env, parent_clone)
+    mask <- rlang::new_data_mask(clone, parent_clone)
+
+    isolate(
+      withReactiveDomain(
+        session,
+        withr::with_options(list(`shiny.allowoutputreads` = TRUE), {
+          rlang::eval_tidy(quosure, mask, rlang::caller_env())
+        })
+      )
+    )
+  } else {
+    if (is.null(app)) {
+      app <- findEnclosingApp(".")
+    }
+
+    appobj <- as.shiny.appobj(app)
+    if (!is.null(appobj$onStart))
+      appobj$onStart()
+    # Ensure appobj$onStop() is called, and the current directory is restored,
+    # regardless of whether invoking the server function is successful.
+    tryCatch({
+      server <- appobj$serverFuncSource()
+      if (! "session" %in% names(formals(server)))
+        stop("Tested application server functions must declare input, output, and session arguments.")
+      body(server) <- rlang::expr({
+        session$setEnv(base::environment())
+        !!!body(server)
+      })
+      if (length(args))
+        stop("Arguments were provided to a server function.")
+      isolate(
+        withReactiveDomain(
+          session,
+          withr::with_options(list(`shiny.allowoutputreads` = TRUE), {
+            server(input = session$input, output = session$output, session = session)
+          })
+        )
+      )
+    }, finally = {
+      if (!is.null(appobj$onStop))
+        appobj$onStop()
+    })
+
+    # If app is a server, we use only the server function's immediate
+    # environment to construct the mask.
+    mask <- rlang::new_data_mask(rlang::env_clone(session$env))
+
+    isolate(
+      withReactiveDomain(
+        session,
+        withr::with_options(list(`shiny.allowoutputreads` = TRUE), {
+          rlang::eval_tidy(quosure, mask, rlang::caller_env())
+        })
+      )
+    )
+  }
+
+  invisible()
+}

R/test.R

@@ -1,11 +1,48 @@
-
-#' Check to see if the given text is a shinytest
-#' Scans for the magic string of `app <- ShinyDriver$new(` as an indicator that this is a shinytest.
-#' Brought in from shinytest to avoid having to export this function.
+#' Creates and returns run result data frame.
+#'
+#' @param file Name of the test runner file, a character vector of length 1.
+#' @param pass Whether or not the test passed, a logical vector of length 1.
+#' @param result Value (wrapped in a list) obtained by evaluating `file`.
+#'   This can also by any errors signaled when evaluating the `file`.
+#'
+#' @return A 1-row data frame representing a single test run. `result` and
+#'   is a "list column", or a column that contains list elements.
 #' @noRd
-isShinyTest <- function(text){
-  lines <- grepl("app\\s*<-\\s*ShinyDriver\\$new\\(", text, perl=TRUE)
-  any(lines)
+result_row <- function(file, pass, result) {
+  stopifnot(is.list(result))
+  df <- data.frame(
+    file = file,
+    pass = pass,
+    result = I(result),
+    stringsAsFactors = FALSE
+  )
+  class(df) <- c("shiny_runtests", class(df))
+  df
+}
+
+#' Check to see if the given directory contains at least one script, and that
+#' all scripts in the directory are shinytest scripts.
+#' Scans for the magic string of `app <- ShinyDriver$new(` as an indicator that
+#' this is a shinytest.
+#' @noRd
+is_legacy_shinytest_dir <- function(path){
+  is_shinytest_script <- function(file) {
+    if (!file.exists(file)) {
+      return(FALSE)
+    }
+
+    text <- readLines(file, warn = FALSE)
+    any(
+      grepl("app\\s*<-\\s*ShinyDriver\\$new\\(", text, perl=TRUE)
+    )
+  }
+
+  files <- dir(path, full.names = TRUE)
+  files <- files[!file.info(files)$isdir]
+  if (length(files) == 0) {
+    return(FALSE)
+  }
+  all(vapply(files, is_shinytest_script, logical(1)))
 }
 
 #' Runs the tests associated with this Shiny app
@@ -18,90 +55,210 @@ isShinyTest <- function(text){
 #' @param filter If not `NULL`, only tests with file names matching this regular
 #'   expression will be executed. Matching is performed on the file name
 #'   including the extension.
+#' @param assert Logical value which determines if an error should be thrown if any error is captured.
+#' @param envir Parent testing environment in which to base the individual testing environments.
+#'
+#' @return A data frame classed with the supplemental class `"shiny_runtests"`.
+#'   The data frame has the following columns:
+#'
+#' | **Name** | **Type** | **Meaning** |
+#' | :-- | :-- | :-- |
+#' | `file` | `character(1)` | File name of the runner script in `tests/` that was sourced. |
+#' | `pass` | `logical(1)` | Whether or not the runner script signaled an error when sourced. |
+#' | `result` | any or `NA` | The return value of the runner |
 #'
 #' @details Historically, [shinytest](https://rstudio.github.io/shinytest/)
-#'   recommended placing tests at the top-level of the `tests/` directory. In
-#'   order to support that model, `testApp` first checks to see if the `.R`
-#'   files in the `tests/` directory are all shinytests; if so, just calls out
-#'   to [shinytest::testApp()].
+#'   recommended placing tests at the top-level of the `tests/` directory.
+#'   This older folder structure is not supported by runTests.
+#'   Please see [shinyAppTemplate()] for more details.
 #' @export
-runTests <- function(appDir=".", filter=NULL){
+runTests <- function(
+  appDir = ".",
+  filter = NULL,
+  assert = TRUE,
+  envir = globalenv()
+) {
+  # similar to runApp()
+  # Allows shiny's functions to be available in the UI, server, and test code
   require(shiny)
 
   testsDir <- file.path(appDir, "tests")
-  if (!dirExists(testsDir)){
+  if (!dirExists(testsDir)) {
     stop("No tests directory found: ", testsDir)
   }
   runners <- list.files(testsDir, pattern="\\.r$", ignore.case = TRUE)
 
-  if (length(runners) == 0){
+  if (length(runners) == 0) {
     message("No test runners found in ", testsDir)
-    return(structure(list(result=NA, files=list()), class="shinytestrun"))
+    return(result_row(character(0), logical(0), list()))
   }
 
-  if (!is.null(filter)){
+  if (!is.null(filter)) {
     runners <- runners[grepl(filter, runners)]
   }
-  if (length(runners) == 0){
+  if (length(runners) == 0) {
     stop("No test runners matched the given filter: '", filter, "'")
   }
 
-  # Inspect each runner to see if it appears to be a shinytest
-  isST <- vapply(runners, function(r){
-    text <- readLines(file.path(testsDir, r), warn = FALSE)
-    isShinyTest(text)
-  }, logical(1))
-
-  if (all(isST)){
-    # just call out to shinytest
-    # We don't need to message/warn here since shinytest already does it.
-    if (!requireNamespace("shinytest", quietly=TRUE) ){
-      stop("It appears that the .R files in ", testsDir,
-           " are all shinytests, but shinytest is not installed.")
-    }
-
-    if (!getOption("shiny.autoload.r", TRUE)) {
-      warning("You've disabled `shiny.autoload.r` via an option but this is not passed through to shinytest. Consider using a _disable_autoload.R file as described at https://rstd.io/shiny-autoload")
-    }
-
-    sares <- shinytest::testApp(appDir)
-    res <- list()
-    lapply(sares$results, function(r){
-      e <- NA_character_
-      if (!r$pass){
-        e <- simpleError("Unknown shinytest error")
-      }
-      res[[r$name]] <<- e
-    })
-    return(structure(list(result=all(is.na(res)), files=res), class="shinytestrun"))
+  # See the @details section of the runTests() docs above for why this branch exists.
+  if (is_legacy_shinytest_dir(testsDir)) {
+    stop(
+      "It appears that the .R files in ", testsDir, " are all shinytests.",
+      " This is not supported by `shiny::runTests()`.",
+      "\nPlease see `?shiny::migrateLegacyShinytest` to migrate your shinytest file structure to the new format.",
+      "\nSee `?shiny::shinyAppTemplate` for an example of the new testing file structure."
+    )
   }
 
-  testenv <- new.env(parent=globalenv())
-  renv <- new.env(parent=testenv)
-  if (getOption("shiny.autoload.r", TRUE)) {
-    loadSupport(appDir, renv=renv, globalrenv=testenv)
-  } else if (file.exists.ci(file.path(appDir, "server.R"))){
-    # then check for global.R to load
-    if (file.exists(file.path.ci(appDir, "global.R"))){
-      sourceUTF8(file.path.ci(appDir, "global.R"))
-    }
-  }
-
-  oldwd <- getwd()
-  on.exit({
-    setwd(oldwd)
-  }, add=TRUE)
-
-  setwd(testsDir)
+  renv <- new.env(parent = envir)
 
   # Otherwise source all the runners -- each in their own environment.
-  fileResults <- list()
-  lapply(runners, function(r){
-    env <- new.env(parent=renv)
-    tryCatch({sourceUTF8(r, envir=env); fileResults[[r]] <<- NA_character_}, error=function(e){
-      fileResults[[r]] <<- e
-    })
-  })
+  ret <- do.call(rbind, lapply(runners, function(r) {
+    pass <- FALSE
+    result <-
+      tryCatch({
+        env <- new.env(parent = renv)
+        withr::with_dir(testsDir, {
+          ret <- sourceUTF8(r, envir = env)
+        })
+        pass <- TRUE
+        ret
+      }, error = function(err) {
+        message("Error in ", r, "\n", err)
+        err
+      })
+    result_row(file.path(testsDir, r), pass, list(result))
+  }))
 
-  return(structure(list(result=all(is.na(fileResults)), files=fileResults), class="shinytestrun"))
+  if (isTRUE(assert)) {
+    if (!all(ret$pass)) {
+      stop("Shiny App Test Failures detected in\n", paste0("* ", runtest_pretty_file(ret$file[!ret$pass]), collapse = "\n"), call. = FALSE)
+    }
+  }
+
+  ret
+}
+
+
+runtest_pretty_file <- function(f) {
+  test_folder <- dirname(f)
+  app_folder <- dirname(test_folder)
+  file.path(
+    basename(app_folder),
+    basename(test_folder),
+    basename(f)
+  )
+}
+
+
+print.shiny_runtests <- function(x, ..., reporter = "summary") {
+
+  cat("Shiny App Test Results\n")
+
+
+  if (any(x$pass)) {
+    # TODO in future... use clisymbols::symbol$tick and crayon green
+    cat("* Success\n")
+    mapply(
+      x$file,
+      x$pass,
+      x$result,
+      FUN = function(file, pass, result) {
+        if (!pass) return()
+        # print(result)
+        cat("  - ", runtest_pretty_file(file), "\n", sep = "")
+      }
+    )
+  }
+  if (any(!x$pass)) {
+    # TODO in future... use clisymbols::symbol$cross and crayon red
+    cat("* Failure\n")
+    mapply(
+      x$file,
+      x$pass,
+      x$result,
+      FUN = function(file, pass, result) {
+        if (pass) return()
+        cat("  - ", runtest_pretty_file(file), "\n", sep = "")
+      }
+    )
+  }
+
+  invisible(x)
+}
+
+
+#' Migrate legacy \pkg{shinytest} files to new test directory structure
+#'
+#' This function migrates the old-style directory structure used by
+#' \pkg{shinytest} to (versions 1.3.1 and below) new test directory structure
+#' used in Shiny 1.5.0 and above.
+#'
+#' In Shiny 1.5.0, the [runTests()] function was added, and it will run test
+#' scripts tests/ subdirectory of the application. The directory structure will
+#' look something like this:
+#'
+#' ```
+#' appdir/
+#'  |- R
+#'  |- tests
+#'      |- shinytest.R
+#'      |- shinytest
+#'      |   `- mytest.R
+#'      |- testthat.R
+#'      `- testthat
+#'          `- test-script.R
+#' ```
+#'
+#' This allows for tests using the \pkg{shinytest} package as well as other
+#' testing tools, such as the [testServer()] function, which can be used for
+#' testing module and server logic, and for unit tests of functions in an R/
+#' subdirectory.
+#'
+#'
+#' With the \pkg{shinytest} package, in versions 1.3.0 and below, the tests/
+#' subdirectory of the application was used specifically for \pkg{shinytest},
+#' and could not be used for other types of tests. So the directory structure
+#' would look like this:
+#'
+#' ```
+#' appdir/
+#'  `- tests
+#'      `- mytest.R
+#' ```
+#'
+#' In \pkg{shinytest} 1.4.0 and above, it defaults to the new directory
+#' structure.
+#'
+#' @param appdir A directory containing a Shiny application.
+#' @param prompt If \code{TRUE}, ask for confirmation when moving files.
+#'
+#' @export
+migrateLegacyShinytest <- function(appdir, prompt = interactive()) {
+  appdir <- findEnclosingApp(appdir)
+
+  test_dir <- file.path(appdir, "tests")
+  shinytest_dir <- file.path(test_dir, "shinytest")
+
+  if (!is_legacy_shinytest_dir(test_dir)) {
+    stop("The .R files in ", test_dir,
+         " must all be test scripts for the shinytest package.")
+  }
+
+  if (prompt) {
+    res <- readline(
+      paste0(
+        "Creating ", shinytest_dir, " and moving files from\n", test_dir,
+        " into it.\nAre you sure you want to do this? [y/n]\n"
+      )
+    )
+    if (!identical(tolower(res), "y")) {
+      return(invisible())
+    }
+  }
+
+  files <- dir(test_dir)
+  dir.create(shinytest_dir, showWarnings = FALSE)
+  file.rename(file.path(test_dir, files), file.path(shinytest_dir, files))
+  invisible()
 }

R/update-input.R

@@ -126,13 +126,15 @@ updateCheckboxInput <- function(session, inputId, label = NULL, value = NULL) {
 #' if (interactive()) {
 #'
 #' ui <- fluidPage(
-#'   actionButton("update", "Update other buttons"),
+#'   actionButton("update", "Update other buttons and link"),
 #'   br(),
 #'   actionButton("goButton", "Go"),
 #'   br(),
 #'   actionButton("goButton2", "Go 2", icon = icon("area-chart")),
 #'   br(),
-#'   actionButton("goButton3", "Go 3")
+#'   actionButton("goButton3", "Go 3"),
+#'   br(),
+#'   actionLink("goLink", "Go Link")
 #' )
 #'
 #' server <- function(input, output, session) {
@@ -153,17 +155,26 @@ updateCheckboxInput <- function(session, inputId, label = NULL, value = NULL) {
 #'     # unchaged and changes its label
 #'     updateActionButton(session, "goButton3",
 #'       label = "New label 3")
+#'
+#'     # Updates goLink's label and icon
+#'     updateActionButton(session, "goLink",
+#'       label = "New link label",
+#'       icon = icon("link"))
 #'   })
 #' }
 #'
 #' shinyApp(ui, server)
 #' }
+#' @rdname updateActionButton
 #' @export
 updateActionButton <- function(session, inputId, label = NULL, icon = NULL) {
   if (!is.null(icon)) icon <- as.character(validateIcon(icon))
   message <- dropNulls(list(label=label, icon=icon))
   session$sendInputMessage(inputId, message)
 }
+#' @rdname updateActionButton
+#' @export
+updateActionLink <- updateActionButton
 
 
 #' Change the value of a date input on the client

R/utils.R

@@ -316,6 +316,15 @@ resolve <- function(dir, relpath) {
   return(abs.path)
 }
 
+# Given a string, make sure it has a trailing slash.
+ensure_trailing_slash <- function(path) {
+  if (!grepl("/$", path)) {
+    path <- paste0(path, "/")
+  }
+  path
+}
+
+
 isWindows <- function() .Platform$OS.type == 'windows'
 
 # This is a wrapper for download.file and has the same interface.
@@ -1812,3 +1821,55 @@ cat_line <- function(...) {
   cat(paste(..., "\n", collapse = ""))
 }
 
+select_menu <- function(choices, title = NULL, msg = "Enter one or more numbers (with spaces), or an empty line to exit: \n")
+{
+  if (!is.null(title)) {
+    cat(title, "\n", sep = "")
+  }
+  nc <- length(choices)
+  op <- paste0(format(seq_len(nc)), ": ", choices)
+  fop <- format(op)
+  cat("", fop, "", sep = "\n")
+  repeat {
+    answer <- readline(msg)
+    answer <- strsplit(answer, "[ ,]+")[[1]]
+    if (all(answer %in% seq_along(choices))) {
+      return(choices[as.integer(answer)])
+    }
+  }
+}
+
+#' @noRd
+isAppDir <- function(path) {
+
+  if (file.exists(file.path.ci(path, "app.R")))
+    return(TRUE)
+
+  if (file.exists(file.path.ci(path, "server.R"))
+      && file.exists(file.path.ci(path, "ui.R")))
+    return(TRUE)
+
+  FALSE
+}
+
+# Borrowed from rprojroot which borrowed from devtools
+#' @noRd
+is_root <- function(path) {
+  identical(
+    normalizePath(path, winslash = "/"),
+    normalizePath(dirname(path), winslash = "/")
+  )
+}
+
+#' @noRd
+findEnclosingApp <- function(path = ".") {
+  orig_path <- path
+  path <- normalizePath(path, winslash = "/", mustWork = TRUE)
+  repeat {
+    if (isAppDir(path))
+      return(path)
+    if (is_root(path))
+      stop("Shiny app not found at ", orig_path, " or in any parent directory.")
+    path <- dirname(path)
+  }
+}

inst/app_template/R/my-module.R

@@ -0,0 +1,27 @@
+mymoduleUI <- function(id, label = "Counter") {
+  # Al uses of Shiny input/output IDs in the UI must be namespaced,
+  # as in ns("x").
+  ns <- NS(id)
+  tagList(
+    actionButton(ns("button"), label = label),
+    verbatimTextOutput(ns("out"))
+  )
+}
+
+mymoduleServer <- function(id) {
+  # moduleServer() wraps a function to create the server component of a
+  # module.
+  moduleServer(
+    id,
+    function(input, output, session) {
+      count <- reactiveVal(0)
+      observeEvent(input$button, {
+        count(count() + 1)
+      })
+      output$out <- renderText({
+        count()
+      })
+      count
+    }
+  )
+}

inst/app_template/R/sort.R

@@ -0,0 +1,5 @@
+# Given a numeric vector, convert to strings, sort, and convert back to
+# numeric.
+lexical_sort <- function(x) {
+  as.numeric(sort(as.character(x)))
+}

inst/app_template/app.R

@@ -0,0 +1,52 @@
+ui <- fluidPage(
+{{
+# These blocks of code are processed with htmlTemplate()
+if (isTRUE(module)) {
+'  # ======== Modules ========
+  # mymoduleUI is defined in R/my-module.R
+  mymoduleUI("mymodule1", "Click counter #1"),
+  mymoduleUI("mymodule2", "Click counter #2"),
+  # =========================
+'
+}
+}}
+  wellPanel(
+    sliderInput("size", "Data size", min = 5, max = 20, value = 10),
+{{
+if (isTRUE(rdir)) {
+  '    div("Lexically sorted sequence:"),'
+} else {
+  '    div("Sorted sequence:"),'
+}
+}}
+    verbatimTextOutput("sequence")
+  )
+)
+
+server <- function(input, output, session) {
+{{
+if (isTRUE(module)) {
+'  # ======== Modules ========
+  # mymoduleServer is defined in R/my-module.R
+  mymoduleServer("mymodule1")
+  mymoduleServer("mymodule2")
+  # =========================
+'
+}
+}}
+  data <- reactive({
+{{
+if (isTRUE(rdir)) {
+'    # lexical_sort from R/sort.R
+    lexical_sort(seq_len(input$size))'
+} else {
+'    sort(seq_len(input$size))'
+}
+}}
+  })
+  output$sequence <- renderText({
+    paste(data(), collapse = " ")
+  })
+}
+
+shinyApp(ui, server)

inst/app_template/tests/shinytest.R

@@ -0,0 +1,3 @@
+library(shinytest)
+shinytest::testApp("../")
+

inst/app_template/tests/shinytest/mytest.R

@@ -0,0 +1,12 @@
+app <- ShinyDriver$new("../../")
+app$snapshotInit("mytest")
+
+app$snapshot()
+{{
+if (isTRUE(module)) {
+'
+app$setInputs(`mymodule1-button` = "click")
+app$setInputs(`mymodule1-button` = "click")
+app$snapshot()'
+}
+}}

inst/app_template/tests/testthat.R

@@ -0,0 +1,9 @@
+library(testthat)
+
+test_dir(
+  "./testthat",
+  # Run in the app's environment containing all support methods.
+  env = shiny::loadSupport(),
+  # Display the regular progress output and throw an error if any test error is found
+  reporter = c("progress", "fail")
+)

inst/app_template/tests/testthat/test-mymodule.R

@@ -0,0 +1,18 @@
+context("mymoduleServer")
+
+# See ?testServer for more information
+testServer(mymoduleServer, {
+  # Set initial value of a button
+  session$setInputs(button = 0)
+
+  # Check the value of the reactiveVal `count()`
+  expect_equal(count(), 1)
+  # Check the value of the renderText()
+  expect_equal(output$out, "1")
+
+  # Simulate a click
+  session$setInputs(button = 1)
+
+  expect_equal(count(), 2)
+  expect_equal(output$out, "2")
+})

inst/app_template/tests/testthat/test-server.R

@@ -0,0 +1,20 @@
+context("app")
+
+testServer(expr = {
+  # Set the `size` slider and check the output
+  session$setInputs(size = 6)
+  expect_equal(output$sequence, "1 2 3 4 5 6")
+{{
+if (isTRUE(rdir)) {
+'
+  session$setInputs(size = 12)
+  expect_equal(output$sequence, "1 10 11 12 2 3 4 5 6 7 8 9")
+'
+} else {
+'
+  session$setInputs(size = 12)
+  expect_equal(output$sequence, "1 2 3 4 5 6 7 8 9 10 11 12")
+'
+}
+}}
+})

inst/app_template/tests/testthat/test-sort.R

@@ -0,0 +1,7 @@
+# Test the lexical_sort function from R/utils.R
+context("sort")
+
+test_that("Lexical sorting works", {
+  expect_equal(lexical_sort(c(1, 2, 3)), c(1, 2, 3))
+  expect_equal(lexical_sort(c(1, 2, 3, 13, 11, 21)), c(1, 11, 13, 2, 21, 3))
+})

inst/template/error.html

@@ -0,0 +1,13 @@
+<html>
+
+<head>
+  <title>An error has occurred</title>
+</head>
+
+<body>
+
+<h1>An error has occurred!</h1>
+<p>{{message}}</p>
+
+</body>
+</html>

inst/www/shared/shiny-autoreload.js

@@ -0,0 +1,17 @@
+(function() {
+  var protocol = 'ws:';
+  if (window.location.protocol === 'https:')
+    protocol = 'wss:';
+
+  var defaultPath = window.location.pathname;
+  if (!/\/$/.test(defaultPath))
+    defaultPath += '/';
+  defaultPath += 'autoreload/';
+
+  var ws = new WebSocket(protocol + '//' + window.location.host + defaultPath);
+  ws.onmessage = function(event) {
+    if (event.data === "autoreload") {
+      window.location.reload()
+    }
+  }
+})();

inst/www/shared/shiny.css

@@ -407,3 +407,10 @@ pre.shiny-text-output {
   color: #aaa;
   cursor: not-allowed;
 }
+
+
+/* Hidden tabPanels */
+.nav-hidden {
+  /* override anything bootstrap sets for `.nav` */
+  display: none !important;
+}

man/HTML.Rd

@@ -1,29 +0,0 @@
-\name{HTML}
-\alias{HTML}
-\title{Mark Characters as HTML}
-\usage{
-HTML(text, ..., .noWS = NULL)
-}
-\arguments{
-\item{text}{The text value to mark with HTML}
-
-\item{...}{Any additional values to be converted to character and
-concatenated together}
-
-\item{.noWS}{Character vector used to omit some of the whitespace that would
-normally be written around this HTML. Valid options include \code{before},
-\code{after}, and \code{outside} (equivalent to \code{before} and
-\code{end}).}
-}
-\value{
-The same value, but marked as HTML.
-}
-\description{
-Marks the given text as HTML, which means the \link{tag} functions will know
-not to perform HTML escaping on it.
-}
-\examples{
-el <- div(HTML("I like <u>turtles</u>"))
-cat(as.character(el))
-
-}

man/MockShinySession.Rd

@@ -13,14 +13,17 @@ provided to Shiny server functions or modules.
 ## Method `MockShinySession$setInputs`
 ## ------------------------------------------------
 
-s <- MockShinySession$new()
-s$setInputs(x=1, y=2)
+\dontrun{
+session$setInputs(x=1, y=2)
+}
 }
 \section{Public fields}{
 \if{html}{\out{<div class="r6-fields">}}
 \describe{
 \item{\code{env}}{The environment associated with the session.}
 
+\item{\code{returned}}{The value returned by the module.}
+
 \item{\code{singletons}}{Hardcoded as empty. Needed for rendering HTML (i.e. renderUI)}
 
 \item{\code{clientData}}{Mock client data that always returns a size for plots}
@@ -38,8 +41,6 @@ s$setInputs(x=1, y=2)
 \section{Active bindings}{
 \if{html}{\out{<div class="r6-active-bindings">}}
 \describe{
-\item{\code{returned}}{The value returned from the module}
-
 \item{\code{request}}{An empty environment where the request should be. The request isn't meaningfully mocked currently.}
 }
 \if{html}{\out{</div>}}
@@ -83,6 +84,10 @@ s$setInputs(x=1, y=2)
 \item \href{#method-ns}{\code{MockShinySession$ns()}}
 \item \href{#method-flushReact}{\code{MockShinySession$flushReact()}}
 \item \href{#method-makeScope}{\code{MockShinySession$makeScope()}}
+\item \href{#method-setEnv}{\code{MockShinySession$setEnv()}}
+\item \href{#method-setReturned}{\code{MockShinySession$setReturned()}}
+\item \href{#method-getReturned}{\code{MockShinySession$getReturned()}}
+\item \href{#method-genId}{\code{MockShinySession$genId()}}
 \item \href{#method-clone}{\code{MockShinySession$clone()}}
 }
 }
@@ -251,8 +256,8 @@ Base64-encode the given file. Needed for image rendering.
 \if{html}{\out{<a id="method-setInputs"></a>}}
 \if{latex}{\out{\hypertarget{method-setInputs}{}}}
 \subsection{Method \code{setInputs()}}{
-Sets reactive values associated with the \code{session$inputs} object
-and flushes the reactives.
+Sets reactive values associated with the \code{session$inputs}
+object and flushes the reactives.
 \subsection{Usage}{
 \if{html}{\out{<div class="r">}}\preformatted{MockShinySession$setInputs(...)}\if{html}{\out{</div>}}
 }
@@ -260,14 +265,17 @@ and flushes the reactives.
 \subsection{Arguments}{
 \if{html}{\out{<div class="arguments">}}
 \describe{
-\item{\code{...}}{The inputs to set.}
+\item{\code{...}}{The inputs to set. These arguments are processed with
+\code{\link[rlang:list2]{rlang::list2()}} and so are \emph{\link[rlang:dyn-dots]{dynamic}}. Input names
+may not be duplicated.}
 }
 \if{html}{\out{</div>}}
 }
 \subsection{Examples}{
 \if{html}{\out{<div class="r example copy">}}
-\preformatted{s <- MockShinySession$new()
-s$setInputs(x=1, y=2)
+\preformatted{\dontrun{
+session$setInputs(x=1, y=2)
+}
 }
 \if{html}{\out{</div>}}
 
@@ -627,7 +635,7 @@ No-op
 \if{html}{\out{<a id="method-ns"></a>}}
 \if{latex}{\out{\hypertarget{method-ns}{}}}
 \subsection{Method \code{ns()}}{
-Returns the given id prefixed by \verb{mock-session-}.
+Returns the given id prefixed by this namespace's id.
 \subsection{Usage}{
 \if{html}{\out{<div class="r">}}\preformatted{MockShinySession$ns(id)}\if{html}{\out{</div>}}
 }
@@ -666,6 +674,67 @@ Create and return a namespace-specific session proxy.
 }
 \if{html}{\out{</div>}}
 }
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-setEnv"></a>}}
+\if{latex}{\out{\hypertarget{method-setEnv}{}}}
+\subsection{Method \code{setEnv()}}{
+Set the environment associated with a testServer() call, but
+only if it has not previously been set. This ensures that only the
+environment of the outermost module under test is the one retained. In
+other words, the first assignment wins.
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{MockShinySession$setEnv(env)}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{env}}{The environment to retain.}
+}
+\if{html}{\out{</div>}}
+}
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-setReturned"></a>}}
+\if{latex}{\out{\hypertarget{method-setReturned}{}}}
+\subsection{Method \code{setReturned()}}{
+Set the value returned by the module call and proactively
+flush. Note that this method may be called multiple times if modules
+are nested. The last assignment, corresponding to an invocation of
+setReturned() in the outermost module, wins.
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{MockShinySession$setReturned(value)}\if{html}{\out{</div>}}
+}
+
+\subsection{Arguments}{
+\if{html}{\out{<div class="arguments">}}
+\describe{
+\item{\code{value}}{The value returned from the module}
+}
+\if{html}{\out{</div>}}
+}
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-getReturned"></a>}}
+\if{latex}{\out{\hypertarget{method-getReturned}{}}}
+\subsection{Method \code{getReturned()}}{
+Get the value returned by the module call.
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{MockShinySession$getReturned()}\if{html}{\out{</div>}}
+}
+
+}
+\if{html}{\out{<hr>}}
+\if{html}{\out{<a id="method-genId"></a>}}
+\if{latex}{\out{\hypertarget{method-genId}{}}}
+\subsection{Method \code{genId()}}{
+Return a distinct character identifier for use as a proxy
+namespace.
+\subsection{Usage}{
+\if{html}{\out{<div class="r">}}\preformatted{MockShinySession$genId()}\if{html}{\out{</div>}}
+}
+
 }
 \if{html}{\out{<hr>}}
 \if{html}{\out{<a id="method-clone"></a>}}

man/actionButton.Rd

@@ -43,7 +43,7 @@ if (interactive()) {
 
 ui <- fluidPage(
   sliderInput("obs", "Number of observations", 0, 1000, 500),
-  actionButton("goButton", "Go!"),
+  actionButton("goButton", "Go!", class = "btn-success"),
   plotOutput("distPlot")
 )
 
@@ -63,6 +63,10 @@ shinyApp(ui, server)
 
 }
 
+## Example of adding extra class values
+actionButton("largeButton", "Large Primary Button", class = "btn-primary btn-lg")
+actionLink("infoLink", "Information Link", class = "btn-info")
+
 }
 \seealso{
 \code{\link[=observeEvent]{observeEvent()}} and \code{\link[=eventReactive]{eventReactive()}}

man/brushOpts.Rd

@@ -5,7 +5,7 @@
 \title{Create an object representing brushing options}
 \usage{
 brushOpts(
-  id = NULL,
+  id,
   fill = "#9cf",
   stroke = "#036",
   opacity = 0.25,

man/brushedPoints.Rd

@@ -2,7 +2,8 @@
 % Please edit documentation in R/image-interact.R
 \name{brushedPoints}
 \alias{brushedPoints}
-\title{Find rows of data that are selected by a brush}
+\alias{nearPoints}
+\title{Find rows of data selected on an interactive plot.}
 \usage{
 brushedPoints(
   df,
@@ -13,64 +14,103 @@ brushedPoints(
   panelvar2 = NULL,
   allRows = FALSE
 )
+
+nearPoints(
+  df,
+  coordinfo,
+  xvar = NULL,
+  yvar = NULL,
+  panelvar1 = NULL,
+  panelvar2 = NULL,
+  threshold = 5,
+  maxpoints = NULL,
+  addDist = FALSE,
+  allRows = FALSE
+)
 }
 \arguments{
 \item{df}{A data frame from which to select rows.}
 
-\item{brush}{The data from a brush, such as \code{input$plot_brush}.}
+\item{brush, coordinfo}{The data from a brush or click/dblclick/hover event
+e.g. \code{input$plot_brush}, \code{input$plot_click}.}
 
-\item{xvar, yvar}{A string with the name of the variable on the x or y axis.
-This must also be the name of a column in \code{df}. If absent, then this
-function will try to infer the variable from the brush (only works for
-ggplot2).}
+\item{xvar, yvar}{A string giving the name of the variable on the x or y axis.
+These are only required for base graphics, and must be the name of
+a column in \code{df}.}
 
-\item{panelvar1, panelvar2}{Each of these is a string with the name of a panel
-variable. For example, if with ggplot2, you facet on a variable called
-\code{cyl}, then you can use \code{"cyl"} here. However, specifying the
-panel variable should not be necessary with ggplot2; Shiny should be able
-to auto-detect the panel variable.}
+\item{panelvar1, panelvar2}{A string giving the name of a panel variable.
+For expert use only; in most cases these will be automatically
+derived from the ggplot2 spec.}
 
 \item{allRows}{If \code{FALSE} (the default) return a data frame containing
 the selected rows. If \code{TRUE}, the input data frame will have a new
-column, \code{selected_}, which indicates whether the row was inside the
-brush (\code{TRUE}) or outside the brush (\code{FALSE}).}
+column, \code{selected_}, which indicates whether the row was selected or not.}
+
+\item{threshold}{A maximum distance (in pixels) to the pointer location.
+Rows in the data frame will be selected if the distance to the pointer is
+less than \code{threshold}.}
+
+\item{maxpoints}{Maximum number of rows to return. If \code{NULL} (the default),
+will return all rows within the threshold distance.}
+
+\item{addDist}{If TRUE, add a column named \code{dist_} that contains the
+distance from the coordinate to the point, in pixels. When no pointer
+event has yet occurred, the value of \code{dist_} will be \code{NA}.}
+}
+\value{
+A data frame based on \code{df}, containing the observations selected by the
+brush or near the click event. For \code{nearPoints()}, the rows will be sorted
+by distance to the event.
+
+If \code{allRows = TRUE}, then all rows will returned, along with a new
+\code{selected_} column that indicates whether or not the point was selected.
+The output from \code{nearPoints()} will no longer be sorted, but you can
+set \code{addDist = TRUE} to get an additional column that gives the pixel
+distance to the pointer.
 }
 \description{
-This function returns rows from a data frame which are under a brush used
-with \code{\link[=plotOutput]{plotOutput()}}.
+\code{brushedPoints()} returns rows from a data frame which are under a brush.
+\code{nearPoints()} returns rows from a data frame which are near a click, hover,
+or double-click. Alternatively, set \code{allRows = TRUE} to return all rows from
+the input data with an additional column \code{selected_} that indicates which
+rows of the would be selected.
 }
-\details{
-It is also possible for this function to return all rows from the input data
-frame, but with an additional column \code{selected_}, which indicates which
-rows of the input data frame are selected by the brush (\code{TRUE} for
-selected, \code{FALSE} for not-selected). This is enabled by setting
-\code{allRows=TRUE} option.
+\section{ggplot2}{
 
-The \code{xvar}, \code{yvar}, \code{panelvar1}, and \code{panelvar2}
-arguments specify which columns in the data correspond to the x variable, y
-variable, and panel variables of the plot. For example, if your plot is
-\code{plot(x=cars$speed, y=cars$dist)}, and your brush is named
-\code{"cars_brush"}, then you would use \code{brushedPoints(cars, input$cars_brush, "speed", "dist")}.
+For plots created with ggplot2, it is not necessary to specify the
+column names to \code{xvar}, \code{yvar}, \code{panelvar1}, and \code{panelvar2} as that
+information can be automatically derived from the plot specification.
 
-For plots created with ggplot2, it should not be necessary to specify the
-column names; that information will already be contained in the brush,
-provided that variables are in the original data, and not computed. For
-example, with \code{ggplot(cars, aes(x=speed, y=dist)) + geom_point()}, you
-could use \code{brushedPoints(cars, input$cars_brush)}. If, however, you use
-a computed column, like \code{ggplot(cars, aes(x=speed/2, y=dist)) + geom_point()}, then it will not be able to automatically extract column names
-and filter on them. If you want to use this function to filter data, it is
-recommended that you not use computed columns; instead, modify the data
+Note, however, that this will not work if you use a computed column, like
+\verb{aes(speed/2, dist))}. Instead, we recommend that you modify the data
 first, and then make the plot with "raw" columns in the modified data.
+}
 
-If a specified x or y column is a factor, then it will be coerced to an
-integer vector. If it is a character vector, then it will be coerced to a
-factor and then integer vector. This means that the brush will be considered
-to cover a given character/factor value when it covers the center value.
+\section{Brushing}{
+
+If x or y column is a factor, then it will be coerced to an integer vector.
+If it is a character vector, then it will be coerced to a factor and then
+integer vector. This means that the brush will be considered to cover a
+given character/factor value when it covers the center value.
 
 If the brush is operating in just the x or y directions (e.g., with
 \code{brushOpts(direction = "x")}, then this function will filter out points
 using just the x or y variable, whichever is appropriate.
 }
+
+\examples{
+\dontrun{
+# Note that in practice, these examples would need to go in reactives
+# or observers.
+
+# This would select all points within 5 pixels of the click
+nearPoints(mtcars, input$plot_click)
+
+# Select just the nearest point within 10 pixels of the click
+nearPoints(mtcars, input$plot_click, threshold = 10, maxpoints = 1)
+
+}
+}
 \seealso{
 \code{\link[=plotOutput]{plotOutput()}} for example usage.
 }

man/builder.Rd

@@ -1,124 +0,0 @@
-\name{builder}
-\alias{builder}
-\alias{tags}
-\alias{p}
-\alias{h1}
-\alias{h2}
-\alias{h3}
-\alias{h4}
-\alias{h5}
-\alias{h6}
-\alias{a}
-\alias{br}
-\alias{div}
-\alias{span}
-\alias{pre}
-\alias{code}
-\alias{img}
-\alias{strong}
-\alias{em}
-\alias{hr}
-\title{HTML Builder Functions}
-\usage{
-tags
-
-p(..., .noWS = NULL)
-
-h1(..., .noWS = NULL)
-
-h2(..., .noWS = NULL)
-
-h3(..., .noWS = NULL)
-
-h4(..., .noWS = NULL)
-
-h5(..., .noWS = NULL)
-
-h6(..., .noWS = NULL)
-
-a(..., .noWS = NULL)
-
-br(..., .noWS = NULL)
-
-div(..., .noWS = NULL)
-
-span(..., .noWS = NULL)
-
-pre(..., .noWS = NULL)
-
-code(..., .noWS = NULL)
-
-img(..., .noWS = NULL)
-
-strong(..., .noWS = NULL)
-
-em(..., .noWS = NULL)
-
-hr(..., .noWS = NULL)
-}
-\arguments{
-\item{...}{Attributes and children of the element. Named arguments become
-attributes, and positional arguments become children. Valid children are
-tags, single-character character vectors (which become text nodes), raw
-HTML (see \code{\link{HTML}}), and \code{html_dependency} objects. You can
-also pass lists that contain tags, text nodes, or HTML. To use boolean
-attributes, use a named argument with a \code{NA} value. (see example)}
-
-\item{.noWS}{A character vector used to omit some of the whitespace that
-would normally be written around this tag. Valid options include
-\code{before}, \code{after}, \code{outside}, \code{after-begin}, and
-\code{before-end}. Any number of these options can be specified.}
-}
-\description{
-Simple functions for constructing HTML documents.
-}
-\details{
-The \code{tags} environment contains convenience functions for all valid
-HTML5 tags. To generate tags that are not part of the HTML5 specification,
-you can use the \code{\link{tag}()} function.
-
-Dedicated functions are available for the most common HTML tags that do not
-conflict with common R functions.
-
-The result from these functions is a tag object, which can be converted using
-\code{\link{as.character}()}.
-}
-\examples{
-doc <- tags$html(
-  tags$head(
-    tags$title('My first page')
-  ),
-  tags$body(
-    h1('My first heading'),
-    p('My first paragraph, with some ',
-      strong('bold'),
-      ' text.'),
-    div(id='myDiv', class='simpleDiv',
-        'Here is a div with some attributes.')
-  )
-)
-cat(as.character(doc))
-
-# create an html5 audio tag with controls.
-# controls is a boolean attributes
-audio_tag <- tags$audio(
-  controls = NA,
-  tags$source(
-    src = "myfile.wav",
-    type = "audio/wav"
-  )
-)
-cat(as.character(audio_tag))
-
-# suppress the whitespace between tags
-oneline <- tags$span(
-  tags$strong("I'm strong", .noWS="outside")
-)
-cat(as.character(oneline))
-}
-\references{
-\itemize{
-   \item W3C html specification about boolean attributes
-   \url{https://www.w3.org/TR/html5/infrastructure.html#sec-boolean-attributes}
- }
-}

man/clickOpts.Rd

@@ -4,7 +4,7 @@
 \alias{clickOpts}
 \title{Create an object representing click options}
 \usage{
-clickOpts(id = NULL, clip = TRUE)
+clickOpts(id, clip = TRUE)
 }
 \arguments{
 \item{id}{Input value name. For example, if the value is \code{"plot_click"},

man/dblclickOpts.Rd

@@ -4,7 +4,7 @@
 \alias{dblclickOpts}
 \title{Create an object representing double-click options}
 \usage{
-dblclickOpts(id = NULL, clip = TRUE, delay = 400)
+dblclickOpts(id, clip = TRUE, delay = 400)
 }
 \arguments{
 \item{id}{Input value name. For example, if the value is

man/hoverOpts.Rd

@@ -5,7 +5,7 @@
 \title{Create an object representing hover options}
 \usage{
 hoverOpts(
-  id = NULL,
+  id,
   delay = 300,
   delayType = c("debounce", "throttle"),
   clip = TRUE,

man/htmlTemplate.Rd

@@ -1,29 +0,0 @@
-\name{htmlTemplate}
-\alias{htmlTemplate}
-\title{Process an HTML template}
-\usage{
-htmlTemplate(filename = NULL, ..., text_ = NULL, document_ = "auto")
-}
-\arguments{
-\item{filename}{Path to an HTML template file. Incompatible with
-\code{text_}.}
-
-\item{...}{Variable values to use when processing the template.}
-
-\item{text_}{A string to use as the template, instead of a file. Incompatible
-with \code{filename}.}
-
-\item{document_}{Is this template a complete HTML document (\code{TRUE}), or
-a fragment of HTML that is to be inserted into an HTML document
-(\code{FALSE})? With \code{"auto"} (the default), auto-detect by searching
-for the string \code{"<HTML>"} within the template.}
-}
-\description{
-Process an HTML template and return a tagList object. If the template is a
-complete HTML document, then the returned object will also have class
-\code{html_document}, and can be passed to the function
-\code{\link{renderDocument}} to get the final HTML text.
-}
-\seealso{
-\code{\link{renderDocument}}
-}

man/include.Rd

@@ -1,44 +0,0 @@
-\name{include}
-\alias{include}
-\alias{includeHTML}
-\alias{includeText}
-\alias{includeMarkdown}
-\alias{includeCSS}
-\alias{includeScript}
-\title{Include Content From a File}
-\usage{
-includeHTML(path)
-
-includeText(path)
-
-includeMarkdown(path)
-
-includeCSS(path, ...)
-
-includeScript(path, ...)
-}
-\arguments{
-\item{path}{The path of the file to be included. It is highly recommended to
-use a relative path (the base path being the Shiny application directory),
-not an absolute path.}
-
-\item{...}{Any additional attributes to be applied to the generated tag.}
-}
-\description{
-Load HTML, text, or rendered Markdown from a file and turn into HTML.
-}
-\details{
-These functions provide a convenient way to include an extensive amount of
-HTML, textual, Markdown, CSS, or JavaScript content, rather than using a
-large literal R string.
-}
-\note{
-\code{includeText} escapes its contents, but does no other processing.
-  This means that hard breaks and multiple spaces will be rendered as they
-  usually are in HTML: as a single space character. If you are looking for
-  preformatted text, wrap the call with \code{\link{pre}}, or consider using
-  \code{includeMarkdown} instead.
-
-The \code{includeMarkdown} function requires the \code{markdown}
-  package.
-}

man/loadSupport.Rd

@@ -5,13 +5,15 @@
 \title{Load an app's supporting R files}
 \usage{
 loadSupport(
-  appDir,
+  appDir = NULL,
   renv = new.env(parent = globalenv()),
   globalrenv = globalenv()
 )
 }
 \arguments{
-\item{appDir}{The application directory}
+\item{appDir}{The application directory. If \code{appDir} is \code{NULL} or
+not supplied, the nearest enclosing directory that is a Shiny app, starting
+with the current directory, is used.}
 
 \item{renv}{The environmeny in which the files in the \verb{R/} directory should
 be evaluated.}

man/markdown.Rd

@@ -0,0 +1,62 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/shiny.R
+\name{markdown}
+\alias{markdown}
+\title{Insert inline Markdown}
+\usage{
+markdown(mds, extensions = TRUE, .noWS = NULL, ...)
+}
+\arguments{
+\item{mds}{A character vector of Markdown source to convert to HTML. If the
+vector has more than one element, a single-element character vector of
+concatenated HTML is returned.}
+
+\item{extensions}{Enable Github syntax extensions; defaults to \code{TRUE}.}
+
+\item{.noWS}{Character vector used to omit some of the whitespace that would
+normally be written around generated HTML. Valid options include \code{before},
+\code{after}, and \code{outside} (equivalent to \code{before} and \code{end}).}
+
+\item{...}{Additional arguments to pass to \code{\link[commonmark:markdown_html]{commonmark::markdown_html()}}.
+These arguments are \emph{\link[rlang:dyn-dots]{dynamic}}.}
+}
+\value{
+a character vector marked as HTML.
+}
+\description{
+This function accepts
+\href{https://en.wikipedia.org/wiki/Markdown}{Markdown}-syntax text and returns
+HTML that may be included in Shiny UIs.
+}
+\details{
+Leading whitespace is trimmed from Markdown text with \code{\link[glue:trim]{glue::trim()}}.
+Whitespace trimming ensures Markdown is processed correctly even when the
+call to \code{markdown()} is indented within surrounding R code.
+
+By default, \link[commonmark:extensions]{Github extensions} are enabled, but this
+can be disabled by passing \code{extensions = FALSE}.
+
+Markdown rendering is performed by \code{\link[commonmark:markdown_html]{commonmark::markdown_html()}}. Additional
+arguments to \code{markdown()} are passed as arguments to \code{markdown_html()}
+}
+\examples{
+ui <- fluidPage(
+  markdown("
+    # Markdown Example
+
+    This is a markdown paragraph, and will be contained within a `<p>` tag
+    in the UI.
+
+    The following is an unordered list, which will be represented in the UI as
+    a `<ul>` with `<li>` children:
+
+    * a bullet
+    * another
+
+    [Links](https://developer.mozilla.org/en-US/docs/Web/HTML/Element/a) work;
+    so does *emphasis*.
+
+    To see more of what's possible, check out [commonmark.org/help](https://commonmark.org/help).
+    ")
+)
+}

man/migrateLegacyShinytest.Rd

@@ -0,0 +1,48 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/test.R
+\name{migrateLegacyShinytest}
+\alias{migrateLegacyShinytest}
+\title{Migrate legacy \pkg{shinytest} files to new test directory structure}
+\usage{
+migrateLegacyShinytest(appdir, prompt = interactive())
+}
+\arguments{
+\item{appdir}{A directory containing a Shiny application.}
+
+\item{prompt}{If \code{TRUE}, ask for confirmation when moving files.}
+}
+\description{
+This function migrates the old-style directory structure used by
+\pkg{shinytest} to (versions 1.3.1 and below) new test directory structure
+used in Shiny 1.5.0 and above.
+}
+\details{
+In Shiny 1.5.0, the \code{\link[=runTests]{runTests()}} function was added, and it will run test
+scripts tests/ subdirectory of the application. The directory structure will
+look something like this:\preformatted{appdir/
+ |- R
+ |- tests
+     |- shinytest.R
+     |- shinytest
+     |   `- mytest.R
+     |- testthat.R
+     `- testthat
+         `- test-script.R
+}
+
+This allows for tests using the \pkg{shinytest} package as well as other
+testing tools, such as the \code{\link[=testServer]{testServer()}} function, which can be used for
+testing module and server logic, and for unit tests of functions in an R/
+subdirectory.
+
+With the \pkg{shinytest} package, in versions 1.3.0 and below, the tests/
+subdirectory of the application was used specifically for \pkg{shinytest},
+and could not be used for other types of tests. So the directory structure
+would look like this:\preformatted{appdir/
+ `- tests
+     `- mytest.R
+}
+
+In \pkg{shinytest} 1.4.0 and above, it defaults to the new directory
+structure.
+}

man/moduleServer.Rd

@@ -31,8 +31,9 @@ modules are easier to reuse and easier to reason about. See the article at
 \url{http://shiny.rstudio.com/articles/modules.html} to learn more.
 }
 \details{
-Starting in Shiny 1.5.0, we recommend using \code{moduleFunction} instead of
-\code{callModule}, because syntax is a little easier to understand.
+Starting in Shiny 1.5.0, we recommend using \code{moduleServer} instead of
+\code{callModule}, because the syntax is a little easier to understand, and
+modules created with \code{moduleServer} can be tested with \code{\link[=testServer]{testServer()}}.
 }
 \examples{
 # Define the UI for a module
@@ -46,16 +47,19 @@ counterUI <- function(id, label = "Counter") {
 
 # Define the server logic for a module
 counterServer <- function(id) {
-  moduleServer(id, function(input, output, session) {
-    count <- reactiveVal(0)
-    observeEvent(input$button, {
-      count(count() + 1)
-    })
-    output$out <- renderText({
-      count()
-    })
-    count
-  })
+  moduleServer(
+    id,
+    function(input, output, session) {
+      count <- reactiveVal(0)
+      observeEvent(input$button, {
+        count(count() + 1)
+      })
+      output$out <- renderText({
+        count()
+      })
+      count
+    }
+  )
 }
 
 # Use the module in an app
@@ -77,16 +81,19 @@ if (interactive()) {
 # add them to your function. In this case `prefix` is text that will be
 # printed before the count.
 counterServer2 <- function(id, prefix = NULL) {
-  moduleServer(id, function(input, output, session) {
-    count <- reactiveVal(0)
-    observeEvent(input$button, {
-      count(count() + 1)
-    })
-    output$out <- renderText({
-      paste0(prefix, count())
-    })
-    count
-  })
+  moduleServer(
+    id,
+    function(input, output, session) {
+      count <- reactiveVal(0)
+      observeEvent(input$button, {
+        count(count() + 1)
+      })
+      output$out <- renderText({
+        paste0(prefix, count())
+      })
+      count
+    }
+  )
 }
 
 ui <- fluidPage(

man/nearPoints.Rd

@@ -1,97 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/image-interact.R
-\name{nearPoints}
-\alias{nearPoints}
-\title{Find rows of data that are near a click/hover/double-click}
-\usage{
-nearPoints(
-  df,
-  coordinfo,
-  xvar = NULL,
-  yvar = NULL,
-  panelvar1 = NULL,
-  panelvar2 = NULL,
-  threshold = 5,
-  maxpoints = NULL,
-  addDist = FALSE,
-  allRows = FALSE
-)
-}
-\arguments{
-\item{df}{A data frame from which to select rows.}
-
-\item{coordinfo}{The data from a mouse event, such as \code{input$plot_click}.}
-
-\item{xvar}{A string with the name of the variable on the x or y axis.
-This must also be the name of a column in \code{df}. If absent, then this
-function will try to infer the variable from the brush (only works for
-ggplot2).}
-
-\item{yvar}{A string with the name of the variable on the x or y axis.
-This must also be the name of a column in \code{df}. If absent, then this
-function will try to infer the variable from the brush (only works for
-ggplot2).}
-
-\item{panelvar1}{Each of these is a string with the name of a panel
-variable. For example, if with ggplot2, you facet on a variable called
-\code{cyl}, then you can use \code{"cyl"} here. However, specifying the
-panel variable should not be necessary with ggplot2; Shiny should be able
-to auto-detect the panel variable.}
-
-\item{panelvar2}{Each of these is a string with the name of a panel
-variable. For example, if with ggplot2, you facet on a variable called
-\code{cyl}, then you can use \code{"cyl"} here. However, specifying the
-panel variable should not be necessary with ggplot2; Shiny should be able
-to auto-detect the panel variable.}
-
-\item{threshold}{A maxmimum distance to the click point; rows in the data
-frame where the distance to the click is less than \code{threshold} will be
-returned.}
-
-\item{maxpoints}{Maximum number of rows to return. If NULL (the default),
-return all rows that are within the threshold distance.}
-
-\item{addDist}{If TRUE, add a column named \code{dist_} that contains the
-distance from the coordinate to the point, in pixels. When no mouse event
-has yet occured, the value of \code{dist_} will be \code{NA}.}
-
-\item{allRows}{If \code{FALSE} (the default) return a data frame containing
-the selected rows. If \code{TRUE}, the input data frame will have a new
-column, \code{selected_}, which indicates whether the row was inside the
-selected by the mouse event (\code{TRUE}) or not (\code{FALSE}).}
-}
-\description{
-This function returns rows from a data frame which are near a click, hover, or
-double-click, when used with \code{\link[=plotOutput]{plotOutput()}}. The rows will be sorted
-by their distance to the mouse event.
-}
-\details{
-It is also possible for this function to return all rows from the input data
-frame, but with an additional column \code{selected_}, which indicates which
-rows of the input data frame are selected by the brush (\code{TRUE} for
-selected, \code{FALSE} for not-selected). This is enabled by setting
-\code{allRows=TRUE} option. If this is used, the resulting data frame will not
-be sorted by distance to the mouse event.
-
-The \code{xvar}, \code{yvar}, \code{panelvar1}, and \code{panelvar2} arguments
-specify which columns in the data correspond to the x variable, y variable,
-and panel variables of the plot. For example, if your plot is
-\code{plot(x=cars$speed, y=cars$dist)}, and your click variable is named
-\code{"cars_click"}, then you would use \code{nearPoints(cars, input$cars_brush, "speed", "dist")}.
-}
-\examples{
-\dontrun{
-# Note that in practice, these examples would need to go in reactives
-# or observers.
-
-# This would select all points within 5 pixels of the click
-nearPoints(mtcars, input$plot_click)
-
-# Select just the nearest point within 10 pixels of the click
-nearPoints(mtcars, input$plot_click, threshold = 10, maxpoints = 1)
-
-}
-}
-\seealso{
-\code{\link[=plotOutput]{plotOutput()}} for more examples.
-}

man/plotOutput.Rd

@@ -12,11 +12,7 @@ imageOutput(
   click = NULL,
   dblclick = NULL,
   hover = NULL,
-  hoverDelay = NULL,
-  hoverDelayType = NULL,
   brush = NULL,
-  clickId = NULL,
-  hoverId = NULL,
   inline = FALSE
 )
 
@@ -27,11 +23,7 @@ plotOutput(
   click = NULL,
   dblclick = NULL,
   hover = NULL,
-  hoverDelay = NULL,
-  hoverDelayType = NULL,
   brush = NULL,
-  clickId = NULL,
-  hoverId = NULL,
   inline = FALSE
 )
 }
@@ -67,12 +59,6 @@ named list with \code{x} and \code{y} elements indicating the mouse
 position. To control the hover time or hover delay type, you must use
 \code{\link[=hoverOpts]{hoverOpts()}}.}
 
-\item{hoverDelay}{Deprecated; use \code{hover} instead. Also see the
-\code{\link[=hoverOpts]{hoverOpts()}} function.}
-
-\item{hoverDelayType}{Deprecated; use \code{hover} instead. Also see the
-\code{\link[=hoverOpts]{hoverOpts()}} function.}
-
 \item{brush}{Similar to the \code{click} argument, this can be \code{NULL}
 (the default), a string, or an object created by the
 \code{\link[=brushOpts]{brushOpts()}} function. If you use a value like
@@ -88,12 +74,6 @@ behavior, use \code{\link[=brushOpts]{brushOpts()}}. Multiple
 value; brushing one image or plot will cause any other brushes with the
 same \code{id} to disappear.}
 
-\item{clickId}{Deprecated; use \code{click} instead. Also see the
-\code{\link[=clickOpts]{clickOpts()}} function.}
-
-\item{hoverId}{Deprecated; use \code{hover} instead. Also see the
-\code{\link[=hoverOpts]{hoverOpts()}} function.}
-
 \item{inline}{use an inline (\code{span()}) or block container (\code{div()})
 for the output}
 }

man/reexports.Rd

@@ -1,10 +1,48 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/cache-utils.R
+% Please edit documentation in R/reexports.R
 \docType{import}
 \name{reexports}
 \alias{reexports}
 \alias{key_missing}
 \alias{is.key_missing}
+\alias{tags}
+\alias{p}
+\alias{h1}
+\alias{h2}
+\alias{h3}
+\alias{h4}
+\alias{h5}
+\alias{h6}
+\alias{a}
+\alias{br}
+\alias{div}
+\alias{span}
+\alias{pre}
+\alias{code}
+\alias{img}
+\alias{strong}
+\alias{em}
+\alias{hr}
+\alias{tag}
+\alias{tagList}
+\alias{tagAppendAttributes}
+\alias{tagHasAttribute}
+\alias{tagGetAttribute}
+\alias{tagAppendChild}
+\alias{tagAppendChildren}
+\alias{tagSetChildren}
+\alias{HTML}
+\alias{includeHTML}
+\alias{includeText}
+\alias{includeMarkdown}
+\alias{includeCSS}
+\alias{includeScript}
+\alias{singleton}
+\alias{is.singleton}
+\alias{validateCssUnit}
+\alias{htmlTemplate}
+\alias{suppressDependencies}
+\alias{withTags}
 \title{Objects exported from other packages}
 \keyword{internal}
 \description{
@@ -13,5 +51,7 @@ below to see their documentation.
 
 \describe{
   \item{fastmap}{\code{\link[fastmap]{is.key_missing}}, \code{\link[fastmap]{key_missing}}}
+
+  \item{htmltools}{\code{\link[htmltools]{a}}, \code{\link[htmltools]{br}}, \code{\link[htmltools]{code}}, \code{\link[htmltools]{div}}, \code{\link[htmltools]{em}}, \code{\link[htmltools]{h1}}, \code{\link[htmltools]{h2}}, \code{\link[htmltools]{h3}}, \code{\link[htmltools]{h4}}, \code{\link[htmltools]{h5}}, \code{\link[htmltools]{h6}}, \code{\link[htmltools]{hr}}, \code{\link[htmltools]{HTML}}, \code{\link[htmltools]{htmlTemplate}}, \code{\link[htmltools]{img}}, \code{\link[htmltools]{includeCSS}}, \code{\link[htmltools]{includeHTML}}, \code{\link[htmltools]{includeMarkdown}}, \code{\link[htmltools]{includeScript}}, \code{\link[htmltools]{includeText}}, \code{\link[htmltools]{is.singleton}}, \code{\link[htmltools]{p}}, \code{\link[htmltools]{pre}}, \code{\link[htmltools]{singleton}}, \code{\link[htmltools]{span}}, \code{\link[htmltools]{strong}}, \code{\link[htmltools]{suppressDependencies}}, \code{\link[htmltools]{tag}}, \code{\link[htmltools]{tagAppendAttributes}}, \code{\link[htmltools]{tagAppendChild}}, \code{\link[htmltools]{tagAppendChildren}}, \code{\link[htmltools]{tagGetAttribute}}, \code{\link[htmltools]{tagHasAttribute}}, \code{\link[htmltools]{tagList}}, \code{\link[htmltools]{tags}}, \code{\link[htmltools]{tagSetChildren}}, \code{\link[htmltools]{validateCssUnit}}, \code{\link[htmltools]{withTags}}}
 }}
 

man/runTests.Rd

@@ -4,7 +4,7 @@
 \alias{runTests}
 \title{Runs the tests associated with this Shiny app}
 \usage{
-runTests(appDir = ".", filter = NULL)
+runTests(appDir = ".", filter = NULL, assert = TRUE, envir = globalenv())
 }
 \arguments{
 \item{appDir}{The base directory for the application.}
@@ -12,6 +12,19 @@ runTests(appDir = ".", filter = NULL)
 \item{filter}{If not \code{NULL}, only tests with file names matching this regular
 expression will be executed. Matching is performed on the file name
 including the extension.}
+
+\item{assert}{Logical value which determines if an error should be thrown if any error is captured.}
+
+\item{envir}{Parent testing environment in which to base the individual testing environments.}
+}
+\value{
+A data frame classed with the supplemental class \code{"shiny_runtests"}.
+The data frame has the following columns:\tabular{lll}{
+   \strong{Name} \tab \strong{Type} \tab \strong{Meaning} \cr
+   \code{file} \tab \code{character(1)} \tab File name of the runner script in \verb{tests/} that was sourced. \cr
+   \code{pass} \tab \code{logical(1)} \tab Whether or not the runner script signaled an error when sourced. \cr
+   \code{result} \tab any or \code{NA} \tab The return value of the runner \cr
+}
 }
 \description{
 Sources the \code{.R} files in the top-level of \verb{tests/} much like \verb{R CMD check}.
@@ -20,8 +33,7 @@ directories under \verb{tests/}.
 }
 \details{
 Historically, \href{https://rstudio.github.io/shinytest/}{shinytest}
-recommended placing tests at the top-level of the \verb{tests/} directory. In
-order to support that model, \code{testApp} first checks to see if the \code{.R}
-files in the \verb{tests/} directory are all shinytests; if so, just calls out
-to \code{\link[shinytest:testApp]{shinytest::testApp()}}.
+recommended placing tests at the top-level of the \verb{tests/} directory.
+This older folder structure is not supported by runTests.
+Please see \code{\link[=shinyAppTemplate]{shinyAppTemplate()}} for more details.
 }

man/shinyAppTemplate.Rd

@@ -0,0 +1,70 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/app_template.R
+\name{shinyAppTemplate}
+\alias{shinyAppTemplate}
+\title{Generate a Shiny application from a template}
+\usage{
+shinyAppTemplate(path = NULL, examples = "default", dryrun = FALSE)
+}
+\arguments{
+\item{path}{Path to create new shiny application template.}
+
+\item{examples}{Either one of "default", "ask", "all", or any combination of
+"app", "rdir", "module", "shinytest", and "testthat". In an
+interactive session, "default" falls back to "ask"; in a non-interactive
+session, "default" falls back to "all". With "ask", this function will
+prompt the user to select which template items will be added to the new app
+directory. With "all", all template items will be added to the app
+directory.}
+
+\item{dryrun}{If \code{TRUE}, don't actually write any files; just print out which
+files would be written.}
+}
+\description{
+This function populates a directory with files for a Shiny application.
+}
+\details{
+In an interactive R session, this function will, by default, prompt the user
+which components to add to the application.
+
+The full example application includes the following files and directories:\preformatted{appdir/
+|- app.R
+|- R
+|   |- my-module.R
+|   `- sort.R
+`- tests
+    |- shinytest.R
+    |- shinytest
+    |   `- mytest.R
+    |- testthat.R
+    `- testthat
+        |- helper-load.R
+        |- test-mymodule.R
+        |- test-server.R
+        `- test-sort.R
+}
+
+Some notes about these files:
+\itemize{
+\item \code{app.R} is the main application file.
+\item All files in the \verb{R/} subdirectory are automatically sourced when the
+application is run.
+\item \code{R/sort.R} and \code{R/my-module.R} are automatically sourced when
+the application is run. The first contains a function \code{lexical_sort()},
+and the second contains code for a \href{moduleServer()}{Shiny module} which
+is used in the application.
+\item \verb{tests/} contains various tests for the application. You may
+choose to use or remove any of them. They can be executed by the
+\code{\link[=runTests]{runTests()}} function.
+\item \code{tests/shinytest.R} is a test runner for test files in the
+\verb{tests/shinytest/} directory.
+\item \code{tests/shinytest/mytest.R} is a test that uses the
+\href{https://rstudio.github.io/shinytest/}{shinytest} package to do
+snapshot-based testing.
+\item \code{tests/testthat.R} is a test runner for test files in the
+\verb{tests/testthat/} directory using the \href{https://testthat.r-lib.org/}{testthat} package.
+\item \code{tests/testthat/test-mymodule.R} is a test for an application's module server function.
+\item \code{tests/testthat/test-server.R} is a test for the application's server code
+\item \code{tests/testthat/test-sort.R} is a test for a supporting function in the \verb{R/} directory.
+}
+}

man/singleton.Rd

@@ -1,20 +0,0 @@
-\name{singleton}
-\alias{singleton}
-\alias{is.singleton}
-\title{Include content only once}
-\usage{
-singleton(x, value = TRUE)
-
-is.singleton(x)
-}
-\arguments{
-\item{x}{A \code{\link{tag}}, text, \code{\link{HTML}}, or list.}
-
-\item{value}{Whether the object should be a singleton.}
-}
-\description{
-Use \code{singleton} to wrap contents (tag, text, HTML, or lists) that should
-be included in the generated document only once, yet may appear in the
-document-generating code more than once. Only the first appearance of the
-content (in document order) will be used.
-}

man/suppressDependencies.Rd

@@ -1,21 +0,0 @@
-\name{suppressDependencies}
-\alias{suppressDependencies}
-\title{Suppress web dependencies}
-\usage{
-suppressDependencies(...)
-}
-\arguments{
-\item{...}{Names of the dependencies to suppress. For example,
-\code{"jquery"} or \code{"bootstrap"}.}
-}
-\description{
-This suppresses one or more web dependencies. It is meant to be used when a
-dependency (like a JavaScript or CSS file) is declared in raw HTML, in an
-HTML template.
-}
-\seealso{
-\code{\link{htmlTemplate}} for more information about using HTML
-  templates.
-
-\code{\link[htmltools]{htmlDependency}}
-}

man/tabPanel.Rd

@@ -2,9 +2,12 @@
 % Please edit documentation in R/bootstrap.R
 \name{tabPanel}
 \alias{tabPanel}
+\alias{tabPanelBody}
 \title{Create a tab panel}
 \usage{
 tabPanel(title, ..., value = title, icon = NULL)
+
+tabPanelBody(..., value = NULL, icon = NULL)
 }
 \arguments{
 \item{title}{Display title for tab}
@@ -22,9 +25,16 @@ valid when using a \code{tabPanel} within a \code{\link[=navbarPage]{navbarPage(
 A tab that can be passed to \code{\link[=tabsetPanel]{tabsetPanel()}}
 }
 \description{
-Create a tab panel that can be included within a \code{\link[=tabsetPanel]{tabsetPanel()}} or
-a \code{\link[=navbarPage]{navbarPage()}}.
+Create a tab panel
 }
+\section{Functions}{
+\itemize{
+\item \code{tabPanel}: Create a tab panel that can be included within a \code{\link[=tabsetPanel]{tabsetPanel()}} or a \code{\link[=navbarPage]{navbarPage()}}.
+
+\item \code{tabPanelBody}: Create a tab panel that drops the title argument.
+This function should be used within \code{tabsetPanel(type = "hidden")}. See \code{\link[=tabsetPanel]{tabsetPanel()}} for example usage.
+}}
+
 \examples{
 # Show a tabset that includes a plot, summary, and
 # table view of the generated distribution

man/tabsetPanel.Rd

@@ -8,7 +8,7 @@ tabsetPanel(
   ...,
   id = NULL,
   selected = NULL,
-  type = c("tabs", "pills"),
+  type = c("tabs", "pills", "hidden"),
   position = NULL
 )
 }
@@ -24,8 +24,13 @@ will correspond to the \code{value} argument that is passed to
 of the tab that should be selected by default. If \code{NULL}, the first
 tab will be selected.}
 
-\item{type}{Use "tabs" for the standard look; Use "pills" for a more plain
-look where tabs are selected using a background fill color.}
+\item{type}{\describe{
+\item{\code{"tabs"}}{Standard tab look}
+\item{\code{"pills"}}{Selected tabs use the background fill color}
+\item{\code{"hidden"}}{Hides the selectable tabs. Use \code{type = "hidden"} in
+conjunction with \code{\link[=tabPanelBody]{tabPanelBody()}} and \code{\link[=updateTabsetPanel]{updateTabsetPanel()}} to control the
+active tab via other input controls. (See example below)}
+}}
 
 \item{position}{This argument is deprecated; it has been discontinued in
 Bootstrap 3.}
@@ -47,6 +52,35 @@ mainPanel(
     tabPanel("Table", tableOutput("table"))
   )
 )
+
+ui <- fluidPage(
+  sidebarLayout(
+    sidebarPanel(
+      radioButtons("controller", "Controller", 1:3, 1)
+    ),
+    mainPanel(
+      tabsetPanel(
+        id = "hidden_tabs",
+        # Hide the tab values.
+        # Can only switch tabs by using `updateTabsetPanel()`
+        type = "hidden",
+        tabPanelBody(value = "panel1", "Panel 1 content"),
+        tabPanelBody(value = "panel2", "Panel 2 content"),
+        tabPanelBody(value = "panel3", "Panel 3 content")
+      )
+    )
+  )
+)
+
+server <- function(input, output, session) {
+  observeEvent(input$controller, {
+    updateTabsetPanel(session, "hidden_tabs", selected = paste0("panel", input$controller))
+  })
+}
+
+if (interactive()) {
+  shinyApp(ui, server)
+}
 }
 \seealso{
 \code{\link[=tabPanel]{tabPanel()}}, \code{\link[=updateTabsetPanel]{updateTabsetPanel()}},

man/tag.Rd

@@ -1,82 +0,0 @@
-\name{tag}
-\alias{tag}
-\alias{tagList}
-\alias{tagAppendAttributes}
-\alias{tagHasAttribute}
-\alias{tagGetAttribute}
-\alias{tagAppendChild}
-\alias{tagAppendChildren}
-\alias{tagSetChildren}
-\title{HTML Tag Object}
-\usage{
-tagList(...)
-
-tagAppendAttributes(tag, ...)
-
-tagHasAttribute(tag, attr)
-
-tagGetAttribute(tag, attr)
-
-tagAppendChild(tag, child)
-
-tagAppendChildren(tag, ..., list = NULL)
-
-tagSetChildren(tag, ..., list = NULL)
-
-tag(`_tag_name`, varArgs, .noWS = NULL)
-}
-\arguments{
-\item{...}{Unnamed items that comprise this list of tags.}
-
-\item{tag}{A tag to append child elements to.}
-
-\item{attr}{The name of an attribute.}
-
-\item{child}{A child element to append to a parent tag.}
-
-\item{list}{An optional list of elements. Can be used with or instead of the
-\code{...} items.}
-
-\item{_tag_name}{HTML tag name}
-
-\item{varArgs}{List of attributes and children of the element. Named list
-items become attributes, and unnamed list items become children. Valid
-children are tags, single-character character vectors (which become text
-nodes), and raw HTML (see \code{\link{HTML}}). You can also pass lists that
-contain tags, text nodes, and HTML.}
-
-\item{.noWS}{Character vector used to omit some of the whitespace that would
-normally be written around this tag. Valid options include \code{before},
-\code{after}, \code{outside}, \code{after-begin}, and \code{before-end}.
-Any number of these options can be specified.}
-}
-\value{
-An HTML tag object that can be rendered as HTML using
-  \code{\link{as.character}()}.
-}
-\description{
-\code{tag()} creates an HTML tag definition. Note that all of the valid HTML5
-tags are already defined in the \code{\link{tags}} environment so these
-functions should only be used to generate additional tags.
-\code{tagAppendChild()} and \code{tagList()} are for supporting package
-authors who wish to create their own sets of tags; see the contents of
-bootstrap.R for examples.
-}
-\examples{
-tagList(tags$h1("Title"),
-        tags$h2("Header text"),
-        tags$p("Text here"))
-
-# Can also convert a regular list to a tagList (internal data structure isn't
-# exactly the same, but when rendered to HTML, the output is the same).
-x <- list(tags$h1("Title"),
-          tags$h2("Header text"),
-          tags$p("Text here"))
-tagList(x)
-
-# suppress the whitespace between tags
-oneline <- tag("span",
-  tag("strong", "Super strong", .noWS="outside")
-)
-cat(as.character(oneline))
-}

man/testModule.Rd

@@ -1,73 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/test-module.R
-\name{testModule}
-\alias{testModule}
-\alias{testServer}
-\title{Integration testing for Shiny modules or server functions}
-\usage{
-testModule(module, expr, ...)
-
-testServer(expr, appDir = NULL)
-}
-\arguments{
-\item{module}{The module to 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{...}{Additional arguments to pass to the module function. These
-arguments are processed with \code{\link[rlang:list2]{rlang::list2()}} and so are
-\emph{\link[rlang:dyn-dots]{dynamic}}.}
-
-\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.}
-}
-\value{
-The result of evaluating \code{expr}.
-}
-\description{
-Offer a way to test the reactive interactions in Shiny --- either in Shiny
-modules or in the server portion of a Shiny application. For more
-information, visit \href{https://shiny.rstudio.com/articles/integration-testing.html}{the Shiny Dev Center article on integration testing}.
-}
-\examples{
-module <- function(input, output, session, multiplier = 2, prefix = "I am ") {
-  myreactive <- reactive({
-    input$x * multiplier
-  })
-  output$txt <- renderText({
-    paste0(prefix, myreactive())
-  })
-}
-
-# Basic Usage
-# -----------
-testModule(module, {
-  session$setInputs(x = 1)
-  # You're also free to use third-party
-  # testing packages like testthat:
-  #   expect_equal(myreactive(), 2)
-  stopifnot(myreactive() == 2)
-  stopifnot(output$txt == "I am 2")
-
-  session$setInputs(x = 2)
-  stopifnot(myreactive() == 4)
-  stopifnot(output$txt == "I am 4")
-  # Any additional arguments, below, are passed along to the module.
-}, multiplier = 2)
-
-# Advanced Usage
-# --------------
-multiplier_arg_name = "multiplier"
-more_args <- list(prefix = "I am ")
-testModule(module, {
-  session$setInputs(x = 1)
-  stopifnot(myreactive() == 2)
-  stopifnot(output$txt == "I am 2")
-  # !!/:= and !!! from rlang are used below to splice computed arguments
-  # into the testModule() argument list.
-}, !!multiplier_arg_name := 2, !!!more_args)
-}

man/testServer.Rd

@@ -0,0 +1,59 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/test-server.R
+\name{testServer}
+\alias{testServer}
+\title{Reactive testing for Shiny server functions and modules}
+\usage{
+testServer(app = NULL, expr, args = list())
+}
+\arguments{
+\item{app}{The path to an application or module to test. In addition to
+paths, applications may be represented by any object suitable for coercion
+to an \code{appObj} by \code{as.shiny.appobj}. Application server functions must
+include a \code{session} argument in order to be tested. If \code{app} is \code{NULL} or
+not supplied, the nearest enclosing directory that is a Shiny app, starting
+with the current directory, is used.}
+
+\item{expr}{Test code containing expectations. The test expression will run
+in the server function environment, meaning that the parameters of the
+server function (e.g. \code{input}, \code{output}, and \code{session}) will be available
+along with any other values created inside of the server function.}
+
+\item{args}{Additional arguments to pass to the module function.
+If \code{app} is a module, and no \code{id} argument is provided, one will be
+generated and supplied automatically.}
+}
+\value{
+The result of evaluating \code{expr}.
+}
+\description{
+A way to test the reactive interactions in Shiny applications. Reactive
+interactions are defined in the server function of applications and in
+modules.
+}
+\examples{
+server <- function(id, multiplier = 2, prefix = "I am ") {
+  moduleServer(id, function(input, output, session) {
+    myreactive <- reactive({
+      input$x * multiplier
+    })
+    output$txt <- renderText({
+      paste0(prefix, myreactive())
+    })
+  })
+}
+
+testServer(server, args = list(multiplier = 2), {
+  session$setInputs(x = 1)
+  # You're also free to use third-party
+  # testing packages like testthat:
+  #   expect_equal(myreactive(), 2)
+  stopifnot(myreactive() == 2)
+  stopifnot(output$txt == "I am 2")
+
+  session$setInputs(x = 2)
+  stopifnot(myreactive() == 4)
+  stopifnot(output$txt == "I am 4")
+  # Any additional arguments, below, are passed along to the module.
+})
+}

man/updateActionButton.Rd

@@ -2,9 +2,12 @@
 % Please edit documentation in R/update-input.R
 \name{updateActionButton}
 \alias{updateActionButton}
+\alias{updateActionLink}
 \title{Change the label or icon of an action button on the client}
 \usage{
 updateActionButton(session, inputId, label = NULL, icon = NULL)
+
+updateActionLink(session, inputId, label = NULL, icon = NULL)
 }
 \arguments{
 \item{session}{The \code{session} object passed to function given to
@@ -42,13 +45,15 @@ can be cleared by using \code{selected=character(0)}.
 if (interactive()) {
 
 ui <- fluidPage(
-  actionButton("update", "Update other buttons"),
+  actionButton("update", "Update other buttons and link"),
   br(),
   actionButton("goButton", "Go"),
   br(),
   actionButton("goButton2", "Go 2", icon = icon("area-chart")),
   br(),
-  actionButton("goButton3", "Go 3")
+  actionButton("goButton3", "Go 3"),
+  br(),
+  actionLink("goLink", "Go Link")
 )
 
 server <- function(input, output, session) {
@@ -69,6 +74,11 @@ server <- function(input, output, session) {
     # unchaged and changes its label
     updateActionButton(session, "goButton3",
       label = "New label 3")
+
+    # Updates goLink's label and icon
+    updateActionButton(session, "goLink",
+      label = "New link label",
+      icon = icon("link"))
   })
 }
 

man/validateCssUnit.Rd

@@ -1,38 +0,0 @@
-\name{validateCssUnit}
-\alias{validateCssUnit}
-\title{Validate proper CSS formatting of a unit}
-\usage{
-validateCssUnit(x)
-}
-\arguments{
-\item{x}{The unit to validate. Will be treated as a number of pixels if a
-unit is not specified.}
-}
-\value{
-A properly formatted CSS unit of length, if possible. Otherwise, will
-  throw an error.
-}
-\description{
-Checks that the argument is valid for use as a CSS unit of length.
-}
-\details{
-\code{NULL} and \code{NA} are returned unchanged.
-
-Single element numeric vectors are returned as a character vector with the
-number plus a suffix of \code{"px"}.
-
-Single element character vectors must be \code{"auto"} or \code{"inherit"},
-a number, or a length calculated by the \code{"calc"} CSS function.
-If the number has a suffix, it must be valid: \code{px},
-\code{\%}, \code{ch}, \code{em}, \code{rem}, \code{pt}, \code{in}, \code{cm},
-\code{mm}, \code{ex}, \code{pc}, \code{vh}, \code{vw}, \code{vmin}, or
-\code{vmax}.
-If the number has no suffix, the suffix \code{"px"} is appended.
-
-
-Any other value will cause an error to be thrown.
-}
-\examples{
-validateCssUnit("10\%")
-validateCssUnit(400)  #treated as '400px'
-}

man/withTags.Rd

@@ -1,39 +0,0 @@
-\name{withTags}
-\alias{withTags}
-\title{Evaluate an expression using \code{tags}}
-\usage{
-withTags(code)
-}
-\arguments{
-\item{code}{A set of tags.}
-}
-\description{
-This function makes it simpler to write HTML-generating code. Instead of
-needing to specify \code{tags} each time a tag function is used, as in
-\code{tags$div()} and \code{tags$p()}, code inside \code{withTags} is
-evaluated with \code{tags} searched first, so you can simply use
-\code{div()} and \code{p()}.
-}
-\details{
-If your code uses an object which happens to have the same name as an
-HTML tag function, such as \code{source()} or \code{summary()}, it will call
-the tag function. To call the intended (non-tags function), specify the
-namespace, as in \code{base::source()} or \code{base::summary()}.
-}
-\examples{
-# Using tags$ each time
-tags$div(class = "myclass",
-  tags$h3("header"),
-  tags$p("text")
-)
-
-# Equivalent to above, but using withTags
-withTags(
-  div(class = "myclass",
-    h3("header"),
-    p("text")
-  )
-)
-
-
-}

revdep/.gitignore

@@ -0,0 +1,3 @@
+*.noindex*
+data.sqlite
+failures.md

revdep/README.md

@@ -0,0 +1,23 @@
+# Platform
+
+|field    |value                        |
+|:--------|:----------------------------|
+|version  |R version 3.6.1 (2019-07-05) |
+|os       |macOS Catalina 10.15.3       |
+|system   |x86_64, darwin15.6.0         |
+|ui       |X11                          |
+|language |(EN)                         |
+|collate  |en_US.UTF-8                  |
+|ctype    |en_US.UTF-8                  |
+|tz       |America/New_York             |
+|date     |2020-03-05                   |
+
+# Dependencies
+
+|package |old   |new     |Δ  |
+|:-------|:-----|:-------|:--|
+|shiny   |1.4.0 |1.4.0.1 |*  |
+|rlang   |NA    |0.4.5   |*  |
+
+# Revdeps
+

revdep/problems.md

@@ -0,0 +1 @@
+*Wow, no problems at all. :)*

revdep/revdep-cran-comments.md

@@ -0,0 +1,6 @@
+## revdepcheck results
+
+We checked 836 reverse dependencies (719 from CRAN + 117 from BioConductor), comparing R CMD check results across CRAN and dev versions of this package.
+
+ * We saw 0 new problems
+ * We failed to check 0 packages

tests/test-all.R

@@ -1,4 +1,8 @@
-library(testthat)
-library(shiny)
 
-test_check("shiny")
+# only test if testthat is available
+if (require(testthat)) {
+  library(testthat)
+  library(shiny)
+
+  test_check("shiny")
+}

tests/test-helpers/app1-standard/R/helperCap.R

@@ -1,2 +1,2 @@
-
+source_wd <- getwd()
 helper1 <- 123

tests/test-helpers/app1-standard/global.R

@@ -1 +1,2 @@
 global <- "ABC"
+global_wd <- getwd()

tests/test-helpers/app1-standard/tests/runner1.R

@@ -1,2 +1,2 @@
 
-a <- 1
+runner1_A <- 1

tests/test-helpers/app1-standard/tests/runner2.R

@@ -1,13 +1,19 @@
 
-b <- 2
-
 
-if (!identical(helper1, "abc")){
-  stop("Missing helper1")
-}
-if (!identical(helper2, 123)){
-  stop("Missing helper2")
-}
-if (exists("a")){
-  stop("a exists -- are we leaking in between test environments?")
-}
+
+withr::with_environment(
+  shiny::loadSupport(),
+  {
+    runner2_B <- 2
+
+    if (!identical(helper1, 123)){
+      stop("Missing helper1")
+    }
+    if (!identical(helper2, "abc")){
+      stop("Missing helper2")
+    }
+    if (exists("runner1_A")){
+      stop("runner1_A exists -- are we leaking in between test environments?")
+    }
+  }
+)

tests/test-modules/06_tabsets/app.R

@@ -48,7 +48,7 @@ ui <- fluidPage(
 )
 
 # Define server logic for random distribution app ----
-server <- function(input, output) {
+server <- function(input, output, session) {
 
   # Reactive expression to generate the requested distribution ----
   # This is called whenever the inputs change. The output functions

tests/test-modules/107_scatterplot/R/linked-scatterplot-module.R

@@ -0,0 +1,37 @@
+
+
+
+
+
+linkedScatterUI <- function(id) {
+  ns <- NS(id)
+
+  fluidRow(
+    column(6, plotOutput(ns("plot1"), brush = ns("brush"))),
+    column(6, plotOutput(ns("plot2"), brush = ns("brush")))
+  )
+}
+
+linkedScatterServer <- function(id, data, left, right) {
+  moduleServer(
+    id,
+    function(input, output, session) {
+      # Yields the data frame with an additional column "selected_"
+      # that indicates whether that observation is brushed
+      dataWithSelection <- reactive({
+        # dput(input$brush)
+        brushedPoints(data(), input$brush, allRows = TRUE)
+      })
+
+      output$plot1 <- renderPlot({
+        scatterPlot(dataWithSelection(), left())
+      })
+
+      output$plot2 <- renderPlot({
+        scatterPlot(dataWithSelection(), right())
+      })
+
+      return(dataWithSelection)
+    }
+  )
+}

tests/test-modules/107_scatterplot/R/scatterplot.R

@@ -0,0 +1,7 @@
+alpha_val <- 0.2
+
+scatterPlot <- function(data, cols) {
+  ggplot(data, aes_string(x = cols[1], y = cols[2])) +
+    geom_point(aes(color = selected_), alpha = alpha_val) +
+    scale_color_manual(values = c("black", "#66D65C"), guide = FALSE)
+}

tests/test-modules/107_scatterplot/app.R

@@ -0,0 +1,24 @@
+library(shiny)
+library(ggplot2)
+
+
+ui <- fixedPage(
+  h2("Module example"),
+  linkedScatterUI("scatters"),
+  textOutput("summary")
+)
+
+server <- function(input, output, session) {
+  df <- linkedScatterServer(
+    "scatters",
+    reactive(mpg), # data
+    left = reactive(c("cty", "hwy")),
+    right = reactive(c("drv", "hwy"))
+  )
+
+  output$summary <- renderText({
+    sprintf("%d observation(s) selected", sum(df()$selected_))
+  })
+}
+
+shinyApp(ui, server)

tests/test-modules/107_scatterplot/tests/testthat.R

@@ -0,0 +1,7 @@
+library(testthat)
+
+test_dir(
+  "./testthat",
+  env = shiny::loadSupport(),
+  reporter = c("progress", "fail")
+)

tests/test-modules/107_scatterplot/tests/testthat/test-linked-scatterplot-module.R

@@ -0,0 +1,38 @@
+
+context("linkedScatterServer")
+
+testServer(
+  linkedScatterServer,
+  args = list(
+    data = reactive(ggplot2::mpg),
+    left = reactive(c("cty", "hwy")),
+    right = reactive(c("drv", "hwy"))
+  ),
+  {
+
+    # Init count... 0
+    expect_equal(sum(dataWithSelection()$selected_), 0)
+
+    # Select a region
+    session$setInputs(
+      brush =
+        list(xmin = 0.84909732337501, xmax = 1.289072630224, ymin = 23.228930276968,
+          ymax = 29.434482709514, coords_css = list(xmin = 105.5999755859,
+              xmax = 176.5999755859, ymin = 172.2000007629, ymax = 236.2000007629),
+          coords_img = list(xmin = 263.99993896475, xmax = 441.49993896475,
+              ymin = 430.50000190725, ymax = 590.50000190725), img_css_ratio = list(
+              x = 2.5, y = 2.5), mapping = list(colour = "selected_",
+              x = "drv", y = "hwy"), domain = list(left = 0.4, right = 3.6,
+              bottom = 10.4, top = 45.6, discrete_limits = list(x = list(
+                  "4", "f", "r"))), range = list(left = 82.8198280399793,
+              right = 1373.80136986301, bottom = 921.272945432678,
+              top = 13.6986301369863), log = list(x = NULL, y = NULL),
+          direction = "xy", brushId = "scatters-brush", outputId = "scatters-plot2"
+        )
+    )
+
+    # Check the value of the reactiveVal `count()`
+    expect_equal(sum(dataWithSelection()$selected_), 23)
+
+  }
+)

tests/test-modules/107_scatterplot/tests/testthat/test-plot.R

@@ -0,0 +1,7 @@
+
+context("plot")
+
+test_that("Value exists", {
+  expect_true(exists("alpha_val"))
+  expect_equal(alpha_val, 0.2)
+})

tests/test-modules/107_scatterplot/tests/testthat/test-server.R

@@ -0,0 +1,29 @@
+context("app")
+
+testServer(expr = {
+  # Init count... 0
+  expect_equal(sum(df()$selected_), 0)
+  expect_equal(output$summary, "0 observation(s) selected")
+
+  # Select a region
+  session$setInputs(
+    `scatters-brush` =
+      list(xmin = 0.84909732337501, xmax = 1.289072630224, ymin = 23.228930276968,
+        ymax = 29.434482709514, coords_css = list(xmin = 105.5999755859,
+            xmax = 176.5999755859, ymin = 172.2000007629, ymax = 236.2000007629),
+        coords_img = list(xmin = 263.99993896475, xmax = 441.49993896475,
+            ymin = 430.50000190725, ymax = 590.50000190725), img_css_ratio = list(
+            x = 2.5, y = 2.5), mapping = list(colour = "selected_",
+            x = "drv", y = "hwy"), domain = list(left = 0.4, right = 3.6,
+            bottom = 10.4, top = 45.6, discrete_limits = list(x = list(
+                "4", "f", "r"))), range = list(left = 82.8198280399793,
+            right = 1373.80136986301, bottom = 921.272945432678,
+            top = 13.6986301369863), log = list(x = NULL, y = NULL),
+        direction = "xy", brushId = "scatters-brush", outputId = "scatters-plot2"
+      )
+  )
+
+  # Check the value of the reactiveVal `count()`
+  expect_equal(sum(df()$selected_), 23)
+  expect_equal(output$summary, "23 observation(s) selected")
+})

tests/test-modules/12_counter/R/my-module.R

@@ -0,0 +1,23 @@
+mymoduleUI <- function(id, label = "Counter") {
+  ns <- NS(id)
+  tagList(
+    actionButton(ns("button"), label = label),
+    verbatimTextOutput(ns("out"))
+  )
+}
+
+mymoduleServer <- function(id) {
+  moduleServer(
+    id,
+    function(input, output, session) {
+      count <- reactiveVal(0)
+      observeEvent(input$button, {
+        count(count() + 1)
+      })
+      output$out <- renderText({
+        count()
+      })
+      count
+    }
+  )
+}

tests/test-modules/12_counter/R/utils.R

@@ -0,0 +1,5 @@
+# Given a numeric vector, convert to strings, sort, and convert back to
+# numeric.
+lexical_sort <- function(x) {
+  as.numeric(sort(as.character(x)))
+}

tests/test-modules/12_counter/app.R

@@ -0,0 +1,32 @@
+library(shiny)
+
+ui <- fluidPage(
+  # ======== Modules ========
+  # mymoduleUI is defined in R/my-module.R
+  mymoduleUI("mymodule1", "Click counter #1"),
+  mymoduleUI("mymodule2", "Click counter #2"),
+  # =========================
+  wellPanel(
+    sliderInput("size", "Data size", min = 5, max = 20, value = 10),
+    div("Lexically sorted sequence:"),
+    verbatimTextOutput("sequence")
+  )
+)
+
+server <- function(input, output, session) {
+  # ======== Modules ========
+  # mymoduleServer is defined in R/my-module.R
+  mymoduleServer("mymodule1")
+  mymoduleServer("mymodule2")
+  # =========================
+
+  data <- reactive({
+    # lexical_sort from R/utils.R
+    lexical_sort(seq_len(input$size))
+  })
+  output$sequence <- renderText({
+    paste(data(), collapse = " ")
+  })
+}
+
+shinyApp(ui, server)

tests/test-modules/12_counter/tests/testthat.R

@@ -0,0 +1,10 @@
+library(testthat)
+
+# Run in the "current" environment, because shiny::runTests() is going to
+# provision a new environment that's just for our test. And we'll want access to
+# the supporting files that were already loaded into that env.
+testthat::test_dir(
+  "./testthat",
+  env = shiny::loadSupport(),
+  reporter = c("summary", "fail")
+)

tests/test-modules/12_counter/tests/testthat/test-mymodule.R

@@ -0,0 +1,18 @@
+
+context("mymoduleServer")
+
+testServer(mymoduleServer, {
+  # Set initial value of a button
+  session$setInputs(button = 0)
+
+  # Check the value of the reactiveVal `count()`
+  expect_equal(count(), 1)
+  # Check the value of the renderText()
+  expect_equal(output$out, "1")
+
+  # Simulate a click
+  session$setInputs(button = 1)
+
+  expect_equal(count(), 2)
+  expect_equal(output$out, "2")
+})

tests/test-modules/12_counter/tests/testthat/test-server.R

@@ -0,0 +1,11 @@
+# Use testthat just for expectations
+context("App")
+
+testServer(expr = {
+  # Set the `size` slider and check the output
+  session$setInputs(size = 6)
+  expect_equal(output$sequence, "1 2 3 4 5 6")
+
+  session$setInputs(size = 12)
+  expect_equal(output$sequence, paste0(lexical_sort(1:12), collapse = " "))
+})

tests/test-modules/12_counter/tests/testthat/test-utils.R

@@ -0,0 +1,7 @@
+context("utils")
+
+# Test the lexical_sort function from R/utils.R
+test_that("Lexical sorting works", {
+  expect_equal(lexical_sort(c(1, 2, 3)), c(1, 2, 3))
+  expect_equal(lexical_sort(c(1, 2, 3, 13, 11, 21)), c(1, 11, 13, 2, 21, 3))
+})

tests/test-modules/server_r/server.R

@@ -1,7 +1,7 @@
 library(shiny)
 
 # Define server logic for random distribution app ----
-function(input, output) {
+function(input, output, session) {
 
   # Reactive expression to generate the requested distribution ----
   # This is called whenever the inputs change. The output functions

tests/testthat/test-actionButton.R

@@ -0,0 +1,59 @@
+context("actionButton")
+
+test_that("Action button accepts class arguments", {
+  make_button <- function(class) {
+    if (missing(class)) {
+      actionButton("id", "label")
+    } else {
+      actionButton("id", "label", class = class)
+    }
+  }
+  act <- make_button()
+  get_class <- function(act) {
+    act_html <- format(act)
+    regmatches(act_html, regexec("class=\"[^\"]\"", act_html))[[1]]
+  }
+  act_class <- get_class(act)
+  expect_equal(
+    get_class(make_button(NULL)), act_class
+  )
+  expect_equal(
+    get_class(make_button(NA)), act_class
+  )
+  expect_equal(
+    get_class(make_button("extra")), sub("\"$", " extra\"", act_class)
+  )
+  expect_equal(
+    get_class(make_button("extra extra2")), sub("\"$", " extra extra2\"", act_class)
+  )
+})
+
+
+
+test_that("Action link accepts class arguments", {
+  make_link <- function(class) {
+    if (missing(class)) {
+      actionLink("id", "label")
+    } else {
+      actionLink("id", "label", class = class)
+    }
+  }
+  act <- make_link()
+  get_class <- function(act) {
+    act_html <- format(act)
+    regmatches(act_html, regexec("class=\"[^\"]\"", act_html))[[1]]
+  }
+  act_class <- get_class(act)
+  expect_equal(
+    get_class(make_link(NULL)), act_class
+  )
+  expect_equal(
+    get_class(make_link(NA)), act_class
+  )
+  expect_equal(
+    get_class(make_link("extra")), sub("\"$", " extra\"", act_class)
+  )
+  expect_equal(
+    get_class(make_link("extra extra2")), sub("\"$", " extra extra2\"", act_class)
+  )
+})

tests/testthat/test-app.R

@@ -12,24 +12,6 @@ test_that("files are loaded into the right env", {
   expect_equal(get("global", genv, inherits=FALSE), "ABC")
 })
 
-test_that("loadSupport messages to inform about loading", {
-  renv <- new.env(parent=environment())
-  genv <- new.env(parent=environment())
-
-  # Plural
-  expect_message(loadSupport(test_path("../test-helpers/app1-standard"), renv=renv, globalrenv=genv),
-                 "Automatically loading 2 .R files")
-  # Singular
-  expect_message(loadSupport(test_path("../test-helpers/app2-nested"), renv=renv, globalrenv=NULL),
-                 "Automatically loading 1 .R file")
-})
-
-test_that("loadSupport skips if _disable_autoload.R found", {
-  expect_message(loadSupport(test_path("../test-helpers/app6-disabled"), renv=environment(), globalrenv=NULL),
-                 "disable_autoload.R detected; not loading")
-  expect_false(exists("helper1"))
-})
-
 test_that("Can suppress sourcing global.R", {
   # Confirm that things blow up if we source global.R
   expect_error(loadSupport(test_path("../test-helpers/app3-badglobal")))
@@ -89,7 +71,7 @@ test_that("With ui/server.R, global.R is loaded before R/ helpers and into the r
 
   # Should have seen three calls -- first to global then to the helpers
   expect_length(calls, 3)
-  expect_match(calls[[1]][[1]], "/global\\.R$", perl=TRUE)
+  expect_match(calls[[1]][[1]], "global\\.R$", perl=TRUE)
   expect_match(calls[[2]][[1]], "/helperCap\\.R$", perl=TRUE)
   expect_match(calls[[3]][[1]], "/helperLower\\.r$", perl=TRUE)
 
@@ -147,7 +129,7 @@ test_that("Loading supporting R files is opt-out", {
 
   # Should have seen three calls from global.R -- helpers are enabled
   expect_length(calls, 3)
-  expect_match(calls[[1]][[1]], "/global\\.R$", perl=TRUE)
+  expect_match(calls[[1]][[1]], "global\\.R$", perl=TRUE)
 })
 
 
@@ -187,7 +169,7 @@ test_that("app.R is loaded after R/ helpers and into the right envs", {
   }
 
   # Temporarily opt-in to R/ file autoloading
-  orig <- getOption("shiny.autoload.r", FALSE)
+  orig <- getOption("shiny.autoload.r", NULL)
   options(shiny.autoload.r=TRUE)
   on.exit({options(shiny.autoload.r=orig)}, add=TRUE)
 
@@ -215,3 +197,16 @@ test_that("app.R is loaded after R/ helpers and into the right envs", {
   # app.R is sourced into a child environment of the helpers
   expect_identical(parent.env(calls[[2]]$envir), helperEnv1)
 })
+
+test_that("global.R and sources in R/ are sourced in the app directory", {
+  appDir <- test_path("../test-helpers/app1-standard")
+  appGlobalEnv <- new.env(parent = globalenv())
+  appEnv <- new.env(parent = appGlobalEnv)
+  loadSupport(appDir, renv = appEnv, globalrenv = appGlobalEnv)
+
+  # Set by ../test-helpers/app1-standard/global.R
+  expect_equal(appGlobalEnv$global_wd, normalizePath(appDir))
+
+  # Set by ../test-helpers/app1-standard/R/helperCap.R
+  expect_equal(appEnv$source_wd, normalizePath(appDir))
+})

tests/testthat/test-inline-markdown.R

@@ -0,0 +1,69 @@
+context("inline-markdown")
+
+test_that("Markdown without newlines translates", {
+  expect_equivalent(markdown("# a top level"), HTML("<h1>a top level</h1>\n"))
+  expect_equivalent(markdown("## a subheading"), HTML("<h2>a subheading</h2>\n"))
+  expect_equivalent(markdown("[rstudio](https://rstudio.com)"), HTML("<p><a href=\"https://rstudio.com\">rstudio</a></p>\n"))
+})
+
+test_that("HTML has correct attributes", {
+  html <- markdown("a paragraph", .noWS = "outside")
+  expect_is(html, "html")
+  expect_equal(attr(html, "noWS"), "outside")
+})
+
+test_that("Github extensions are on by default", {
+  html <- markdown("a ~paragraph~ with a link: https://example.com")
+  expect_equivalent(html, HTML("<p>a <del>paragraph</del> with a link: <a href=\"https://example.com\">https://example.com</a></p>\n"))
+})
+
+test_that("Github extensions can be disabled", {
+  html <- markdown("a ~paragraph~", extensions = FALSE)
+  expect_equivalent(html, HTML("<p>a ~paragraph~</p>\n"))
+})
+
+test_that("Additional options are respected", {
+  html <- markdown("a ~paragraph~", extensions = FALSE, sourcepos = TRUE)
+  expect_equivalent(html, HTML("<p data-sourcepos=\"1:1-1:13\">a ~paragraph~</p>\n"))
+})
+
+test_that("Multiline markdown works properly", {
+  essay <- "
+   # The [Louisiana Purchase](https://en.wikipedia.org/wiki/Louisiana_Purchase)
+   
+   Larry Sellers
+   Mrs. Jamtoss
+   History Period 4
+
+   ## Introduction
+
+   The most important purchase in history is the Lousiana
+   Purchase. It was also the most important evente. It
+   happened in President Jeffersons 1st administration.
+   Its when the United States bought 827,987 square miles
+   of lande from the French guys.
+
+   The end."
+
+  # Ensure markdown string contains leading whitespace, which might be removed
+  # by some editors. We care about it here to ensure blank are ignored in the
+  # conversion to markdown. The line being tested here is the one after the one
+  # that starts with "   # The [Louis...". It should contain three spaces.
+  expect_equal(strsplit(essay, "\n")[[1]][[3]], "   ")
+
+  expected <- HTML(paste0(c(
+    "<h1>The <a href=\"https://en.wikipedia.org/wiki/Louisiana_Purchase\">Louisiana Purchase</a></h1>",
+    "<p>Larry Sellers",
+    "Mrs. Jamtoss",
+    "History Period 4</p>",
+    "<h2>Introduction</h2>",
+    "<p>The most important purchase in history is the Lousiana",
+    "Purchase. It was also the most important evente. It",
+    "happened in President Jeffersons 1st administration.",
+    "Its when the United States bought 827,987 square miles",
+    "of lande from the French guys.</p>",
+    "<p>The end.</p>",
+    ""
+  ), collapse = "\n"))
+  expect_equivalent(markdown(essay), expected)
+})

tests/testthat/test-pkgdown.R

@@ -1,40 +1,17 @@
+
 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", {
+test_that("pkgdown works", {
   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")
+  # only test pkgdown from within `devtools::test()`
+  ## `./tools` will not exist when shiny is installed
+  pkgdown_file <- "../../tools/documentation/checkPkgdown.R"
+  if (file.exists(pkgdown_file)) {
+    source(pkgdown_file)
+  }
+
+  expect_true(TRUE)
 
-  ## 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 = ""))
 })