Only do logic if there is SOMETHING, not NOTHING

Co-authored-by: Barret Schloerke <schloerke@gmail.com>
Co-authored-by: Winston Chang <winston@stdout.org>
Co-authored-by: Carson Sievert <cpsievert1@gmail.com>
Co-authored-by: Joe Cheng <joe@rstudio.com>

.Rbuildignore

@@ -21,3 +21,19 @@
 ^TODO-promises.md$
 ^manualtests$
 ^\.github$
+
+^\.yarn$
+^\.vscode$
+^\.madgerc$
+^\.prettierrc\.yml$
+^babel\.config\.json$
+^jest\.config\.js$
+^package\.json$
+^tsconfig\.json$
+^yarn\.lock$
+^node_modules$
+^coverage$
+^.ignore$
+^\.browserslistrc$
+^\.eslintrc\.yml$
+^\.yarnrc\.yml$

.eslintrc.yml

@@ -0,0 +1,108 @@
+root: true
+env:
+  browser: true
+  es6: true
+extends:
+  - 'eslint:recommended'
+  - 'plugin:@typescript-eslint/recommended'
+  - 'plugin:jest/recommended'
+  - 'prettier/@typescript-eslint'
+  - 'plugin:prettier/recommended'
+  - 'plugin:jest-dom/recommended'
+globals:
+  Atomics: readonly
+  SharedArrayBuffer: readonly
+parser: '@typescript-eslint/parser'
+parserOptions:
+  ecmaVersion: 2018
+  sourceType: module
+plugins:
+  - '@typescript-eslint'
+  - prettier
+  - jest-dom
+  - unicorn
+rules:
+  "@typescript-eslint/explicit-function-return-type":
+    - off
+  "@typescript-eslint/no-explicit-any":
+    - off
+  "@typescript-eslint/explicit-module-boundary-types":
+    - error
+
+  default-case:
+    - error
+  indent:
+    - error
+    - 2
+    - SwitchCase: 1
+  linebreak-style:
+    - error
+    - unix
+  quotes:
+    - error
+    - double
+    - avoid-escape
+  semi:
+    - error
+    - always
+  newline-after-var:
+    - error
+    - always
+  dot-location:
+    - error
+    - property
+
+  camelcase:
+    # - error
+    - "off"
+
+  unicorn/filename-case:
+    - error
+    - case: camelCase
+
+  "@typescript-eslint/array-type":
+    - error
+    - default: array-simple
+      readonly: array-simple
+  "@typescript-eslint/consistent-indexed-object-style":
+    - error
+    - index-signature
+
+  "@typescript-eslint/sort-type-union-intersection-members":
+    - error
+
+  "@typescript-eslint/consistent-type-imports":
+    - error
+  "@typescript-eslint/naming-convention":
+    - error
+
+    - selector: default
+      format: [camelCase]
+
+    - selector: method
+      modifiers: [private]
+      format: [camelCase]
+      leadingUnderscore: require
+    - selector: method
+      modifiers: [protected]
+      format: [camelCase]
+      leadingUnderscore: require
+
+    - selector: variable
+      format: [camelCase]
+      trailingUnderscore: forbid
+      leadingUnderscore: forbid
+
+    - selector: parameter
+      format: [camelCase]
+      trailingUnderscore: allow
+      leadingUnderscore: forbid
+
+    - selector: [enum, enumMember]
+      format: [PascalCase]
+
+    - selector: typeLike
+      format: [PascalCase]
+      custom:
+        regex: "(t|T)ype$"
+        match: false

.gitattributes

@@ -1,4 +1,6 @@
 /NEWS merge=union
 /inst/www/shared/shiny.js -merge -diff
+/inst/www/shared/shiny-*.js -merge -diff
+/inst/www/shared/shiny*.css -merge -diff
 *.min.js -merge -diff
 *.js.map -merge -diff

.github/workflows/rituals.yaml

@@ -71,13 +71,12 @@ jobs:
         shell: Rscript {0}
         run: |
           pak::local_install_dev_deps(upgrade = TRUE)
-          pak::pkg_install("sessioninfo")
-          pak::pkg_install("devtools")
 
       - name: Session info
         shell: Rscript {0}
         run: |
           options(width = 100)
+          pak::pkg_install("sessioninfo")
           pkgs <- installed.packages()[, "Package"]
           sessioninfo::session_info(pkgs, include_base = TRUE)
 
@@ -100,6 +99,7 @@ jobs:
 
       - name: Document
         run: |
+          Rscript -e 'pak::pkg_install("devtools")'
           Rscript -e 'devtools::document()'
           git add man/\* NAMESPACE
           git commit -m 'Document (GitHub Actions)' || echo "No documentation changes to commit"
@@ -123,31 +123,50 @@ jobs:
           key: ${{ matrix.config.os }}-${{ matrix.config.node }}-yarn-${{ hashFiles('**/yarn.lock') }}
           restore-keys: |
             ${{ matrix.config.os }}-${{ matrix.config.node }}-yarn-
+
+      - name: Sync DESCRIPTION and package.json versions
+        run: |
+          Rscript -e 'pak::pkg_install("jsonlite")'
+          Rscript -e 'pkg <- jsonlite::read_json("package.json", simplifyVector = TRUE)' \
+          -e 'version <- as.list(read.dcf("DESCRIPTION")[1,])$Version' \
+          -e 'pkg$version <- gsub("^(\\d+).(\\d+).(\\d+).(.+)$", "\\1.\\2.\\3-alpha.\\4", version)' \
+          -e 'pkg$files <- as.list(pkg$files)' \
+          -e 'jsonlite::write_json(pkg, path = "package.json", pretty = TRUE, auto_unbox = TRUE)'
+          git add package.json && git commit -m 'sync package version (GitHub Actions)' || echo "No version changes to commit"
       - name: Build JS
         run: |
-          cd srcts
-          tree src
+          tree srcts
+          rm -r srcts/types
           yarn install --immutable && yarn build
-          git add ./src && git commit -m 'yarn lint (GitHub Actions)' || echo "No yarn lint changes to commit"
-          git add ../inst && git commit -m 'yarn build (GitHub Actions)' || echo "No yarn build changes to commit"
-
-      - name: Check JS build is latest
-        run: |
-          ./tools/checkJSCurrent.sh
-
+          git add ./srcts/src && git commit -m 'yarn lint (GitHub Actions)' || echo "No yarn lint changes to commit"
+          git add ./srcts/types && git commit -m 'yarn tsc (GitHub Actions)' || echo "No type definition changes to commit"
+          git add ./inst && git commit -m 'yarn build (GitHub Actions)' || echo "No yarn build changes to commit"
+          if [ -n "$(git status --porcelain)" ]
+          then
+            git status --porcelain
+            >&2 echo "The above files changed when we built the JavaScript assets."
+            exit 1
+          else
+            echo "No difference detected; TypeScript build is current."
+          fi
 
       - name: Git Push (PR)
         uses: r-lib/actions/pr-push@master
         if: github.event_name == 'pull_request'
         with:
           repo-token: ${{ secrets.GITHUB_TOKEN }}
-      - name: Git Push (MASTER)
+      - name: Verify no un-pushed commits (MASTER)
         if: github.event_name == 'push'
         run: |
-          git push https://${{github.actor}}:${{secrets.GITHUB_TOKEN}}@github.com/${{github.repository}}.git HEAD:${{ github.ref }} || echo "No changes to push"
+          # Can't push to a protected branch
+          if [ -n "`git cherry origin/master`"]; then
+            echo "Un-pushed commits:"
+            git cherry -v origin/master
+            echo "\nCan not push to a protected branch. Exiting"
+            exit 1
+          fi
 
       # Execute after pushing, as no updated files will be produced
       - name: Test TypeScript code
         run: |
-          cd srcts
           yarn test

.gitignore

@@ -11,5 +11,18 @@ README.html
 .*.Rnb.cached
 tools/yarn-error.log
 
+# TypeScript / yarn
+node_modules/
+.cache
+.yarn/*
+!.yarn/releases
+!.yarn/plugins
+!.yarn/sdks
+!.yarn/versions
+.pnp.*
+coverage/
+madge.svg
+
+
 # GHA remotes installation
 .github/r-depends.rds

.madgerc

@@ -0,0 +1,7 @@
+{
+  "detectiveOptions": {
+    "ts": {
+      "skipTypeImports": true
+    }
+  }
+}

.yarnrc.yml

@@ -3,5 +3,7 @@ nodeLinker: node-modules
 plugins:
   - path: .yarn/plugins/@yarnpkg/plugin-outdated.cjs
     spec: "https://github.com/mskelton/yarn-plugin-outdated/raw/main/bundles/@yarnpkg/plugin-outdated.js"
+  - path: .yarn/plugins/@yarnpkg/plugin-interactive-tools.cjs
+    spec: "@yarnpkg/plugin-interactive-tools"
 
 yarnPath: .yarn/releases/yarn-2.4.0.cjs

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 1.6.0.9000
+Version: 1.6.0.9022
 Authors@R: c(
     person("Winston", "Chang", role = c("aut", "cre"), email = "winston@rstudio.com", comment = c(ORCID = "0000-0002-1576-2126")),
     person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"),
@@ -91,7 +91,7 @@ Imports:
     withr,
     commonmark (>= 1.7),
     glue (>= 1.3.2),
-    bslib (>= 0.2.4.9003),
+    bslib (>= 0.2.5.9002),
     cachem,
     ellipsis,
     lifecycle (>= 0.2.0)
@@ -199,7 +199,11 @@ Collate:
     'test.R'
     'update-input.R'
     'utils-lang.R'
+    'version_bs_date_picker.R'
+    'version_ion_range_slider.R'
     'version_jquery.R'
+    'version_selectize.R'
+    'version_strftime.R'
     'viewer.R'
 RoxygenNote: 7.1.1
 Encoding: UTF-8

NAMESPACE

@@ -378,6 +378,7 @@ importFrom(htmltools,tags)
 importFrom(htmltools,validateCssUnit)
 importFrom(htmltools,withTags)
 importFrom(lifecycle,deprecated)
+importFrom(lifecycle,is_present)
 importFrom(promises,"%...!%")
 importFrom(promises,"%...>%")
 importFrom(promises,as.promise)
@@ -386,14 +387,18 @@ importFrom(promises,promise)
 importFrom(promises,promise_reject)
 importFrom(promises,promise_resolve)
 importFrom(rlang,"%||%")
+importFrom(rlang,"fn_body<-")
+importFrom(rlang,"fn_fmls<-")
 importFrom(rlang,as_function)
 importFrom(rlang,as_quosure)
 importFrom(rlang,enexpr)
 importFrom(rlang,enquo)
+importFrom(rlang,enquo0)
 importFrom(rlang,enquos)
 importFrom(rlang,enquos0)
 importFrom(rlang,eval_tidy)
 importFrom(rlang,expr)
+importFrom(rlang,fn_body)
 importFrom(rlang,get_env)
 importFrom(rlang,get_expr)
 importFrom(rlang,inject)
@@ -408,4 +413,8 @@ importFrom(rlang,new_function)
 importFrom(rlang,new_quosure)
 importFrom(rlang,pairlist2)
 importFrom(rlang,quo)
+importFrom(rlang,quo_get_expr)
+importFrom(rlang,quo_is_missing)
+importFrom(rlang,quo_set_env)
+importFrom(rlang,quo_set_expr)
 importFrom(rlang,zap_srcref)

NEWS.md

@@ -7,19 +7,27 @@ shiny 1.6.0.9000
 
 * The `format` and `locale` arguments to `sliderInput()` have been removed. They have been deprecated since 0.10.2.2 (released on 2014-12-08).
 
+* Closed #3403: `insertTab()`'s `position` parameter now defaults to `"after"` instead of `"before"`. This has the benefit of allowing us to fix a bug in positioning when `target = NULL`, but has the drawback of changing the default behavior when `target` is not `NULL`. (#3404)
+
 ### New features and improvements
 
+* Bootstrap 5 support. (#3410 and rstudio/bslib#304)
+  * As explained [here](https://rstudio.github.io/bslib/index.html#basic-usage), to opt-in to Bootstrap 5, provide `bslib::bs_theme(version = 5)` to a page layout function with a `theme` argument (e.g., `fluidPage()`, `navbarPage()`, etc).
+
+* Closed #3322, #3313, #1823, #3321, #3320, #1928, and #2310: Various improvements to `navbarPage()`, `tabsetPanel()`, `tabPanel()`, `navbarMenu()`, etc. Also, these functions are now powered by the `{bslib}` package's new `nav()` API (consider using `{bslib}`'s API to create better looking and more fully featured navs). (#3388)
+
 * All uses of `list(...)` have been replaced with `rlang::list2(...)`. This means that you can use trailing `,` without error and use rlang's `!!!` operator to "splice" a list of argument values into `...`. We think this'll be particularly useful for passing a list of `tabPanel()` to their consumers (i.e., `tabsetPanel()`, `navbarPage()`, etc). For example, `tabs <- list(tabPanel("A", "a"), tabPanel("B", "b")); navbarPage(!!!tabs)`. (#3315 and #3328)
 
-* Numerous improvements tabset panels (i.e., `tabPanel()`, `navbarMenu()`, `tabsetPanel()`, `navbarPage()`, etc) (#3315):
-  * Closed #3322: `tabsetPanel()` and `navlistPanel()` gain `header`/`footer` arguments (inspired by `navbarPage()`'s already existing `header`/`footer`), making it easier to include content that should appear on every tab.
-  * Closed #3313 and #1823: More informative error when non-`tabPanel()`/`shiny.tag` objects are supplied to `...`.
-  * Closed #3321: New informative warning when `shiny.tag` object(s) are supplied to `...`. In this case we will continue to create an "empty" nav item and include the content on every tab, but the warning will mention the (new) `header`/`footer` args, which is likely what the user wants.
-  * Closed #3320: The HTML markup that `tabPanel()` et. al generate (for Bootstrap nav) is now Bootstrap 4+ compliant when used with `theme = bslib::bs_theme()`.
-  * Closed #1928: `NULL` values are now dropped instead of producing an empty nav item.
-  
+* `installExprFunction()` and `exprToFunction()` are now able to handle quosures, so `render`-functions which call these functions can now understand quosures, when they are called using `rlang::inject()`. This also means that `render` function no longer need `env` and `quoted` parameters; that information can be embedded into a quosure which is then passed to the `render` function. Additionally, the `getQuosure()` function was added, which makes it easier for developers to create `render` functions which understand quosures. Better documentation was added for how to create `render` functions. (#3462, #3466)
+
 * `icon(lib="fontawesome")` is now powered by the `{fontawesome}` package, which will make it easier to use the latest FA icons in the future (by updating the `{fontawesome}` package). (#3302)
 
+* Closed #3397: `renderPlot()` new uses `ggplot2::get_alt_text()` to inform an `alt` text default (for `{ggplot2}` plots). (#3398)
+
+* `modalDialog()` gains support for `size = "xl"`. (#3410)
+
+* Addressed #2521: Updated the list of TCP ports that will be rejected by default in runapp.R, adding 5060, 5061 and 6566. Added documentation describing the port range (3000:8000) and which ports are rejected. (#3456)
+
 ### Other improvements
 
 * Shiny's core JavaScript code was converted to TypeScript. For the latest development information, please see the [README.md in `./srcts`](https://github.com/rstudio/shiny/tree/master/srcts). (#3296)
@@ -34,6 +42,8 @@ shiny 1.6.0.9000
 
 * Closed #3345: Shiny now correctly renders `htmltools::htmlDependency()`(s) with a `list()` of `script` attributes when used in a dynamic UI context. This fairly new `htmlDependency()` feature was added in `{htmltools}` v0.5.1. (#3395)
 
+* Fixed [#2666](https://github.com/rstudio/shiny/issues/2666) and [#2670](https://github.com/rstudio/shiny/issues/2670): `nearPoints()` and `brushedPoints()` weren't properly account for missing values (#2666 was introduced in v1.4.0). ([#2668](https://github.com/rstudio/shiny/pull/2668))
+
 * Closed #3374: `quoToFunction()` now works correctly with nested quosures; and as a result, quasi-quotation with rendering function (e.g., `renderPrint()`, `renderPlot()`, etc) now works as expected with nested quosures. (#3373) 
 
 * Exported `register_devmode_option()`. This method was described in the documentation for `devmode()` but was never exported. See `?devmode()` for more details on how to register Shiny Developer options using `register_devmode_option()`. (#3364)

R/bind-cache.R

@@ -292,11 +292,11 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
 #'   In some cases, however, the automatic cache hint inference is not
 #'   sufficient, and it is necessary to provide a cache hint. This is true
 #'   for `renderPrint()`. Unlike `renderText()`, it wraps the user-provided
-#'   expression in another function, before passing it to [markRenderFunction()]
+#'   expression in another function, before passing it to [createRenderFunction()]
 #'   (instead of [createRenderFunction()]). Because the user code is wrapped in
-#'   another function, `markRenderFunction()` is not able to automatically
+#'   another function, `createRenderFunction()` is not able to automatically
 #'   extract the user-provided code and use it in the cache key. Instead,
-#'   `renderPrint` calls `markRenderFunction()`, it explicitly passes along a
+#'   `renderPrint` calls `createRenderFunction()`, it explicitly passes along a
 #'   `cacheHint`, which includes a label and the original user expression.
 #'
 #'   In general, if you need to provide a `cacheHint`, it is best practice to
@@ -310,19 +310,19 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
 #'
 #'   ```
 #'   renderMyWidget <- function(expr) {
-#'     expr <- substitute(expr)
+#'     q <- rlang::enquo0(expr)
 #'
-#'     htmlwidgets::shinyRenderWidget(expr,
+#'     htmlwidgets::shinyRenderWidget(
+#'       q,
 #'       myWidgetOutput,
 #'       quoted = TRUE,
-#'       env = parent.frame(),
-#'       cacheHint = list(label = "myWidget", userExpr = expr)
+#'       cacheHint = list(label = "myWidget", userQuo = q)
 #'     )
 #'   }
 #'   ```
 #'
 #'   If your `render` function sets any internal state, you may find it useful
-#'   in your call to [createRenderFunction()] or [markRenderFunction()] to use
+#'   in your call to [createRenderFunction()] to use
 #'   the `cacheWriteHook` and/or `cacheReadHook` parameters. These hooks are
 #'   functions that run just before the object is stored in the cache, and just
 #'   after the object is retrieved from the cache. They can modify the data
@@ -339,8 +339,8 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
 #'   effects or modify some external state, and they must re-execute each time
 #'   in order to work properly.
 #'
-#'   For developers of such code, they should call [createRenderFunction()] or
-#'   [markRenderFunction()] with `cacheHint = FALSE`.
+#'   For developers of such code, they should call [createRenderFunction()] (or
+#'   [markRenderFunction()]) with `cacheHint = FALSE`.
 #'
 #'
 #' @section Caching with `renderPlot()`:

R/bootstrap.R

@@ -380,8 +380,10 @@ collapseSizes <- function(padding) {
 #'   (useful for viewing on smaller touchscreen device)
 #' @param fluid `TRUE` to use a fluid layout. `FALSE` to use a fixed
 #'   layout.
-#' @param windowTitle The title that should be displayed by the browser window.
-#'   Useful if `title` is not a string.
+#' @param windowTitle the browser window title (as a character string). The
+#'   default value, `NA`, means to use any character strings that appear in
+#'   `title` (if none are found, the host URL of the page is displayed by
+#'   default).
 #' @inheritParams bootstrapPage
 #' @param icon Optional icon to appear on a `navbarMenu` tab.
 #'
@@ -425,70 +427,18 @@ navbarPage <- function(title,
                        collapsible = FALSE,
                        fluid = TRUE,
                        theme = NULL,
-                       windowTitle = title,
+                       windowTitle = NA,
                        lang = NULL) {
-
-  # alias title so we can avoid conflicts w/ title in withTags
-  pageTitle <- title
-
-  # navbar class based on options
-  # TODO: tagFunction() the navbar logic?
-  navbarClass <- "navbar navbar-default"
-  position <- match.arg(position)
-  if (!is.null(position))
-    navbarClass <- paste0(navbarClass, " navbar-", position)
-  if (inverse)
-    navbarClass <- paste(navbarClass, "navbar-inverse")
-
-  if (!is.null(id))
-    selected <- restoreInput(id = id, default = selected)
-
-  # build the tabset
-  tabset <- buildTabset(..., ulClass = "nav navbar-nav", id = id, selected = selected)
-
-  containerClass <- paste0("container", if (fluid) "-fluid")
-
-  # built the container div dynamically to support optional collapsibility
-  if (collapsible) {
-    navId <- paste0("navbar-collapse-", p_randomInt(1000, 10000))
-    containerDiv <- div(class=containerClass,
-      div(class="navbar-header",
-        tags$button(type="button", class="navbar-toggle collapsed",
-          `data-toggle`="collapse", `data-target`=paste0("#", navId),
-          span(class="sr-only", "Toggle navigation"),
-          span(class="icon-bar"),
-          span(class="icon-bar"),
-          span(class="icon-bar")
-        ),
-        span(class="navbar-brand", pageTitle)
-      ),
-      div(class="navbar-collapse collapse", id=navId, tabset$navList)
-    )
-  } else {
-    containerDiv <- div(class=containerClass,
-      div(class="navbar-header",
-        span(class="navbar-brand", pageTitle)
-      ),
-      tabset$navList
-    )
-  }
-
-  # build the main tab content div
-  contentDiv <- div(class=containerClass)
-  if (!is.null(header))
-    contentDiv <- tagAppendChild(contentDiv, div(class="row", header))
-  contentDiv <- tagAppendChild(contentDiv, tabset$content)
-  if (!is.null(footer))
-    contentDiv <- tagAppendChild(contentDiv, div(class="row", footer))
-
-  # build the page
-  bootstrapPage(
-    title = windowTitle,
+  remove_first_class(bslib::page_navbar(
+    ..., title = title, id = id, selected = selected,
+    position = match.arg(position),
+    header = header, footer = footer,
+    inverse = inverse, collapsible = collapsible,
+    fluid = fluid,
     theme = theme,
-    lang = lang,
-    tags$nav(class=navbarClass, role="navigation", containerDiv),
-    contentDiv
-  )
+    window_title = windowTitle,
+    lang = lang
+  ))
 }
 
 #' @param menuName A name that identifies this `navbarMenu`. This
@@ -498,19 +448,7 @@ navbarPage <- function(title,
 #' @rdname navbarPage
 #' @export
 navbarMenu <- function(title, ..., menuName = title, icon = NULL) {
-  icon <- prepTabIcon(icon)
-  structure(list(title = title,
-                 menuName = menuName,
-                 tabs = list2(...),
-                 # Here for legacy reasons
-                 # https://github.com/cran/miniUI/blob/74c87d3/R/layout.R#L369
-                 iconClass = tagGetAttribute(icon, "class"),
-                 icon = icon),
-            class = "shiny.navbarmenu")
-}
-
-isNavbarMenu <- function(x) {
-  inherits(x, "shiny.navbarmenu")
+  bslib::nav_menu(title, ..., value = menuName, icon = icon)
 }
 
 #' Create a well panel
@@ -645,39 +583,14 @@ 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) {
-  icon <- prepTabIcon(icon)
-  pane <- div(
-    class = "tab-pane",
-    title = title,
-    `data-value` = value,
-    # Here for legacy reasons
-    # https://github.com/cran/miniUI/blob/74c87d/R/layout.R#L395
-    `data-icon-class` = tagGetAttribute(icon, "class"),
-    ...
-  )
-  attr(pane, "_shiny_icon") <- icon
-  pane
-}
-
-isTabPanel <- function(x) {
-  if (!inherits(x, "shiny.tag")) return(FALSE)
-  class <- tagGetAttribute(x, "class") %||% ""
-  "tab-pane" %in% strsplit(class, "\\s+")[[1]]
+  bslib::nav(title, ..., value = value, icon = 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, ..., icon = NULL) {
-  if (
-    !is.character(value) ||
-    length(value) != 1 ||
-    any(is.na(value)) ||
-    nchar(value) == 0
-  ) {
-    stop("`value` must be a single, non-empty string value")
-  }
-  tabPanel(title = NULL, ..., value = value, icon = icon)
+  bslib::nav_content(value, ..., icon = icon)
 }
 
 #' Create a tabset panel
@@ -753,20 +666,17 @@ tabsetPanel <- function(...,
                         header = NULL,
                         footer = NULL) {
 
-  if (!is.null(id))
-    selected <- restoreInput(id = id, default = selected)
+  func <- switch(
+    match.arg(type),
+    tabs = bslib::navs_tab,
+    pills = bslib::navs_pill,
+    hidden = bslib::navs_hidden
+  )
 
-  type <- match.arg(type)
-  tabset <- buildTabset(..., ulClass = paste0("nav nav-", type), id = id, selected = selected)
-
-  tags$div(
-    class = "tabbable",
-    !!!dropNulls(list(
-      tabset$navList,
-      header,
-      tabset$content,
-      footer
-    ))
+  # bslib adds a class to make the content browsable() by default,
+  # but that's probably too big of a change for shiny
+  remove_first_class(
+    func(..., id = id, selected = selected, header = header, footer = footer)
   )
 }
 
@@ -822,275 +732,18 @@ navlistPanel <- function(...,
                          well = TRUE,
                          fluid = TRUE,
                          widths = c(4, 8)) {
-
-  if (!is.null(id))
-    selected <- restoreInput(id = id, default = selected)
-
-  tabset <- buildTabset(
-    ..., ulClass = "nav nav-pills nav-stacked",
-    textFilter = function(text) tags$li(class = "navbar-brand", text),
-    id = id, selected = selected
-  )
-
-  row <- if (fluid) fluidRow else fixedRow
-
-  row(
-    column(widths[[1]], class = if (well) "well", tabset$navList),
-    column(
-      widths[[2]],
-      !!!dropNulls(list(header, tabset$content, footer))
-    )
-  )
+  remove_first_class(bslib::navs_pill_list(
+    ..., id = id, selected = selected,
+    header = header, footer = footer,
+    well = well, fluid = fluid, widths = widths
+  ))
 }
 
-# Helpers to build tabsetPanels (& Co.) and their elements
-markTabAsSelected <- function(x) {
-  attr(x, "selected") <- TRUE
+remove_first_class <- function(x) {
+  class(x) <- class(x)[-1]
   x
 }
 
-isTabSelected <- function(x) {
-  isTRUE(attr(x, "selected", exact = TRUE))
-}
-
-containsSelectedTab <- function(tabs) {
-  any(vapply(tabs, isTabSelected, logical(1)))
-}
-
-findAndMarkSelectedTab <- function(tabs, selected, foundSelected) {
-  tabs <- lapply(tabs, function(x) {
-    if (foundSelected || is.character(x)) {
-      # Strings are not selectable items
-
-    } else if (isNavbarMenu(x)) {
-      # Recur for navbarMenus
-      res <- findAndMarkSelectedTab(x$tabs, selected, foundSelected)
-      x$tabs <- res$tabs
-      foundSelected <<- res$foundSelected
-
-    } else {
-      # Base case: regular tab item. If the `selected` argument is
-      # provided, check for a match in the existing tabs; else,
-      # mark first available item as selected
-      if (is.null(selected)) {
-        foundSelected <<- TRUE
-        x <- markTabAsSelected(x)
-      } else {
-        tabValue <- x$attribs$`data-value` %||% x$attribs$title
-        if (identical(selected, tabValue)) {
-          foundSelected <<- TRUE
-          x <- markTabAsSelected(x)
-        }
-      }
-    }
-    return(x)
-  })
-  return(list(tabs = tabs, foundSelected = foundSelected))
-}
-
-prepTabIcon <- function(x = NULL) {
-  if (is.null(x)) return(NULL)
-  if (!inherits(x, "shiny.tag")) {
-    stop(
-      "`icon` must be a `shiny.tag` object. ",
-      "Try passing `icon()` (or `tags$i()`) to the `icon` parameter.",
-      call. = FALSE
-    )
-  }
-
-  is_fa <- grepl("fa-", tagGetAttribute(x, "class") %||% "", fixed = TRUE)
-  if (!is_fa) {
-    return(x)
-  }
-
-  # for font-awesome we specify fixed-width
-  tagAppendAttributes(x, class = "fa-fw")
-}
-
-# Text filter for navbarMenu's (plain text) separators
-navbarMenuTextFilter <- function(text) {
-  if (grepl("^\\-+$", text)) tags$li(class = "divider")
-  else tags$li(class = "dropdown-header", text)
-}
-
-# This function is called internally by navbarPage, tabsetPanel
-# and navlistPanel
-buildTabset <- function(..., ulClass, textFilter = NULL, id = NULL,
-                        selected = NULL, foundSelected = FALSE) {
-
-  tabs <- dropNulls(list2(...))
-  res <- findAndMarkSelectedTab(tabs, selected, foundSelected)
-  tabs <- res$tabs
-  foundSelected <- res$foundSelected
-
-  # add input class if we have an id
-  if (!is.null(id)) ulClass <- paste(ulClass, "shiny-tab-input")
-
-  if (anyNamed(tabs)) {
-    nms <- names(tabs)
-    nms <- nms[nzchar(nms)]
-    stop("Tabs should all be unnamed arguments, but some are named: ",
-      paste(nms, collapse = ", "))
-  }
-
-  tabsetId <- p_randomInt(1000, 10000)
-  tabs <- lapply(seq_len(length(tabs)), buildTabItem,
-            tabsetId = tabsetId, foundSelected = foundSelected,
-            tabs = tabs, textFilter = textFilter)
-
-  tabNavList <- tags$ul(class = ulClass, id = id,
-                  `data-tabsetid` = tabsetId, !!!lapply(tabs, "[[", "liTag"))
-
-  tabContent <- tags$div(class = "tab-content",
-                  `data-tabsetid` = tabsetId, !!!lapply(tabs, "[[", "divTag"))
-
-  list(navList = tabNavList, content = tabContent)
-}
-
-# Builds tabPanel/navbarMenu items (this function used to be
-# declared inside the buildTabset() function and it's been
-# refactored for clarity and reusability). Called internally
-# by buildTabset.
-buildTabItem <- function(index, tabsetId, foundSelected, tabs = NULL,
-                         divTag = NULL, textFilter = NULL) {
-
-  divTag <- divTag %||% tabs[[index]]
-
-  # Handles navlistPanel() headers and dropdown dividers
-  if (is.character(divTag) && !is.null(textFilter)) {
-    return(list(liTag = textFilter(divTag), divTag = NULL))
-  }
-
-  if (isNavbarMenu(divTag)) {
-    # tabPanelMenu item: build the child tabset
-    tabset <- buildTabset(
-      !!!divTag$tabs, ulClass = "dropdown-menu",
-      textFilter = navbarMenuTextFilter,
-      foundSelected = foundSelected
-    )
-    return(buildDropdown(divTag, tabset))
-  }
-
-  if (isTabPanel(divTag)) {
-    return(buildNavItem(divTag, tabsetId, index))
-  }
-
-  # The behavior is undefined at this point, so construct a condition message
-  msg <- paste0(
-    "Expected a collection `tabPanel()`s",
-    if (is.null(textFilter)) " and `navbarMenu()`.",
-    if (!is.null(textFilter)) ", `navbarMenu()`, and/or character strings.",
-    " Consider using `header` or `footer` if you wish to place content above (or below) every panel's contents"
-  )
-
-  # Luckily this case has never worked, so it's safe to throw here
-  # https://github.com/rstudio/shiny/issues/3313
-  if (!inherits(divTag, "shiny.tag"))  {
-    stop(msg, call. = FALSE)
-  }
-
-  # Unfortunately, this 'off-label' use case creates an 'empty' nav and includes
-  # the divTag content on every tab. There shouldn't be any reason to be relying on
-  # this behavior since we now have pre/post arguments, so throw a warning, but still
-  # support the use case since we don't make breaking changes
-  warning(msg, call. = FALSE)
-
-  return(buildNavItem(divTag, tabsetId, index))
-}
-
-buildNavItem <- function(divTag, tabsetId, index) {
-  id <- paste("tab", tabsetId, index, sep = "-")
-  # Get title attribute directory (not via tagGetAttribute()) so that contents
-  # don't get passed to as.character().
-  # https://github.com/rstudio/shiny/issues/3352
-  title <- divTag$attribs[["title"]]
-  value <- divTag$attribs[["data-value"]]
-  active <- isTabSelected(divTag)
-  divTag <- tagAppendAttributes(divTag, class = if (active) "active")
-  divTag$attribs$id <- id
-  divTag$attribs$title <- NULL
-  list(
-    divTag = divTag,
-    liTag = tagAddRenderHook(
-      liTag(id, title, value, attr(divTag, "_shiny_icon")),
-      function(x) {
-        if (isTRUE(getCurrentThemeVersion() >= 4)) {
-          tagQuery(x)$
-            addClass("nav-item")$
-            find("a")$
-            addClass(c("nav-link", if (active) "active"))$
-            allTags()
-        } else {
-          tagAppendAttributes(x, class = if (active) "active")
-        }
-      }
-    )
-  )
-}
-
-liTag <- function(id, title, value, icon) {
-  tags$li(
-    tags$a(
-      href = paste0("#", id),
-      `data-toggle` = "tab",
-      `data-value` = value,
-       icon, title
-    )
-  )
-}
-
-buildDropdown <- function(divTag, tabset) {
-
-  navList <- tagAddRenderHook(
-    tabset$navList,
-    function(x) {
-      if (isTRUE(getCurrentThemeVersion() >= 4)) {
-        tagQuery(x)$
-          find(".nav-item")$
-          removeClass("nav-item")$
-          find(".nav-link")$
-          removeClass("nav-link")$
-          addClass("dropdown-item")$
-          allTags()
-      } else {
-        x
-      }
-    }
-  )
-
-  active <- containsSelectedTab(divTag$tabs)
-
-  dropdown <- tags$li(
-    class = "dropdown",
-    tags$a(
-      href = "#",
-      class = "dropdown-toggle",
-      `data-toggle` = "dropdown",
-      `data-value` = divTag$menuName,
-      divTag$icon,
-      divTag$title,
-      tags$b(class = "caret")
-    ),
-    navList,
-    .renderHook = function(x) {
-      if (isTRUE(getCurrentThemeVersion() >= 4)) {
-        tagQuery(x)$
-          addClass("nav-item")$
-          find(".dropdown-toggle")$
-          addClass("nav-link")$
-          allTags()
-      } else {
-        x
-      }
-    }
-  )
-
-  list(
-    divTag = tabset$content$children,
-    liTag = dropdown
-  )
-}
-
 #' Create a text output element
 #'
 #' Render a reactive output variable as text within an application page.

R/deprecated.R

@@ -9,13 +9,19 @@
 #' @param details Additional information to be added after a new line to the displayed message
 #' @keywords internal
 shinyDeprecated <- function(
-  version, what, with = NULL, details = NULL
+  version,
+  what,
+  with = NULL,
+  details = NULL,
+  type = c("deprecated", "superseded")
 ) {
   if (is_false(getOption("shiny.deprecation.messages"))) {
     return(invisible())
   }
 
-  msg <- paste0("`", what, "` is deprecated as of shiny ", version, ".")
+  type <- match.arg(type)
+
+  msg <- paste0("`", what, "` is ", type, " as of shiny ", version, ".")
   if (!is.null(with)) {
     msg <- paste0(msg, "\n", "Please use `", with, "` instead.")
   }
@@ -32,13 +38,20 @@ deprecatedEnvQuotedMessage <- function() {
   if (!in_devmode()) return(invisible())
   if (is_false(getOption("shiny.deprecation.messages"))) return(invisible())
 
-  # manually
+  # Capture calling function
+  grandparent_call <- sys.call(-2)
+  # Turn language into user friendly string
+  grandparent_txt <- paste0(utils::capture.output({grandparent_call}), collapse = "\n")
+
   msg <- paste0(
-    "The `env` and `quoted` arguments are deprecated as of shiny 1.6.0.",
+    "The `env` and `quoted` arguments are deprecated as of shiny 1.7.0.",
     " Please use quosures from `rlang` instead.\n",
-    "See <https://github.com/rstudio/shiny/issues/3108> for more information."
+    "See <https://github.com/rstudio/shiny/issues/3108> for more information.\n",
+    "Function call:\n",
+    grandparent_txt
   )
-  rlang::inform(message = msg, .frequency = "always", .frequency_id = msg, .file = stderr())
+  # Call less often as users do not have much control over this warning
+  rlang::inform(message = msg, .frequency = "regularly", .frequency_id = msg, .file = stderr())
 }
 
 
@@ -60,7 +73,7 @@ diskCache <- function(
   logfile = NULL
 ) {
   shinyDeprecated("1.6.0", "diskCache()", "cachem::cache_disk()")
-  if (lifecycle::is_present(exec_missing)) {
+  if (is_present(exec_missing)) {
     shinyDeprecated("1.6.0", "diskCache(exec_missing =)")
   }
 
@@ -93,7 +106,7 @@ memoryCache <- function(
   logfile = NULL)
 {
   shinyDeprecated("1.6.0", "diskCache()", "cachem::cache_mem()")
-  if (lifecycle::is_present(exec_missing)) {
+  if (is_present(exec_missing)) {
     shinyDeprecated("1.6.0", "diskCache(exec_missing =)")
   }
 

R/graph.R

@@ -512,7 +512,7 @@ MessageLogger = R6Class(
       return(txt)
     },
     singleLine = function(txt) {
-      gsub("[^\\]\\n", "\\\\n", txt)
+      gsub("([^\\])\\n", "\\1\\\\n", txt)
     },
     valueStr = function(valueStr) {
       paste0(

R/image-interact-opts.R

@@ -20,7 +20,6 @@
 #'   `delay` milliseconds before sending an event.
 #' @seealso [brushOpts()] for brushing events.
 #' @export
-#' @keywords internal
 clickOpts <- function(id, clip = TRUE) {
   if (is.null(id))
     stop("id must not be NULL")

R/image-interact.R

@@ -267,6 +267,7 @@ nearPoints <- function(df, coordinfo, xvar = NULL, yvar = NULL,
     stop("nearPoints: `yvar` ('", yvar ,"')  not in names of input")
 
   # Extract data values from the data frame
+  coordinfo <- fortifyDiscreteLimits(coordinfo)
   x <- asNumber(df[[xvar]], coordinfo$domain$discrete_limits$x)
   y <- asNumber(df[[yvar]], coordinfo$domain$discrete_limits$y)
 
@@ -392,6 +393,7 @@ nearPoints <- function(df, coordinfo, xvar = NULL, yvar = NULL,
 # an input brush
 within_brush <- function(vals, brush, var = "x") {
   var <- match.arg(var, c("x", "y"))
+  brush <- fortifyDiscreteLimits(brush)
   vals <- asNumber(vals, brush$domain$discrete_limits[[var]])
   # It's possible for a non-missing data values to not
   # map to the axis limits, for example:
@@ -414,11 +416,43 @@ asNumber <- function(x, levels = NULL) {
   as.numeric(x)
 }
 
+# Ensure the discrete limits/levels of a coordmap received
+# from the client matches the data structure sent the client.
+#
+# When we construct the coordmap (in getGgplotCoordmap()),
+# we save a character vector which may contain missing values
+# (e.g., c("a", "b", NA)). When that same character is received
+# from the client, it runs through decodeMessage() which sets
+# simplifyVector=FALSE, which means NA are replaced by NULL
+# (because jsonlite::fromJSON('["a", "b", null]') -> list("a", "b", NULL))
+#
+# Thankfully, it doesn't seem like it's meaningful for limits to
+# contains a NULL in the 1st place, so we simply treat NULL like NA.
+# For more context, https://github.com/rstudio/shiny/issues/2666
+fortifyDiscreteLimits <- function(coord) {
+  # Note that discrete_limits$x/y are populated iff
+  # x/y are discrete mappings
+  coord$domain$discrete_limits <- lapply(
+    coord$domain$discrete_limits,
+    function(var) {
+      # if there is an 'explicit' NULL, then the limits are NA
+      if (is.null(var)) return(NA)
+      vapply(var, function(x) {
+        if (is.null(x) || isTRUE(is.na(x))) NA_character_ else x
+      }, character(1))
+    }
+  )
+  coord
+}
+
+
+
 # Given a panelvar value and a vector x, return logical vector indicating which
 # items match the panelvar value. Because the panelvar value is always a
 # string but the vector could be numeric, it might be necessary to coerce the
 # panelvar to a number before comparing to the vector.
 panelMatch <- function(search_value, x) {
+  if (is.null(search_value)) return(is.na(x))
   if (is.numeric(x)) search_value <- as.numeric(search_value)
   x == search_value
 }

R/input-date.R

@@ -133,13 +133,11 @@ dateInput <- function(inputId, label, value = NULL, min = NULL, max = NULL,
 }
 
 
-datePickerVersion <- "1.9.0"
-
 datePickerDependency <- function(theme) {
   list(
     htmlDependency(
       name = "bootstrap-datepicker-js",
-      version = datePickerVersion,
+      version = version_bs_date_picker,
       src = c(href = "shared/datepicker"),
       script = if (getOption("shiny.minified", TRUE)) "js/bootstrap-datepicker.min.js"
                else                                   "js/bootstrap-datepicker.js",
@@ -158,7 +156,7 @@ datePickerCSS <- function(theme) {
   if (!is_bs_theme(theme)) {
     return(htmlDependency(
       name = "bootstrap-datepicker-css",
-      version = datePickerVersion,
+      version = version_bs_date_picker,
       src = c(href = "shared/datepicker"),
       stylesheet = "css/bootstrap-datepicker3.min.css"
     ))
@@ -170,7 +168,7 @@ datePickerCSS <- function(theme) {
     input = sass::sass_file(scss_file),
     theme = theme,
     name = "bootstrap-datepicker",
-    version = datePickerVersion,
+    version = version_bs_date_picker,
     cache_key_extra = shinyPackageVersion()
   )
 }

R/input-select.R

@@ -243,19 +243,14 @@ selectizeDependency <- function() {
 }
 
 selectizeDependencyFunc <- function(theme) {
-  selectizeVersion <- "0.12.4"
   if (!is_bs_theme(theme)) {
-    return(selectizeStaticDependency(selectizeVersion))
+    return(selectizeStaticDependency(version_selectize))
   }
 
   selectizeDir <- system.file(package = "shiny", "www/shared/selectize/")
+  bs_version <- bslib::theme_version(theme)
   stylesheet <- file.path(
-    selectizeDir, "scss",
-    if ("3" %in% bslib::theme_version(theme)) {
-      "selectize.bootstrap3.scss"
-    } else {
-      "selectize.bootstrap4.scss"
-    }
+    selectizeDir, "scss", paste0("selectize.bootstrap", bs_version, ".scss")
   )
   # It'd be cleaner to ship the JS in a separate, href-based,
   # HTML dependency (which we currently do for other themable widgets),
@@ -271,7 +266,7 @@ selectizeDependencyFunc <- function(theme) {
     input = sass::sass_file(stylesheet),
     theme = theme,
     name = "selectize",
-    version = selectizeVersion,
+    version = version_selectize,
     cache_key_extra = shinyPackageVersion(),
     .dep_args = list(script = script)
   )

R/input-slider.R

@@ -201,18 +201,16 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
 }
 
 
-ionRangeSliderVersion <- "2.3.1"
-
 ionRangeSliderDependency <- function() {
   list(
     # ion.rangeSlider also needs normalize.css, which is already included in Bootstrap.
     htmlDependency(
-      "ionrangeslider-javascript", ionRangeSliderVersion,
+      "ionrangeslider-javascript", version_ion_range_slider,
       src = c(href = "shared/ionrangeslider"),
       script = "js/ion.rangeSlider.min.js"
     ),
     htmlDependency(
-      "strftime", "0.9.2",
+      "strftime", version_strftime,
       src = c(href = "shared/strftime"),
       script = "strftime-min.js"
     ),
@@ -224,35 +222,22 @@ ionRangeSliderDependencyCSS <- function(theme) {
   if (!is_bs_theme(theme)) {
     return(htmlDependency(
       "ionrangeslider-css",
-      ionRangeSliderVersion,
+      version_ion_range_slider,
       src = c(href = "shared/ionrangeslider"),
       stylesheet = "css/ion.rangeSlider.css"
     ))
   }
 
-  # Remap some variable names for ionRangeSlider's scss
-  sass_input <- list(
-    list(
-      # The bootswatch materia theme sets $input-bg: transparent;
-      # which is an issue for the slider's handle(s) (#3130)
-      bg = "if(alpha($input-bg)==0, $body-bg, $input-bg)",
-      fg = sprintf(
-        "if(alpha($input-color)==0, $%s, $input-color)",
-        if ("3" %in% bslib::theme_version(theme)) "text-color" else "body-color"
-      ),
-      accent = "$component-active-bg",
-      `font-family` = "$font-family-base"
-    ),
-    sass::sass_file(
-      system.file(package = "shiny", "www/shared/ionrangeslider/scss/shiny.scss")
-    )
-  )
-
   bslib::bs_dependency(
-    input = sass_input,
+    input = list(
+      list(accent = "$component-active-bg"),
+      sass::sass_file(
+        system.file(package = "shiny", "www/shared/ionrangeslider/scss/shiny.scss")
+      )
+    ),
     theme = theme,
     name = "ionRangeSlider",
-    version = ionRangeSliderVersion,
+    version = version_ion_range_slider,
     cache_key_extra = shinyPackageVersion()
   )
 }

R/insert-tab.R

@@ -112,35 +112,13 @@
 #'
 #' }
 #' @export
-insertTab <- function(inputId, tab, target,
-                      position = c("before", "after"), select = FALSE,
+insertTab <- function(inputId, tab, target = NULL,
+                      position = c("after", "before"), select = FALSE,
                       session = getDefaultReactiveDomain()) {
-  force(target)
-  force(select)
-  position <- match.arg(position)
-  inputId <- session$ns(inputId)
-
-  # Barbara -- August 2017
-  # Note: until now, the number of tabs in a tabsetPanel (or navbarPage
-  # or navlistPanel) was always fixed. So, an easy way to give an id to
-  # a tab was simply incrementing a counter. (Just like it was easy to
-  # give a random 4-digit number to identify the tabsetPanel). Since we
-  # can only know this in the client side, we'll just pass `id` and
-  # `tsid` (TabSetID) as dummy values that will be fixed in the JS code.
-  item <- buildTabItem("id", "tsid", TRUE, divTag = tab,
-    textFilter = if (is.character(tab)) navbarMenuTextFilter else NULL)
-
-  callback <- function() {
-    session$sendInsertTab(
-      inputId = inputId,
-      liTag = processDeps(item$liTag, session),
-      divTag = processDeps(item$divTag, session),
-      menuName = NULL,
-      target = target,
-      position = position,
-      select = select)
-  }
-  session$onFlush(callback, once = TRUE)
+  bslib::nav_insert(
+    inputId, tab, target,
+    match.arg(position), select, session
+  )
 }
 
 #' @param menuName This argument should only be used when you want to
@@ -159,63 +137,21 @@ insertTab <- function(inputId, tab, target,
 #' @export
 prependTab <- function(inputId, tab, select = FALSE, menuName = NULL,
                        session = getDefaultReactiveDomain()) {
-  force(select)
-  force(menuName)
-  inputId <- session$ns(inputId)
-
-  item <- buildTabItem("id", "tsid", TRUE, divTag = tab,
-    textFilter = if (is.character(tab)) navbarMenuTextFilter else NULL)
-
-  callback <- function() {
-    session$sendInsertTab(
-      inputId = inputId,
-      liTag = processDeps(item$liTag, session),
-      divTag = processDeps(item$divTag, session),
-      menuName = menuName,
-      target = NULL,
-      position = "after",
-      select = select)
-  }
-  session$onFlush(callback, once = TRUE)
+  bslib::nav_prepend(inputId, tab, menu_title = menuName, select = select, session = session)
 }
 
 #' @rdname insertTab
 #' @export
 appendTab <- function(inputId, tab, select = FALSE, menuName = NULL,
                       session = getDefaultReactiveDomain()) {
-  force(select)
-  force(menuName)
-  inputId <- session$ns(inputId)
-
-  item <- buildTabItem("id", "tsid", TRUE, divTag = tab,
-    textFilter = if (is.character(tab)) navbarMenuTextFilter else NULL)
-
-  callback <- function() {
-    session$sendInsertTab(
-      inputId = inputId,
-      liTag = processDeps(item$liTag, session),
-      divTag = processDeps(item$divTag, session),
-      menuName = menuName,
-      target = NULL,
-      position = "before",
-      select = select)
-  }
-  session$onFlush(callback, once = TRUE)
+  bslib::nav_append(inputId, tab, menu_title = menuName, select = select, session = session)
 }
 
 #' @rdname insertTab
 #' @export
 removeTab <- function(inputId, target,
                       session = getDefaultReactiveDomain()) {
-  force(target)
-  inputId <- session$ns(inputId)
-
-  callback <- function() {
-    session$sendRemoveTab(
-      inputId = inputId,
-      target = target)
-  }
-  session$onFlush(callback, once = TRUE)
+  bslib::nav_remove(inputId, target, session)
 }
 
 

R/knitr.R

@@ -4,6 +4,7 @@
 #' themselves in knitr/rmarkdown documents.
 #'
 #' @name knitr_methods
+#' @keywords internal
 #' @param x Object to knit_print
 #' @param ... Additional knit_print arguments
 NULL

R/map.R

@@ -1,4 +1,3 @@
-#' @importFrom fastmap fastmap
 Map <- R6Class(
   'Map',
   portable = FALSE,

R/modal.R

@@ -151,18 +151,25 @@ removeModal <- function(session = getDefaultReactiveDomain()) {
 #' }
 #' @export
 modalDialog <- function(..., title = NULL, footer = modalButton("Dismiss"),
-  size = c("m", "s", "l"), easyClose = FALSE, fade = TRUE) {
+  size = c("m", "s", "l", "xl"), easyClose = FALSE, fade = TRUE) {
 
   size <- match.arg(size)
 
-  cls <- if (fade) "modal fade" else "modal"
-  div(id = "shiny-modal", class = cls, tabindex = "-1",
-    `data-backdrop` = if (!easyClose) "static",
-    `data-keyboard` = if (!easyClose) "false",
+  backdrop <- if (!easyClose) "static"
+  keyboard <- if (!easyClose) "false"
+  div(
+    id = "shiny-modal",
+    class = "modal",
+    class = if (fade) "fade",
+    tabindex = "-1",
+    `data-backdrop` = backdrop,
+    `data-bs-backdrop` = backdrop,
+    `data-keyboard` = keyboard,
+    `data-bs-keyboard` = keyboard,
 
     div(
       class = "modal-dialog",
-      class = switch(size, s = "modal-sm", m = NULL, l = "modal-lg"),
+      class = switch(size, s = "modal-sm", m = NULL, l = "modal-lg", xl = "modal-xl"),
       div(class = "modal-content",
         if (!is.null(title)) div(class = "modal-header",
           tags$h4(class = "modal-title", title)
@@ -171,14 +178,26 @@ modalDialog <- function(..., title = NULL, footer = modalButton("Dismiss"),
         if (!is.null(footer)) div(class = "modal-footer", footer)
       )
     ),
-    tags$script("$('#shiny-modal').modal().focus();")
+    # jQuery plugin doesn't work in Bootstrap 5, but vanilla JS doesn't work in Bootstrap 4 :sob:
+    tags$script(HTML(
+      "if (window.bootstrap && !window.bootstrap.Modal.VERSION.match(/^4\\./)) {
+         var modal = new bootstrap.Modal(document.getElementById('shiny-modal'));
+         modal.show();
+      } else {
+         $('#shiny-modal').modal().focus();
+      }"
+    ))
   )
 }
 
 #' @export
 #' @rdname modalDialog
 modalButton <- function(label, icon = NULL) {
-  tags$button(type = "button", class = "btn btn-default",
-    `data-dismiss` = "modal", validateIcon(icon), label
+  tags$button(
+    type = "button",
+    class = "btn btn-default",
+    `data-dismiss` = "modal",
+    `data-bs-dismiss` = "modal",
+    validateIcon(icon), label
   )
 }

R/reactives.R

@@ -875,8 +875,7 @@ Observable <- R6Class(
         invisible(.value)
     },
     format = function() {
-      label <- sprintf('reactive(%s)', paste(deparse(body(.origFunc)), collapse='\n'))
-      strsplit(label, "\n")[[1]]
+      simpleExprToFunction(fn_body(.origFunc), "reactive")
     },
     .updateValue = function() {
       ctx <- Context$new(.domain, .label, type = 'observable',
@@ -945,14 +944,15 @@ Observable <- R6Class(
 #' See the [Shiny tutorial](https://shiny.rstudio.com/tutorial/) for
 #' more information about reactive expressions.
 #'
-#' @param x For `reactive`, an expression (quoted or unquoted). For
-#'   `is.reactive`, an object to test.
-#' @param env The parent environment for the reactive expression. By default,
-#'   this is the calling environment, the same as when defining an ordinary
-#'   non-reactive expression.
-#' @param quoted Is the expression quoted? By default, this is `FALSE`.
-#'   This is useful when you want to use an expression that is stored in a
-#'   variable; to do so, it must be quoted with `quote()`.
+#' @param x For `is.reactive()`, an object to test. For `reactive()`, an expression. When passing in a [`quo()`]sure with `reactive()`, remember to use [`rlang::inject()`] to distinguish that you are passing in the content of your quosure, not the expression of the quosure.
+#' @template param-env
+#' @templateVar x x
+#' @templateVar env env
+#' @templateVar quoted quoted
+#' @template param-quoted
+#' @templateVar x x
+#' @templateVar quoted quoted
+
 #' @param label A label for the reactive expression, useful for debugging.
 #' @param domain See [domains].
 #' @param ..stacktraceon Advanced use only. For stack manipulation purposes; see
@@ -961,46 +961,56 @@ Observable <- R6Class(
 #' @return a function, wrapped in a S3 class "reactive"
 #'
 #' @examples
+#' library(rlang)
 #' values <- reactiveValues(A=1)
 #'
 #' reactiveB <- reactive({
 #'   values$A + 1
 #' })
-#'
-#' # Can use quoted expressions
-#' reactiveC <- reactive(quote({ values$A + 2 }), quoted = TRUE)
-#'
-#' # To store expressions for later conversion to reactive, use quote()
-#' expr_q <- quote({ values$A + 3 })
-#' reactiveD <- reactive(expr_q, quoted = TRUE)
-#'
 #' # View the values from the R console with isolate()
 #' isolate(reactiveB())
+#' # 2
+#'
+#' # To store expressions for later conversion to reactive, use quote()
+#' myquo <- rlang::quo(values$A + 2)
+#' # Unexpected value! Sending a quosure directly will not work as expected.
+#' reactiveC <- reactive(myquo)
+#' # We'd hope for `3`, but instead we get the quosure that was supplied.
 #' isolate(reactiveC())
+#'
+#' # Instead, the quosure should be `rlang::inject()`ed
+#' reactiveD <- rlang::inject(reactive(!!myquo))
 #' isolate(reactiveD())
+#' # 3
+#'
+#' # (Legacy) Can use quoted expressions
+#' expr <- quote({ values$A + 3 })
+#' reactiveE <- reactive(expr, quoted = TRUE)
+#' isolate(reactiveE())
+#' # 4
+#'
 #' @export
-reactive <- function(x, env = parent.frame(), quoted = FALSE,
+reactive <- function(
+  x,
+  env = parent.frame(),
+  quoted = FALSE,
   ...,
   label = NULL,
   domain = getDefaultReactiveDomain(),
-  ..stacktraceon = TRUE)
-{
+  ..stacktraceon = TRUE
+) {
   check_dots_empty()
 
-  x <- get_quosure(x, env, quoted)
-  fun <- as_function(x)
-  # as_function returns a function that takes `...`. We need one that takes no
-  # args.
-  formals(fun) <- list()
-
+  func <- installExprFunction(x, "func", env, quoted, wrappedWithLabel = FALSE)
   # Attach a label and a reference to the original user source for debugging
-  label <- exprToLabel(get_expr(x), "reactive", label)
+  userExpr <- fn_body(func)
+  label <- exprToLabel(userExpr, "reactive", label)
 
-  o <- Observable$new(fun, label, domain, ..stacktraceon = ..stacktraceon)
+  o <- Observable$new(func, label, domain, ..stacktraceon = ..stacktraceon)
   structure(
     o$getValue,
     observable = o,
-    cacheHint = list(userExpr = zap_srcref(get_expr(x))),
+    cacheHint = list(userExpr = zap_srcref(userExpr)),
     class = c("reactiveExpr", "reactive", "function")
   )
 }
@@ -1325,12 +1335,7 @@ Observer <- R6Class(
 #'
 #' @param x An expression (quoted or unquoted). Any return value will be
 #'   ignored.
-#' @param env The parent environment for the reactive expression. By default,
-#'   this is the calling environment, the same as when defining an ordinary
-#'   non-reactive expression.
-#' @param quoted Is the expression quoted? By default, this is `FALSE`.
-#'   This is useful when you want to use an expression that is stored in a
-#'   variable; to do so, it must be quoted with `quote()`.
+#' @inheritParams reactive
 #' @param label A label for the observer, useful for debugging.
 #' @param suspended If `TRUE`, start the observer in a suspended state. If
 #'   `FALSE` (the default), start in a non-suspended state.
@@ -1389,18 +1394,21 @@ Observer <- R6Class(
 #'   print(values$A + 1)
 #' })
 #'
-#' # Can use quoted expressions
-#' obsC <- observe(quote({ print(values$A + 2) }), quoted = TRUE)
+#' # To store expressions for later conversion to observe, use rlang::quo()
+#' myquo <- rlang::quo({ print(values$A + 3) })
+#' obsC <- rlang::inject(observe(!!myquo))
 #'
-#' # To store expressions for later conversion to observe, use quote()
-#' expr_q <- quote({ print(values$A + 3) })
-#' obsD <- observe(expr_q, quoted = TRUE)
+#' # (Legacy) Can use quoted expressions
+#' obsD <- observe(quote({ print(values$A + 2) }), quoted = TRUE)
 #'
 #' # In a normal Shiny app, the web client will trigger flush events. If you
 #' # are at the console, you can force a flush with flushReact()
 #' shiny:::flushReact()
 #' @export
-observe <- function(x, env = parent.frame(), quoted = FALSE,
+observe <- function(
+  x,
+  env = parent.frame(),
+  quoted = FALSE,
   ...,
   label = NULL,
   suspended = FALSE,
@@ -1411,18 +1419,11 @@ observe <- function(x, env = parent.frame(), quoted = FALSE,
 {
   check_dots_empty()
 
-  x <- get_quosure(x, env, quoted)
-  fun <- as_function(x)
-  # as_function returns a function that takes `...`. We need one that takes no
-  # args.
-  formals(fun) <- list()
-
-  if (is.null(label)) {
-    label <- sprintf('observe(%s)', paste(deparse(get_expr(x)), collapse='\n'))
-  }
+  func <- installExprFunction(x, "func", env, quoted)
+  label <- funcToLabel(func, "observe", label)
 
   o <- Observer$new(
-    fun,
+    func,
     label = label,
     suspended = suspended,
     priority = priority,
@@ -2144,23 +2145,30 @@ maskReactiveContext <- function(expr) {
 #' @param valueExpr The expression that produces the return value of the
 #'   `eventReactive`. It will be executed within an [isolate()]
 #'   scope.
-#' @param event.env The parent environment for `eventExpr`. By default,
-#'   this is the calling environment.
-#' @param event.quoted Is the `eventExpr` expression quoted? By default,
-#'   this is `FALSE`. This is useful when you want to use an expression
-#'   that is stored in a variable; to do so, it must be quoted with
-#'   `quote()`.
-#' @param handler.env The parent environment for `handlerExpr`. By default,
-#'   this is the calling environment.
-#' @param handler.quoted Is the `handlerExpr` expression quoted? By
-#'   default, this is `FALSE`. This is useful when you want to use an
-#'   expression that is stored in a variable; to do so, it must be quoted with
-#'   `quote()`.
-#' @param value.env The parent environment for `valueExpr`. By default,
-#'   this is the calling environment.
-#' @param value.quoted Is the `valueExpr` expression quoted? By default,
-#'   this is `FALSE`. This is useful when you want to use an expression
-#'   that is stored in a variable; to do so, it must be quoted with `quote()`.
+#' @param event.env The parent environment for the reactive expression. By default,
+#'   this is the calling environment, the same as when defining an ordinary
+#'   non-reactive expression. If `eventExpr` is a quosure and `event.quoted` is `TRUE`,
+#'   then `event.env` is ignored.
+#' @param event.quoted If it is `TRUE`, then the [`quote()`]ed value of `eventExpr`
+#'   will be used when `eventExpr` is evaluated. If `eventExpr` is a quosure and you
+#'   would like to use its expression as a value for `eventExpr`, then you must set
+#'  `event.quoted` to `TRUE`.
+#' @param handler.env The parent environment for the reactive expression. By default,
+#'   this is the calling environment, the same as when defining an ordinary
+#'   non-reactive expression. If `handlerExpr` is a quosure and `handler.quoted` is `TRUE`,
+#'   then `handler.env` is ignored.
+#' @param handler.quoted If it is `TRUE`, then the [`quote()`]ed value of `handlerExpr`
+#'   will be used when `handlerExpr` is evaluated. If `handlerExpr` is a quosure and you
+#'   would like to use its expression as a value for `handlerExpr`, then you must set
+#'  `handler.quoted` to `TRUE`.
+#' @param value.env The parent environment for the reactive expression. By default,
+#'   this is the calling environment, the same as when defining an ordinary
+#'   non-reactive expression. If `valueExpr` is a quosure and `value.quoted` is `TRUE`,
+#'   then `value.env` is ignored.
+#' @param value.quoted If it is `TRUE`, then the [`quote()`]ed value of `valueExpr`
+#'   will be used when `valueExpr` is evaluated. If `valueExpr` is a quosure and you
+#'   would like to use its expression as a value for `valueExpr`, then you must set
+#'  `value.quoted` to `TRUE`.
 #' @param label A label for the observer or reactive, useful for debugging.
 #' @param suspended If `TRUE`, start the observer in a suspended state. If
 #'   `FALSE` (the default), start in a non-suspended state.
@@ -2274,15 +2282,13 @@ observeEvent <- function(eventExpr, handlerExpr,
 {
   check_dots_empty()
 
-  eventExpr   <- get_quosure(eventExpr,   event.env,   event.quoted)
-  handlerExpr <- get_quosure(handlerExpr, handler.env, handler.quoted)
+  eventQ <- exprToQuo(eventExpr, event.env, event.quoted)
+  handlerQ <- exprToQuo(handlerExpr, handler.env, handler.quoted)
 
-  if (is.null(label)) {
-    label <- sprintf('observeEvent(%s)', paste(deparse(get_expr(eventExpr)), collapse='\n'))
-  }
+  label <- quoToLabel(eventQ, "observeEvent", label)
 
   handler <- inject(observe(
-    !!handlerExpr,
+    !!handlerQ,
     label = label,
     suspended = suspended,
     priority = priority,
@@ -2296,7 +2302,7 @@ observeEvent <- function(eventExpr, handlerExpr,
     ignoreInit = ignoreInit,
     once = once,
     label = label,
-    !!eventExpr,
+    !!eventQ,
     x = handler
   ))
 
@@ -2314,19 +2320,17 @@ eventReactive <- function(eventExpr, valueExpr,
 {
   check_dots_empty()
 
-  eventExpr <- get_quosure(eventExpr, event.env, event.quoted)
-  valueExpr <- get_quosure(valueExpr, value.env, value.quoted)
+  eventQ <- exprToQuo(eventExpr, event.env, event.quoted)
+  valueQ <- exprToQuo(valueExpr, value.env, value.quoted)
 
-  if (is.null(label)) {
-    label <- sprintf('eventReactive(%s)', paste(deparse(get_expr(eventExpr)), collapse='\n'))
-  }
+  label <- quoToLabel(eventQ, "eventReactive", label)
 
   invisible(inject(bindEvent(
     ignoreNULL = ignoreNULL,
     ignoreInit = ignoreInit,
     label = label,
-    !!eventExpr,
-    x = reactive(!!valueExpr, domain = domain, label = label)
+    !!eventQ,
+    x = reactive(!!valueQ, domain = domain, label = label)
   )))
 }
 

R/render-plot.R

@@ -36,17 +36,17 @@
 #' @param res Resolution of resulting plot, in pixels per inch. This value is
 #'   passed to [grDevices::png()]. Note that this affects the resolution of PNG
 #'   rendering in R; it won't change the actual ppi of the browser.
-#' @param alt Alternate text for the HTML `<img>` tag
-#'   if it cannot be displayed or viewed (i.e., the user uses a screen reader).
-#'   In addition to a character string, the value may be a reactive expression
-#'   (or a function referencing reactive values) that returns a character string.
-#'   NULL or "" is not recommended because those should be limited to decorative images
-#'   (the default is "Plot object").
+#' @param alt Alternate text for the HTML `<img>` tag if it cannot be displayed
+#'   or viewed (i.e., the user uses a screen reader). In addition to a character
+#'   string, the value may be a reactive expression (or a function referencing
+#'   reactive values) that returns a character string. If the value is `NA` (the
+#'   default), then `ggplot2::get_alt_text()` is used to extract alt text from
+#'   ggplot objects; for other plots, `NA` results in alt text of "Plot object".
+#'   `NULL` or `""` is not recommended because those should be limited to
+#'   decorative images.
 #' @param ... Arguments to be passed through to [grDevices::png()].
 #'   These can be used to set the width, height, background color, etc.
-#' @param env The environment in which to evaluate `expr`.
-#' @param quoted Is `expr` a quoted expression (with `quote()`)? This
-#'   is useful if you want to save an expression in a variable.
+#' @inheritParams renderUI
 #' @param execOnResize If `FALSE` (the default), then when a plot is
 #'   resized, Shiny will *replay* the plot drawing commands with
 #'   [grDevices::replayPlot()] instead of re-executing `expr`.
@@ -58,15 +58,18 @@
 #'   interactive R Markdown document.
 #' @export
 renderPlot <- function(expr, width = 'auto', height = 'auto', res = 72, ...,
-                       alt = "Plot object",
+                       alt = NA,
                        env = parent.frame(), quoted = FALSE,
                        execOnResize = FALSE, outputArgs = list()
 ) {
 
-  expr <- get_quosure(expr, env, quoted)
-  # This ..stacktraceon is matched by a ..stacktraceoff.. when plotFunc
-  # is called
-  func <- quoToFunction(expr, "renderPlot", ..stacktraceon = TRUE)
+  func <- installExprFunction(
+    expr, "func", env, quoted,
+    label = "renderPlot",
+    # This ..stacktraceon is matched by a ..stacktraceoff.. when plotFunc
+    # is called
+    ..stacktraceon = TRUE
+  )
 
   args <- list(...)
 
@@ -184,7 +187,7 @@ renderPlot <- function(expr, width = 'auto', height = 'auto', res = 72, ...,
     outputFunc,
     renderFunc,
     outputArgs,
-    cacheHint = list(userExpr = get_expr(expr), res = res)
+    cacheHint = list(userExpr = installedFuncExpr(func), res = res)
   )
   class(markedFunc) <- c("shiny.renderPlot", class(markedFunc))
   markedFunc
@@ -212,7 +215,7 @@ resizeSavedPlot <- function(name, session, result, width, height, alt, pixelrati
     src = session$fileUrl(name, outfile, contentType = "image/png"),
     width = width,
     height = height,
-    alt = alt,
+    alt = result$alt,
     coordmap = coordmap,
     error = attr(coordmap, "error", exact = TRUE)
   )
@@ -288,6 +291,7 @@ drawPlot <- function(name, session, func, width, height, alt, pixelratio, res, .
               recordedPlot = grDevices::recordPlot(),
               coordmap = getCoordmap(value, width*pixelratio, height*pixelratio, res*pixelratio),
               pixelratio = pixelratio,
+              alt = if (anyNA(alt)) getAltText(value) else alt,
               res = res
             )
           }
@@ -302,10 +306,10 @@ drawPlot <- function(name, session, func, width, height, alt, pixelratio, res, .
     ),
     function(result) {
       result$img <- dropNulls(list(
-        src = session$fileUrl(name, outfile, contentType='image/png'),
+        src = session$fileUrl(name, outfile, contentType = 'image/png'),
         width = width,
         height = height,
-        alt = alt,
+        alt = result$alt,
         coordmap = result$coordmap,
         # Get coordmap error message if present
         error = attr(result$coordmap, "error", exact = TRUE)
@@ -339,6 +343,24 @@ custom_print.ggplot <- function(x) {
   ), class = "ggplot_build_gtable")
 }
 
+# Infer alt text description from renderPlot() value
+# (currently just ggplot2 is supported)
+getAltText <- function(x, default = "Plot object") {
+  # Since, inside renderPlot(), custom_print.ggplot()
+  # overrides print.ggplot, this class indicates a ggplot()
+  if (!inherits(x, "ggplot_build_gtable")) {
+    return(default)
+  }
+  # ggplot2::get_alt_text() was added in v3.3.4
+  # https://github.com/tidyverse/ggplot2/pull/4482
+  get_alt <- getNamespace("ggplot2")$get_alt_text
+  if (!is.function(get_alt)) {
+    return(default)
+  }
+  alt <- paste(get_alt(x$build), collapse = " ")
+  if (nzchar(alt)) alt else default
+}
+
 # The coordmap extraction functions below return something like the examples
 # below. For base graphics:
 # plot(mtcars$wt, mtcars$mpg)

R/render-table.R

@@ -42,9 +42,7 @@
 #'   (i.e. they either evaluate to `NA` or `NaN`).
 #' @param ... Arguments to be passed through to [xtable::xtable()]
 #'   and [xtable::print.xtable()].
-#' @param env The environment in which to evaluate `expr`.
-#' @param quoted Is `expr` a quoted expression (with `quote()`)?
-#'   This is useful if you want to save an expression in a variable.
+#' @inheritParams renderUI
 #' @param outputArgs A list of arguments to be passed through to the
 #'   implicit call to [tableOutput()] when `renderTable` is
 #'   used in an interactive R Markdown document.
@@ -74,8 +72,7 @@ renderTable <- function(expr, striped = FALSE, hover = FALSE,
                         env = parent.frame(), quoted = FALSE,
                         outputArgs=list())
 {
-  expr <- get_quosure(expr, env, quoted)
-  func <- quoToFunction(expr, "renderTable")
+  func <- installExprFunction(expr, "func", env, quoted, label = "renderTable")
 
   if (!is.function(spacing)) spacing <- match.arg(spacing)
 

R/runapp.R

@@ -22,7 +22,10 @@
 #' @param port The TCP port that the application should listen on. If the
 #'   `port` is not specified, and the `shiny.port` option is set (with
 #'   `options(shiny.port = XX)`), then that port will be used. Otherwise,
-#'   use a random port.
+#'   use a random port between 3000:8000, excluding ports that are blocked
+#'   by Google Chrome for being considered unsafe: 3659, 4045, 5060,
+#'   5061, 6000, 6566, 6665:6669 and 6697. Up to twenty random
+#'   ports will be tried.
 #' @param launch.browser If true, the system's default web browser will be
 #'   launched automatically after the app is started. Defaults to true in
 #'   interactive sessions only. This value of this parameter can also be a
@@ -301,7 +304,8 @@ runApp <- function(appDir=getwd(),
           # Reject ports in this range that are considered unsafe by Chrome
           # http://superuser.com/questions/188058/which-ports-are-considered-unsafe-on-chrome
           # https://github.com/rstudio/shiny/issues/1784
-          if (!port %in% c(3659, 4045, 6000, 6665:6669, 6697)) {
+          # https://chromium.googlesource.com/chromium/src.git/+/refs/heads/main/net/base/port_util.cc
+          if (!port %in% c(3659, 4045, 5060, 5061, 6000, 6566, 6665:6669, 6697)) {
             break
           }
         }

R/serializers.R

@@ -5,7 +5,6 @@
 #'   value. The returned value will be used for the test snapshot.
 #' @param session A Shiny session object.
 #'
-#' @keywords internal
 #' @export
 setSerializer <- function(inputId, fun, session = getDefaultReactiveDomain()) {
   if (is.null(session)) {

R/server-input-handlers.R

@@ -46,7 +46,7 @@ inputHandlers <- Map$new()
 #' }
 #'
 #' }
-#' @seealso [removeInputHandler()]
+#' @seealso [removeInputHandler()] [applyInputHandlers()]
 #' @export
 registerInputHandler <- function(type, fun, force=FALSE){
   if (inputHandlers$containsKey(type) && !force){

R/shiny-package.R

@@ -2,7 +2,7 @@
 
 ## usethis namespace: start
 ## usethis namespace: end
-#' @importFrom lifecycle deprecated
+#' @importFrom lifecycle deprecated is_present
 #' @importFrom grDevices dev.set dev.cur
 #' @importFrom fastmap fastmap
 #' @importFrom promises %...!%
@@ -11,11 +11,13 @@
 #'    promise promise_resolve promise_reject is.promising
 #'    as.promise
 #' @importFrom rlang
-#'    quo enquo as_function get_expr get_env new_function enquos
+#'    quo enquo enquo0 as_function get_expr get_env new_function enquos
 #'    eval_tidy expr pairlist2 new_quosure enexpr as_quosure is_quosure inject
+#'    quo_set_env quo_set_expr quo_get_expr
 #'    enquos0 zap_srcref %||% is_na
 #'    is_false list2
 #'    missing_arg is_missing maybe_missing
+#'    quo_is_missing fn_fmls<- fn_body fn_body<-
 #' @importFrom ellipsis
 #'    check_dots_empty check_dots_unnamed
 #' @import htmltools

R/shinywrappers.R

@@ -2,12 +2,23 @@ utils::globalVariables('func', add = TRUE)
 
 #' Mark a function as a render function
 #'
+#' `r lifecycle::badge("superseded")` Please use [`createRenderFunction()`] to
+#' support async execution. (Shiny 1.1.0)
+#'
 #' Should be called by implementers of `renderXXX` functions in order to mark
 #' their return values as Shiny render functions, and to provide a hint to Shiny
 #' regarding what UI function is most commonly used with this type of render
 #' function. This can be used in R Markdown documents to create complete output
 #' widgets out of just the render function.
 #'
+#' Note that it is generally preferable to use [createRenderFunction()] instead
+#' of `markRenderFunction()`. It essentially wraps up the user-provided
+#' expression in the `transform` function passed to it, then passes the resulting
+#' function to `markRenderFunction()`. It also provides a simpler calling
+#' interface. There may be cases where `markRenderFunction()` must be used instead of
+#' [createRenderFunction()] -- for example, when the `transform` parameter of
+#' [createRenderFunction()] is not flexible enough for your needs.
+#'
 #' @param uiFunc A function that renders Shiny UI. Must take a single argument:
 #'   an output ID.
 #' @param renderFunc A function that is suitable for assigning to a Shiny output
@@ -37,7 +48,7 @@ utils::globalVariables('func', add = TRUE)
 #'   is able to serve JS and CSS resources.
 #' @return The `renderFunc` function, with annotations.
 #'
-#' @seealso [createRenderFunction()], [quoToFunction()]
+#' @seealso [createRenderFunction()]
 #' @export
 markRenderFunction <- function(
   uiFunc,
@@ -47,6 +58,12 @@ markRenderFunction <- function(
   cacheWriteHook = NULL,
   cacheReadHook = NULL
 ) {
+  # (Do not emit warning for superseded code, "since there’s no risk if you keep using it")
+  # # This method is called by the superseding function, createRenderFunction().
+  # if (in_devmode()) {
+  #   shinyDeprecated("1.1.0", "markRenderFunction()", "createRenderFunction()")
+  # }
+
   force(renderFunc)
 
   # a mutable object that keeps track of whether `useRenderFunction` has been
@@ -94,6 +111,7 @@ markRenderFunction <- function(
     # For everything else, do nothing.
     cacheHint <- lapply(cacheHint, function(x) {
       if      (is.function(x)) formalsAndBody(x)
+      else if (is_quosure(x)) zap_srcref(quo_get_expr(x))
       else if (is.language(x)) zap_srcref(x)
       else                     x
     })
@@ -133,10 +151,27 @@ print.shiny.render.function <- function(x, ...) {
   cat_line("<shiny.render.function>")
 }
 
-#' Implement render functions
+#' Implement custom render functions
 #'
-#' This function is a wrapper for [markRenderFunction()] which provides support
-#' for async computation via promises.
+#' Developer-facing utilities for implementing a custom `renderXXX()` function.
+#' Before using these utilities directly, consider using the [`htmlwidgets`
+#' package](http://www.htmlwidgets.org/develop_intro.html) to implement custom
+#' outputs (i.e., custom `renderXXX()`/`xxxOutput()` functions). That said,
+#' these utilities can be used more directly if a full-blown htmlwidget isn't
+#' needed and/or the user-supplied reactive expression needs to be wrapped in
+#' additional call(s).
+#'
+#' To implement a custom `renderXXX()` function, essentially 2 things are needed:
+#'   1. Capture the user's reactive expression as a function.
+#'      * New `renderXXX()` functions can use `quoToFunction()` for this, but
+#'      already existing `renderXXX()` functions that contain `env` and `quoted`
+#'      parameters may want to continue using `installExprFunction()` for better
+#'      legacy support (see examples).
+#'   2. Flag the resulting function (from 1) as a Shiny rendering function and
+#'   also provide a UI container for displaying the result of the rendering
+#'   function.
+#'      * `createRenderFunction()` is currently recommended (instead of
+#'      [markRenderFunction()]) for this step (see examples).
 #'
 #' @param func A function without parameters, that returns user data. If the
 #'   returned value is a promise, then the render function will proceed in async
@@ -153,16 +188,24 @@ print.shiny.render.function <- function(x, ...) {
 #' @return An annotated render function, ready to be assigned to an
 #'   `output` slot.
 #'
-#' @seealso [quoToFunction()], [markRenderFunction()].
-#'
 #' @examples
-#' # A very simple render function
-#' renderTriple <- function(x) {
-#'   x <- substitute(x)
-#'   if (!rlang::is_quosure(x)) {
-#'     x <- rlang::new_quosure(x, env = parent.frame())
-#'   }
-#'   func <- quoToFunction(x, "renderTriple")
+#' # A custom render function that repeats the supplied value 3 times
+#' renderTriple <- function(expr) {
+#'   # Wrap user-supplied reactive expression into a function
+#'   func <- quoToFunction(rlang::enquo0(expr))
+#'
+#'   createRenderFunction(
+#'     func,
+#'     transform = function(value, session, name, ...) {
+#'       paste(rep(value, 3), collapse=", ")
+#'     },
+#'     outputFunc = textOutput
+#'   )
+#' }
+#'
+#' # For better legacy support, consider using installExprFunction() over quoToFunction()
+#' renderTripleLegacy <- function(expr, env = parent.frame(), quoted = FALSE) {
+#'   func <- installExprFunction(expr, "func", env, quoted)
 #'
 #'   createRenderFunction(
 #'     func,
@@ -174,10 +217,38 @@ print.shiny.render.function <- function(x, ...) {
 #' }
 #'
 #' # Test render function from the console
-#' a <- 1
-#' r <- renderTriple({ a + 1 })
-#' a <- 2
+#' reactiveConsole(TRUE)
+#'
+#' v <- reactiveVal("basic")
+#' r <- renderTriple({ v() })
 #' r()
+#' #> [1] "basic, basic, basic"
+#'
+#' # User can supply quoted code via rlang::quo(). Note that evaluation of the
+#' # expression happens when r2() is invoked, not when r2 is created.
+#' q <- rlang::quo({ v() })
+#' r2 <- rlang::inject(renderTriple(!!q))
+#' v("rlang")
+#' r2()
+#' #> [1] "rlang, rlang, rlang"
+#'
+#' # Supplying quoted code without rlang::quo() requires installExprFunction()
+#' expr <- quote({ v() })
+#' r3 <- renderTripleLegacy(expr, quoted = TRUE)
+#' v("legacy")
+#' r3()
+#' #> [1] "legacy, legacy, legacy"
+#'
+#' # The legacy approach also supports with quosures (env is ignored in this case)
+#' q <- rlang::quo({ v() })
+#' r4 <- renderTripleLegacy(q, quoted = TRUE)
+#' v("legacy-rlang")
+#' r4()
+#' #> [1] "legacy-rlang, legacy-rlang, legacy-rlang"
+#'
+#' # Turn off reactivity in the console
+#' reactiveConsole(FALSE)
+#'
 #' @export
 createRenderFunction <- function(
   func,
@@ -316,9 +387,7 @@ markOutputAttrs <- function(renderFunc, snapshotExclude = NULL,
 #'   the output, see [plotPNG()].
 #'
 #' @param expr An expression that returns a list.
-#' @param env The environment in which to evaluate `expr`.
-#' @param quoted Is `expr` a quoted expression (with `quote()`)? This
-#'   is useful if you want to save an expression in a variable.
+#' @inheritParams renderUI
 #' @param deleteFile Should the file in `func()$src` be deleted after
 #'   it is sent to the client browser? Generally speaking, if the image is a
 #'   temp file generated within `func`, then this should be `TRUE`;
@@ -397,11 +466,10 @@ markOutputAttrs <- function(renderFunc, snapshotExclude = NULL,
 #'
 #' shinyApp(ui, server)
 #' }
-renderImage <- function(expr, env=parent.frame(), quoted=FALSE,
+renderImage <- function(expr, env = parent.frame(), quoted = FALSE,
                         deleteFile, outputArgs=list())
 {
-  expr <- get_quosure(expr, env, quoted)
-  func <- quoToFunction(expr, "renderImage")
+  func <- installExprFunction(expr, "func", env, quoted, label = "renderImage")
 
   # missing() must be used directly within the function with the given arg
   if (missing(deleteFile)) {
@@ -523,9 +591,7 @@ isTemp <- function(path, tempDir = tempdir(), mustExist) {
 #' function return [invisible()].
 #'
 #' @param expr An expression to evaluate.
-#' @param env The environment in which to evaluate `expr`. For expert use only.
-#' @param quoted Is `expr` a quoted expression (with `quote()`)? This
-#'   is useful if you want to save an expression in a variable.
+#' @inheritParams renderUI
 #' @param width Width of printed output.
 #' @param outputArgs A list of arguments to be passed through to the implicit
 #'   call to [verbatimTextOutput()] or [textOutput()] when the functions are
@@ -536,8 +602,7 @@ isTemp <- function(path, tempDir = tempdir(), mustExist) {
 renderPrint <- function(expr, env = parent.frame(), quoted = FALSE,
                         width = getOption('width'), outputArgs=list())
 {
-  expr <- get_quosure(expr, env, quoted)
-  func <- quoToFunction(expr, "renderPrint")
+  func <- installExprFunction(expr, "func", env, quoted, label = "renderPrint")
 
   # Set a promise domain that sets the console width
   #   and captures output
@@ -569,7 +634,7 @@ renderPrint <- function(expr, env = parent.frame(), quoted = FALSE,
     outputArgs,
     cacheHint = list(
       label = "renderPrint",
-      origUserExpr = get_expr(expr)
+      origUserExpr = installedFuncExpr(func)
     )
   )
 }
@@ -619,11 +684,10 @@ createRenderPrintPromiseDomain <- function(width) {
 #'   element.
 #' @export
 #' @rdname renderPrint
-renderText <- function(expr, env=parent.frame(), quoted=FALSE,
+renderText <- function(expr, env = parent.frame(), quoted = FALSE,
                        outputArgs=list(), sep=" ") {
 
-  expr <- get_quosure(expr, env, quoted)
-  func <- quoToFunction(expr, "renderText")
+  func <- installExprFunction(expr, "func", env, quoted, label = "renderText")
 
   createRenderFunction(
     func,
@@ -644,9 +708,13 @@ renderText <- function(expr, env=parent.frame(), quoted=FALSE,
 #'
 #' @param expr An expression that returns a Shiny tag object, [HTML()],
 #'   or a list of such objects.
-#' @param env The environment in which to evaluate `expr`.
-#' @param quoted Is `expr` a quoted expression (with `quote()`)? This
-#'   is useful if you want to save an expression in a variable.
+#' @template param-env
+#' @templateVar x expr
+#' @templateVar env env
+#' @templateVar quoted quoted
+#' @template param-quoted
+#' @templateVar x expr
+#' @templateVar quoted quoted
 #' @param outputArgs A list of arguments to be passed through to the implicit
 #'   call to [uiOutput()] when `renderUI` is used in an
 #'   interactive R Markdown document.
@@ -675,8 +743,7 @@ renderText <- function(expr, env=parent.frame(), quoted=FALSE,
 renderUI <- function(expr, env = parent.frame(), quoted = FALSE,
                      outputArgs = list())
 {
-  expr <- get_quosure(expr, env, quoted)
-  func <- quoToFunction(expr, "renderUI")
+  func <- installExprFunction(expr, "func", env, quoted, label = "renderUI")
 
   createRenderFunction(
     func,
@@ -755,6 +822,8 @@ downloadHandler <- function(filename, content, contentType=NA, outputArgs=list()
 #' Table output with the JavaScript DataTables library
 #'
 #' @description
+#' `r lifecycle::badge("superseded")` Please use [`DT::renderDataTable()`]. (Shiny 0.11.1)
+#'
 #' Makes a reactive version of the given function that returns a data frame (or
 #' matrix), which will be rendered with the [DataTables](https://datatables.net)
 #' library. Paging, searching, filtering, and sorting can be done on the R side
@@ -829,8 +898,7 @@ renderDataTable <- function(expr, options = NULL, searchDelay = 500,
     )
   }
 
-  expr <- get_quosure(expr, env, quoted)
-  func <- quoToFunction(expr, "renderDataTable")
+  func <- installExprFunction(expr, "func", env, quoted, label = "renderDataTable")
 
   renderFunc <- function(shinysession, name, ...) {
     if (is.function(options)) options <- options()

R/showcase.R

@@ -83,7 +83,7 @@ navTabsHelper <- function(files, prefix = "") {
     with(tags,
       li(class=if (tolower(file) %in% c("app.r", "server.r")) "active" else "",
          a(href=paste("#", gsub(".", "_", file, fixed=TRUE), "_code", sep=""),
-           "data-toggle"="tab", paste0(prefix, file)))
+           "data-toggle"="tab", "data-bs-toggle"="tab", paste0(prefix, file)))
     )
   })
 }
@@ -92,7 +92,7 @@ navTabsDropdown <- function(files) {
   if (length(files) > 0) {
     with(tags,
       li(role="presentation", class="dropdown",
-        a(class="dropdown-toggle", `data-toggle`="dropdown", href="#",
+        a(class="dropdown-toggle", `data-toggle`="dropdown", `data-bs-toggle`="dropdown", href="#",
           role="button", `aria-haspopup`="true", `aria-expanded`="false",
           "www", span(class="caret")
         ),

R/utils-lang.R

@@ -51,60 +51,199 @@ formalsAndBody <- function(x) {
 }
 
 
-# This function is to be called from functions like `reactive()`, `observe()`,
-# and the various render functions. It handles the following cases:
-# - The typical case where x is an unquoted expression, and `env` and `quoted`
-#   are not used.
-# - New-style metaprogramming cases, where rlang::inject() is used to inline a
-#   quosure into the AST, as in `inject(reactive(!!x))`.
-# - Old-style metaprogramming cases, where `env` and/or `quoted` are used.
-#
-# Much of the complexity is handling old-style metaprogramming cases. The code
-# in this function is more complicated because it needs to look at unevaluated
-# expressions in the _calling_ function. If this code were put directly in the
-# calling function, it would look like this:
-#
-# if (!missing(env) || !missing(quoted)) {
-#   deprecatedEnvQuotedMessage()
-#   if (!quoted) x <- substitute(x)
-#   x <- new_quosure(x, env)
-#
-# } else {
-#   x <- substitute(x)
-#   if (!is_quosure(x)) {
-#     x <- new_quosure(x, env = parent.frame())
-#   }
-# }
-#
-# In the future, the calling functions will not need to have the `env` and
-# `quoted` arguments -- `rlang::inject()` and quosures can be used instead.
-# Instead of using this function, `get_quosure()`, the caller can instead use
-# just the following code:
-#
-# x <- substitute(x)
-# if (!is_quosure(x)) {
-#   x <- new_quosure(x, env = parent.frame())
-# }
-#
-get_quosure <- function(x, env, quoted) {
-  if (!eval(substitute(missing(env)), parent.frame()) ||
-      !eval(substitute(missing(quoted)), parent.frame()))
-  {
-    deprecatedEnvQuotedMessage()
-    if (!quoted) {
-      x <- eval(substitute(substitute(x)), parent.frame())
-    }
-    x <- new_quosure(x, env)
+#' @describeIn createRenderFunction convert a quosure to a function.
+#' @param q Quosure of the expression `x`. When capturing expressions to create
+#'   your quosure, it is recommended to use [`enquo0()`] to not unquote the
+#'   object too early. See [`enquo0()`] for more details.
+#' @inheritParams installExprFunction
+#' @export
+quoToFunction <- function(
+  q,
+  label = sys.call(-1)[[1]],
+  ..stacktraceon = FALSE
+) {
+  func <- quoToSimpleFunction(as_quosure(q))
+  wrapFunctionLabel(func, updateFunctionLabel(label), ..stacktraceon = ..stacktraceon, dots = FALSE)
+}
 
-  } else {
-    x <- eval(substitute(substitute(x)), parent.frame())
-
-    # At this point, x can be a quosure if rlang::inject() is used, but the
-    # typical case is that x is not a quosure.
-    if (!is_quosure(x)) {
-      x <- new_quosure(x, env = parent.frame(2L))
+updateFunctionLabel <- function(label) {
+  badFnName <- "anonymous"
+  if (all(is.language(label))) {
+    # Prevent immediately invoked functions like as.language(a()())
+    if (is.language(label) && length(label) > 1) {
+      return(badFnName)
     }
+    label <- deparse(label, width.cutoff = 500L)
+  }
+  label <- as.character(label)
+  # Prevent function calls that are over one line; (Assignments are hard to perform)
+    # Prevent immediately invoked functions like "a()()"
+  if (length(label) > 1 || grepl("(", label, fixed = TRUE)) {
+    return(badFnName)
+  }
+  if (label == "NULL") {
+    return(badFnName)
+  }
+  label
+}
+
+quoToSimpleFunction <- function(q) {
+  # Should not use `new_function(list(), get_expr(q), get_env(q))` as extra logic
+  # is done by rlang to convert the quosure to a function within `as_function(q)`
+  fun <- as_function(q)
+
+  # If the quosure is empty, then the returned function can not be called.
+  # https://github.com/r-lib/rlang/issues/1244
+  if (quo_is_missing(q)) {
+    fn_body(fun) <- quote({})
   }
 
-  x
+  # `as_function()` returns a function that takes `...`. We need one that takes no
+  # args.
+  fn_fmls(fun) <- list()
+
+  fun
+}
+
+
+#' Convert an expression to a function
+#'
+#' `r lifecycle::badge("superseded")` Please use [`installExprFunction()`] for a better
+#' debugging experience (Shiny 0.8.0). If the `expr` and `quoted` parameters are not needed, please see
+#' [`quoToFunction()`] (Shiny 1.6.0).
+#'
+#' Similar to [installExprFunction()] but doesn't register debug hooks.
+#'
+#' @param expr A quoted or unquoted expression, or a quosure.
+#' @param env The desired environment for the function. Defaults to the
+#'   calling environment two steps back.
+#' @param quoted Is the expression quoted?
+#' @seealso [`installExprFunction()`] for the modern approach to converting an expression to a function
+#' @export
+#' @keywords internal
+exprToFunction <- function(expr, env = parent.frame(), quoted = FALSE) {
+  # If `expr` is a raw quosure, must say `quoted = TRUE`; (env is ignored)
+  # If `inject()` a quosure, env is ignored, and quoted should be FALSE (aka ignored).
+  # Make article of usage
+  # * (by joe)
+
+  if (!quoted) {
+    expr <- eval(substitute(substitute(expr)), parent.frame())
+  }
+  # MUST call with `quoted = TRUE` as exprToQuo() will not reach high enough
+  q <- exprToQuo(expr, env, quoted = TRUE)
+
+  # MUST call `as_function()`. Can NOT call `new_function()`
+  # rlang has custom logic for handling converting a quosure to a function
+  quoToSimpleFunction(q)
+}
+# For internal use only; External users should be using `exprToFunction()` or `installExprFunction()`
+# MUST be the exact same logic as `exprToFunction()`, but without the `quoToSimpleFunction()` call
+exprToQuo <- function(expr, env = parent.frame(), quoted = FALSE) {
+  if (!quoted) {
+    expr <- eval(substitute(substitute(expr)), parent.frame())
+  }
+  q <-
+    if (is_quosure(expr)) {
+      # inject()ed quosure
+      # do nothing
+      expr
+    } else if (is.language(expr) || rlang::is_atomic(expr) || is.null(expr)) {
+      # Most common case...
+      new_quosure(expr, env = env)
+    } else {
+      stop("Don't know how to convert '", class(expr)[1], "' to a function; a quosure or quoted expression was expected")
+    }
+  q
+}
+
+#' @describeIn createRenderFunction converts a user's reactive `expr` into a
+#'   function that's assigned to a `name` in the `assign.env`.
+#'
+#' @param name The name the function should be given
+#' @param eval.env The desired environment for the function. Defaults to the
+#'   calling environment two steps back.
+#' @param assign.env The environment in which the function should be assigned.
+#' @param label A label for the object to be shown in the debugger. Defaults to
+#'   the name of the calling function.
+#' @param wrappedWithLabel,..stacktraceon Advanced use only. For stack manipulation purposes; see
+#'   [stacktrace()].
+#' @inheritParams exprToFunction
+#' @export
+installExprFunction <- function(expr, name, eval.env = parent.frame(2),
+                                quoted = FALSE,
+                                assign.env = parent.frame(1),
+                                label = sys.call(-1)[[1]],
+                                wrappedWithLabel = TRUE,
+                                ..stacktraceon = FALSE) {
+  if (!quoted) {
+    quoted <- TRUE
+    expr <- eval(substitute(substitute(expr)), parent.frame())
+  }
+
+  func <- exprToFunction(expr, eval.env, quoted)
+  if (length(label) > 1) {
+    # Just in case the deparsed code is more complicated than we imagine. If we
+    # have a label with length > 1 it causes warnings in wrapFunctionLabel.
+    label <- paste0(label, collapse = "\n")
+  }
+  wrappedWithLabel <- isTRUE(wrappedWithLabel)
+  if (wrappedWithLabel) {
+    func <- wrapFunctionLabel(func, updateFunctionLabel(label), ..stacktraceon = ..stacktraceon, dots = FALSE)
+  }
+  assign(name, func, envir = assign.env)
+  if (!wrappedWithLabel) {
+    registerDebugHook(name, assign.env, label)
+  }
+
+  invisible(func)
+}
+
+# Utility function for creating a debugging label, given an expression.
+# `expr` is a quoted expression.
+# `function_name` is the name of the calling function.
+# `label` is an optional user-provided label. If NULL, it will be inferred.
+exprToLabel <- function(expr, function_name, label = NULL) {
+  srcref <- attr(expr, "srcref", exact = TRUE)
+  if (is.null(label)) {
+    label <- rexprSrcrefToLabel(
+      srcref[[1]],
+      simpleExprToFunction(expr, function_name)
+    )
+  }
+  if (length(srcref) >= 2) attr(label, "srcref") <- srcref[[2]]
+  attr(label, "srcfile") <- srcFileOfRef(srcref[[1]])
+  label
+}
+simpleExprToFunction <- function(expr, function_name) {
+  sprintf('%s(%s)', function_name, paste(deparse(expr), collapse='\n'))
+}
+
+installedFuncExpr <- function(func) {
+  fn_body(attr(func, "wrappedFunc", exact = TRUE))
+}
+
+funcToLabelBody <- function(func) {
+  paste(deparse(installedFuncExpr(func)), collapse='\n')
+}
+funcToLabel <- function(func, functionLabel, label = NULL) {
+  if (!is.null(label)) return(label)
+
+  sprintf(
+    '%s(%s)',
+    functionLabel,
+    funcToLabelBody(func)
+  )
+}
+quoToLabelBody <- function(q) {
+  paste(deparse(quo_get_expr(q)), collapse='\n')
+}
+quoToLabel <- function(q, functionLabel, label = NULL) {
+  if (!is.null(label)) return(label)
+
+  sprintf(
+    '%s(%s)',
+    functionLabel,
+    quoToLabelBody(q)
+  )
 }

R/utils.R

@@ -404,165 +404,6 @@ getContentType <- function(file, defaultType = 'application/octet-stream') {
   mime::guess_type(file, unknown = defaultType, subtype = subtype)
 }
 
-# Create a zero-arg function from a quoted expression and environment
-# @examples
-# makeFunction(body=quote(print(3)))
-makeFunction <- function(args = pairlist(), body, env = parent.frame()) {
-  eval(call("function", args, body), env)
-}
-
-#' Convert an expression to a function
-#'
-#' This is to be called from another function, because it will attempt to get
-#' an unquoted expression from two calls back. Note: as of Shiny 1.6.0, it is
-#' recommended to use [quoToFunction()] instead.
-#'
-#' If expr is a quoted expression, then this just converts it to a function.
-#' If expr is a function, then this simply returns expr (and prints a
-#'   deprecation message).
-#' If expr was a non-quoted expression from two calls back, then this will
-#'   quote the original expression and convert it to a function.
-#
-#' @param expr A quoted or unquoted expression, or a function.
-#' @param env The desired environment for the function. Defaults to the
-#'   calling environment two steps back.
-#' @param quoted Is the expression quoted?
-#'
-#' @examples
-#' # Example of a new renderer, similar to renderText
-#' # This is something that toolkit authors will do
-#' renderTriple <- function(expr, env=parent.frame(), quoted=FALSE) {
-#'   # Convert expr to a function
-#'   func <- shiny::exprToFunction(expr, env, quoted)
-#'
-#'   function() {
-#'     value <- func()
-#'     paste(rep(value, 3), collapse=", ")
-#'   }
-#' }
-#'
-#'
-#' # Example of using the renderer.
-#' # This is something that app authors will do.
-#' values <- reactiveValues(A="text")
-#'
-#' \dontrun{
-#' # Create an output object
-#' output$tripleA <- renderTriple({
-#'   values$A
-#' })
-#' }
-#'
-#' # At the R console, you can experiment with the renderer using isolate()
-#' tripleA <- renderTriple({
-#'   values$A
-#' })
-#'
-#' isolate(tripleA())
-#' # "text, text, text"
-#' @export
-exprToFunction <- function(expr, env=parent.frame(), quoted=FALSE) {
-  if (!quoted) {
-    expr <- eval(substitute(substitute(expr)), parent.frame())
-  }
-
-  # expr is a quoted expression
-  makeFunction(body=expr, env=env)
-}
-
-#' Install an expression as a function
-#'
-#' Installs an expression in the given environment as a function, and registers
-#' debug hooks so that breakpoints may be set in the function. Note: as of
-#' Shiny 1.6.0, it is recommended to use [quoToFunction()] instead.
-#'
-#' This function can replace `exprToFunction` as follows: we may use
-#' `func <- exprToFunction(expr)` if we do not want the debug hooks, or
-#' `installExprFunction(expr, "func")` if we do. Both approaches create a
-#' function named `func` in the current environment.
-#'
-#' @seealso Wraps [exprToFunction()]; see that method's documentation
-#'   for more documentation and examples.
-#'
-#' @param expr A quoted or unquoted expression
-#' @param name The name the function should be given
-#' @param eval.env The desired environment for the function. Defaults to the
-#'   calling environment two steps back.
-#' @param quoted Is the expression quoted?
-#' @param assign.env The environment in which the function should be assigned.
-#' @param label A label for the object to be shown in the debugger. Defaults to
-#'   the name of the calling function.
-#' @param wrappedWithLabel,..stacktraceon Advanced use only. For stack manipulation purposes; see
-#'   [stacktrace()].
-#' @export
-installExprFunction <- function(expr, name, eval.env = parent.frame(2),
-                                quoted = FALSE,
-                                assign.env = parent.frame(1),
-                                label = deparse(sys.call(-1)[[1]]),
-                                wrappedWithLabel = TRUE,
-                                ..stacktraceon = FALSE) {
-  if (!quoted) {
-    quoted <- TRUE
-    expr <- eval(substitute(substitute(expr)), parent.frame())
-  }
-
-  func <- exprToFunction(expr, eval.env, quoted)
-  if (length(label) > 1) {
-    # Just in case the deparsed code is more complicated than we imagine. If we
-    # have a label with length > 1 it causes warnings in wrapFunctionLabel.
-    label <- paste0(label, collapse = "\n")
-  }
-  if (wrappedWithLabel) {
-    func <- wrapFunctionLabel(func, label, ..stacktraceon = ..stacktraceon)
-  } else {
-    registerDebugHook(name, assign.env, label)
-  }
-  assign(name, func, envir = assign.env)
-}
-
-#' Convert a quosure to a function for a Shiny render function
-#'
-#' This takes a quosure and label, and wraps them into a function that should be
-#' passed to [createRenderFunction()] or [markRenderFunction()].
-#'
-#' This function was added in Shiny 1.6.0. Previously, it was recommended to use
-#' [installExprFunction()] or [exprToFunction()] in render functions, but now we
-#' recommend using [quoToFunction()], because it does not require `env` and
-#' `quoted` arguments -- that information is captured by quosures provided by
-#' \pkg{rlang}.
-#'
-#' @param q A quosure.
-#' @inheritParams installExprFunction
-#' @seealso [createRenderFunction()] for example usage.
-#'
-#' @export
-quoToFunction <- function(q, label, ..stacktraceon = FALSE) {
-  q <- as_quosure(q)
-  func <- as_function(q)
-  # as_function returns a function that takes `...`. We want one that takes no
-  # args.
-  formals(func) <- list()
-  wrapFunctionLabel(func, label, ..stacktraceon = ..stacktraceon)
-}
-
-
-# Utility function for creating a debugging label, given an expression.
-# `expr` is a quoted expression.
-# `function_name` is the name of the calling function.
-# `label` is an optional user-provided label. If NULL, it will be inferred.
-exprToLabel <- function(expr, function_name, label = NULL) {
-  srcref <- attr(expr, "srcref", exact = TRUE)
-  if (is.null(label)) {
-    label <- rexprSrcrefToLabel(
-      srcref[[1]],
-      sprintf('%s(%s)', function_name, paste(deparse(expr), collapse = '\n'))
-    )
-  }
-  if (length(srcref) >= 2) attr(label, "srcref") <- srcref[[2]]
-  attr(label, "srcfile") <- srcFileOfRef(srcref[[1]])
-  label
-}
-
 #' Parse a GET query string from a URL
 #'
 #' Returns a named list of key-value pairs.
@@ -1159,7 +1000,7 @@ reactiveStop <- function(message = "", class = NULL) {
 #'
 #' ui <- fluidPage(
 #'   checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)),
-#'   selectizeInput('in2', 'Select a state', choices = state.name),
+#'   selectizeInput('in2', 'Select a state', choices = c("", state.name)),
 #'   plotOutput('plot')
 #' )
 #'
@@ -1597,21 +1438,31 @@ dateYMD <- function(date = NULL, argName = "value") {
 # function which calls the original function using the specified name. This can
 # be helpful for profiling, because the specified name will show up on the stack
 # trace.
-wrapFunctionLabel <- function(func, name, ..stacktraceon = FALSE) {
+wrapFunctionLabel <- function(func, name, ..stacktraceon = FALSE, dots = TRUE) {
   if (name == "name" || name == "func" || name == "relabelWrapper") {
     stop("Invalid name for wrapFunctionLabel: ", name)
   }
   assign(name, func, environment())
   registerDebugHook(name, environment(), name)
 
-  if (..stacktraceon) {
-    # We need to wrap the `...` in `!!quote(...)` so that R CMD check won't
-    # complain about "... may be used in an incorrect context"
-    body <- expr({ ..stacktraceon..((!!name)(!!quote(...))) })
+  if (isTRUE(dots)) {
+    if (..stacktraceon) {
+      # We need to wrap the `...` in `!!quote(...)` so that R CMD check won't
+      # complain about "... may be used in an incorrect context"
+      body <- expr({ ..stacktraceon..((!!name)(!!quote(...))) })
+    } else {
+      body <- expr({ (!!name)(!!quote(...)) })
+    }
+    relabelWrapper <- new_function(pairlist2(... =), body, environment())
   } else {
-    body <- expr({ (!!name)(!!quote(...)) })
+    # Same logic as when `dots = TRUE`, but without the `...`
+    if (..stacktraceon) {
+      body <- expr({ ..stacktraceon..((!!name)()) })
+    } else {
+      body <- expr({ (!!name)() })
+    }
+    relabelWrapper <- new_function(list(), body, environment())
   }
-  relabelWrapper <- new_function(pairlist2(... =), body, environment())
 
   # Preserve the original function that was passed in; is used for caching.
   attr(relabelWrapper, "wrappedFunc") <- func

R/version_bs_date_picker.R

@@ -0,0 +1,2 @@
+# Generated by tools/updateBootstrapDatepicker.R; do not edit by hand
+version_bs_date_picker <- "1.9.0"

R/version_ion_range_slider.R

@@ -0,0 +1,2 @@
+# Generated by tools/updateIonRangeSlider.R; do not edit by hand
+version_ion_range_slider <- "2.3.1"

R/version_selectize.R

@@ -0,0 +1,2 @@
+# Generated by tools/updateSelectize.R; do not edit by hand
+version_selectize <- "0.12.4"

R/version_strftime.R

@@ -0,0 +1,2 @@
+# Generated by tools/updateStrftime.R; do not edit by hand
+version_strftime <- "0.9.2"

README.md

@@ -58,3 +58,7 @@ We welcome contributions to the **shiny** package. Please see our [CONTRIBUTING.
 ## License
 
 The shiny package as a whole is licensed under the GPLv3. See the [LICENSE](LICENSE) file for more details.
+
+## R version support
+
+Shiny is supported on the latest release version of R, as well as the previous four minor release versions of R. For example, if the latest release R version is 4.1, then that version is supported, as well as 4.0, 3.6, 3.5, and 3.4.

babel.config.json

@@ -5,7 +5,7 @@
       "@babel/preset-env",
       {
         "useBuiltIns": "usage",
-        "corejs": "3.9"
+        "corejs": "3.12"
       }
     ]
   ],

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

@@ -13,8 +13,13 @@
   -moz-user-select: none;
   -ms-user-select: none;
   user-select: none;
-  font-size: 12px;
-  font-family: Arial, sans-serif;
+  /* https://github.com/rstudio/shiny/issues/3443 */
+  /* https://css-tricks.com/inheriting-box-sizing-probably-slightly-better-best-practice/ */
+  box-sizing: border-box;
+}
+
+.irs *, .irs *:before, .irs *:after {
+  box-sizing: inherit;
 }
 
 .irs-line {
@@ -92,7 +97,6 @@
   left: 0;
   width: 1px;
   height: 8px;
-  background: #000;
 }
 
 .irs-grid-pol.small {
@@ -108,7 +112,6 @@
   font-size: 9px;
   line-height: 9px;
   padding: 0 3px;
-  color: #000;
 }
 
 .irs-disable-mask {
@@ -153,7 +156,7 @@
 }
 
 .irs {
-  font-family: Arial, sans-serif;
+  font-family: "Helvetica Neue", Helvetica, Arial, sans-serif;
 }
 
 .irs--shiny {
@@ -167,7 +170,7 @@
 .irs--shiny .irs-line {
   top: 25px;
   height: 8px;
-  background: linear-gradient(to bottom, #dedede -50%, white 150%);
+  background: linear-gradient(to bottom, #dedede -50%, #fff 150%);
   background-color: #ededed;
   border: 1px solid #cccccc;
   border-radius: 8px;
@@ -207,14 +210,13 @@
 }
 
 .irs--shiny .irs-handle.state_hover, .irs--shiny .irs-handle:hover {
-  background: white;
+  background: #fff;
 }
 
 .irs--shiny .irs-min,
 .irs--shiny .irs-max {
   top: 0;
   padding: 1px 3px;
-  color: #333333;
   text-shadow: none;
   background-color: rgba(0, 0, 0, 0.1);
   border-radius: 3px;
@@ -250,12 +252,11 @@
 }
 
 .irs--shiny .irs-grid-pol {
-  background-color: black;
+  background-color: #000;
 }
 
 .irs--shiny .irs-grid-text {
   bottom: 5px;
-  color: #1a1a1a;
 }
 
 .irs--shiny .irs-grid-pol.small {

inst/www/shared/ionrangeslider/scss/_base.scss

@@ -4,8 +4,12 @@
     @include pos-r();
     -webkit-touch-callout: none;
     @include no-click();
-    font-size: 12px;
-    font-family: Arial, sans-serif;
+    /* https://github.com/rstudio/shiny/issues/3443 */
+    /* https://css-tricks.com/inheriting-box-sizing-probably-slightly-better-best-practice/ */
+    box-sizing: border-box;
+    *, *:before, *:after {
+      box-sizing: inherit;
+    }
 
     &-line {
         @include pos-r();
@@ -83,7 +87,6 @@
             left: 0;
             width: 1px;
             height: 8px;
-            background: #000;
 
             &.small {
                 height: 4px;
@@ -99,7 +102,6 @@
             font-size: 9px;
             line-height: 9px;
             padding: 0 3px;
-            color: #000;
         }
     }
 

inst/www/shared/ionrangeslider/scss/shiny.scss

@@ -19,8 +19,7 @@
 
 ////////////////////////////////////////////////////////////////////////////
 
-// Re-define font-family on .irs to make it configurable
-$font-family: Arial, sans-serif !default;
+$font-family: $font-family-base !default;
 .irs {
   font-family: $font-family;
 }
@@ -36,8 +35,8 @@ $font-family: Arial, sans-serif !default;
   $custom_radius: 3px !default;
 
   // "High-level" coloring
-  $bg:     white !default;
-  $fg:     black !default;
+  $bg:     $body-bg !default;
+  $fg:     color-contrast($body-bg) !default;
   $accent: #428bca !default;
 
   // "Low-level" coloring, borders, and fonts
@@ -52,7 +51,7 @@ $font-family: Arial, sans-serif !default;
   $handle_border:      1px solid mix($bg, $fg, 67%) !default;
   $handle_box_shadow:  1px 1px 3px rgba($bg, 0.3) !default;
 
-  $minmax_text_color:  mix($bg, $fg, 20%) !default;
+  $minmax_text_color:  null !default;
   $minmax_bg_color:    rgba($fg, 0.1) !default;
   $minmax_font_size:   10px !default;
   $minmax_line_height: 1.333 !default;
@@ -64,7 +63,7 @@ $font-family: Arial, sans-serif !default;
 
   $grid_major_color:  $fg !default;
   $grid_minor_color:  mix($bg, $fg, 60%) !default;
-  $grid_text_color:   mix($bg, $fg, 10%) !default;
+  $grid_text_color:   null !default;
 
 
   height: 40px;

inst/www/shared/selectize/scss/selectize.bootstrap4.scss

@@ -13,7 +13,7 @@ $selectize-color-text: $input-color !default;
 $selectize-color-highlight: rgba(255,237,40,0.4) !default;
 $selectize-color-input: $input-bg !default;
 $selectize-color-input-full: $input-bg !default;
-$selectize-color-input-error: theme-color("danger") !default;
+$selectize-color-input-error: $danger !default;
 $selectize-color-input-error-focus: darken($selectize-color-input-error, 10%) !default;
 $selectize-color-disabled: $input-bg !default;
 $selectize-color-item: mix($selectize-color-input, $selectize-color-text, 90%) !default;

inst/www/shared/selectize/scss/selectize.bootstrap5.scss

@@ -0,0 +1,3 @@
+$input-line-height-sm: $form-select-line-height !default;
+@import 'selectize.bootstrap4';
+.selectize-control{padding:0;}

inst/www/shared/shiny-autoreload.js

@@ -1,17 +1,3 @@
-(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()
-    }
-  }
-})();
+/*! shiny 1.6.0.9022 | (c) 2012-2021 RStudio, PBC. | License: GPL-3 | file LICENSE */
+(function(){var t="ws:";window.location.protocol==="https:"&&(t="wss:");var o=window.location.pathname;/\/$/.test(o)||(o+="/");o+="autoreload/";var n=new WebSocket(t+"//"+window.location.host+o);n.onmessage=function(a){a.data==="autoreload"&&window.location.reload()};})();
+//# sourceMappingURL=data:application/json;base64,ewogICJ2ZXJzaW9uIjogMywKICAic291cmNlcyI6IFsiLi4vLi4vLi4vc3JjdHMvZXh0cmFzL3NoaW55LWF1dG9yZWxvYWQudHMiXSwKICAic291cmNlc0NvbnRlbnQiOiBbIi8qIGVzbGludC1kaXNhYmxlIHVuaWNvcm4vZmlsZW5hbWUtY2FzZSAqL1xudmFyIHByb3RvY29sID0gXCJ3czpcIjtcbmlmICh3aW5kb3cubG9jYXRpb24ucHJvdG9jb2wgPT09IFwiaHR0cHM6XCIpIHByb3RvY29sID0gXCJ3c3M6XCI7XG52YXIgZGVmYXVsdFBhdGggPSB3aW5kb3cubG9jYXRpb24ucGF0aG5hbWU7XG5pZiAoIS9cXC8kLy50ZXN0KGRlZmF1bHRQYXRoKSkgZGVmYXVsdFBhdGggKz0gXCIvXCI7XG5kZWZhdWx0UGF0aCArPSBcImF1dG9yZWxvYWQvXCI7XG52YXIgd3MgPSBuZXcgV2ViU29ja2V0KHByb3RvY29sICsgXCIvL1wiICsgd2luZG93LmxvY2F0aW9uLmhvc3QgKyBkZWZhdWx0UGF0aCk7XG5cbndzLm9ubWVzc2FnZSA9IGZ1bmN0aW9uIChldmVudCkge1xuICBpZiAoZXZlbnQuZGF0YSA9PT0gXCJhdXRvcmVsb2FkXCIpIHtcbiAgICB3aW5kb3cubG9jYXRpb24ucmVsb2FkKCk7XG4gIH1cbn07XG5cbmV4cG9ydCB7fTsiXSwKICAibWFwcGluZ3MiOiAiO1lBQ0EsR0FBSSxHQUFXLE1BQ2YsQUFBSSxPQUFPLFNBQVMsV0FBYSxVQUFVLEdBQVcsUUFDdEQsR0FBSSxHQUFjLE9BQU8sU0FBUyxTQUNsQyxBQUFLLE1BQU0sS0FBSyxJQUFjLElBQWUsS0FDN0MsR0FBZSxjQUNmLEdBQUksR0FBSyxHQUFJLFdBQVUsRUFBVyxLQUFPLE9BQU8sU0FBUyxLQUFPLEdBRWhFLEVBQUcsVUFBWSxTQUFVLEVBQU8sQ0FDOUIsQUFBSSxFQUFNLE9BQVMsY0FDakIsT0FBTyxTQUFTIiwKICAibmFtZXMiOiBbXQp9Cg==

inst/www/shared/shiny-showcase.css

@@ -1,87 +1,2 @@
-#showcase-well {
-  border-radius: 0;
-  -webkit-border-radius: 0;
-  -moz-border-radius: 0;
-}
-
-.shiny-code {
-  background-color: white;
-  margin-bottom: 0;
-}
-
-.shiny-code code {
-  font-family: Menlo, Consolas, "Courier New", monospace;
-}
-
-.shiny-code-container {
-  margin-top: 20px;
-  clear: both;
-}
-
-.shiny-code-container h3 {
-  display: inline;
-  margin-right: 15px;
-}
-
-.showcase-header {
-  font-size: 16px;
-  font-weight: normal;
-}
-
-.showcase-code-link {
-  text-align: right;
-  padding: 15px;
-}
-
-#showcase-app-container {
-  vertical-align: top;
-}
-
-#showcase-code-tabs pre {
-  border: none;
-  line-height: 1em;
-}
-
-#showcase-code-tabs .nav, 
-#showcase-code-tabs ul {
-  margin-bottom: 0px;
-}
-
-#showcase-app-code {
-  width: 100%;
-}
-
-#showcase-code-tabs {
-  margin-right: 15px;
-}
-
-#showcase-code-tabs .tab-content {
-  border-style: solid;
-  border-color: #e5e5e5;
-  border-width: 0px 1px 1px 1px;
-  overflow:auto;
-  -webkit-border-bottom-right-radius: 4px;
-  -webkit-border-bottom-left-radius: 4px;
-  -moz-border-radius-bottomright: 4px;
-  -moz-border-radius-bottomleft: 4px;
-  border-bottom-right-radius: 4px;
-  border-bottom-left-radius: 4px;
-}
-
-#showcase-code-position-toggle {
-  float: right;
-}
-
-#showcase-sxs-code {
-  padding-top: 20px;
-  vertical-align: top;
-}
-
-.showcase-code-license {
-  display: block;
-  text-align: right;
-}
-
-#showcase-code-content pre {
-  background-color: white;
-}
+/*! shiny 1.6.0.9022 | (c) 2012-2021 RStudio, PBC. | License: GPL-3 | file LICENSE */
+#showcase-well{border-radius:0}.shiny-code{background-color:#fff;margin-bottom:0}.shiny-code code{font-family:Menlo,Consolas,"Courier New",monospace}.shiny-code-container{margin-top:20px;clear:both}.shiny-code-container h3{display:inline;margin-right:15px}.showcase-header{font-size:16px;font-weight:normal}.showcase-code-link{text-align:right;padding:15px}#showcase-app-container{vertical-align:top}#showcase-code-tabs{margin-right:15px}#showcase-code-tabs pre{border:none;line-height:1em}#showcase-code-tabs .nav{margin-bottom:0}#showcase-code-tabs ul{margin-bottom:0}#showcase-code-tabs .tab-content{border-style:solid;border-color:#e5e5e5;border-width:0px 1px 1px 1px;overflow:auto;border-bottom-right-radius:4px;border-bottom-left-radius:4px}#showcase-app-code{width:100%}#showcase-code-position-toggle{float:right}#showcase-sxs-code{padding-top:20px;vertical-align:top}.showcase-code-license{display:block;text-align:right}#showcase-code-content pre{background-color:#fff}

inst/www/shared/shiny-testmode.js

@@ -1,8 +1,3 @@
-// Listen for messages from parent frame. This file is only added when the
-// shiny.testmode option is TRUE.
-window.addEventListener("message", function(e) {
-  var message = e.data;
-
-  if (message.code)
-    eval(message.code);
-});
+/*! shiny 1.6.0.9022 | (c) 2012-2021 RStudio, PBC. | License: GPL-3 | file LICENSE */
+(function(){var a=eval;window.addEventListener("message",function(i){var e=i.data;e.code&&a(e.code)});})();
+//# sourceMappingURL=data:application/json;base64,ewogICJ2ZXJzaW9uIjogMywKICAic291cmNlcyI6IFsiLi4vLi4vLi4vc3JjdHMvc3JjL3V0aWxzL2V2YWwudHMiLCAiLi4vLi4vLi4vc3JjdHMvZXh0cmFzL3NoaW55LXRlc3Rtb2RlLnRzIl0sCiAgInNvdXJjZXNDb250ZW50IjogWyIvL2VzYnVpbGQuZ2l0aHViLmlvL2NvbnRlbnQtdHlwZXMvI2RpcmVjdC1ldmFsXG4vL3RsL2RyO1xuLy8gKiBEaXJlY3QgdXNhZ2Ugb2YgYGV2YWwoXCJ4XCIpYCBpcyBiYWQgd2l0aCBidW5kbGVkIGNvZGUuXG4vLyAqIEluc3RlYWQsIHVzZSBpbmRpcmVjdCBjYWxscyB0byBgZXZhbGAgc3VjaCBhcyBgaW5kaXJlY3RFdmFsKFwieFwiKWBcbi8vICAgKiBFdmVuIGp1c3QgcmVuYW1pbmcgdGhlIGZ1bmN0aW9uIHdvcmtzIHdlbGwgZW5vdWdoLlxuLy8gPiBUaGlzIGlzIGtub3duIGFzIFwiaW5kaXJlY3QgZXZhbFwiIGJlY2F1c2UgZXZhbCBpcyBub3QgYmVpbmcgY2FsbGVkIGRpcmVjdGx5LCBhbmQgc28gZG9lcyBub3QgdHJpZ2dlciB0aGUgZ3JhbW1hdGljYWwgc3BlY2lhbCBjYXNlIGZvciBkaXJlY3QgZXZhbCBpbiB0aGUgSmF2YVNjcmlwdCBWTS4gWW91IGNhbiBjYWxsIGluZGlyZWN0IGV2YWwgdXNpbmcgYW55IHN5bnRheCBhdCBhbGwgZXhjZXB0IGZvciBhbiBleHByZXNzaW9uIG9mIHRoZSBleGFjdCBmb3JtIGV2YWwoJ3gnKS4gRm9yIGV4YW1wbGUsIHZhciBldmFsMiA9IGV2YWw7IGV2YWwyKCd4JykgYW5kIFtldmFsXVswXSgneCcpIGFuZCB3aW5kb3cuZXZhbCgneCcpIGFyZSBhbGwgaW5kaXJlY3QgZXZhbCBjYWxscy5cbi8vID4gV2hlbiB5b3UgdXNlIGluZGlyZWN0IGV2YWwsIHRoZSBjb2RlIGlzIGV2YWx1YXRlZCBpbiB0aGUgZ2xvYmFsIHNjb3BlIGluc3RlYWQgb2YgaW4gdGhlIGlubGluZSBzY29wZSBvZiB0aGUgY2FsbGVyLlxudmFyIGluZGlyZWN0RXZhbCA9IGV2YWw7XG5leHBvcnQgeyBpbmRpcmVjdEV2YWwgfTsiLCAiLyogZXNsaW50LWRpc2FibGUgdW5pY29ybi9maWxlbmFtZS1jYXNlICovXG5pbXBvcnQgeyBpbmRpcmVjdEV2YWwgfSBmcm9tIFwiLi4vc3JjL3V0aWxzL2V2YWxcIjsgLy8gTGlzdGVuIGZvciBtZXNzYWdlcyBmcm9tIHBhcmVudCBmcmFtZS4gVGhpcyBmaWxlIGlzIG9ubHkgYWRkZWQgd2hlbiB0aGVcbi8vIHNoaW55LnRlc3Rtb2RlIG9wdGlvbiBpcyBUUlVFLlxuXG53aW5kb3cuYWRkRXZlbnRMaXN0ZW5lcihcIm1lc3NhZ2VcIiwgZnVuY3Rpb24gKGUpIHtcbiAgdmFyIG1lc3NhZ2UgPSBlLmRhdGE7XG4gIGlmIChtZXNzYWdlLmNvZGUpIGluZGlyZWN0RXZhbChtZXNzYWdlLmNvZGUpO1xufSk7Il0sCiAgIm1hcHBpbmdzIjogIjtZQU9BLEdBQUksR0FBZSxLQ0huQixPQUFPLGlCQUFpQixVQUFXLFNBQVUsRUFBRyxDQUM5QyxHQUFJLEdBQVUsRUFBRSxLQUNoQixBQUFJLEVBQVEsTUFBTSxFQUFhLEVBQVEiLAogICJuYW1lcyI6IFtdCn0K

man-roxygen/param-env.R

@@ -0,0 +1,6 @@
+# Also update observeEvent param descriptions!
+# https://github.com/r-lib/roxygen2/issues/1241
+#' @param <%= env %> The parent environment for the reactive expression. By default,
+#'   this is the calling environment, the same as when defining an ordinary
+#'   non-reactive expression. If `<%= x %>` is a quosure and `<%= quoted %>` is `TRUE`,
+#'   then `<%= env %>` is ignored.

man-roxygen/param-quoted.R

@@ -0,0 +1,6 @@
+# Also update observeEvent param descriptions!
+# https://github.com/r-lib/roxygen2/issues/1241
+#' @param <%= quoted %> If it is `TRUE`, then the [`quote()`]ed value of `<%= x %>`
+#'   will be used when `<%= x %>` is evaluated. If `<%= x %>` is a quosure and you
+#'   would like to use its expression as a value for `<%= x %>`, then you must set
+#'  `<%= quoted %>` to `TRUE`.

man/bindCache.Rd

@@ -275,11 +275,11 @@ render function for cache collisions in a real application.
 In some cases, however, the automatic cache hint inference is not
 sufficient, and it is necessary to provide a cache hint. This is true
 for \code{renderPrint()}. Unlike \code{renderText()}, it wraps the user-provided
-expression in another function, before passing it to \code{\link[=markRenderFunction]{markRenderFunction()}}
+expression in another function, before passing it to \code{\link[=createRenderFunction]{createRenderFunction()}}
 (instead of \code{\link[=createRenderFunction]{createRenderFunction()}}). Because the user code is wrapped in
-another function, \code{markRenderFunction()} is not able to automatically
+another function, \code{createRenderFunction()} is not able to automatically
 extract the user-provided code and use it in the cache key. Instead,
-\code{renderPrint} calls \code{markRenderFunction()}, it explicitly passes along a
+\code{renderPrint} calls \code{createRenderFunction()}, it explicitly passes along a
 \code{cacheHint}, which includes a label and the original user expression.
 
 In general, if you need to provide a \code{cacheHint}, it is best practice to
@@ -290,19 +290,19 @@ For \pkg{htmlwidgets}, it will try to automatically infer a cache hint;
 again, you can inspect the cache hint with \code{shiny:::extractCacheHint()} and
 also test it in an application. If you do need to explicitly provide a
 cache hint, pass it to \code{shinyRenderWidget}. For example:\preformatted{renderMyWidget <- function(expr) \{
-  expr <- substitute(expr)
+  q <- rlang::enquo0(expr)
 
-  htmlwidgets::shinyRenderWidget(expr,
+  htmlwidgets::shinyRenderWidget(
+    q,
     myWidgetOutput,
     quoted = TRUE,
-    env = parent.frame(),
-    cacheHint = list(label = "myWidget", userExpr = expr)
+    cacheHint = list(label = "myWidget", userQuo = q)
   )
 \}
 }
 
 If your \code{render} function sets any internal state, you may find it useful
-in your call to \code{\link[=createRenderFunction]{createRenderFunction()}} or \code{\link[=markRenderFunction]{markRenderFunction()}} to use
+in your call to \code{\link[=createRenderFunction]{createRenderFunction()}} to use
 the \code{cacheWriteHook} and/or \code{cacheReadHook} parameters. These hooks are
 functions that run just before the object is stored in the cache, and just
 after the object is retrieved from the cache. They can modify the data
@@ -321,8 +321,8 @@ Some render functions cannot be cached, typically because they have side
 effects or modify some external state, and they must re-execute each time
 in order to work properly.
 
-For developers of such code, they should call \code{\link[=createRenderFunction]{createRenderFunction()}} or
-\code{\link[=markRenderFunction]{markRenderFunction()}} with \code{cacheHint = FALSE}.
+For developers of such code, they should call \code{\link[=createRenderFunction]{createRenderFunction()}} (or
+\code{\link[=markRenderFunction]{markRenderFunction()}}) with \code{cacheHint = FALSE}.
 }
 
 \section{Caching with \code{renderPlot()}}{

man/clickOpts.Rd

@@ -49,4 +49,3 @@ These functions give control over the \code{click}, \code{dblClick} and
 \seealso{
 \code{\link[=brushOpts]{brushOpts()}} for brushing events.
 }
-\keyword{internal}

man/createRenderFunction.Rd

@@ -1,8 +1,10 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/shinywrappers.R
+% Please edit documentation in R/shinywrappers.R, R/utils-lang.R
 \name{createRenderFunction}
 \alias{createRenderFunction}
-\title{Implement render functions}
+\alias{quoToFunction}
+\alias{installExprFunction}
+\title{Implement custom render functions}
 \usage{
 createRenderFunction(
   func,
@@ -13,6 +15,19 @@ createRenderFunction(
   cacheWriteHook = NULL,
   cacheReadHook = NULL
 )
+
+quoToFunction(q, label = sys.call(-1)[[1]], ..stacktraceon = FALSE)
+
+installExprFunction(
+  expr,
+  name,
+  eval.env = parent.frame(2),
+  quoted = FALSE,
+  assign.env = parent.frame(1),
+  label = sys.call(-1)[[1]],
+  wrappedWithLabel = TRUE,
+  ..stacktraceon = FALSE
+)
 }
 \arguments{
 \item{func}{A function without parameters, that returns user data. If the
@@ -55,23 +70,85 @@ argument, the value retrieved from the cache. This can be useful when some
 side effect needs to occur for a render function to behave correctly. For
 example, some render functions call \code{\link[=createWebDependency]{createWebDependency()}} so that Shiny
 is able to serve JS and CSS resources.}
+
+\item{q}{Quosure of the expression \code{x}. When capturing expressions to create
+your quosure, it is recommended to use \code{\link[=enquo0]{enquo0()}} to not unquote the
+object too early. See \code{\link[=enquo0]{enquo0()}} for more details.}
+
+\item{label}{A label for the object to be shown in the debugger. Defaults to
+the name of the calling function.}
+
+\item{expr}{A quoted or unquoted expression, or a quosure.}
+
+\item{name}{The name the function should be given}
+
+\item{eval.env}{The desired environment for the function. Defaults to the
+calling environment two steps back.}
+
+\item{quoted}{Is the expression quoted?}
+
+\item{assign.env}{The environment in which the function should be assigned.}
+
+\item{wrappedWithLabel, ..stacktraceon}{Advanced use only. For stack manipulation purposes; see
+\code{\link[=stacktrace]{stacktrace()}}.}
 }
 \value{
 An annotated render function, ready to be assigned to an
 \code{output} slot.
 }
 \description{
-This function is a wrapper for \code{\link[=markRenderFunction]{markRenderFunction()}} which provides support
-for async computation via promises.
+Developer-facing utilities for implementing a custom \code{renderXXX()} function.
+Before using these utilities directly, consider using the \href{http://www.htmlwidgets.org/develop_intro.html}{\code{htmlwidgets} package} to implement custom
+outputs (i.e., custom \code{renderXXX()}/\code{xxxOutput()} functions). That said,
+these utilities can be used more directly if a full-blown htmlwidget isn't
+needed and/or the user-supplied reactive expression needs to be wrapped in
+additional call(s).
 }
+\details{
+To implement a custom \code{renderXXX()} function, essentially 2 things are needed:
+\enumerate{
+\item Capture the user's reactive expression as a function.
+\itemize{
+\item New \code{renderXXX()} functions can use \code{quoToFunction()} for this, but
+already existing \code{renderXXX()} functions that contain \code{env} and \code{quoted}
+parameters may want to continue using \code{installExprFunction()} for better
+legacy support (see examples).
+}
+\item Flag the resulting function (from 1) as a Shiny rendering function and
+also provide a UI container for displaying the result of the rendering
+function.
+\itemize{
+\item \code{createRenderFunction()} is currently recommended (instead of
+\code{\link[=markRenderFunction]{markRenderFunction()}}) for this step (see examples).
+}
+}
+}
+\section{Functions}{
+\itemize{
+\item \code{quoToFunction}: convert a quosure to a function.
+
+\item \code{installExprFunction}: converts a user's reactive \code{expr} into a
+function that's assigned to a \code{name} in the \code{assign.env}.
+}}
+
 \examples{
-# A very simple render function
-renderTriple <- function(x) {
-  x <- substitute(x)
-  if (!rlang::is_quosure(x)) {
-    x <- rlang::new_quosure(x, env = parent.frame())
-  }
-  func <- quoToFunction(x, "renderTriple")
+# A custom render function that repeats the supplied value 3 times
+renderTriple <- function(expr) {
+  # Wrap user-supplied reactive expression into a function
+  func <- quoToFunction(rlang::enquo0(expr))
+
+  createRenderFunction(
+    func,
+    transform = function(value, session, name, ...) {
+      paste(rep(value, 3), collapse=", ")
+    },
+    outputFunc = textOutput
+  )
+}
+
+# For better legacy support, consider using installExprFunction() over quoToFunction()
+renderTripleLegacy <- function(expr, env = parent.frame(), quoted = FALSE) {
+  func <- installExprFunction(expr, "func", env, quoted)
 
   createRenderFunction(
     func,
@@ -83,11 +160,36 @@ renderTriple <- function(x) {
 }
 
 # Test render function from the console
-a <- 1
-r <- renderTriple({ a + 1 })
-a <- 2
+reactiveConsole(TRUE)
+
+v <- reactiveVal("basic")
+r <- renderTriple({ v() })
 r()
-}
-\seealso{
-\code{\link[=quoToFunction]{quoToFunction()}}, \code{\link[=markRenderFunction]{markRenderFunction()}}.
+#> [1] "basic, basic, basic"
+
+# User can supply quoted code via rlang::quo(). Note that evaluation of the
+# expression happens when r2() is invoked, not when r2 is created.
+q <- rlang::quo({ v() })
+r2 <- rlang::inject(renderTriple(!!q))
+v("rlang")
+r2()
+#> [1] "rlang, rlang, rlang"
+
+# Supplying quoted code without rlang::quo() requires installExprFunction()
+expr <- quote({ v() })
+r3 <- renderTripleLegacy(expr, quoted = TRUE)
+v("legacy")
+r3()
+#> [1] "legacy, legacy, legacy"
+
+# The legacy approach also supports with quosures (env is ignored in this case)
+q <- rlang::quo({ v() })
+r4 <- renderTripleLegacy(q, quoted = TRUE)
+v("legacy-rlang")
+r4()
+#> [1] "legacy-rlang, legacy-rlang, legacy-rlang"
+
+# Turn off reactivity in the console
+reactiveConsole(FALSE)
+
 }

man/exprToFunction.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/utils.R
+% Please edit documentation in R/utils-lang.R
 \name{exprToFunction}
 \alias{exprToFunction}
 \title{Convert an expression to a function}
@@ -7,7 +7,7 @@
 exprToFunction(expr, env = parent.frame(), quoted = FALSE)
 }
 \arguments{
-\item{expr}{A quoted or unquoted expression, or a function.}
+\item{expr}{A quoted or unquoted expression, or a quosure.}
 
 \item{env}{The desired environment for the function. Defaults to the
 calling environment two steps back.}
@@ -15,47 +15,14 @@ calling environment two steps back.}
 \item{quoted}{Is the expression quoted?}
 }
 \description{
-This is to be called from another function, because it will attempt to get
-an unquoted expression from two calls back. Note: as of Shiny 1.6.0, it is
-recommended to use \code{\link[=quoToFunction]{quoToFunction()}} instead.
+\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} Please use \code{\link[=installExprFunction]{installExprFunction()}} for a better
+debugging experience (Shiny 0.8.0). If the \code{expr} and \code{quoted} parameters are not needed, please see
+\code{\link[=quoToFunction]{quoToFunction()}} (Shiny 1.6.0).
 }
 \details{
-If expr is a quoted expression, then this just converts it to a function.
-If expr is a function, then this simply returns expr (and prints a
-deprecation message).
-If expr was a non-quoted expression from two calls back, then this will
-quote the original expression and convert it to a function.
+Similar to \code{\link[=installExprFunction]{installExprFunction()}} but doesn't register debug hooks.
 }
-\examples{
-# Example of a new renderer, similar to renderText
-# This is something that toolkit authors will do
-renderTriple <- function(expr, env=parent.frame(), quoted=FALSE) {
-  # Convert expr to a function
-  func <- shiny::exprToFunction(expr, env, quoted)
-
-  function() {
-    value <- func()
-    paste(rep(value, 3), collapse=", ")
-  }
-}
-
-
-# Example of using the renderer.
-# This is something that app authors will do.
-values <- reactiveValues(A="text")
-
-\dontrun{
-# Create an output object
-output$tripleA <- renderTriple({
-  values$A
-})
-}
-
-# At the R console, you can experiment with the renderer using isolate()
-tripleA <- renderTriple({
-  values$A
-})
-
-isolate(tripleA())
-# "text, text, text"
+\seealso{
+\code{\link[=installExprFunction]{installExprFunction()}} for the modern approach to converting an expression to a function
 }
+\keyword{internal}

man/insertTab.Rd

@@ -10,8 +10,8 @@
 insertTab(
   inputId,
   tab,
-  target,
-  position = c("before", "after"),
+  target = NULL,
+  position = c("after", "before"),
   select = FALSE,
   session = getDefaultReactiveDomain()
 )

man/installExprFunction.Rd

@@ -1,50 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/utils.R
-\name{installExprFunction}
-\alias{installExprFunction}
-\title{Install an expression as a function}
-\usage{
-installExprFunction(
-  expr,
-  name,
-  eval.env = parent.frame(2),
-  quoted = FALSE,
-  assign.env = parent.frame(1),
-  label = deparse(sys.call(-1)[[1]]),
-  wrappedWithLabel = TRUE,
-  ..stacktraceon = FALSE
-)
-}
-\arguments{
-\item{expr}{A quoted or unquoted expression}
-
-\item{name}{The name the function should be given}
-
-\item{eval.env}{The desired environment for the function. Defaults to the
-calling environment two steps back.}
-
-\item{quoted}{Is the expression quoted?}
-
-\item{assign.env}{The environment in which the function should be assigned.}
-
-\item{label}{A label for the object to be shown in the debugger. Defaults to
-the name of the calling function.}
-
-\item{wrappedWithLabel, ..stacktraceon}{Advanced use only. For stack manipulation purposes; see
-\code{\link[=stacktrace]{stacktrace()}}.}
-}
-\description{
-Installs an expression in the given environment as a function, and registers
-debug hooks so that breakpoints may be set in the function. Note: as of
-Shiny 1.6.0, it is recommended to use \code{\link[=quoToFunction]{quoToFunction()}} instead.
-}
-\details{
-This function can replace \code{exprToFunction} as follows: we may use
-\code{func <- exprToFunction(expr)} if we do not want the debug hooks, or
-\code{installExprFunction(expr, "func")} if we do. Both approaches create a
-function named \code{func} in the current environment.
-}
-\seealso{
-Wraps \code{\link[=exprToFunction]{exprToFunction()}}; see that method's documentation
-for more documentation and examples.
-}

man/knitr_methods.Rd

@@ -24,3 +24,4 @@ knit_print.reactive(x, ..., inline = FALSE)
 These S3 methods are necessary to help Shiny applications and UI chunks embed
 themselves in knitr/rmarkdown documents.
 }
+\keyword{internal}

man/markRenderFunction.Rd

@@ -51,12 +51,24 @@ is able to serve JS and CSS resources.}
 The \code{renderFunc} function, with annotations.
 }
 \description{
+\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} Please use \code{\link[=createRenderFunction]{createRenderFunction()}} to
+support async execution. (Shiny 1.1.0)
+}
+\details{
 Should be called by implementers of \code{renderXXX} functions in order to mark
 their return values as Shiny render functions, and to provide a hint to Shiny
 regarding what UI function is most commonly used with this type of render
 function. This can be used in R Markdown documents to create complete output
 widgets out of just the render function.
+
+Note that it is generally preferable to use \code{\link[=createRenderFunction]{createRenderFunction()}} instead
+of \code{markRenderFunction()}. It essentially wraps up the user-provided
+expression in the \code{transform} function passed to it, then passes the resulting
+function to \code{markRenderFunction()}. It also provides a simpler calling
+interface. There may be cases where \code{markRenderFunction()} must be used instead of
+\code{\link[=createRenderFunction]{createRenderFunction()}} -- for example, when the \code{transform} parameter of
+\code{\link[=createRenderFunction]{createRenderFunction()}} is not flexible enough for your needs.
 }
 \seealso{
-\code{\link[=createRenderFunction]{createRenderFunction()}}, \code{\link[=quoToFunction]{quoToFunction()}}
+\code{\link[=createRenderFunction]{createRenderFunction()}}
 }

man/modalDialog.Rd

@@ -9,7 +9,7 @@ modalDialog(
   ...,
   title = NULL,
   footer = modalButton("Dismiss"),
-  size = c("m", "s", "l"),
+  size = c("m", "s", "l", "xl"),
   easyClose = FALSE,
   fade = TRUE
 )

man/navbarPage.Rd

@@ -17,7 +17,7 @@ navbarPage(
   collapsible = FALSE,
   fluid = TRUE,
   theme = NULL,
-  windowTitle = title,
+  windowTitle = NA,
   lang = NULL
 )
 
@@ -73,8 +73,10 @@ build of Bootstrap 3 with a customized version of Bootstrap 3 or higher.
 (normally a css file within the www directory, e.g. \code{www/bootstrap.css}).
 }}
 
-\item{windowTitle}{The title that should be displayed by the browser window.
-Useful if \code{title} is not a string.}
+\item{windowTitle}{the browser window title (as a character string). The
+default value, \code{NA}, means to use any character strings that appear in
+\code{title} (if none are found, the host URL of the page is displayed by
+default).}
 
 \item{lang}{ISO 639-1 language code for the HTML page, such as "en" or "ko".
 This will be used as the lang in the \code{<html>} tag, as in \code{<html lang="en">}.

man/observe.Rd

@@ -23,11 +23,13 @@ ignored.}
 
 \item{env}{The parent environment for the reactive expression. By default,
 this is the calling environment, the same as when defining an ordinary
-non-reactive expression.}
+non-reactive expression. If \code{x} is a quosure and \code{quoted} is \code{TRUE},
+then \code{env} is ignored.}
 
-\item{quoted}{Is the expression quoted? By default, this is \code{FALSE}.
-This is useful when you want to use an expression that is stored in a
-variable; to do so, it must be quoted with \code{quote()}.}
+\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{x}
+will be used when \code{x} is evaluated. If \code{x} is a quosure and you
+would like to use its expression as a value for \code{x}, then you must set
+\code{quoted} to \code{TRUE}.}
 
 \item{...}{Not used.}
 
@@ -116,12 +118,12 @@ obsB <- observe({
   print(values$A + 1)
 })
 
-# Can use quoted expressions
-obsC <- observe(quote({ print(values$A + 2) }), quoted = TRUE)
+# To store expressions for later conversion to observe, use rlang::quo()
+myquo <- rlang::quo({ print(values$A + 3) })
+obsC <- rlang::inject(observe(!!myquo))
 
-# To store expressions for later conversion to observe, use quote()
-expr_q <- quote({ print(values$A + 3) })
-obsD <- observe(expr_q, quoted = TRUE)
+# (Legacy) Can use quoted expressions
+obsD <- observe(quote({ print(values$A + 2) }), quoted = TRUE)
 
 # In a normal Shiny app, the web client will trigger flush events. If you
 # are at the console, you can force a flush with flushReact()

man/observeEvent.Rd

@@ -48,21 +48,25 @@ invalidated. This should be a side-effect-producing action (the return
 value will be ignored). It will be executed within an \code{\link[=isolate]{isolate()}}
 scope.}
 
-\item{event.env}{The parent environment for \code{eventExpr}. By default,
-this is the calling environment.}
+\item{event.env}{The parent environment for the reactive expression. By default,
+this is the calling environment, the same as when defining an ordinary
+non-reactive expression. If \code{eventExpr} is a quosure and \code{event.quoted} is \code{TRUE},
+then \code{event.env} is ignored.}
 
-\item{event.quoted}{Is the \code{eventExpr} expression quoted? By default,
-this is \code{FALSE}. This is useful when you want to use an expression
-that is stored in a variable; to do so, it must be quoted with
-\code{quote()}.}
+\item{event.quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{eventExpr}
+will be used when \code{eventExpr} is evaluated. If \code{eventExpr} is a quosure and you
+would like to use its expression as a value for \code{eventExpr}, then you must set
+\code{event.quoted} to \code{TRUE}.}
 
-\item{handler.env}{The parent environment for \code{handlerExpr}. By default,
-this is the calling environment.}
+\item{handler.env}{The parent environment for the reactive expression. By default,
+this is the calling environment, the same as when defining an ordinary
+non-reactive expression. If \code{handlerExpr} is a quosure and \code{handler.quoted} is \code{TRUE},
+then \code{handler.env} is ignored.}
 
-\item{handler.quoted}{Is the \code{handlerExpr} expression quoted? By
-default, this is \code{FALSE}. This is useful when you want to use an
-expression that is stored in a variable; to do so, it must be quoted with
-\code{quote()}.}
+\item{handler.quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{handlerExpr}
+will be used when \code{handlerExpr} is evaluated. If \code{handlerExpr} is a quosure and you
+would like to use its expression as a value for \code{handlerExpr}, then you must set
+\code{handler.quoted} to \code{TRUE}.}
 
 \item{...}{Currently not used.}
 
@@ -99,12 +103,15 @@ happen once.}
 \code{eventReactive}. It will be executed within an \code{\link[=isolate]{isolate()}}
 scope.}
 
-\item{value.env}{The parent environment for \code{valueExpr}. By default,
-this is the calling environment.}
+\item{value.env}{The parent environment for the reactive expression. By default,
+this is the calling environment, the same as when defining an ordinary
+non-reactive expression. If \code{valueExpr} is a quosure and \code{value.quoted} is \code{TRUE},
+then \code{value.env} is ignored.}
 
-\item{value.quoted}{Is the \code{valueExpr} expression quoted? By default,
-this is \code{FALSE}. This is useful when you want to use an expression
-that is stored in a variable; to do so, it must be quoted with \code{quote()}.}
+\item{value.quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{valueExpr}
+will be used when \code{valueExpr} is evaluated. If \code{valueExpr} is a quosure and you
+would like to use its expression as a value for \code{valueExpr}, then you must set
+\code{value.quoted} to \code{TRUE}.}
 }
 \value{
 \code{observeEvent} returns an observer reference class object (see

man/quoToFunction.Rd

@@ -1,31 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/utils.R
-\name{quoToFunction}
-\alias{quoToFunction}
-\title{Convert a quosure to a function for a Shiny render function}
-\usage{
-quoToFunction(q, label, ..stacktraceon = FALSE)
-}
-\arguments{
-\item{q}{A quosure.}
-
-\item{label}{A label for the object to be shown in the debugger. Defaults to
-the name of the calling function.}
-
-\item{..stacktraceon}{Advanced use only. For stack manipulation purposes; see
-\code{\link[=stacktrace]{stacktrace()}}.}
-}
-\description{
-This takes a quosure and label, and wraps them into a function that should be
-passed to \code{\link[=createRenderFunction]{createRenderFunction()}} or \code{\link[=markRenderFunction]{markRenderFunction()}}.
-}
-\details{
-This function was added in Shiny 1.6.0. Previously, it was recommended to use
-\code{\link[=installExprFunction]{installExprFunction()}} or \code{\link[=exprToFunction]{exprToFunction()}} in render functions, but now we
-recommend using \code{\link[=quoToFunction]{quoToFunction()}}, because it does not require \code{env} and
-\code{quoted} arguments -- that information is captured by quosures provided by
-\pkg{rlang}.
-}
-\seealso{
-\code{\link[=createRenderFunction]{createRenderFunction()}} for example usage.
-}

man/reactive.Rd

@@ -18,16 +18,17 @@ reactive(
 is.reactive(x)
 }
 \arguments{
-\item{x}{For \code{reactive}, an expression (quoted or unquoted). For
-\code{is.reactive}, an object to test.}
+\item{x}{For \code{is.reactive()}, an object to test. For \code{reactive()}, an expression. When passing in a \code{\link[=quo]{quo()}}sure with \code{reactive()}, remember to use \code{\link[rlang:inject]{rlang::inject()}} to distinguish that you are passing in the content of your quosure, not the expression of the quosure.}
 
 \item{env}{The parent environment for the reactive expression. By default,
 this is the calling environment, the same as when defining an ordinary
-non-reactive expression.}
+non-reactive expression. If \code{x} is a quosure and \code{quoted} is \code{TRUE},
+then \code{env} is ignored.}
 
-\item{quoted}{Is the expression quoted? By default, this is \code{FALSE}.
-This is useful when you want to use an expression that is stored in a
-variable; to do so, it must be quoted with \code{quote()}.}
+\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{x}
+will be used when \code{x} is evaluated. If \code{x} is a quosure and you
+would like to use its expression as a value for \code{x}, then you must set
+\code{quoted} to \code{TRUE}.}
 
 \item{...}{Not used.}
 
@@ -58,21 +59,32 @@ See the \href{https://shiny.rstudio.com/tutorial/}{Shiny tutorial} for
 more information about reactive expressions.
 }
 \examples{
+library(rlang)
 values <- reactiveValues(A=1)
 
 reactiveB <- reactive({
   values$A + 1
 })
-
-# Can use quoted expressions
-reactiveC <- reactive(quote({ values$A + 2 }), quoted = TRUE)
-
-# To store expressions for later conversion to reactive, use quote()
-expr_q <- quote({ values$A + 3 })
-reactiveD <- reactive(expr_q, quoted = TRUE)
-
 # View the values from the R console with isolate()
 isolate(reactiveB())
+# 2
+
+# To store expressions for later conversion to reactive, use quote()
+myquo <- rlang::quo(values$A + 2)
+# Unexpected value! Sending a quosure directly will not work as expected.
+reactiveC <- reactive(myquo)
+# We'd hope for `3`, but instead we get the quosure that was supplied.
 isolate(reactiveC())
+
+# Instead, the quosure should be `rlang::inject()`ed
+reactiveD <- rlang::inject(reactive(!!myquo))
 isolate(reactiveD())
+# 3
+
+# (Legacy) Can use quoted expressions
+expr <- quote({ values$A + 3 })
+reactiveE <- reactive(expr, quoted = TRUE)
+isolate(reactiveE())
+# 4
+
 }

man/registerInputHandler.Rd

@@ -58,5 +58,5 @@ getType: function(el) {
 }
 }
 \seealso{
-\code{\link[=removeInputHandler]{removeInputHandler()}}
+\code{\link[=removeInputHandler]{removeInputHandler()}} \code{\link[=applyInputHandlers]{applyInputHandlers()}}
 }

man/renderCachedPlot.Rd

@@ -40,12 +40,14 @@ information on the default sizing policy.}
 \item{...}{Arguments to be passed through to \code{\link[grDevices:png]{grDevices::png()}}.
 These can be used to set the width, height, background color, etc.}
 
-\item{alt}{Alternate text for the HTML \verb{<img>} tag
-if it cannot be displayed or viewed (i.e., the user uses a screen reader).
-In addition to a character string, the value may be a reactive expression
-(or a function referencing reactive values) that returns a character string.
-NULL or "" is not recommended because those should be limited to decorative images
-(the default is "Plot object").}
+\item{alt}{Alternate text for the HTML \verb{<img>} tag if it cannot be displayed
+or viewed (i.e., the user uses a screen reader). In addition to a character
+string, the value may be a reactive expression (or a function referencing
+reactive values) that returns a character string. If the value is \code{NA} (the
+default), then \code{ggplot2::get_alt_text()} is used to extract alt text from
+ggplot objects; for other plots, \code{NA} results in alt text of "Plot object".
+\code{NULL} or \code{""} is not recommended because those should be limited to
+decorative images.}
 
 \item{outputArgs}{A list of arguments to be passed through to the implicit
 call to \code{\link[=plotOutput]{plotOutput()}} when \code{renderPlot} is used in an

man/renderDataTable.Rd

@@ -48,16 +48,23 @@ indicate which columns to escape, e.g. \code{1:5} (the first 5 columns),
 \code{c(1, 3, 4)}, or \code{c(-1, -3)} (all columns except the first and
 third), or \code{c('Species', 'Sepal.Length')}.}
 
-\item{env}{The environment in which to evaluate \code{expr}.}
+\item{env}{The parent environment for the reactive expression. By default,
+this is the calling environment, the same as when defining an ordinary
+non-reactive expression. If \code{expr} is a quosure and \code{quoted} is \code{TRUE},
+then \code{env} is ignored.}
 
-\item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})?
-This is useful if you want to save an expression in a variable.}
+\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{expr}
+will be used when \code{expr} is evaluated. If \code{expr} is a quosure and you
+would like to use its expression as a value for \code{expr}, then you must set
+\code{quoted} to \code{TRUE}.}
 
 \item{outputArgs}{A list of arguments to be passed through to the implicit
 call to \code{dataTableOutput()} when \code{renderDataTable()} is used
 in an interactive R Markdown document.}
 }
 \description{
+\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} Please use \code{\link[DT:renderDataTable]{DT::renderDataTable()}}. (Shiny 0.11.1)
+
 Makes a reactive version of the given function that returns a data frame (or
 matrix), which will be rendered with the \href{https://datatables.net}{DataTables}
 library. Paging, searching, filtering, and sorting can be done on the R side

man/renderImage.Rd

@@ -15,10 +15,15 @@ renderImage(
 \arguments{
 \item{expr}{An expression that returns a list.}
 
-\item{env}{The environment in which to evaluate \code{expr}.}
+\item{env}{The parent environment for the reactive expression. By default,
+this is the calling environment, the same as when defining an ordinary
+non-reactive expression. If \code{expr} is a quosure and \code{quoted} is \code{TRUE},
+then \code{env} is ignored.}
 
-\item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})? This
-is useful if you want to save an expression in a variable.}
+\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{expr}
+will be used when \code{expr} is evaluated. If \code{expr} is a quosure and you
+would like to use its expression as a value for \code{expr}, then you must set
+\code{quoted} to \code{TRUE}.}
 
 \item{deleteFile}{Should the file in \code{func()$src} be deleted after
 it is sent to the client browser? Generally speaking, if the image is a

man/renderPlot.Rd

@@ -10,7 +10,7 @@ renderPlot(
   height = "auto",
   res = 72,
   ...,
-  alt = "Plot object",
+  alt = NA,
   env = parent.frame(),
   quoted = FALSE,
   execOnResize = FALSE,
@@ -41,17 +41,24 @@ rendering in R; it won't change the actual ppi of the browser.}
 \item{...}{Arguments to be passed through to \code{\link[grDevices:png]{grDevices::png()}}.
 These can be used to set the width, height, background color, etc.}
 
-\item{alt}{Alternate text for the HTML \verb{<img>} tag
-if it cannot be displayed or viewed (i.e., the user uses a screen reader).
-In addition to a character string, the value may be a reactive expression
-(or a function referencing reactive values) that returns a character string.
-NULL or "" is not recommended because those should be limited to decorative images
-(the default is "Plot object").}
+\item{alt}{Alternate text for the HTML \verb{<img>} tag if it cannot be displayed
+or viewed (i.e., the user uses a screen reader). In addition to a character
+string, the value may be a reactive expression (or a function referencing
+reactive values) that returns a character string. If the value is \code{NA} (the
+default), then \code{ggplot2::get_alt_text()} is used to extract alt text from
+ggplot objects; for other plots, \code{NA} results in alt text of "Plot object".
+\code{NULL} or \code{""} is not recommended because those should be limited to
+decorative images.}
 
-\item{env}{The environment in which to evaluate \code{expr}.}
+\item{env}{The parent environment for the reactive expression. By default,
+this is the calling environment, the same as when defining an ordinary
+non-reactive expression. If \code{expr} is a quosure and \code{quoted} is \code{TRUE},
+then \code{env} is ignored.}
 
-\item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})? This
-is useful if you want to save an expression in a variable.}
+\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{expr}
+will be used when \code{expr} is evaluated. If \code{expr} is a quosure and you
+would like to use its expression as a value for \code{expr}, then you must set
+\code{quoted} to \code{TRUE}.}
 
 \item{execOnResize}{If \code{FALSE} (the default), then when a plot is
 resized, Shiny will \emph{replay} the plot drawing commands with

man/renderPrint.Rd

@@ -24,10 +24,15 @@ renderText(
 \arguments{
 \item{expr}{An expression to evaluate.}
 
-\item{env}{The environment in which to evaluate \code{expr}. For expert use only.}
+\item{env}{The parent environment for the reactive expression. By default,
+this is the calling environment, the same as when defining an ordinary
+non-reactive expression. If \code{expr} is a quosure and \code{quoted} is \code{TRUE},
+then \code{env} is ignored.}
 
-\item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})? This
-is useful if you want to save an expression in a variable.}
+\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{expr}
+will be used when \code{expr} is evaluated. If \code{expr} is a quosure and you
+would like to use its expression as a value for \code{expr}, then you must set
+\code{quoted} to \code{TRUE}.}
 
 \item{width}{Width of printed output.}
 

man/renderTable.Rd

@@ -71,10 +71,15 @@ columns will be displayed in scientific format with a precision of
 \item{...}{Arguments to be passed through to \code{\link[xtable:xtable]{xtable::xtable()}}
 and \code{\link[xtable:print.xtable]{xtable::print.xtable()}}.}
 
-\item{env}{The environment in which to evaluate \code{expr}.}
+\item{env}{The parent environment for the reactive expression. By default,
+this is the calling environment, the same as when defining an ordinary
+non-reactive expression. If \code{expr} is a quosure and \code{quoted} is \code{TRUE},
+then \code{env} is ignored.}
 
-\item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})?
-This is useful if you want to save an expression in a variable.}
+\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{expr}
+will be used when \code{expr} is evaluated. If \code{expr} is a quosure and you
+would like to use its expression as a value for \code{expr}, then you must set
+\code{quoted} to \code{TRUE}.}
 
 \item{outputArgs}{A list of arguments to be passed through to the
 implicit call to \code{\link[=tableOutput]{tableOutput()}} when \code{renderTable} is

man/renderUI.Rd

@@ -10,10 +10,15 @@ renderUI(expr, env = parent.frame(), quoted = FALSE, outputArgs = list())
 \item{expr}{An expression that returns a Shiny tag object, \code{\link[=HTML]{HTML()}},
 or a list of such objects.}
 
-\item{env}{The environment in which to evaluate \code{expr}.}
+\item{env}{The parent environment for the reactive expression. By default,
+this is the calling environment, the same as when defining an ordinary
+non-reactive expression. If \code{expr} is a quosure and \code{quoted} is \code{TRUE},
+then \code{env} is ignored.}
 
-\item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})? This
-is useful if you want to save an expression in a variable.}
+\item{quoted}{If it is \code{TRUE}, then the \code{\link[=quote]{quote()}}ed value of \code{expr}
+will be used when \code{expr} is evaluated. If \code{expr} is a quosure and you
+would like to use its expression as a value for \code{expr}, then you must set
+\code{quoted} to \code{TRUE}.}
 
 \item{outputArgs}{A list of arguments to be passed through to the implicit
 call to \code{\link[=uiOutput]{uiOutput()}} when \code{renderUI} is used in an

man/runApp.Rd

@@ -30,7 +30,10 @@ expression that produces a Shiny app object.
 \item{port}{The TCP port that the application should listen on. If the
 \code{port} is not specified, and the \code{shiny.port} option is set (with
 \code{options(shiny.port = XX)}), then that port will be used. Otherwise,
-use a random port.}
+use a random port between 3000:8000, excluding ports that are blocked
+by Google Chrome for being considered unsafe: 3659, 4045, 5060,
+5061, 6000, 6566, 6665:6669 and 6697. Up to twenty random
+ports will be tried.}
 
 \item{launch.browser}{If true, the system's default web browser will be
 launched automatically after the app is started. Defaults to true in

man/runExample.Rd

@@ -19,7 +19,10 @@ list the available examples.}
 \item{port}{The TCP port that the application should listen on. If the
 \code{port} is not specified, and the \code{shiny.port} option is set (with
 \code{options(shiny.port = XX)}), then that port will be used. Otherwise,
-use a random port.}
+use a random port between 3000:8000, excluding ports that are blocked
+by Google Chrome for being considered unsafe: 3659, 4045, 5060,
+5061, 6000, 6566, 6665:6669 and 6697. Up to twenty random
+ports will be tried.}
 
 \item{launch.browser}{If true, the system's default web browser will be
 launched automatically after the app is started. Defaults to true in

man/setSerializer.Rd

@@ -17,4 +17,3 @@ value. The returned value will be used for the test snapshot.}
 \description{
 Add a function for serializing an input before bookmarking application state
 }
-\keyword{internal}

man/shinyDeprecated.Rd

@@ -4,7 +4,13 @@
 \alias{shinyDeprecated}
 \title{Print message for deprecated functions in Shiny}
 \usage{
-shinyDeprecated(version, what, with = NULL, details = NULL)
+shinyDeprecated(
+  version,
+  what,
+  with = NULL,
+  details = NULL,
+  type = c("deprecated", "superseded")
+)
 }
 \arguments{
 \item{version}{Shiny version when the function was deprecated}

man/validate.Rd

@@ -68,7 +68,7 @@ options(device.ask.default = FALSE)
 
 ui <- fluidPage(
   checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)),
-  selectizeInput('in2', 'Select a state', choices = state.name),
+  selectizeInput('in2', 'Select a state', choices = c("", state.name)),
   plotOutput('plot')
 )
 

package.json

@@ -0,0 +1,98 @@
+{
+  "private": true,
+  "homepage": "https://shiny.rstudio.com",
+  "repository": "github:rstudio/shiny",
+  "name": "@types/rstudio-shiny",
+  "version": "1.6.0-alpha.9022",
+  "license": "GPL-3.0-only",
+  "main": "",
+  "browser": "",
+  "types": "srcts/types/extras/globalShiny.d.ts",
+  "files": [
+    "DESCRIPTION",
+    "LICENSE",
+    "NEWS.md",
+    "srcts/types/**/*.d.ts"
+  ],
+  "engines": {
+    "node": ">= 14",
+    "yarn": ">= 1.22"
+  },
+  "dependencies": {
+    "@types/bootstrap": "3.4.0",
+    "@types/bootstrap-datepicker": "0.0.14",
+    "@types/datatables.net": "^1.10.19",
+    "@types/ion-rangeslider": "2.3.0",
+    "@types/jquery": "patch:@types/jquery@3.5.5#./srcts/patch/types-jquery.patch",
+    "@types/selectize": "0.12.34"
+  },
+  "devDependencies": {
+    "@babel/core": "^7.14.3",
+    "@babel/plugin-proposal-class-properties": "^7.13.0",
+    "@babel/preset-env": "^7.14.2",
+    "@babel/preset-typescript": "^7.13.0",
+    "@babel/runtime": "^7.14.0",
+    "@deanc/esbuild-plugin-postcss": "^1.0.1",
+    "@testing-library/dom": "^7.31.0",
+    "@testing-library/jest-dom": "^5.12.0",
+    "@testing-library/user-event": "^13.1.9",
+    "@types/highlightjs": "^9.12.1",
+    "@types/jest": "^26.0.23",
+    "@types/jqueryui": "1.12.15",
+    "@types/lodash": "^4.14.170",
+    "@types/node": "^15.6.1",
+    "@types/showdown": "^1.9.3",
+    "@typescript-eslint/eslint-plugin": "^4.25.0",
+    "@typescript-eslint/parser": "^4.25.0",
+    "autoprefixer": "^10.2.6",
+    "bootstrap-datepicker": "1.9.0",
+    "browserslist": "^4.16.6",
+    "core-js": "^3.13.0",
+    "esbuild": "^0.12.4",
+    "esbuild-plugin-babel": "https://github.com/schloerke/esbuild-plugin-babel#patch-2",
+    "esbuild-plugin-globals": "^0.1.1",
+    "esbuild-plugin-sass": "^0.5.2",
+    "eslint": "^7.27.0",
+    "eslint-config-prettier": "^7.2.0",
+    "eslint-plugin-jest": "^24.3.6",
+    "eslint-plugin-jest-dom": "^3.9.0",
+    "eslint-plugin-prettier": "^3.4.0",
+    "eslint-plugin-unicorn": "^33.0.1",
+    "ion-rangeslider": "2.3.1",
+    "jest": "^26.6.3",
+    "jquery": "3.6.0",
+    "lodash": "^4.17.21",
+    "madge": "^4.0.2",
+    "node-gyp": "^8.1.0",
+    "phantomjs-prebuilt": "^2.1.16",
+    "postcss": "^8.3.5",
+    "prettier": "2.3.0",
+    "readcontrol": "^1.0.0",
+    "replace": "^1.2.1",
+    "selectize": "0.12.4",
+    "strftime": "0.9.2",
+    "ts-jest": "^26",
+    "ts-node": "^10.0.0",
+    "type-coverage": "^2.17.5",
+    "typescript": "~4.1.5",
+    "util-inspect": "https://github.com/deecewan/browser-util-inspect#c0b4350df4378ffd743e8c36dd3898ce3992823e"
+  },
+  "scripts": {
+    "prepare": "node --eval \"1+1; // help yarn users not install the whole repo; https://github.com/yarnpkg/yarn/issues/2822#issuecomment-847360267\"",
+    "watch": "yarn run build_shiny --watch",
+    "build": "yarn run build_shiny && yarn run bundle_extras && yarn run bundle_external_libs",
+    "build_shiny": "yarn run checks && yarn run bundle_shiny",
+    "bundle_shiny": "ts-node srcts/build/shiny.ts",
+    "bundle_external_libs": "ts-node srcts/build/external_libs.ts",
+    "bundle_extras": "ts-node srcts/build/extras.ts",
+    "test": "jest --coverage",
+    "test_phantom": "echo '\n\t!! Must manually stop phantomjs test !!\n\n' && yarn bundle_shiny && phantomjs --debug=yes ../inst/www/shared/shiny.js",
+    "checks": "yarn run lint && yarn run build_types && yarn run coverage && yarn run circular",
+    "lint": "node --eval \"console.log('linting code...')\" && eslint --fix --ext .ts srcts/src",
+    "build_types": "tsc -p tsconfig.json",
+    "coverage_detailed": "yarn type-check --detail",
+    "coverage": "type-coverage -p tsconfig.json --at-least 90",
+    "circular": "madge --circular --extensions ts srcts/src",
+    "circular_image": "madge --circular --extensions ts --image madge.svg srcts/src"
+  }
+}

srcts/.eslintrc.yml

@@ -1,51 +0,0 @@
-root: true
-env:
-  browser: true
-  es6: true
-extends:
-  - 'eslint:recommended'
-  - 'plugin:@typescript-eslint/recommended'
-  - 'plugin:jest/recommended'
-  - 'prettier/@typescript-eslint'
-  - 'plugin:prettier/recommended'
-  - 'plugin:jest-dom/recommended'
-globals:
-  Atomics: readonly
-  SharedArrayBuffer: readonly
-parser: '@typescript-eslint/parser'
-parserOptions:
-  ecmaVersion: 2018
-  sourceType: module
-plugins:
-  - '@typescript-eslint'
-  - prettier
-  - jest-dom
-rules:
-  "@typescript-eslint/explicit-function-return-type":
-    - off
-  "@typescript-eslint/no-explicit-any":
-    - off
-  camelcase:
-    - error
-  default-case:
-    - error
-  indent:
-    - error
-    - 2
-    - SwitchCase: 1
-  linebreak-style:
-    - error
-    - unix
-  quotes:
-    - error
-    - double
-    - avoid-escape
-  semi:
-    - error
-    - always
-  newline-after-var:
-    - error
-    - always
-  dot-location:
-    - error
-    - property

srcts/.gitignore

@@ -1,9 +0,0 @@
-node_modules/
-.cache
-.yarn/*
-!.yarn/releases
-!.yarn/plugins
-!.yarn/sdks
-!.yarn/versions
-.pnp.*
-coverage/

srcts/.yarn/sdks/eslint/bin/eslint.js

@@ -1,20 +0,0 @@
-#!/usr/bin/env node
-
-const {existsSync} = require(`fs`);
-const {createRequire, createRequireFromPath} = require(`module`);
-const {resolve} = require(`path`);
-
-const relPnpApiPath = "../../../../.pnp.js";
-
-const absPnpApiPath = resolve(__dirname, relPnpApiPath);
-const absRequire = (createRequire || createRequireFromPath)(absPnpApiPath);
-
-if (existsSync(absPnpApiPath)) {
-  if (!process.versions.pnp) {
-    // Setup the environment to be able to require eslint/bin/eslint.js
-    require(absPnpApiPath).setup();
-  }
-}
-
-// Defer to the real eslint/bin/eslint.js your application uses
-module.exports = absRequire(`eslint/bin/eslint.js`);