Fix logic for ShinySession$startCycle

The previous code could result in a call stack that keeps increasing in depth as it polls.

.Rbuildignore

@@ -12,7 +12,7 @@
 ^\.travis\.yml$
 ^staticdocs$
 ^tools$
-^srcts$
+^srcjs$
 ^CONTRIBUTING.md$
 ^cran-comments.md$
 ^.*\.o$
@@ -21,19 +21,3 @@
 ^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$

.browserslistrc

@@ -1,8 +0,0 @@
-# Browsers that we support
-last 2 versions
-not dead
-> 0.2%
-# > 1%
-Firefox ESR
-phantomjs 2.1
-IE 11 # sorry

.eslintrc.yml

@@ -1,108 +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
-  - 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,6 +1,4 @@
 /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/shiny-workflows/routine.sh

@@ -1,12 +0,0 @@
-#!/bin/bash -e
-. ./tools/documentation/checkDocsCurrent.sh
-
-echo "Updating package.json version to match DESCRIPTION Version"
-Rscript ./tools/updatePackageJsonVersion.R
-if [ -n "$(git status --porcelain package.json)" ]
-then
-  yarn build
-  git add ./inst package.json && git commit -m 'Sync package version (GitHub Actions)' || echo "No package version to commit"
-else
-  echo "No package version difference detected; package.json is current."
-fi

.github/workflows/R-CMD-check.yaml

@@ -1,23 +1,198 @@
-# Workflow derived from https://github.com/rstudio/shiny-workflows
-#
-# NOTE: This Shiny team GHA workflow is overkill for most R packages.
-# For most R packages it is better to use https://github.com/r-lib/actions
+name: R-CMD-check
 on:
   push:
-    branches: [main, rc-**]
+    branches:
+      - master
   pull_request:
-    branches: [main]
-  schedule:
-    - cron: '0 5 * * 1' # every monday
+    branches:
+      - master
 
-name: Package checks
 
 jobs:
-  website:
-    uses: rstudio/shiny-workflows/.github/workflows/website.yaml@v1
-  routine:
-    uses: rstudio/shiny-workflows/.github/workflows/routine.yaml@v1
-    with:
-      node-version: "14.x"
+
   R-CMD-check:
-    uses: rstudio/shiny-workflows/.github/workflows/R-CMD-check.yaml@v1
+    runs-on: ${{ matrix.config.os }}
+
+    name: ${{ matrix.config.os }} (${{ matrix.config.r }})
+
+    strategy:
+      fail-fast: false
+      matrix:
+        config:
+          - {os: macOS-latest,   r: 'devel'}
+          - {os: macOS-latest,   r: '4.0'}
+          - {os: windows-latest, r: '4.0'}
+          - {os: ubuntu-16.04,   r: '4.0', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
+          - {os: ubuntu-16.04,   r: '3.6', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
+          - {os: ubuntu-16.04,   r: '3.5', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
+          - {os: ubuntu-16.04,   r: '3.4', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
+          - {os: ubuntu-16.04,   r: '3.3', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
+
+    env:
+      _R_CHECK_FORCE_SUGGESTS_: false
+      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
+      RSPM: ${{ matrix.config.rspm }}
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      # https://github.com/actions/checkout/issues/135
+      - name: Set git to use LF
+        if: runner.os == 'Windows'
+        run: |
+          git config --system core.autocrlf false
+          git config --system core.eol lf
+
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-r@master
+        with:
+          r-version: ${{ matrix.config.r }}
+
+      - uses: r-lib/actions/setup-pandoc@master
+
+      - name: Query dependencies
+        run: |
+          install.packages('remotes')
+          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
+        shell: Rscript {0}
+
+      - name: Cache R packages
+        if: runner.os != 'Windows'
+        uses: actions/cache@v1
+        with:
+          path: ${{ env.R_LIBS_USER }}
+          key: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-1-${{ hashFiles('.github/depends.Rds') }}
+          restore-keys: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-1-
+
+      - name: Install system dependencies
+        if: runner.os == 'Linux'
+        env:
+          RHUB_PLATFORM: linux-x86_64-ubuntu-gcc
+        run: |
+          Rscript -e "remotes::install_github('r-hub/sysreqs')"
+          sysreqs=$(Rscript -e "cat(sysreqs::sysreq_commands('DESCRIPTION'))")
+          sudo -s eval "$sysreqs"
+
+      - name: Install dependencies
+        run: |
+          remotes::install_deps(dependencies = TRUE)
+          remotes::install_cran("rcmdcheck")
+        shell: Rscript {0}
+
+      - name: Find PhantomJS path
+        id: phantomjs
+        run: |
+          echo "::set-output name=path::$(Rscript -e 'cat(shinytest:::phantom_paths()[[1]])')"
+      - name: Cache PhantomJS
+        uses: actions/cache@v1
+        with:
+          path: ${{ steps.phantomjs.outputs.path }}
+          key: ${{ runner.os }}-phantomjs
+          restore-keys: ${{ runner.os }}-phantomjs
+      - name: Install PhantomJS
+        run: >
+          Rscript
+          -e "if (!shinytest::dependenciesInstalled()) shinytest::installDependencies()"
+
+      - name: Session info
+        run: |
+          options(width = 100)
+          pkgs <- installed.packages()[, "Package"]
+          sessioninfo::session_info(pkgs, include_base = TRUE)
+        shell: Rscript {0}
+
+      - name: Check
+        env:
+          _R_CHECK_CRAN_INCOMING_: false
+        run: rcmdcheck::rcmdcheck(args = c("--no-manual", "--as-cran"), error_on = "warning", check_dir = "check")
+        shell: Rscript {0}
+
+      - name: Show testthat output
+        if: always()
+        run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload check results
+        if: failure()
+        uses: actions/upload-artifact@v2
+        with:
+          name: ${{ runner.os }}-r${{ matrix.config.r }}-results
+          path: check
+
+
+  documentation:
+    runs-on: ${{ matrix.config.os }}
+    name: documentation
+
+    strategy:
+      fail-fast: false
+      matrix:
+        config:
+          - {os: macOS-latest, r: '4.0'}
+
+    env:
+      R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-r@master
+        with:
+          r-version: ${{ matrix.config.r }}
+
+      - name: Query dependencies
+        run: |
+          install.packages('remotes')
+          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
+        shell: Rscript {0}
+      - name: Cache R packages
+        uses: actions/cache@v1
+        with:
+          path: ${{ env.R_LIBS_USER }}
+          key: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-2-${{ hashFiles('.github/depends.Rds') }}
+          restore-keys: ${{ matrix.config.os }}-r-${{ matrix.config.r }}-2-
+      - name: Remove dependencies file
+        run: |
+          rm .github/depends.Rds
+
+      - name: Install dependencies
+        run: |
+          install.packages(c("remotes"))
+          remotes::install_deps(dependencies = TRUE)
+          remotes::install_cran("devtools")
+          remotes::install_cran("rprojroot")
+        shell: Rscript {0}
+
+      - name: Check documentation
+        run: |
+          ./tools/documentation/checkDocsCurrent.sh
+
+
+  node_js:
+    runs-on: macOS-latest
+    name: node_js
+
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: actions/setup-node@v1
+        with:
+          node-version: '12.x'
+
+      # https://github.com/actions/cache/blame/ccf96194800dbb7b7094edcd5a7cf3ec3c270f10/examples.md#L185-L200
+      - name: Get yarn cache directory path
+        id: yarn-cache-dir-path
+        run: echo "::set-output name=dir::$(yarn cache dir)"
+      - name: yarn cache
+        uses: actions/cache@v1
+        id: yarn-cache # use this to check for `cache-hit` (`steps.yarn-cache.outputs.cache-hit != 'true'`)
+        with:
+          path: ${{ steps.yarn-cache-dir-path.outputs.dir }}
+          key: ${{ runner.os }}-yarn-${{ hashFiles('**/yarn.lock') }}
+          restore-keys: |
+            ${{ runner.os }}-yarn-
+
+      - name: Check node build
+        run: |
+          ./tools/checkJSCurrent.sh

.github/workflows/pr-commands.yaml

@@ -0,0 +1,35 @@
+on:
+  issue_comment:
+    types: [created]
+name: Commands
+jobs:
+  document:
+    if: startsWith(github.event.comment.body, '/document')
+    name: document
+    runs-on: macOS-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - uses: actions/checkout@v2
+      - uses: r-lib/actions/pr-fetch@master
+        with:
+          repo-token: ${{ secrets.GITHUB_TOKEN }}
+      - uses: r-lib/actions/setup-r@master
+      - name: Install dependencies
+        run: Rscript -e 'install.packages(c("remotes", "roxygen2"))' -e 'remotes::install_deps(dependencies = TRUE)'
+      - name: Document
+        run: Rscript -e 'roxygen2::roxygenise()'
+      - name: commit
+        run: |
+          git add man/\* NAMESPACE
+          git commit -m 'Document'
+      - uses: r-lib/actions/pr-push@master
+        with:
+          repo-token: ${{ secrets.GITHUB_TOKEN }}
+
+  # added so that the workflow doesn't fail.
+  always_runner:
+    runs-on: ubuntu-latest
+    steps:
+      - name: Always run
+        run: echo "This job is used to prevent the workflow status from showing as failed when all other jobs are skipped"

.gitignore

@@ -10,19 +10,3 @@ shinyapps/
 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

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

.vscode/extensions.json

@@ -1,7 +0,0 @@
-{
-  "recommendations": [
-    "arcanis.vscode-zipfs",
-    "dbaeumer.vscode-eslint",
-    "esbenp.prettier-vscode"
-  ]
-}

.vscode/settings.json

@@ -1,18 +0,0 @@
-{
-  "search.exclude": {
-    "**/.yarn": true,
-    "**/.pnp.*": true
-  },
-  "prettier.prettierPath": "./node_modules/prettier",
-  "typescript.enablePromptUseWorkspaceTsdk": true,
-  "[r]": {
-    "files.trimTrailingWhitespace": true,
-    "files.insertFinalNewline": true,
-  },
-  "[typescript]": {
-    "editor.defaultFormatter": "esbenp.prettier-vscode",
-    "editor.formatOnSave": true,
-    "files.trimTrailingWhitespace": true,
-    "files.insertFinalNewline": true,
-  },
-}

.yarnrc.yml

@@ -1,9 +0,0 @@
-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,13 +1,13 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 1.7.2.9000
+Version: 1.5.0.9005
 Authors@R: c(
-    person("Winston", "Chang", role = c("aut", "cre"), email = "winston@rstudio.com", comment = c(ORCID = "0000-0002-1576-2126")),
+    person("Winston", "Chang", role = c("aut", "cre"), email = "winston@rstudio.com"),
     person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"),
     person("JJ", "Allaire", role = "aut", email = "jj@rstudio.com"),
-    person("Carson", "Sievert", role = "aut", email = "carson@rstudio.com", comment = c(ORCID = "0000-0002-4958-2844")),
-    person("Barret", "Schloerke", role = "aut", email = "barret@rstudio.com", comment = c(ORCID = "0000-0001-9986-114X")),
+    person("Carson", "Sievert", role = "aut", email = "carson@rstudio.com"),
+    person("Barret", "Schloerke", role = "aut", email = "barret@rstudio.com"),
     person("Yihui", "Xie", role = "aut", email = "yihui@rstudio.com"),
     person("Jeff", "Allen", role = "aut", email = "jeff@rstudio.com"),
     person("Jonathan", "McPherson", role = "aut", email = "jonathan@rstudio.com"),
@@ -44,6 +44,8 @@ Authors@R: c(
     comment = "Bootstrap-datepicker library"),
     person("Andrew", "Rowls", role = c("ctb", "cph"),
     comment = "Bootstrap-datepicker library"),
+    person("Dave", "Gandy", role = c("ctb", "cph"),
+    comment = "Font-Awesome font"),
     person("Brian", "Reavis", role = c("ctb", "cph"),
     comment = "selectize.js library"),
     person("Salmen", "Bejaoui", role = c("ctb", "cph"),
@@ -78,40 +80,48 @@ Imports:
     mime (>= 0.3),
     jsonlite (>= 0.9.16),
     xtable,
-    fontawesome (>= 0.2.1),
-    htmltools (>= 0.5.2),
+    digest (>= 0.6.25),
+    htmltools (>= 0.5.0.9001),
     R6 (>= 2.0),
     sourcetools,
     later (>= 1.0.0),
-    promises (>= 1.1.0),
+    promises (>= 1.1.1.9001),
     tools,
     crayon,
-    rlang (>= 0.4.10),
-    fastmap (>= 1.1.0),
+    rlang (>= 0.4.8.9002),
+    fastmap (>= 1.0.0),
     withr,
     commonmark (>= 1.7),
     glue (>= 1.3.2),
-    bslib (>= 0.3.0),
+    bslib (>= 0.2.2.9002),
     cachem,
-    ellipsis,
-    lifecycle (>= 0.2.0)
+    ellipsis
 Suggests:
     datasets,
     Cairo (>= 1.5-5),
-    testthat (>= 3.0.0),
+    testthat (>= 2.1.1),
     knitr (>= 1.6),
     markdown,
     rmarkdown,
     ggplot2,
     reactlog (>= 1.0.0),
     magrittr,
+    shinytest (>= 1.4.0.9003),
     yaml,
     future,
     dygraphs,
     ragg,
     showtext,
     sass
-URL: https://shiny.rstudio.com/
+Remotes:
+    rstudio/htmltools,
+    rstudio/promises,
+    rstudio/sass,
+    rstudio/bslib,
+    rstudio/shinytest,
+    r-lib/cachem,
+    r-lib/rlang
+URL: http://shiny.rstudio.com
 BugReports: https://github.com/rstudio/shiny/issues
 Collate:
     'globals.R'
@@ -120,6 +130,7 @@ Collate:
     'bind-cache.R'
     'bind-event.R'
     'bookmark-state-local.R'
+    'stack.R'
     'bookmark-state.R'
     'bootstrap-deprecated.R'
     'bootstrap-layout.R'
@@ -129,15 +140,16 @@ Collate:
     'bootstrap.R'
     'cache-utils.R'
     'deprecated.R'
-    'devmode.R'
     'diagnose.R'
     'fileupload.R'
+    'font-awesome.R'
     'graph.R'
     'reactives.R'
     'reactive-domains.R'
     'history.R'
     'hooks.R'
     'html-deps.R'
+    'htmltools.R'
     'image-interact-opts.R'
     'image-interact.R'
     'imageutils.R'
@@ -182,29 +194,18 @@ Collate:
     'server-resource-paths.R'
     'server.R'
     'shiny-options.R'
-    'shiny-package.R'
     'shinyapp.R'
     'shinyui.R'
     'shinywrappers.R'
     'showcase.R'
     'snapshot.R'
-    'staticimports.R'
     'tar.R'
     'test-export.R'
     'test-server.R'
     '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.2.1
+RoxygenNote: 7.1.1
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RdMacros: lifecycle
-Config/testthat/edition: 3
-Config/Needs/check:
-  rstudio/shinytest2

LICENSE

@@ -10,6 +10,7 @@ these components are included below):
 - Bootstrap, https://github.com/twbs/bootstrap
 - bootstrap-accessibility-plugin, https://github.com/paypal/bootstrap-accessibility-plugin
 - bootstrap-datepicker, https://github.com/eternicode/bootstrap-datepicker
+- Font Awesome, https://github.com/FortAwesome/Font-Awesome
 - selectize.js, https://github.com/selectize/selectize.js
 - selectize-plugin-a11y, https://github.com/SLMNBJ/selectize-plugin-a11y
 - ion.rangeSlider, https://github.com/IonDen/ion.rangeSlider
@@ -307,6 +308,449 @@ bootstrap-datepicker
    limitations under the License.
 
 
+Font Awesome (CSS files are MIT licensed; fonts have SIL Open Font License 1.1, svgs have CC BY 4.0 License)
+----------------------------------------------------------------------
+
+The MIT License (MIT)
+
+Copyright (c) 2014 Dave Gandy
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
+
+----
+
+Copyright (c) 2014, Dave Gandy http://fontawesome.io/,
+with Reserved Font Name Font Awesome.
+
+This Font Software is licensed under the SIL Open Font License, Version 1.1.
+This license is copied below, and is also available with a FAQ at:
+http://scripts.sil.org/OFL
+
+
+-----------------------------------------------------------
+SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
+-----------------------------------------------------------
+
+PREAMBLE
+The goals of the Open Font License (OFL) are to stimulate worldwide
+development of collaborative font projects, to support the font creation
+efforts of academic and linguistic communities, and to provide a free and
+open framework in which fonts may be shared and improved in partnership
+with others.
+
+The OFL allows the licensed fonts to be used, studied, modified and
+redistributed freely as long as they are not sold by themselves. The
+fonts, including any derivative works, can be bundled, embedded,
+redistributed and/or sold with any software provided that any reserved
+names are not used by derivative works. The fonts and derivatives,
+however, cannot be released under any other type of license. The
+requirement for fonts to remain under this license does not apply
+to any document created using the fonts or their derivatives.
+
+DEFINITIONS
+"Font Software" refers to the set of files released by the Copyright
+Holder(s) under this license and clearly marked as such. This may
+include source files, build scripts and documentation.
+
+"Reserved Font Name" refers to any names specified as such after the
+copyright statement(s).
+
+"Original Version" refers to the collection of Font Software components as
+distributed by the Copyright Holder(s).
+
+"Modified Version" refers to any derivative made by adding to, deleting,
+or substituting -- in part or in whole -- any of the components of the
+Original Version, by changing formats or by porting the Font Software to a
+new environment.
+
+"Author" refers to any designer, engineer, programmer, technical
+writer or other person who contributed to the Font Software.
+
+PERMISSION & CONDITIONS
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of the Font Software, to use, study, copy, merge, embed, modify,
+redistribute, and sell modified and unmodified copies of the Font
+Software, subject to the following conditions:
+
+1) Neither the Font Software nor any of its individual components,
+in Original or Modified Versions, may be sold by itself.
+
+2) Original or Modified Versions of the Font Software may be bundled,
+redistributed and/or sold with any software, provided that each copy
+contains the above copyright notice and this license. These can be
+included either as stand-alone text files, human-readable headers or
+in the appropriate machine-readable metadata fields within text or
+binary files as long as those fields can be easily viewed by the user.
+
+3) No Modified Version of the Font Software may use the Reserved Font
+Name(s) unless explicit written permission is granted by the corresponding
+Copyright Holder. This restriction only applies to the primary font name as
+presented to the users.
+
+4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
+Software shall not be used to promote, endorse or advertise any
+Modified Version, except to acknowledge the contribution(s) of the
+Copyright Holder(s) and the Author(s) or with their explicit written
+permission.
+
+5) The Font Software, modified or unmodified, in part or in whole,
+must be distributed entirely under this license, and must not be
+distributed under any other license. The requirement for fonts to
+remain under this license does not apply to any document created
+using the Font Software.
+
+TERMINATION
+This license becomes null and void if any of the above conditions are
+not met.
+
+DISCLAIMER
+THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
+OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
+COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
+OTHER DEALINGS IN THE FONT SOFTWARE.
+
+=======================================================================
+
+Creative Commons Attribution 4.0 International Public License
+
+By exercising the Licensed Rights (defined below), You accept and agree
+to be bound by the terms and conditions of this Creative Commons
+Attribution 4.0 International Public License ("Public License"). To the
+extent this Public License may be interpreted as a contract, You are
+granted the Licensed Rights in consideration of Your acceptance of
+these terms and conditions, and the Licensor grants You such rights in
+consideration of benefits the Licensor receives from making the
+Licensed Material available under these terms and conditions.
+
+
+Section 1 -- Definitions.
+
+  a. Adapted Material means material subject to Copyright and Similar
+     Rights that is derived from or based upon the Licensed Material
+     and in which the Licensed Material is translated, altered,
+     arranged, transformed, or otherwise modified in a manner requiring
+     permission under the Copyright and Similar Rights held by the
+     Licensor. For purposes of this Public License, where the Licensed
+     Material is a musical work, performance, or sound recording,
+     Adapted Material is always produced where the Licensed Material is
+     synched in timed relation with a moving image.
+
+  b. Adapter's License means the license You apply to Your Copyright
+     and Similar Rights in Your contributions to Adapted Material in
+     accordance with the terms and conditions of this Public License.
+
+  c. Copyright and Similar Rights means copyright and/or similar rights
+     closely related to copyright including, without limitation,
+     performance, broadcast, sound recording, and Sui Generis Database
+     Rights, without regard to how the rights are labeled or
+     categorized. For purposes of this Public License, the rights
+     specified in Section 2(b)(1)-(2) are not Copyright and Similar
+     Rights.
+
+  d. Effective Technological Measures means those measures that, in the
+     absence of proper authority, may not be circumvented under laws
+     fulfilling obligations under Article 11 of the WIPO Copyright
+     Treaty adopted on December 20, 1996, and/or similar international
+     agreements.
+
+  e. Exceptions and Limitations means fair use, fair dealing, and/or
+     any other exception or limitation to Copyright and Similar Rights
+     that applies to Your use of the Licensed Material.
+
+  f. Licensed Material means the artistic or literary work, database,
+     or other material to which the Licensor applied this Public
+     License.
+
+  g. Licensed Rights means the rights granted to You subject to the
+     terms and conditions of this Public License, which are limited to
+     all Copyright and Similar Rights that apply to Your use of the
+     Licensed Material and that the Licensor has authority to license.
+
+  h. Licensor means the individual(s) or entity(ies) granting rights
+     under this Public License.
+
+  i. Share means to provide material to the public by any means or
+     process that requires permission under the Licensed Rights, such
+     as reproduction, public display, public performance, distribution,
+     dissemination, communication, or importation, and to make material
+     available to the public including in ways that members of the
+     public may access the material from a place and at a time
+     individually chosen by them.
+
+  j. Sui Generis Database Rights means rights other than copyright
+     resulting from Directive 96/9/EC of the European Parliament and of
+     the Council of 11 March 1996 on the legal protection of databases,
+     as amended and/or succeeded, as well as other essentially
+     equivalent rights anywhere in the world.
+
+  k. You means the individual or entity exercising the Licensed Rights
+     under this Public License. Your has a corresponding meaning.
+
+
+Section 2 -- Scope.
+
+  a. License grant.
+
+       1. Subject to the terms and conditions of this Public License,
+          the Licensor hereby grants You a worldwide, royalty-free,
+          non-sublicensable, non-exclusive, irrevocable license to
+          exercise the Licensed Rights in the Licensed Material to:
+
+            a. reproduce and Share the Licensed Material, in whole or
+               in part; and
+
+            b. produce, reproduce, and Share Adapted Material.
+
+       2. Exceptions and Limitations. For the avoidance of doubt, where
+          Exceptions and Limitations apply to Your use, this Public
+          License does not apply, and You do not need to comply with
+          its terms and conditions.
+
+       3. Term. The term of this Public License is specified in Section
+          6(a).
+
+       4. Media and formats; technical modifications allowed. The
+          Licensor authorizes You to exercise the Licensed Rights in
+          all media and formats whether now known or hereafter created,
+          and to make technical modifications necessary to do so. The
+          Licensor waives and/or agrees not to assert any right or
+          authority to forbid You from making technical modifications
+          necessary to exercise the Licensed Rights, including
+          technical modifications necessary to circumvent Effective
+          Technological Measures. For purposes of this Public License,
+          simply making modifications authorized by this Section 2(a)
+          (4) never produces Adapted Material.
+
+       5. Downstream recipients.
+
+            a. Offer from the Licensor -- Licensed Material. Every
+               recipient of the Licensed Material automatically
+               receives an offer from the Licensor to exercise the
+               Licensed Rights under the terms and conditions of this
+               Public License.
+
+            b. No downstream restrictions. You may not offer or impose
+               any additional or different terms or conditions on, or
+               apply any Effective Technological Measures to, the
+               Licensed Material if doing so restricts exercise of the
+               Licensed Rights by any recipient of the Licensed
+               Material.
+
+       6. No endorsement. Nothing in this Public License constitutes or
+          may be construed as permission to assert or imply that You
+          are, or that Your use of the Licensed Material is, connected
+          with, or sponsored, endorsed, or granted official status by,
+          the Licensor or others designated to receive attribution as
+          provided in Section 3(a)(1)(A)(i).
+
+  b. Other rights.
+
+       1. Moral rights, such as the right of integrity, are not
+          licensed under this Public License, nor are publicity,
+          privacy, and/or other similar personality rights; however, to
+          the extent possible, the Licensor waives and/or agrees not to
+          assert any such rights held by the Licensor to the limited
+          extent necessary to allow You to exercise the Licensed
+          Rights, but not otherwise.
+
+       2. Patent and trademark rights are not licensed under this
+          Public License.
+
+       3. To the extent possible, the Licensor waives any right to
+          collect royalties from You for the exercise of the Licensed
+          Rights, whether directly or through a collecting society
+          under any voluntary or waivable statutory or compulsory
+          licensing scheme. In all other cases the Licensor expressly
+          reserves any right to collect such royalties.
+
+
+Section 3 -- License Conditions.
+
+Your exercise of the Licensed Rights is expressly made subject to the
+following conditions.
+
+  a. Attribution.
+
+       1. If You Share the Licensed Material (including in modified
+          form), You must:
+
+            a. retain the following if it is supplied by the Licensor
+               with the Licensed Material:
+
+                 i. identification of the creator(s) of the Licensed
+                    Material and any others designated to receive
+                    attribution, in any reasonable manner requested by
+                    the Licensor (including by pseudonym if
+                    designated);
+
+                ii. a copyright notice;
+
+               iii. a notice that refers to this Public License;
+
+                iv. a notice that refers to the disclaimer of
+                    warranties;
+
+                 v. a URI or hyperlink to the Licensed Material to the
+                    extent reasonably practicable;
+
+            b. indicate if You modified the Licensed Material and
+               retain an indication of any previous modifications; and
+
+            c. indicate the Licensed Material is licensed under this
+               Public License, and include the text of, or the URI or
+               hyperlink to, this Public License.
+
+       2. You may satisfy the conditions in Section 3(a)(1) in any
+          reasonable manner based on the medium, means, and context in
+          which You Share the Licensed Material. For example, it may be
+          reasonable to satisfy the conditions by providing a URI or
+          hyperlink to a resource that includes the required
+          information.
+
+       3. If requested by the Licensor, You must remove any of the
+          information required by Section 3(a)(1)(A) to the extent
+          reasonably practicable.
+
+       4. If You Share Adapted Material You produce, the Adapter's
+          License You apply must not prevent recipients of the Adapted
+          Material from complying with this Public License.
+
+
+Section 4 -- Sui Generis Database Rights.
+
+Where the Licensed Rights include Sui Generis Database Rights that
+apply to Your use of the Licensed Material:
+
+  a. for the avoidance of doubt, Section 2(a)(1) grants You the right
+     to extract, reuse, reproduce, and Share all or a substantial
+     portion of the contents of the database;
+
+  b. if You include all or a substantial portion of the database
+     contents in a database in which You have Sui Generis Database
+     Rights, then the database in which You have Sui Generis Database
+     Rights (but not its individual contents) is Adapted Material; and
+
+  c. You must comply with the conditions in Section 3(a) if You Share
+     all or a substantial portion of the contents of the database.
+
+For the avoidance of doubt, this Section 4 supplements and does not
+replace Your obligations under this Public License where the Licensed
+Rights include other Copyright and Similar Rights.
+
+
+Section 5 -- Disclaimer of Warranties and Limitation of Liability.
+
+  a. UNLESS OTHERWISE SEPARATELY UNDERTAKEN BY THE LICENSOR, TO THE
+     EXTENT POSSIBLE, THE LICENSOR OFFERS THE LICENSED MATERIAL AS-IS
+     AND AS-AVAILABLE, AND MAKES NO REPRESENTATIONS OR WARRANTIES OF
+     ANY KIND CONCERNING THE LICENSED MATERIAL, WHETHER EXPRESS,
+     IMPLIED, STATUTORY, OR OTHER. THIS INCLUDES, WITHOUT LIMITATION,
+     WARRANTIES OF TITLE, MERCHANTABILITY, FITNESS FOR A PARTICULAR
+     PURPOSE, NON-INFRINGEMENT, ABSENCE OF LATENT OR OTHER DEFECTS,
+     ACCURACY, OR THE PRESENCE OR ABSENCE OF ERRORS, WHETHER OR NOT
+     KNOWN OR DISCOVERABLE. WHERE DISCLAIMERS OF WARRANTIES ARE NOT
+     ALLOWED IN FULL OR IN PART, THIS DISCLAIMER MAY NOT APPLY TO YOU.
+
+  b. TO THE EXTENT POSSIBLE, IN NO EVENT WILL THE LICENSOR BE LIABLE
+     TO YOU ON ANY LEGAL THEORY (INCLUDING, WITHOUT LIMITATION,
+     NEGLIGENCE) OR OTHERWISE FOR ANY DIRECT, SPECIAL, INDIRECT,
+     INCIDENTAL, CONSEQUENTIAL, PUNITIVE, EXEMPLARY, OR OTHER LOSSES,
+     COSTS, EXPENSES, OR DAMAGES ARISING OUT OF THIS PUBLIC LICENSE OR
+     USE OF THE LICENSED MATERIAL, EVEN IF THE LICENSOR HAS BEEN
+     ADVISED OF THE POSSIBILITY OF SUCH LOSSES, COSTS, EXPENSES, OR
+     DAMAGES. WHERE A LIMITATION OF LIABILITY IS NOT ALLOWED IN FULL OR
+     IN PART, THIS LIMITATION MAY NOT APPLY TO YOU.
+
+  c. The disclaimer of warranties and limitation of liability provided
+     above shall be interpreted in a manner that, to the extent
+     possible, most closely approximates an absolute disclaimer and
+     waiver of all liability.
+
+
+Section 6 -- Term and Termination.
+
+  a. This Public License applies for the term of the Copyright and
+     Similar Rights licensed here. However, if You fail to comply with
+     this Public License, then Your rights under this Public License
+     terminate automatically.
+
+  b. Where Your right to use the Licensed Material has terminated under
+     Section 6(a), it reinstates:
+
+       1. automatically as of the date the violation is cured, provided
+          it is cured within 30 days of Your discovery of the
+          violation; or
+
+       2. upon express reinstatement by the Licensor.
+
+     For the avoidance of doubt, this Section 6(b) does not affect any
+     right the Licensor may have to seek remedies for Your violations
+     of this Public License.
+
+  c. For the avoidance of doubt, the Licensor may also offer the
+     Licensed Material under separate terms or conditions or stop
+     distributing the Licensed Material at any time; however, doing so
+     will not terminate this Public License.
+
+  d. Sections 1, 5, 6, 7, and 8 survive termination of this Public
+     License.
+
+
+Section 7 -- Other Terms and Conditions.
+
+  a. The Licensor shall not be bound by any additional or different
+     terms or conditions communicated by You unless expressly agreed.
+
+  b. Any arrangements, understandings, or agreements regarding the
+     Licensed Material not stated herein are separate from and
+     independent of the terms and conditions of this Public License.
+
+
+Section 8 -- Interpretation.
+
+  a. For the avoidance of doubt, this Public License does not, and
+     shall not be interpreted to, reduce, limit, restrict, or impose
+     conditions on any use of the Licensed Material that could lawfully
+     be made without permission under this Public License.
+
+  b. To the extent possible, if any provision of this Public License is
+     deemed unenforceable, it shall be automatically reformed to the
+     minimum extent necessary to make it enforceable. If the provision
+     cannot be reformed, it shall be severed from this Public License
+     without affecting the enforceability of the remaining terms and
+     conditions.
+
+  c. No term or condition of this Public License will be waived and no
+     failure to comply consented to unless expressly agreed to by the
+     Licensor.
+
+  d. Nothing in this Public License constitutes or may be interpreted
+     as a limitation upon, or waiver of, any privileges and immunities
+     that apply to the Licensor or You, including from the legal
+     processes of any jurisdiction or authority.
+
+
 selectize.js
 ----------------------------------------------------------------------
 

NAMESPACE

@@ -91,7 +91,6 @@ export(dateInput)
 export(dateRangeInput)
 export(dblclickOpts)
 export(debounce)
-export(devmode)
 export(dialogViewer)
 export(diskCache)
 export(div)
@@ -103,6 +102,7 @@ export(enableBookmarking)
 export(eventReactive)
 export(exportTestValues)
 export(exprToFunction)
+export(extractStackTrace)
 export(fileInput)
 export(fillCol)
 export(fillPage)
@@ -113,6 +113,7 @@ export(fixedRow)
 export(flowLayout)
 export(fluidPage)
 export(fluidRow)
+export(formatStackTrace)
 export(freezeReactiveVal)
 export(freezeReactiveValue)
 export(getCurrentOutputInfo)
@@ -121,7 +122,6 @@ export(getDefaultReactiveDomain)
 export(getQueryString)
 export(getShinyOption)
 export(getUrlHash)
-export(get_devmode_option)
 export(h1)
 export(h2)
 export(h3)
@@ -139,7 +139,6 @@ export(httpResponse)
 export(icon)
 export(imageOutput)
 export(img)
-export(in_devmode)
 export(incProgress)
 export(includeCSS)
 export(includeHTML)
@@ -205,8 +204,13 @@ export(radioButtons)
 export(reactive)
 export(reactiveConsole)
 export(reactiveFileReader)
+export(reactivePlot)
 export(reactivePoll)
+export(reactivePrint)
+export(reactiveTable)
+export(reactiveText)
 export(reactiveTimer)
+export(reactiveUI)
 export(reactiveVal)
 export(reactiveValues)
 export(reactiveValuesToList)
@@ -215,7 +219,6 @@ export(reactlogReset)
 export(reactlogShow)
 export(registerInputHandler)
 export(registerThemeDependency)
-export(register_devmode_option)
 export(removeInputHandler)
 export(removeModal)
 export(removeNotification)
@@ -258,6 +261,7 @@ export(shinyUI)
 export(showBookmarkUrlModal)
 export(showModal)
 export(showNotification)
+export(showReactLog)
 export(showTab)
 export(sidebarLayout)
 export(sidebarPanel)
@@ -325,13 +329,14 @@ export(withMathJax)
 export(withProgress)
 export(withReactiveDomain)
 export(withTags)
-export(with_devmode)
 import(R6)
+import(digest)
 import(htmltools)
 import(httpuv)
 import(methods)
 import(mime)
 import(xtable)
+importFrom(digest,digest)
 importFrom(ellipsis,check_dots_empty)
 importFrom(ellipsis,check_dots_unnamed)
 importFrom(fastmap,fastmap)
@@ -377,8 +382,6 @@ importFrom(htmltools,tagSetChildren)
 importFrom(htmltools,tags)
 importFrom(htmltools,validateCssUnit)
 importFrom(htmltools,withTags)
-importFrom(lifecycle,deprecated)
-importFrom(lifecycle,is_present)
 importFrom(promises,"%...!%")
 importFrom(promises,"%...>%")
 importFrom(promises,as.promise)
@@ -387,34 +390,21 @@ 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)
-importFrom(rlang,is_false)
-importFrom(rlang,is_missing)
 importFrom(rlang,is_na)
 importFrom(rlang,is_quosure)
-importFrom(rlang,list2)
-importFrom(rlang,maybe_missing)
-importFrom(rlang,missing_arg)
 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

@@ -1,145 +1,7 @@
-shiny 1.7.2.9000
+
+shiny 1.5.0.9000
 ================
 
-
-
-shiny 1.7.2
-===========
-
-## Full changelog
-
-### Breaking changes
-
-* Closed #3626: `renderPlot()` (and `plotPNG()`) now uses `ragg::agg_png()` by default when the [`{ragg}` package](https://github.com/r-lib/ragg) is installed. To restore the previous behavior, set `options(shiny.useragg = FALSE)`. (#3654)
-
-### New features and improvements
-
-* Closed #1545: `insertUI()` now executes `<script>` tags. (#3630)
-
-* `fileInput()` can set the `capture` attribute to facilitates user access to a device's media capture mechanism, such as a camera, or microphone, from within a file upload control ([W3C HTML Media Capture](https://www.w3.org/TR/html-media-capture/)). (Thanks to khaled-alshamaa, #3481)
-
-* Closed tidyverse/dplyr#5552: Compatibility of dplyr 1.0 (and rlang chained errors in general) with `req()`, `validate()`, and friends.
-
-* Closed tidyverse/dplyr#6154: Values from an `actionButton()` had S3 classes in the incorrect order.
-
-* Closed #3346: Default for `ref` input in `runGithub()` changed from `"master"` to `"HEAD"`. (#3564)
-
-* Closed #3619: In R 4.2, `splitLayout()` no longer raises warnings about incorrect length in an `if` statement. (Thanks to @dmenne, #3625)
-
-### Bug fixes
-
-* Closed #3250:`{rlang}`/`{tidyeval}` conditions (i.e., warnings and errors) are no longer filtered from stack traces. (#3602)
-
-* Closed #3581: Errors in throttled/debounced reactive expressions no longer cause the session to exit. (#3624)
-
-* Closed #3657: `throttle.ts` and the `Throttler` typescript objects it provides now function as intended. (Thanks gto @dvg-p4, #3659)
-
-* The auto-reload feature (`options(shiny.autoreload=TRUE)`) was not being activated by `devmode(TRUE)`, despite a console message asserting that it was. (#3620)
-
-* Closed #2297: If an error occurred in parsing a value in a bookmark query string, an error would be thrown and nothing would be restored. Now a message is displayed and that value is ignored. (Thanks to @daattali, #3385)
-
-* Restored the previous behavior of automatically guessing the `Content-Type` header for `downloadHandler` functions when no explicit `contentType` argument is supplied. (#3393)
-
-* Previously, updating an input value without a corresponding Input binding element did not trigger a JavaScript `shiny:inputchanged` event. Now, if no Input binding element is found, the `shiny:inputchanged` event is triggered on `window.document`. (#3584)
-
-* Closed #2955: Input and output bindings previously attempted to use `el['data-input-id']`, but that never worked. They now use `el.getAttribute('data-input-id')` instead. (#3538)
-
-### Minor improvements
-
-* When taking a test snapshot, the sort order of the json keys of the `input`, `output`, and `export` fields is currently sorted using the locale of the machine. This can lead to inconsistent test snapshot results. To opt-in to a consistent ordering of snapshot fields with `{shinytest}`, please set the global option `options(shiny.snapshotsortc = TRUE)`. `{shinytest2}` users do not need to set this value. (#3515)
-
-* Closed rstudio/shinytest2#222: When restoring a context (i.e., bookmarking) from a URL, Shiny now better handles a trailing `=` after `_inputs_` and `_values_`. (#3648)
-
-* Shiny's internal HTML dependencies are now mounted dynamically instead of statically. (#3537)
-
-* HTML dependencies that are sent to dynamic UI now have better type checking, and no longer require a `dep.src.href` field. (#3537)
-
-
-shiny 1.7.1
-===========
-
-## Bug Fixes
-
-* Closed #3516: Fix regression in repeated calls to `appendTab()` when `navbarMenu()` is already present within a `tabsetPanel()`/`navbarPage()`. (#3518)
-
-* Re-arranged conditions for testthat 1.0.0 compatibility. (#3512)
-
-
-shiny 1.7.0
-===========
-
-## Full changelog
-
-### Breaking changes
-
-* 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)
-
-* `installExprFunction()` and `exprToFunction()` are now able to handle quosures when `quoted = TRUE`. So `render`-functions which call these functions (such as with `htmlwidgets`) can now understand quosures. Users can also use `rlang::inject()` to unquote a quosure for evaluation.  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. Better documentation was added for how to create `render` functions. (#3472)
-
-* `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/v1.7.0/srcts). (#3296)
-
-* Switched from `digest::digest()` to `rlang::hash()` for hashing. (#3264)
-
-* Switched from internal `Stack` class to `fastmap::faststack()`, and used `fastmap::fastqueue()`. (#3176)
-
-* Some long-deprecated functions and function parameters were removed. (#3137)
-
-### Bug fixes
-
-* 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)
-
-* Closed #3484: In the RStudio IDE on Mac 11.5, selected checkboxes and radio buttons were not visible. (#3485)
-
-### Library updates
-
-* Closed #3286: Updated to Font-Awesome 5.15.2. (#3288)
-
-* Updated to jQuery 3.6.0. (#3311)
-
-shiny 1.6.0
-===========
-
-This release focuses on improvements in three main areas:
-
-1. Better theming (and Bootstrap 4) support:
-  * The `theme` argument of `fluidPage()`, `navbarPage()`, and `bootstrapPage()` all now understand `bslib::bs_theme()` objects, which can be used to opt-into Bootstrap 4, use any Bootswatch theme, and/or implement custom themes without writing any CSS.
-  * The `session` object now includes `$setCurrentTheme()` and `$getCurrentTheme()` methods to dynamically update (or obtain) the page's `theme` after initial load, which is useful for things such as [adding a dark mode switch to an app](https://rstudio.github.io/bslib/articles/bslib.html#dynamic) or some other "real-time" theming tool like `bslib::bs_themer()`.
-  * For more details, see [`{bslib}`'s website](https://rstudio.github.io/bslib/)
-
-2. Caching of `reactive()` and `render*()` (e.g. `renderText()`, `renderTable()`, etc) expressions.
-  * Such expressions automatically cache their _most recent value_, which helps to avoid redundant computation within a single "flush" of reactivity. The new `bindCache()` function can be used to cache _all previous values_ (as long as they fit in the cache). This cache may be optionally scoped within and/or across user sessions, possibly leading to huge performance gains, especially when deployed at scale across user sessions.
-  * For more details, see `help(bindCache, package = "shiny")`
-
-3. Various improvements to accessibility for screen-reader and keyboard users.
-  * For more details, see the accessibility section below.
-
 ## Full changelog
 
 ### Breaking changes
@@ -154,8 +16,6 @@ This release focuses on improvements in three main areas:
 
 * Added [bootstrap accessibility plugin](https://github.com/paypal/bootstrap-accessibility-plugin) under the hood to improve accessibility of shiny apps for screen-reader and keyboard users: the enhancements include better navigations for alert, tooltip, popover, modal dialog, dropdown, tab Panel, collapse, and carousel elements. (#2911)
 
-* Closed #2987: Improved accessibility of "live regions" -- namely, `*Output()` bindings and `update*Input()`. (#3042)
-
 * Added appropriate labels to `icon()` element to provide screen-reader users with alternative descriptions for the `fontawesome` and `glyphicon`: `aria-label` is automatically applied based on the fontawesome name. For example, `icon("calendar")` will be announced as "calendar icon" to screen readers. "presentation" aria role has also been attached to `icon()` to remove redundant semantic info for screen readers. (#2917)
 
 * Closed #2929: Fixed keyboard accessibility for file picker button: keyboard users can now tab to focus on `fileInput()` widget. (#2937)
@@ -170,12 +30,8 @@ This release focuses on improvements in three main areas:
 
 * Closed #2844: Added `lang` argument to ui `*Page()` functions (e.g., `fluidPage`, `bootstrapPage`) that specifies document-level language within the app for the accessibility of screen readers and search-engine parsers. By default, it is set to empty string which is commonly recognized as a browser's default locale. (#2920)
 
-* Improved accessibility for `radioButtons()` and `checkboxGroupInput()`: All options are now grouped together semantically for assistive technologies. (thanks @jooyoungseo, #3187).
-
 ### Minor new features and improvements
 
-* Added support for Shiny Developer Mode. Developer Mode enables a number of `options()` to make a developer's life easier, like enabling non-minified JS and printing messages about deprecated functions and options. See `?devmode()` for more details. (#3174)
-
 * New `reactiveConsole()` makes it easier to interactively experiment with reactivity at the console (#2518).
 
 * When UI is specified as a function (e.g. `ui <- function(req) { ... }`), the response can now be an HTTP response as returned from the (newly exported) `httpResponse()` function. (#2970)
@@ -204,28 +60,20 @@ This release focuses on improvements in three main areas:
 
 * Closed #3140: Added support for `...` argument in `icon()`. (#3143)
 
-* Closed #629: All `update*` functions now have a default value for `session`, and issue an informative warning if it is missing. (#3195, #3199)
-
-* Improved error messages when reading reactive values outside of a reactive domain (e.g., `reactiveVal()()`). (#3007)
-
 ### Bug fixes
 
+* Fixed #2859: `renderPlot()` wasn't correctly setting `showtext::showtext_opts()`'s `dpi` setting with the correct resolution on high resolution displays; which means, if the font was rendered by showtext, font sizes would look smaller than they should on such displays. (#2941)
+
 * Fixed #1942: Calling `runApp("app.R")` no longer ignores options passed into `shinyApp()`. This makes it possible for Shiny apps to specify what port/host should be used by default. (#2969)
 
 * Fixed #3033: When a `DiskCache` was created with both `max_n` and `max_size`, too many items could get pruned when `prune()` was called. (#3034)
 
-* Fixed #2703: Fixed numerous issues with some combinations of `min`/`value`/`max` causing issues with `date[Range]Input()` and `updateDate[Range]Input()`. (#3038, #3201)
-
 * Fixed #2936: `dateYMD` was giving a warning when passed a vector of dates from `dateInput` which was greater than length 1. The length check was removed because it was not needed. (#3061)
 
 * Fixed #2266, #2688: `radioButtons` and `updateRadioButtons` now accept `character(0)` to indicate that none of the options should be selected (thanks to @ColinFay). (#3043)
 
 * Fixed a bug that `textAreaInput()` doesn't work as expected for relative `width` (thanks to @shrektan). (#2049)
 
-* Fixed #2859: `renderPlot()` wasn't correctly setting `showtext::showtext_opts()`'s `dpi` setting with the correct resolution on high resolution displays; which means, if the font was rendered by showtext, font sizes would look smaller than they should on such displays. (#2941)
-
-* Closed #2910, #2909, #1552: `sliderInput()` warns if the `value` is outside of `min` and `max`, and errors if `value` is `NULL` or `NA`. (#3194)
-
 ### Library updates
 
 * Removed html5shiv and respond.js, which were used for IE 8 and IE 9 compatibility. (#2973)
@@ -252,7 +100,7 @@ shiny 1.5.0
 
 * The new `moduleServer` function provides a simpler interface for creating and using modules. (#2773)
 
-* Resolved #2732: `markdown()` is a new function for writing Markdown with Github extensions directly in Shiny UIs. Markdown rendering is performed by the [commonmark](https://github.com/r-lib/commonmark) package. (#2737)
+* Resolved #2732: `markdown()` is a new function for writing Markdown with Github extensions directly in Shiny UIs. Markdown rendering is performed by the [commonmark](https://github.com/jeroen/commonmark) package. (#2737)
 
 * The `getCurrentOutputInfo()` function can now return the background color (`bg`), foreground color (`fg`), `accent` (i.e., hyperlink) color, and `font` information of the output's HTML container. This information is reported by `plotOutput()`, `imageOutput()`, and any other output bindings containing a class of `.shiny-report-theme`. This feature allows developers to style an output's contents based on the container's CSS styling.  (#2740)
 
@@ -418,7 +266,7 @@ shiny 1.3.0
 shiny 1.2.0
 ===========
 
-This release features plot caching, an important new tool for improving performance and scalability. Using `renderCachedPlot` in place of `renderPlot` can greatly improve responsiveness for apps that show the same plot many times (for example, a dashboard or report where all users view the same data). Shiny gives you a fair amount of control in where the cache is stored and how cached plots are invalidated, so be sure to read [this article](https://shiny.rstudio.com/articles/plot-caching.html) to get the most out of this feature.
+This release features plot caching, an important new tool for improving performance and scalability. Using `renderCachedPlot` in place of `renderPlot` can greatly improve responsiveness for apps that show the same plot many times (for example, a dashboard or report where all users view the same data). Shiny gives you a fair amount of control in where the cache is stored and how cached plots are invalidated, so be sure to read [this article](http://shiny.rstudio.com/articles/plot-caching.html) to get the most out of this feature.
 
 ## Full changelog
 
@@ -518,7 +366,7 @@ This is a significant release for Shiny, with a major new feature that was nearl
 
 * Removed the (ridiculously outdated) "experimental feature" tag from the reference documentation for `renderUI`. (#2036)
 
-* Addressed #1907: the `ignoreInit` argument was first added only to `observeEvent`. Later, we also added it to `eventReactive`, but forgot to update the documentation. Now done, thanks @flo12392! (#2036)
+* Addressed #1907: the `ignoreInit` argument was first added only to `observeEvent`. Later, we also added it to `eventReactive`, but forgot to update the documentation. Now done, thanks [@flo12392](https://github.com/flo12392)! (#2036)
 
 ### Bug fixes
 
@@ -532,7 +380,7 @@ This is a significant release for Shiny, with a major new feature that was nearl
 
 * Fixed #1600: URL-encoded bookmarking did not work with sliders that had dates or date-times. (#1961)
 
-* Fixed #1962: [File dragging and dropping](https://www.rstudio.com/blog/shiny-1-0-4/) broke in the presence of jQuery version 3.0 as introduced by the [rhandsontable](https://jrowen.github.io/rhandsontable/) [htmlwidget](https://www.htmlwidgets.org/). (#2005)
+* Fixed #1962: [File dragging and dropping](https://blog.rstudio.com/2017/08/15/shiny-1-0-4/) broke in the presence of jQuery version 3.0 as introduced by the [rhandsontable](https://jrowen.github.io/rhandsontable/) [htmlwidget](https://www.htmlwidgets.org/). (#2005)
 
 * Improved the error handling inside the `addResourcePath()` function, to give end users more informative error messages when the `directoryPath` argument cannot be normalized. This is especially useful for `runtime: shiny_prerendered` Rmd documents, like `learnr` tutorials. (#1968)
 
@@ -842,7 +690,7 @@ This is a maintenance release of Shiny, with some bug fixes and minor new featur
 
 * Restored file inputs are now copied on restore, so that the restored application can't modify the bookmarked file. (#1370)
 
-* Added support for plot interaction in the development version of ggplot2, 2.1.0.9000. Also added support for ggplot2 plots with `coord_flip()` (in the development version of ggplot2). ([hadley/ggplot2#1781](https://github.com/tidyverse/ggplot2/issues/1781), #1392)
+* Added support for plot interaction in the development version of ggplot2, 2.1.0.9000. Also added support for ggplot2 plots with `coord_flip()` (in the development version of ggplot2). ([hadley/ggplot2#1781](https://github.com/hadley/ggplot2/issues/1781), #1392)
 
 
 ### Bug fixes
@@ -874,7 +722,7 @@ Shiny now supports bookmarkable state: users can save the state of an applicatio
 **_Important note_:**
 > Saved-to-server bookmarking currently works with Shiny Server Open Source. Support on Shiny Server Pro, RStudio Connect, and shinyapps.io is under development and testing. However, URL-encoded bookmarking works on all hosting platforms.
 
-See [this article](https://shiny.rstudio.com/articles/bookmarking-state.html) to get started with bookmarkable state. There is also an [advanced-level article](https://shiny.rstudio.com/articles/advanced-bookmarking.html) (for apps that have a complex state), and [a modules article](https://shiny.rstudio.com/articles/bookmarking-modules.html) that details how to use bookmarking in conjunction with modules.
+See [this article](http://shiny.rstudio.com/articles/bookmarking-state.html) to get started with bookmarkable state. There is also an [advanced-level article](http://shiny.rstudio.com/articles/advanced-bookmarking.html) (for apps that have a complex state), and [a modules article](http://shiny.rstudio.com/articles/bookmarking-modules.html) that details how to use bookmarking in conjunction with modules.
 
 ## Notifications
 
@@ -884,7 +732,7 @@ Shiny can now display notifications on the client browser by using the `showNoti
 <img src="http://shiny.rstudio.com/images/notification.png" alt="notification" width="50%"/>
 </p>
 
-[Here](https://shiny.rstudio.com/articles/notifications.html)'s our article about it, and the [reference documentation](https://shiny.rstudio.com/reference/shiny/latest/showNotification.html).
+[Here](http://shiny.rstudio.com/articles/notifications.html)'s our article about it, and the [reference documentation](http://shiny.rstudio.com/reference/shiny/latest/showNotification.html).
 
 ## Progress indicators
 
@@ -893,7 +741,7 @@ If your Shiny app contains computations that take a long time to complete, a pro
 **_Important note_:**
 > If you were already using progress bars and had customized them with your own CSS, you can add the `style = "old"` argument to your `withProgress()` call (or `Progress$new()`). This will result in the same appearance as before. You can also call `shinyOptions(progress.style = "old")` in your app's server function to make all progress indicators use the old styling.
 
-To see new progress bars in action, see [this app](https://gallery.shinyapps.io/085-progress/) in the gallery. You can also learn more about this in [our article](https://shiny.rstudio.com/articles/progress.html) and in the reference documentation (either for the easier [`withProgress` functional API](https://shiny.rstudio.com/reference/shiny/latest/withProgress.html) or the more complicated, but more powerful, [`Progress` object-oriented API](https://shiny.rstudio.com/reference/shiny/latest/Progress.html).
+To see new progress bars in action, see [this app](https://gallery.shinyapps.io/085-progress/) in the gallery. You can also learn more about this in [our article](http://shiny.rstudio.com/articles/progress.html) and in the reference documentation (either for the easier [`withProgress` functional API](http://shiny.rstudio.com/reference/shiny/latest/withProgress.html) or the more complicated, but more powerful, [`Progress` object-oriented API](http://shiny.rstudio.com/reference/shiny/latest/Progress.html).
 
 ## Reconnection
 
@@ -907,7 +755,7 @@ Shiny has now built-in support for displaying modal dialogs like the one below (
 <img src="http://shiny.rstudio.com/images/modal-dialog.png" alt="modal-dialog" width="50%"/>
 </p>
 
-To learn more about this, read [our article](https://shiny.rstudio.com/articles/modal-dialogs.html) and the [reference documentation](https://shiny.rstudio.com/reference/shiny/latest/modalDialog.html).
+To learn more about this, read [our article](http://shiny.rstudio.com/articles/modal-dialogs.html) and the [reference documentation](http://shiny.rstudio.com/reference/shiny/latest/modalDialog.html).
 
 ## `insertUI` and `removeUI`
 
@@ -915,13 +763,13 @@ Sometimes in a Shiny app, arbitrary HTML UI may need to be created on-the-fly in
 
 See [this simple demo app](https://gallery.shinyapps.io/111-insert-ui/) of how one could use `insertUI` and `removeUI` to insert and remove text elements using a queue. Also see [this other app](https://gallery.shinyapps.io/insertUI/) that demonstrates how to insert and remove a few common Shiny input objects. Finally, [this app](https://gallery.shinyapps.io/insertUI-modules/) shows how to dynamically insert modules using `insertUI`.
 
-For more, read [our article](https://shiny.rstudio.com/articles/dynamic-ui.html) about dynamic UI generation and the reference documentation about [`insertUI`](https://shiny.rstudio.com/reference/shiny/latest/insertUI.html) and [`removeUI`](https://shiny.rstudio.com/reference/shiny/latest/insertUI.html).
+For more, read [our article](http://shiny.rstudio.com/articles/dynamic-ui.html) about dynamic UI generation and the reference documentation about [`insertUI`](http://shiny.rstudio.com/reference/shiny/latest/insertUI.html) and [`removeUI`](http://shiny.rstudio.com/reference/shiny/latest/removeUI.html).
 
 ## Documentation for connecting to an external database
 
-Many Shiny users have asked about best practices for accessing external databases from their Shiny applications. Although database access has long been possible using various database connector packages in R, it can be challenging to use them robustly in the dynamic environment that Shiny provides. So far, it has been mostly up to application authors to find the appropriate database drivers and to discover how to manage the database connections within an application. In order to demystify this process, we wrote a series of articles ([first one here](https://shiny.rstudio.com/articles/overview.html)) that covers the basics of connecting to an external database, as well as some security precautions to keep in mind (e.g. [how to avoid SQL injection attacks](https://shiny.rstudio.com/articles/sql-injections.html)).
+Many Shiny users have asked about best practices for accessing external databases from their Shiny applications. Although database access has long been possible using various database connector packages in R, it can be challenging to use them robustly in the dynamic environment that Shiny provides. So far, it has been mostly up to application authors to find the appropriate database drivers and to discover how to manage the database connections within an application. In order to demystify this process, we wrote a series of articles ([first one here](http://shiny.rstudio.com/articles/overview.html)) that covers the basics of connecting to an external database, as well as some security precautions to keep in mind (e.g. [how to avoid SQL injection attacks](http://shiny.rstudio.com/articles/sql-injections.html)).
 
-There are a few packages that you should look at if you're using a relational database in a Shiny app: the `dplyr` and `DBI` packages (both featured in the article linked to above), and the brand new `pool` package, which provides a further layer of abstraction to make it easier and safer to use either `DBI` or `dplyr`. `pool` is not yet on CRAN. In particular, `pool` will take care of managing connections, preventing memory leaks, and ensuring the best performance. See this [`pool` basics article](https://shiny.rstudio.com/articles/pool-basics.html) and the [more advanced-level article](https://shiny.rstudio.com/articles/pool-advanced.html) if you're feeling adventurous! (Both of these articles contain Shiny app examples that use `DBI` to connect to an external MySQL database.) If you are more comfortable with `dplyr` than `DBI`, don't miss the article about the [integration of `pool` and `dplyr`](https://shiny.rstudio.com/articles/pool-dplyr.html).
+There are a few packages that you should look at if you're using a relational database in a Shiny app: the `dplyr` and `DBI` packages (both featured in the article linked to above), and the brand new `pool` package, which provides a further layer of abstraction to make it easier and safer to use either `DBI` or `dplyr`. `pool` is not yet on CRAN. In particular, `pool` will take care of managing connections, preventing memory leaks, and ensuring the best performance. See this [`pool` basics article](http://shiny.rstudio.com/articles/pool-basics.html) and the [more advanced-level article](http://shiny.rstudio.com/articles/pool-advanced.html) if you're feeling adventurous! (Both of these articles contain Shiny app examples that use `DBI` to connect to an external MySQL database.) If you are more comfortable with `dplyr` than `DBI`, don't miss the article about the [integration of `pool` and `dplyr`](http://shiny.rstudio.com/articles/pool-dplyr.html).
 
 If you're new to databases in the Shiny world, we recommend using `dplyr` and `pool` if possible. If you need greater control than `dplyr` offers (for example, if you need to modify data in the database or use transactions), then use `DBI` and `pool`. The `pool` package was introduced to make your life easier, but in no way constrains you, so we don't envision any situation in which you'd be better off *not* using it. The only caveat is that `pool` is not yet on CRAN, so you may prefer to wait for that.
 
@@ -929,11 +777,11 @@ If you're new to databases in the Shiny world, we recommend using `dplyr` and `p
 
 There are many more minor features, small improvements, and bug fixes than we can cover here, so we'll just mention a few of the more noteworthy ones (the full changelog, with links to all the relevant issues and pull requests, is right below this section):
 
-*    **Error Sanitization**: you now have the option to sanitize error messages; in other words, the content of the original error message can be suppressed so that it doesn't leak any sensitive information. To sanitize errors everywhere in your app, just add `options(shiny.sanitize.errors = TRUE)` somewhere in your app. Read [this article](https://shiny.rstudio.com/articles/sanitize-errors.html) for more, or play with the [demo app](https://gallery.shinyapps.io/110-error-sanitization/).
+*    **Error Sanitization**: you now have the option to sanitize error messages; in other words, the content of the original error message can be suppressed so that it doesn't leak any sensitive information. To sanitize errors everywhere in your app, just add `options(shiny.sanitize.errors = TRUE)` somewhere in your app. Read [this article](http://shiny.rstudio.com/articles/sanitize-errors.html) for more, or play with the [demo app](https://gallery.shinyapps.io/110-error-sanitization/).
 
 *    **Code Diagnostics**: if there is an error parsing `ui.R`, `server.R`, `app.R`, or `global.R`, Shiny will search the code for missing commas, extra commas, and unmatched braces, parens, and brackets, and will print out messages pointing out those problems. (#1126)
 
-*    **Reactlog visualization**: by default, the [`showReactLog()` function](https://shiny.rstudio.com/reference/shiny/latest/reactlog.html) (which brings up the reactive graph) also displays the time that each reactive and observer were active for:
+*    **Reactlog visualization**: by default, the [`showReactLog()` function](http://shiny.rstudio.com/reference/shiny/latest/reactlog.html) (which brings up the reactive graph) also displays the time that each reactive and observer were active for:
 
       <p align="center">
       <img src="http://shiny.rstudio.com/images/reactlog.png" alt="modal-dialog" width="75%"/>
@@ -949,7 +797,7 @@ There are many more minor features, small improvements, and bug fixes than we ca
       <img src="http://shiny.rstudio.com/images/render-table.png" alt="render-table" width="75%"/>
       </p>
 
-      For more, read our [short article](https://shiny.rstudio.com/articles/render-table.html) about this update, experiment with all the new features in this [demo app](https://gallery.shinyapps.io/109-render-table/), or check out the [reference documentation](https://shiny.rstudio.com/reference/shiny/latest/renderTable.html).
+      For more, read our [short article](http://shiny.rstudio.com/articles/render-table.html) about this update, experiment with all the new features in this [demo app](https://gallery.shinyapps.io/109-render-table/), or check out the [reference documentation](http://shiny.rstudio.com/reference/shiny/latest/renderTable.html).
 
 ## Full changelog
 
@@ -1276,7 +1124,7 @@ Shiny 0.11 switches away from the Bootstrap 2 web framework to the next version,
   * `updateSliderInput()` can now control the min, max, value, and step size of a slider. Previously, only the value could be controlled this way, and if you wanted to change other values, you needed to use Shiny's dynamic UI.
 
 
-*    If in your HTML you are using custom CSS classes that are specific to Bootstrap, you may need to update them for Bootstrap 3. See the Bootstrap [migration guide](https://getbootstrap.com/migration/).
+*    If in your HTML you are using custom CSS classes that are specific to Bootstrap, you may need to update them for Bootstrap 3. See the Bootstrap [migration guide](http://getbootstrap.com/migration/).
 
 
 If you encounter other migration issues, please let us know on the [shiny-discuss](https://groups.google.com/forum/#!forum/shiny-discuss) mailing list, or on the Shiny [issue tracker](https://github.com/rstudio/shiny/issues).
@@ -1469,7 +1317,7 @@ shiny 0.9.0
 
 * Added `theme` parameter to page building functions for specifying alternate bootstrap css styles.
 
-* Added `icon()` function for embedding icons from the [font awesome](https://fontawesome.com) icon library
+* Added `icon()` function for embedding icons from the [font awesome](http://fontawesome.io/) icon library
 
 * Added `makeReactiveBinding` function to turn a "regular" variable into a reactive one (i.e. reading the variable makes the current reactive context dependent on it, and setting the variable is a source of reactivity).
 

R/app_template.R

@@ -10,7 +10,8 @@
 #' 2: app.R              : Main application file
 #' 3: R/example.R        : Helper file with R code
 #' 4: R/example-module.R : Example module
-#' 5: tests/testthat/    : Tests using the testthat and shinytest2 package
+#' 5: tests/shinytest/   : Tests using the shinytest package
+#' 6: tests/testthat/    : Tests using the testthat package
 #' ```
 #'
 #' If option 1 is selected, the full example application including the
@@ -23,11 +24,13 @@
 #' |   |- example-module.R
 #' |   `- example.R
 #' `- tests
+#'     |- shinytest.R
+#'     |- shinytest
+#'     |   `- mytest.R
 #'     |- testthat.R
 #'     `- testthat
 #'         |- test-examplemodule.R
 #'         |- test-server.R
-#'         |- test-shinytest2.R
 #'         `- test-sort.R
 #' ```
 #'
@@ -42,20 +45,20 @@
 #' * `tests/` contains various tests for the application. You may
 #'   choose to use or remove any of them. They can be executed by the
 #'   [runTests()] function.
+#' * `tests/shinytest.R` is a test runner for test files in the
+#'   `tests/shinytest/` directory.
+#' * `tests/shinytest/mytest.R` is a test that uses the
+#'   [shinytest](https://rstudio.github.io/shinytest/) package to do
+#'   snapshot-based testing.
 #' * `tests/testthat.R` is a test runner for test files in the
-#'   `tests/testthat/` directory using the
-#'   [shinytest2](https://rstudio.github.io/shinytest2/reference/test_app.html)
-#'   package.
+#'   `tests/testthat/` directory using the [testthat](https://testthat.r-lib.org/) package.
 #' * `tests/testthat/test-examplemodule.R` is a test for an application's module server function.
 #' * `tests/testthat/test-server.R` is a test for the application's server code
-#' * `tests/testthat/test-shinytest2.R` is a test that uses the
-#'   [shinytest2](https://rstudio.github.io/shinytest2/) package to do
-#'   snapshot-based testing.
 #' * `tests/testthat/test-sort.R` is a test for a supporting function in the `R/` directory.
 #'
 #' @param path Path to create new shiny application template.
 #' @param examples Either one of "default", "ask", "all", or any combination of
-#'   "app", "rdir", "module", and "tests". In an
+#'   "app", "rdir", "module", "shinytest", and "testthat". In an
 #'   interactive session, "default" falls back to "ask"; in a non-interactive
 #'   session, "default" falls back to "all". With "ask", this function will
 #'   prompt the user to select which template items will be added to the new app
@@ -76,19 +79,15 @@ shinyAppTemplate <- function(path = NULL, examples = "default", dryrun = FALSE)
   # =======================================================
 
   choices <- c(
-    app    = "app.R              : Main application file",
-    rdir   = "R/example.R        : Helper file with R code",
-    module = "R/example-module.R : Example module",
-    tests  = "tests/testthat/    : Tests using {testthat} and {shinytest2}"
+    app       = "app.R              : Main application file",
+    rdir      = "R/example.R        : Helper file with R code",
+    module    = "R/example-module.R : Example module",
+    shinytest = "tests/shinytest/   : Tests using the shinytest package",
+    testthat  = "tests/testthat/    : Tests using the testthat package"
   )
 
-  # Support legacy value
-  examples[examples == "shinytest"] <- "tests"
-  examples[examples == "testthat"] <- "tests"
-  examples <- unique(examples)
-
   if (identical(examples, "default")) {
-    if (rlang::is_interactive()) {
+    if (interactive()) {
       examples <- "ask"
     } else {
       examples <- "all"
@@ -125,8 +124,18 @@ shinyAppTemplate <- function(path = NULL, examples = "default", dryrun = FALSE)
     return(invisible())
   }
 
-  if ("tests" %in% examples) {
-    rlang::check_installed("shinytest2", "for {testthat} tests to work as expected")
+  if ("shinytest" %in% examples) {
+    if (!is_available("shinytest", "1.4.0"))
+    {
+      message(
+        "The tests/shinytest directory needs shinytest 1.4.0 or later to work properly."
+      )
+      if (is_available("shinytest")) {
+        message("You currently have shinytest ",
+                utils::packageVersion("shinytest"), " installed.")
+      }
+
+    }
   }
 
   # =======================================================
@@ -143,7 +152,7 @@ shinyAppTemplate <- function(path = NULL, examples = "default", dryrun = FALSE)
 
   # Helper to resolve paths relative to our template
   template_path <- function(...) {
-    system_file("app_template", ..., package = "shiny")
+    system.file("app_template", ..., package = "shiny")
   }
 
   # Resolve path relative to destination
@@ -199,13 +208,16 @@ shinyAppTemplate <- function(path = NULL, examples = "default", dryrun = FALSE)
   }
 
   # Copy the files for a tests/ subdirectory
-  copy_test_dir <- function() {
+  copy_test_dir <- function(name) {
     files <- dir(template_path("tests"), recursive = TRUE)
+    # Note: This is not the same as using dir(pattern = "^shinytest"), since
+    # that will not match files inside of shinytest/.
+    files <- files[grepl(paste0("^", name), files)]
 
     # Filter out files that are not module files in the R directory.
     if (! "rdir" %in% examples) {
       # find all files in the testthat folder that are not module or server files
-      is_r_folder_file <- !grepl("module|server|shinytest2|testthat", basename(files))
+      is_r_folder_file <- (!grepl("module|server", basename(files))) & (dirname(files) == "testthat")
       files <- files[!is_r_folder_file]
     }
 
@@ -270,10 +282,12 @@ shinyAppTemplate <- function(path = NULL, examples = "default", dryrun = FALSE)
     copy_file(file.path("R", module_files))
   }
 
-  # tests/testthat dir
-  if ("tests" %in% examples) {
-    copy_test_dir()
+  # tests/ dir
+  if ("shinytest" %in% examples) {
+    copy_test_dir("shinytest")
+  }
+  if ("testthat" %in% examples) {
+    copy_test_dir("testthat")
   }
-
   invisible()
 }

R/bind-cache.R

@@ -62,7 +62,7 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
 #'   bindCache({ extract_most_recent_time(bigdata()) })
 #' ```
 #'
-#' For computations that are very slow, it often makes sense to pair
+#' For computations that are vert slow, it often makes sense to pair
 #' [bindCache()] with [bindEvent()] so that no computation is performed until
 #' the user explicitly requests it (for more, see the Details section of
 #' [bindEvent()]).
@@ -155,7 +155,7 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
 #'   instead of the default 200 MB:
 #'
 #'   ```
-#'   shinyOptions(cache = cachem::cache_mem(max_size = 500e6))
+#'   shinyOptions(cache = cachem::cache_mem(size = 500e6))
 #'   ```
 #'
 #'   To use different settings for a session-scoped cache, you can set
@@ -167,7 +167,7 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
 #'
 #'   ```
 #'   function(input, output, session) {
-#'     session$cache <- cachem::cache_mem(max_size = 100e6)
+#'     session$cache <- cachem::cache_mem(size = 100e6)
 #'     ...
 #'   }
 #'   ```
@@ -247,15 +247,9 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
 #'
 #' @section Developing render functions for caching:
 #'
-#'   If you've implemented your own `render*()` function, it may just work with
-#'   `bindCache()`, but it is possible that you will need to make some
-#'   modifications. These modifications involve helping `bindCache()` avoid
-#'   cache collisions, dealing with internal state that may be set by the,
-#'   `render` function, and modifying the data as it goes in and comes out of
-#'   the cache.
-#'
-#'   You may need to provide a `cacheHint` to [createRenderFunction()] (or
-#'   `htmlwidgets::shinyRenderWidget()`, if you've authored an htmlwidget) in
+#'   If you've implemented your own `render*()` function, you may need to
+#'   provide a `cacheHint` to [createRenderFunction()] (or
+#'   [htmlwidgets::shinyRenderWidget()], if you've authored an htmlwidget) in
 #'   order for `bindCache()` to correctly compute a cache key.
 #'
 #'   The potential problem is a cache collision. Consider the following:
@@ -292,12 +286,12 @@ 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 [createRenderFunction()]
+#'   expression in another function, before passing it to [markRenderFunction()]
 #'   (instead of [createRenderFunction()]). Because the user code is wrapped in
-#'   another function, `createRenderFunction()` is not able to automatically
-#'   extract the user-provided code and use it in the cache key. Instead,
-#'   `renderPrint` calls `createRenderFunction()`, it explicitly passes along a
-#'   `cacheHint`, which includes a label and the original user expression.
+#'   another function, markRenderFunction() 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 `cacheHint`,
+#'   which includes a label and the original user expression.
 #'
 #'   In general, if you need to provide a `cacheHint`, it is best practice to
 #'   provide a `label` id, the user's `expr`, as well as any other arguments
@@ -310,28 +304,17 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
 #'
 #'   ```
 #'   renderMyWidget <- function(expr) {
-#'     q <- rlang::enquo0(expr)
+#'     expr <- substitute(expr)
 #'
-#'     htmlwidgets::shinyRenderWidget(
-#'       q,
+#'     htmlwidgets::shinyRenderWidget(expr,
 #'       myWidgetOutput,
 #'       quoted = TRUE,
-#'       cacheHint = list(label = "myWidget", userQuo = q)
+#'       env = parent.frame(),
+#'       cacheHint = list(label = "myWidget", userExpr = expr)
 #'     )
 #'   }
 #'   ```
 #'
-#'   If your `render` function sets any internal state, you may find it useful
-#'   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
-#'   that is stored and retrieved; this can be useful if extra information needs
-#'   to be stored in the cache. They can also be used to modify the state of the
-#'   application; for example, it can call [createWebDependency()] to make
-#'   JS/CSS resources available if the cached object is loaded in a different R
-#'   process. (See the source of `htmlwidgets::shinyRenderWidget` for an example
-#'   of this.)
 #'
 #' @section Uncacheable objects:
 #'
@@ -339,8 +322,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()`:
@@ -487,7 +470,7 @@ bindCache.reactiveExpr <- function(x, ..., cache = "app") {
   valueFunc <- reactive_get_value_func(x)
   # Hash cache hint now -- this will be added to the key later on, to reduce the
   # chance of key collisions with other cachedReactives.
-  cacheHint <- rlang::hash(extractCacheHint(x))
+  cacheHint <- digest(extractCacheHint(x), algo = "spookyhash")
   valueFunc <- wrapFunctionLabel(valueFunc, "cachedReactiveValueFunc", ..stacktraceon = TRUE)
 
   # Don't hold on to the reference for x, so that it can be GC'd
@@ -517,7 +500,7 @@ bindCache.shiny.render.function <- function(x, ..., cache = "app") {
 
   keyFunc <- quos_to_func(enquos0(...))
 
-  cacheHint <- rlang::hash(extractCacheHint(x))
+  cacheHint <- digest(extractCacheHint(x), algo = "spookyhash")
 
   cacheWriteHook <- attr(x, "cacheWriteHook", exact = TRUE) %||% identity
   cacheReadHook  <- attr(x, "cacheReadHook",  exact = TRUE) %||% identity
@@ -675,7 +658,7 @@ generateCacheFun <- function(
   ...
 ) {
   function(cacheKeyResult) {
-    key_str <- rlang::hash(list(cacheKeyResult, cacheHint))
+    key_str <- digest(list(cacheKeyResult, cacheHint), algo = "spookyhash")
     res <- cache$get(key_str)
 
     # Case 1: cache hit

R/bind-event.R

@@ -8,12 +8,6 @@
 #' the `...` arguments, and not on the original object's code. This can, for
 #' example, be used to make an observer execute only when a button is pressed.
 #'
-#' `bindEvent()` was added in Shiny 1.6.0. When it is used with [reactive()] and
-#' [observe()], it does the same thing as [eventReactive()] and
-#' [observeEvent()]. However, `bindEvent()` is more flexible: it can be combined
-#' with [bindCache()], and it can also be used with `render` functions (like
-#' [renderText()] and [renderPlot()]).
-#'
 #' @section Details:
 #'
 #'   Shiny's reactive programming framework is primarily designed for calculated
@@ -37,17 +31,16 @@
 #'   the original object's code to execute.
 #'
 #'   Use `bindEvent()` with `observe()` whenever you want to *perform an action*
-#'   in response to an event. (This does the same thing as [observeEvent()],
-#'   which was available in Shiny prior to version 1.6.0.) Note that
-#'   "recalculate a value" does not generally count as performing an action --
-#'   use [reactive()] for that.
+#'   in response to an event. (Note that "recalculate a value" does not
+#'   generally count as performing an action -- use [reactive()] for that.) The
+#'   first argument is observer whose code should be executed whenever the event
+#'   occurs.
 #'
-#'   Use `bindEvent()` with `reactive()` to create a *calculated value* that
-#'   only updates in response to an event. This is just like a normal [reactive
+#'   Use `bindEvent()` with `reactive()` to create a *calculated value* that only
+#'   updates in response to an event. This is just like a normal [reactive
 #'   expression][reactive] except it ignores all the usual invalidations that
 #'   come from its reactive dependencies; it only invalidates in response to the
-#'   given event. (This does the same thing as [eventReactive()], which was
-#'   available in Shiny prior to version 1.6.0.)
+#'   given event.
 #'
 #'   `bindEvent()` is often used with [bindCache()].
 #'

R/bookmark-state.R

@@ -1,3 +1,6 @@
+#' @include stack.R
+NULL
+
 ShinySaveState <- R6Class("ShinySaveState",
   public = list(
     input = NULL,
@@ -321,38 +324,34 @@ RestoreContext <- R6Class("RestoreContext",
       if (substr(queryString, 1, 1) == '?')
         queryString <- substr(queryString, 2, nchar(queryString))
 
-      # The "=" after "_inputs_" is optional. Shiny doesn't generate URLs with
-      # "=", but httr always adds "=".
-      inputs_reg <- "(^|&)_inputs_=?(&|$)"
-      values_reg <- "(^|&)_values_=?(&|$)"
 
       # Error if multiple '_inputs_' or '_values_'. This is needed because
       # strsplit won't add an entry if the search pattern is at the end of a
       # string.
-      if (length(gregexpr(inputs_reg, queryString)[[1]]) > 1)
+      if (length(gregexpr("(^|&)_inputs_(&|$)", queryString)[[1]]) > 1)
         stop("Invalid state string: more than one '_inputs_' found")
-      if (length(gregexpr(values_reg, queryString)[[1]]) > 1)
+      if (length(gregexpr("(^|&)_values_(&|$)", queryString)[[1]]) > 1)
         stop("Invalid state string: more than one '_values_' found")
 
       # Look for _inputs_ and store following content in inputStr
-      splitStr <- strsplit(queryString, inputs_reg)[[1]]
+      splitStr <- strsplit(queryString, "(^|&)_inputs_(&|$)")[[1]]
       if (length(splitStr) == 2) {
         inputStr <- splitStr[2]
         # Remove any _values_ (and content after _values_) that may come after
         # _inputs_
-        inputStr <- strsplit(inputStr, values_reg)[[1]][1]
+        inputStr <- strsplit(inputStr, "(^|&)_values_(&|$)")[[1]][1]
 
       } else {
         inputStr <- ""
       }
 
       # Look for _values_ and store following content in valueStr
-      splitStr <- strsplit(queryString, values_reg)[[1]]
+      splitStr <- strsplit(queryString, "(^|&)_values_(&|$)")[[1]]
       if (length(splitStr) == 2) {
         valueStr <- splitStr[2]
         # Remove any _inputs_ (and content after _inputs_) that may come after
         # _values_
-        valueStr <- strsplit(valueStr, inputs_reg)[[1]][1]
+        valueStr <- strsplit(valueStr, "(^|&)_inputs_(&|$)")[[1]][1]
 
       } else {
         valueStr <- ""
@@ -363,20 +362,16 @@ RestoreContext <- R6Class("RestoreContext",
       values <- parseQueryString(valueStr, nested = TRUE)
 
       valuesFromJSON <- function(vals) {
-        varsUnparsed <- c()
-        valsParsed <- mapply(names(vals), vals, SIMPLIFY = FALSE,
+        mapply(names(vals), vals, SIMPLIFY = FALSE,
           FUN = function(name, value) {
             tryCatch(
               safeFromJSON(value),
               error = function(e) {
-                varsUnparsed <<- c(varsUnparsed, name)
-                warning("Failed to parse URL parameter \"", name, "\"")
+                stop("Failed to parse URL parameter \"", name, "\"")
               }
             )
           }
         )
-        valsParsed[varsUnparsed] <- NULL
-        valsParsed
       }
 
       inputs <- valuesFromJSON(inputs)
@@ -452,8 +447,8 @@ RestoreInputSet <- R6Class("RestoreInputSet",
   )
 )
 
-# This is a fastmap::faststack(); value is assigned in .onLoad().
-restoreCtxStack <- NULL
+
+restoreCtxStack <- Stack$new()
 
 withRestoreContext <- function(ctx, expr) {
   restoreCtxStack$push(ctx)
@@ -1165,10 +1160,10 @@ setBookmarkExclude <- function(names = character(0), session = getDefaultReactiv
 #'     toupper(input$text)
 #'   })
 #'   onBookmark(function(state) {
-#'     state$values$hash <- rlang::hash(input$text)
+#'     state$values$hash <- digest::digest(input$text, "md5")
 #'   })
 #'   onRestore(function(state) {
-#'     if (identical(rlang::hash(input$text), state$values$hash)) {
+#'     if (identical(digest::digest(input$text, "md5"), state$values$hash)) {
 #'       message("Module's input text matches hash ", state$values$hash)
 #'     } else {
 #'       message("Module's input text does not match hash ", state$values$hash)
@@ -1191,10 +1186,10 @@ setBookmarkExclude <- function(names = character(0), session = getDefaultReactiv
 #' server <- function(input, output, session) {
 #'   callModule(capitalizerServer, "tc")
 #'   onBookmark(function(state) {
-#'     state$values$hash <- rlang::hash(input$text)
+#'     state$values$hash <- digest::digest(input$text, "md5")
 #'   })
 #'   onRestore(function(state) {
-#'     if (identical(rlang::hash(input$text), state$values$hash)) {
+#'     if (identical(digest::digest(input$text, "md5"), state$values$hash)) {
 #'       message("App's input text matches hash ", state$values$hash)
 #'     } else {
 #'       message("App's input text does not match hash ", state$values$hash)

R/bootstrap-deprecated.R

@@ -6,7 +6,7 @@
 #' @param sidebarPanel The [sidebarPanel] containing input controls
 #' @param mainPanel The [mainPanel] containing outputs
 #' @keywords internal
-#' @return A UI definition that can be passed to the [shinyUI] function
+#' @return A UI defintion that can be passed to the [shinyUI] function
 #' @export
 pageWithSidebar <- function(headerPanel,
                             sidebarPanel,

R/bootstrap-layout.R

@@ -11,9 +11,14 @@
 #' @param ... Elements to include within the page
 #' @param title The browser window title (defaults to the host URL of the page).
 #'   Can also be set as a side effect of the [titlePanel()] function.
+#' @param responsive This option is deprecated; it is no longer optional with
+#'   Bootstrap 3.
+#' @param theme Alternative Bootstrap stylesheet (normally a css file within the
+#'   www directory). For example, to use the theme located at
+#'   `www/bootstrap.css` you would use `theme = "bootstrap.css"`.
 #' @inheritParams bootstrapPage
 #'
-#' @return A UI definition that can be passed to the [shinyUI] function.
+#' @return A UI defintion that can be passed to the [shinyUI] function.
 #'
 #' @details To create a fluid page use the `fluidPage` function and include
 #'   instances of `fluidRow` and [column()] within it. As an
@@ -21,7 +26,7 @@
 #'   higher-level layout functions like [sidebarLayout()].
 #'
 #' @note See the [
-#'   Shiny-Application-Layout-Guide](https://shiny.rstudio.com/articles/layout-guide.html) for additional details on laying out fluid
+#'   Shiny-Application-Layout-Guide](http://shiny.rstudio.com/articles/layout-guide.html) for additional details on laying out fluid
 #'   pages.
 #'
 #' @family layout functions
@@ -83,9 +88,10 @@
 #' }
 #' @rdname fluidPage
 #' @export
-fluidPage <- function(..., title = NULL, theme = NULL, lang = NULL) {
+fluidPage <- function(..., title = NULL, responsive = NULL, theme = NULL, lang = NULL) {
   bootstrapPage(div(class = "container-fluid", ...),
                 title = title,
+                responsive = responsive,
                 theme = theme,
                 lang = lang)
 }
@@ -109,9 +115,14 @@ fluidRow <- function(...) {
 #'
 #' @param ... Elements to include within the container
 #' @param title The browser window title (defaults to the host URL of the page)
+#' @param responsive This option is deprecated; it is no longer optional with
+#'   Bootstrap 3.
+#' @param theme Alternative Bootstrap stylesheet (normally a css file within the
+#'   www directory). For example, to use the theme located at
+#'   `www/bootstrap.css` you would use `theme = "bootstrap.css"`.
 #' @inheritParams bootstrapPage
 #'
-#' @return A UI definition that can be passed to the [shinyUI] function.
+#' @return A UI defintion that can be passed to the [shinyUI] function.
 #'
 #' @details To create a fixed page use the `fixedPage` function and include
 #'   instances of `fixedRow` and [column()] within it. Note that
@@ -120,7 +131,7 @@ fluidRow <- function(...) {
 #'   with `fixedRow` and `column`.
 #'
 #' @note See the [
-#'   Shiny Application Layout Guide](https://shiny.rstudio.com/articles/layout-guide.html) for additional details on laying out fixed
+#'   Shiny Application Layout Guide](http://shiny.rstudio.com/articles/layout-guide.html) for additional details on laying out fixed
 #'   pages.
 #'
 #' @family layout functions
@@ -148,9 +159,10 @@ fluidRow <- function(...) {
 #'
 #' @rdname fixedPage
 #' @export
-fixedPage <- function(..., title = NULL, theme = NULL, lang = NULL) {
+fixedPage <- function(..., title = NULL, responsive = NULL, theme = NULL, lang = NULL) {
   bootstrapPage(div(class = "container", ...),
                 title = title,
+                responsive = responsive,
                 theme = theme,
                 lang = lang)
 }
@@ -390,7 +402,7 @@ mainPanel <- function(..., width = 8) {
 #' }
 #' @export
 verticalLayout <- function(..., fluid = TRUE) {
-  lapply(list2(...), function(row) {
+  lapply(list(...), function(row) {
     col <- column(12, row)
     if (fluid)
       fluidRow(col)
@@ -427,7 +439,7 @@ verticalLayout <- function(..., fluid = TRUE) {
 #' @export
 flowLayout <- function(..., cellArgs = list()) {
 
-  children <- list2(...)
+  children <- list(...)
   childIdx <- !nzchar(names(children) %||% character(length(children)))
   attribs <- children[!childIdx]
   children <- children[childIdx]
@@ -510,13 +522,13 @@ inputPanel <- function(...) {
 #' @export
 splitLayout <- function(..., cellWidths = NULL, cellArgs = list()) {
 
-  children <- list2(...)
+  children <- list(...)
   childIdx <- !nzchar(names(children) %||% character(length(children)))
   attribs <- children[!childIdx]
   children <- children[childIdx]
   count <- length(children)
 
-  if (length(cellWidths) == 0 || isTRUE(is.na(cellWidths))) {
+  if (length(cellWidths) == 0 || is.na(cellWidths)) {
     cellWidths <- sprintf("%.3f%%", 100 / count)
   }
   cellWidths <- rep(cellWidths, length.out = count)
@@ -608,7 +620,7 @@ fillCol <- function(..., flex = 1, width = "100%", height = "100%") {
 }
 
 flexfill <- function(..., direction, flex, width = width, height = height) {
-  children <- list2(...)
+  children <- list(...)
   attrs <- list()
 
   if (!is.null(names(children))) {
@@ -689,3 +701,37 @@ flexfill <- function(..., direction, flex, width = width, height = height) {
   )
   do.call(tags$div, c(attrs, divArgs))
 }
+
+css <- function(..., collapse_ = "") {
+  props <- list(...)
+  if (length(props) == 0) {
+    return("")
+  }
+
+  if (is.null(names(props)) || any(names(props) == "")) {
+    stop("cssList expects all arguments to be named")
+  }
+
+  # Necessary to make factors show up as level names, not numbers
+  props[] <- lapply(props, paste, collapse = " ")
+
+  # Drop null args
+  props <- props[!sapply(props, empty)]
+  if (length(props) == 0) {
+    return("")
+  }
+
+  # Replace all '.' and '_' in property names to '-'
+  names(props) <- gsub("[._]", "-", tolower(gsub("([A-Z])", "-\\1", names(props))))
+
+  # Create "!important" suffix for each property whose name ends with !, then
+  # remove the ! from the property name
+  important <- ifelse(grepl("!$", names(props), perl = TRUE), " !important", "")
+  names(props) <- sub("!$", "", names(props), perl = TRUE)
+
+  paste0(names(props), ":", props, important, ";", collapse = collapse_)
+}
+
+empty <- function(x) {
+  length(x) == 0 || (is.character(x) && !any(nzchar(x)))
+}

R/bootstrap.R

@@ -4,7 +4,7 @@ NULL
 #' Create a Bootstrap page
 #'
 #' Create a Shiny UI page that loads the CSS and JavaScript for
-#' [Bootstrap](https://getbootstrap.com/), and has no content in the page
+#' [Bootstrap](http://getbootstrap.com/), and has no content in the page
 #' body (other than what you provide).
 #'
 #' This function is primarily intended for users who are proficient in HTML/CSS,
@@ -14,6 +14,8 @@ NULL
 #'
 #' @param ... The contents of the document body.
 #' @param title The browser window title (defaults to the host URL of the page)
+#' @param responsive This option is deprecated; it is no longer optional with
+#'   Bootstrap 3.
 #' @param theme One of the following:
 #'   * `NULL` (the default), which implies a "stock" build of Bootstrap 3.
 #'   * A [bslib::bs_theme()] object. This can be used to replace a stock
@@ -24,40 +26,33 @@ NULL
 #'   This will be used as the lang in the \code{<html>} tag, as in \code{<html lang="en">}.
 #'   The default (NULL) results in an empty string.
 #'
-#' @return A UI definition that can be passed to the [shinyUI] function.
+#' @return A UI defintion that can be passed to the [shinyUI] function.
 #'
 #' @note The `basicPage` function is deprecated, you should use the
 #'   [fluidPage()] function instead.
 #'
 #' @seealso [fluidPage()], [fixedPage()]
 #' @export
-bootstrapPage <- function(..., title = NULL, theme = NULL, lang = NULL) {
+bootstrapPage <- function(..., title = NULL, responsive = NULL, theme = NULL, lang = NULL) {
 
-  args <- list(
-    jqueryDependency(),
-    if (!is.null(title)) tags$head(tags$title(title)),
-    if (is.character(theme)) {
-      if (length(theme) > 1) stop("`theme` must point to a single CSS file, not multiple files.")
-      tags$head(tags$link(rel="stylesheet", type="text/css", href=theme))
-    },
-    # remainder of tags passed to the function
-    list2(...)
-  )
-
-  # If theme is a bslib::bs_theme() object, bootstrapLib() needs to come first
-  # (so other tags, when rendered via tagFunction(), know about the relevant
-  # theme). However, if theme is anything else, we intentionally avoid changing
-  # the tagList() contents to avoid breaking user code that makes assumptions
-  # about the return value https://github.com/rstudio/shiny/issues/3235
-  if (is_bs_theme(theme)) {
-    args <- c(bootstrapLib(theme), args)
-    ui <- do.call(tagList, args)
-  } else {
-    ui <- do.call(tagList, args)
-    ui <- attachDependencies(ui, bootstrapLib())
+  if (!is.null(responsive)) {
+    shinyDeprecated("The 'responsive' argument is no longer used with Bootstrap 3.")
   }
 
-  setLang(ui, lang)
+  ui <- tagList(
+    bootstrapLib(theme),
+    if (!is.null(title)) tags$head(tags$title(title)),
+    # TODO: throw better error when length > 1?
+    if (is.character(theme)) {
+      tags$head(tags$link(rel="stylesheet", type="text/css", href = theme))
+    },
+    # remainder of tags passed to the function
+    list(...)
+  )
+
+  ui <- setLang(ui, lang)
+
+  return(ui)
 }
 
 setLang <- function(ui, lang) {
@@ -83,10 +78,6 @@ getLang <- function(ui) {
 #' @export
 bootstrapLib <- function(theme = NULL) {
   tagFunction(function() {
-    if (isRunning()) {
-      setCurrentTheme(theme)
-    }
-
     # If we're not compiling Bootstrap Sass (from bslib), return the
     # static Bootstrap build.
     if (!is_bs_theme(theme)) {
@@ -108,6 +99,7 @@ bootstrapLib <- function(theme = NULL) {
     # Note also that since this is shinyOptions() (and not options()), the
     # option is automatically reset when the app (or session) exits
     if (isRunning()) {
+      setCurrentTheme(theme)
       registerThemeDependency(bs_theme_deps)
 
     } else {
@@ -138,7 +130,8 @@ bs_theme_deps <- function(theme) {
 }
 
 is_bs_theme <- function(x) {
-  bslib::is_bs_theme(x)
+  is_available("bslib", "0.2.0.9000") &&
+    bslib::is_bs_theme(x)
 }
 
 #' Obtain Shiny's Bootstrap Sass theme
@@ -157,15 +150,6 @@ getCurrentTheme <- function() {
   getShinyOption("bootstrapTheme", default = NULL)
 }
 
-getCurrentThemeVersion <- function() {
-  theme <- getCurrentTheme()
-  if (bslib::is_bs_theme(theme)) {
-    bslib::theme_version(theme)
-  } else {
-    strsplit(bootstrapVersion, ".", fixed = TRUE)[[1]][[1]]
-  }
-}
-
 setCurrentTheme <- function(theme) {
   shinyOptions(bootstrapTheme = theme)
 }
@@ -214,10 +198,11 @@ registerThemeDependency <- function(func) {
 
 bootstrapDependency <- function(theme) {
   htmlDependency(
-    "bootstrap",
-    bootstrapVersion,
-    src = "www/shared/bootstrap",
-    package = "shiny",
+    "bootstrap", "3.4.1",
+    c(
+      href = "shared/bootstrap",
+      file = system.file("www/shared/bootstrap", package = "shiny")
+    ),
     script = c(
       "js/bootstrap.min.js",
       # Safely adding accessibility plugin for screen readers and keyboard users; no break for sighted aspects (see https://github.com/paypal/bootstrap-accessibility-plugin)
@@ -226,14 +211,12 @@ bootstrapDependency <- function(theme) {
     stylesheet = c(
       theme %||% "css/bootstrap.min.css",
       # Safely adding accessibility plugin for screen readers and keyboard users; no break for sighted aspects (see https://github.com/paypal/bootstrap-accessibility-plugin)
-      "accessibility/css/bootstrap-accessibility.min.css"
+      "accessibility/css/bootstrap-accessibility.css"
     ),
     meta = list(viewport = "width=device-width, initial-scale=1")
   )
 }
 
-bootstrapVersion <- "3.4.1"
-
 
 #' @rdname bootstrapPage
 #' @export
@@ -287,6 +270,7 @@ basicPage <- function(...) {
 #' @param title The title to use for the browser window/tab (it will not be
 #'   shown in the document).
 #' @param bootstrap If `TRUE`, load the Bootstrap CSS library.
+#' @param theme URL to alternative Bootstrap stylesheet.
 #' @inheritParams bootstrapPage
 #'
 #' @family layout functions
@@ -376,16 +360,20 @@ collapseSizes <- function(padding) {
 #' @param collapsible `TRUE` to automatically collapse the navigation
 #'   elements into a menu when the width of the browser is less than 940 pixels
 #'   (useful for viewing on smaller touchscreen device)
+#' @param collapsable Deprecated; use `collapsible` instead.
 #' @param fluid `TRUE` to use a fluid layout. `FALSE` to use a fixed
 #'   layout.
-#' @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).
+#' @param responsive This option is deprecated; it is no longer optional with
+#'   Bootstrap 3.
+#' @param theme Alternative Bootstrap stylesheet (normally a css file within the
+#'   www directory). For example, to use the theme located at
+#'   `www/bootstrap.css` you would use `theme = "bootstrap.css"`.
+#' @param windowTitle The title that should be displayed by the browser window.
+#'   Useful if `title` is not a string.
 #' @inheritParams bootstrapPage
 #' @param icon Optional icon to appear on a `navbarMenu` tab.
 #'
-#' @return A UI definition that can be passed to the [shinyUI] function.
+#' @return A UI defintion that can be passed to the [shinyUI] function.
 #'
 #' @details The `navbarMenu` function can be used to create an embedded
 #'   menu within the navbar that in turns includes additional tabPanels (see
@@ -423,20 +411,86 @@ navbarPage <- function(title,
                        footer = NULL,
                        inverse = FALSE,
                        collapsible = FALSE,
+                       collapsable,
                        fluid = TRUE,
+                       responsive = NULL,
                        theme = NULL,
-                       windowTitle = NA,
+                       windowTitle = title,
                        lang = NULL) {
-  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,
+
+  if (!missing(collapsable)) {
+    shinyDeprecated("`collapsable` is deprecated; use `collapsible` instead.")
+    collapsible <- collapsable
+  }
+
+  # alias title so we can avoid conflicts w/ title in withTags
+  pageTitle <- title
+
+  # navbar class based on options
+  navbarClass <- "navbar navbar-default"
+  position <- match.arg(position)
+  if (!is.null(position))
+    navbarClass <- paste(navbarClass, " navbar-", position, sep = "")
+  if (inverse)
+    navbarClass <- paste(navbarClass, "navbar-inverse")
+
+  if (!is.null(id))
+    selected <- restoreInput(id = id, default = selected)
+
+  # build the tabset
+  tabs <- list(...)
+  tabset <- buildTabset(tabs, "nav navbar-nav", NULL, id, selected)
+
+  # function to return plain or fluid class name
+  className <- function(name) {
+    if (fluid)
+      paste(name, "-fluid", sep="")
+    else
+      name
+  }
+
+  # built the container div dynamically to support optional collapsibility
+  if (collapsible) {
+    navId <- paste("navbar-collapse-", p_randomInt(1000, 10000), sep="")
+    containerDiv <- div(class=className("container"),
+      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=className("container"),
+      div(class="navbar-header",
+        span(class="navbar-brand", pageTitle)
+      ),
+      tabset$navList
+    )
+  }
+
+  # build the main tab content div
+  contentDiv <- div(class=className("container"))
+  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,
+    responsive = responsive,
     theme = theme,
-    window_title = windowTitle,
-    lang = lang
-  ))
+    lang = lang,
+    tags$nav(class=navbarClass, role="navigation", containerDiv),
+    contentDiv
+  )
 }
 
 #' @param menuName A name that identifies this `navbarMenu`. This
@@ -446,7 +500,11 @@ navbarPage <- function(title,
 #' @rdname navbarPage
 #' @export
 navbarMenu <- function(title, ..., menuName = title, icon = NULL) {
-  bslib::nav_menu(title, ..., value = menuName, icon = icon)
+  structure(list(title = title,
+                 menuName = menuName,
+                 tabs = list(...),
+                 iconClass = iconClass(icon)),
+            class = "shiny.navbarmenu")
 }
 
 #' Create a well panel
@@ -581,14 +639,27 @@ 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) {
-  bslib::nav(title, ..., value = value, icon = icon)
+  div(
+    class = "tab-pane",
+    title = title,
+    `data-value` = value,
+    `data-icon-class` = iconClass(icon),
+    ...
+  )
 }
-
 #' @export
 #' @describeIn tabPanel Create a tab panel that drops the title argument.
 #'   This function should be used within `tabsetPanel(type = "hidden")`. See [tabsetPanel()] for example usage.
 tabPanelBody <- function(value, ..., icon = NULL) {
-  bslib::nav_content(value, ..., icon = icon)
+  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)
 }
 
 #' Create a tabset panel
@@ -611,7 +682,8 @@ tabPanelBody <- function(value, ..., icon = NULL) {
 #'   conjunction with [tabPanelBody()] and [updateTabsetPanel()] to control the
 #'   active tab via other input controls. (See example below)}
 #' }
-#' @inheritParams navbarPage
+#' @param position This argument is deprecated; it has been discontinued in
+#'   Bootstrap 3.
 #' @return A tabset that can be passed to [mainPanel()]
 #'
 #' @seealso [tabPanel()], [updateTabsetPanel()],
@@ -661,21 +733,28 @@ tabsetPanel <- function(...,
                         id = NULL,
                         selected = NULL,
                         type = c("tabs", "pills", "hidden"),
-                        header = NULL,
-                        footer = NULL) {
+                        position = NULL) {
+  if (!is.null(position)) {
+    shinyDeprecated(msg = paste("tabsetPanel: argument 'position' is deprecated;",
+                                "it has been discontinued in Bootstrap 3."),
+                    version = "0.10.2.2")
+  }
 
-  func <- switch(
-    match.arg(type),
-    tabs = bslib::navs_tab,
-    pills = bslib::navs_pill,
-    hidden = bslib::navs_hidden
-  )
+  if (!is.null(id))
+    selected <- restoreInput(id = id, default = selected)
 
-  # 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)
-  )
+  # build the tabset
+  tabs <- list(...)
+  type <- match.arg(type)
+
+  tabset <- buildTabset(tabs, paste0("nav nav-", type), NULL, id, selected)
+
+  # create the content
+  first <- tabset$navList
+  second <- tabset$content
+
+  # create the tab div
+  tags$div(class = "tabbable", first, second)
 }
 
 #' Create a navigation list panel
@@ -695,10 +774,8 @@ tabsetPanel <- function(...,
 #'   navigation list.
 #' @param fluid `TRUE` to use fluid layout; `FALSE` to use fixed
 #'   layout.
-#' @param widths Column widths of the navigation list and tabset content areas
+#' @param widths Column withs of the navigation list and tabset content areas
 #'   respectively.
-#' @inheritParams tabsetPanel
-#' @inheritParams navbarPage
 #'
 #' @details You can include headers within the `navlistPanel` by including
 #'   plain text elements in the list. Versions of Shiny before 0.11 supported
@@ -725,37 +802,208 @@ tabsetPanel <- function(...,
 navlistPanel <- function(...,
                          id = NULL,
                          selected = NULL,
-                         header = NULL,
-                         footer = NULL,
                          well = TRUE,
                          fluid = TRUE,
                          widths = c(4, 8)) {
-  remove_first_class(bslib::navs_pill_list(
-    ..., id = id, selected = selected,
-    header = header, footer = footer,
-    well = well, fluid = fluid, widths = widths
-  ))
+
+  # text filter for headers
+  textFilter <- function(text) {
+      tags$li(class="navbar-brand", text)
+  }
+
+  if (!is.null(id))
+    selected <- restoreInput(id = id, default = selected)
+
+  # build the tabset
+  tabs <- list(...)
+  tabset <- buildTabset(tabs,
+                        "nav nav-pills nav-stacked",
+                        textFilter,
+                        id,
+                        selected)
+
+  # create the columns
+  columns <- list(
+    column(widths[[1]], class=ifelse(well, "well", ""), tabset$navList),
+    column(widths[[2]], tabset$content)
+  )
+
+  # return the row
+  if (fluid)
+    fluidRow(columns)
+  else
+    fixedRow(columns)
 }
 
-remove_first_class <- function(x) {
-  class(x) <- class(x)[-1]
+# Helpers to build tabsetPanels (& Co.) and their elements
+markTabAsSelected <- function(x) {
+  attr(x, "selected") <- TRUE
   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(div) {
+    if (foundSelected || is.character(div)) {
+      # Strings are not selectable items
+
+    } else if (inherits(div, "shiny.navbarmenu")) {
+      # Recur for navbarMenus
+      res <- findAndMarkSelectedTab(div$tabs, selected, foundSelected)
+      div$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
+        div <- markTabAsSelected(div)
+      } else {
+        tabValue <- div$attribs$`data-value` %||% div$attribs$title
+        if (identical(selected, tabValue)) {
+          foundSelected <<- TRUE
+          div <- markTabAsSelected(div)
+        }
+      }
+    }
+    return(div)
+  })
+  return(list(tabs = tabs, foundSelected = foundSelected))
+}
+
+# Returns the icon object (or NULL if none), provided either a
+# tabPanel, OR the icon class
+getIcon <- function(tab = NULL, iconClass = NULL) {
+  if (!is.null(tab)) iconClass <- tab$attribs$`data-icon-class`
+  if (!is.null(iconClass)) {
+    if (grepl("fa-", iconClass, fixed = TRUE)) {
+      # for font-awesome we specify fixed-width
+      iconClass <- paste(iconClass, "fa-fw")
+    }
+    icon(name = NULL, class = iconClass)
+  } else NULL
+}
+
+# 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(tabs, ulClass, textFilter = NULL, id = NULL,
+                        selected = NULL, foundSelected = FALSE) {
+
+  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, "[[", 1))
+
+  tabContent <- tags$div(class = "tab-content",
+                  `data-tabsetid` = tabsetId, lapply(tabs, "[[", 2))
+
+  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 <- if (!is.null(divTag)) divTag else tabs[[index]]
+
+  if (is.character(divTag) && !is.null(textFilter)) {
+    # text item: pass it to the textFilter if it exists
+    liTag <- textFilter(divTag)
+    divTag <- NULL
+
+  } else if (inherits(divTag, "shiny.navbarmenu")) {
+    # navbarMenu item: build the child tabset
+    tabset <- buildTabset(divTag$tabs, "dropdown-menu",
+      navbarMenuTextFilter, foundSelected = foundSelected)
+
+    # if this navbarMenu contains a selected item, mark it active
+    containsSelected <- containsSelectedTab(divTag$tabs)
+    liTag <- tags$li(
+      class = paste0("dropdown", if (containsSelected) " active"),
+      tags$a(href = "#",
+        class = "dropdown-toggle", `data-toggle` = "dropdown",
+        `data-value` = divTag$menuName,
+        getIcon(iconClass = divTag$iconClass),
+        divTag$title, tags$b(class = "caret")
+      ),
+      tabset$navList   # inner tabPanels items
+    )
+    # list of tab content divs from the child tabset
+    divTag <- tabset$content$children
+
+  } else {
+    # tabPanel item: create the tab's liTag and divTag
+    tabId <- paste("tab", tabsetId, index, sep = "-")
+    liTag <- tags$li(
+               tags$a(
+                 href = paste("#", tabId, sep = ""),
+                 `data-toggle` = "tab",
+                 `data-value` = divTag$attribs$`data-value`,
+                 getIcon(iconClass = divTag$attribs$`data-icon-class`),
+                 divTag$attribs$title
+               )
+    )
+    # if this tabPanel is selected item, mark it active
+    if (isTabSelected(divTag)) {
+      liTag$attribs$class <- "active"
+      divTag$attribs$class <- "tab-pane active"
+    }
+    divTag$attribs$id <- tabId
+    divTag$attribs$title <- NULL
+  }
+  return(list(liTag = liTag, divTag = divTag))
+}
+
+
 #' Create a text output element
 #'
 #' Render a reactive output variable as text within an application page.
 #' `textOutput()` is usually paired with [renderText()] and puts regular text
 #' in `<div>` or `<span>`; `verbatimTextOutput()` is usually paired with
-#' [renderPrint()] and provides fixed-width text in a `<pre>`.
+#' [renderPrint()] and provudes fixed-width text in a `<pre>`.
 #'
-#' In both functions, text is HTML-escaped prior to rendering.
+#' In both funtions, text is HTML-escaped prior to rendering.
 #'
 #' @param outputId output variable to read the value from
 #' @param container a function to generate an HTML element to contain the text
 #' @param inline use an inline (`span()`) or block container (`div()`)
 #'   for the output
-#' @return An output element for use in UI.
+#' @return A output element for use in UI.
 #' @examples
 #' ## Only run this example in interactive R sessions
 #' if (interactive()) {
@@ -778,14 +1026,14 @@ textOutput <- function(outputId, container = if (inline) span else div, inline =
 
 #' @param placeholder if the output is empty or `NULL`, should an empty
 #'   rectangle be displayed to serve as a placeholder? (does not affect
-#'   behavior when the output is nonempty)
+#'   behavior when the the output in nonempty)
 #' @export
 #' @rdname textOutput
 verbatimTextOutput <- function(outputId, placeholder = FALSE) {
   pre(id = outputId,
-    class = "shiny-text-output",
-    class = if (!placeholder) "noplaceholder"
-  )
+      class = paste(c("shiny-text-output", if (!placeholder) "noplaceholder"),
+                    collapse = " ")
+      )
 }
 
 
@@ -797,9 +1045,7 @@ imageOutput <- function(outputId, width = "100%", height="400px",
                         inline = FALSE) {
 
   style <- if (!inline) {
-    # Using `css()` here instead of paste/sprintf so that NULL values will
-    # result in the property being dropped altogether
-    css(width = validateCssUnit(width), height = validateCssUnit(height))
+    paste("width:", validateCssUnit(width), ";", "height:", validateCssUnit(height))
   }
 
 
@@ -1098,8 +1344,49 @@ plotOutput <- function(outputId, width = "100%", height="400px",
   res
 }
 
+#' Create a table output element
+#'
+#' Render a [renderTable()] or [renderDataTable()] within an
+#' application page. `renderTable` uses a standard HTML table, while
+#' `renderDataTable` uses the DataTables Javascript library to create an
+#' interactive table with more features.
+#'
 #' @param outputId output variable to read the table from
-#' @rdname renderTable
+#' @return A table output element that can be included in a panel
+#'
+#' @seealso [renderTable()], [renderDataTable()].
+#' @examples
+#' ## Only run this example in interactive R sessions
+#' if (interactive()) {
+#'   # table example
+#'   shinyApp(
+#'     ui = fluidPage(
+#'       fluidRow(
+#'         column(12,
+#'           tableOutput('table')
+#'         )
+#'       )
+#'     ),
+#'     server = function(input, output) {
+#'       output$table <- renderTable(iris)
+#'     }
+#'   )
+#'
+#'
+#'   # DataTables example
+#'   shinyApp(
+#'     ui = fluidPage(
+#'       fluidRow(
+#'         column(12,
+#'           dataTableOutput('table')
+#'         )
+#'       )
+#'     ),
+#'     server = function(input, output) {
+#'       output$table <- renderDataTable(iris)
+#'     }
+#'   )
+#' }
 #' @export
 tableOutput <- function(outputId) {
   div(id = outputId, class="shiny-html-output")
@@ -1107,23 +1394,17 @@ tableOutput <- function(outputId) {
 
 dataTableDependency <- list(
   htmlDependency(
-    "datatables",
-    "1.10.5",
-    src = "www/shared/datatables",
-    package = "shiny",
+    "datatables", "1.10.5", c(href = "shared/datatables"),
     script = "js/jquery.dataTables.min.js"
   ),
   htmlDependency(
-    "datatables-bootstrap",
-    "1.10.5",
-    src = "www/shared/datatables",
-    package = "shiny",
+    "datatables-bootstrap", "1.10.5", c(href = "shared/datatables"),
     stylesheet = c("css/dataTables.bootstrap.css", "css/dataTables.extra.css"),
     script = "js/dataTables.bootstrap.js"
   )
 )
 
-#' @rdname renderDataTable
+#' @rdname tableOutput
 #' @export
 dataTableOutput <- function(outputId) {
   attachDependencies(
@@ -1157,7 +1438,7 @@ dataTableOutput <- function(outputId) {
 htmlOutput <- function(outputId, inline = FALSE,
   container = if (inline) span else div, ...)
 {
-  if (any_unnamed(list(...))) {
+  if (anyUnnamed(list(...))) {
     warning("Unnamed elements in ... will be replaced with dynamic UI.")
   }
   container(id = outputId, class="shiny-html-output", ...)
@@ -1236,31 +1517,32 @@ downloadLink <- function(outputId, label="Download", class=NULL, ...) {
 #' Create an icon
 #'
 #' Create an icon for use within a page. Icons can appear on their own, inside
-#' of a button, and/or used with [tabPanel()] and [navbarMenu()].
+#' of a button, or as an icon for a [tabPanel()] within a
+#' [navbarPage()].
 #'
-#' @param name The name of the icon. A name from either [Font
-#'   Awesome](https://fontawesome.com/) (when `lib="font-awesome"`) or
-#'   [Bootstrap
-#'   Glyphicons](https://getbootstrap.com/docs/3.3/components/#glyphicons) (when
-#'   `lib="glyphicon"`) may be provided. Note that the `"fa-"` and
-#'   `"glyphicon-"` prefixes should not appear in name (i.e., the
-#'   `"fa-calendar"` icon should be referred to as `"calendar"`). A `name` of
-#'   `NULL` may also be provided to get a raw `<i>` tag with no library attached
-#'   to it.
-#' @param class Additional classes to customize the style of an icon (see the
-#'   [usage examples](https://fontawesome.com/how-to-use) for details on
+#' @param name Name of icon. Icons are drawn from the
+#'   [Font Awesome Free](https://fontawesome.com/) (currently icons from
+#'   the v5.13.0 set are supported with the v4 naming convention) and
+#'   [Glyphicons](http://getbootstrap.com/components/#glyphicons)
+#'   libraries. Note that the "fa-" and "glyphicon-" prefixes should not be used
+#'   in icon names (i.e. the "fa-calendar" icon should be referred to as
+#'   "calendar")
+#' @param class Additional classes to customize the style of the icon (see the
+#'   [usage examples](http://fontawesome.io/examples/) for details on
 #'   supported styles).
-#' @param lib The icon library to use. Either `"font-awesome"` or `"glyphicon"`.
-#' @param ... Arguments passed to the `<i>` tag of [htmltools::tags].
+#' @param lib Icon library to use ("font-awesome" or "glyphicon")
+#' @param ... Arguments passed to the `<i>` tag of [htmltools::tags]
 #'
-#' @return An `<i>` (icon) HTML tag.
+#' @return An icon element
+#'
+#' @seealso For lists of available icons, see
+#'   [http://fontawesome.io/icons/](http://fontawesome.io/icons/) and
+#'   [http://getbootstrap.com/components/#glyphicons](http://getbootstrap.com/components/#glyphicons).
 #'
-#' @seealso For lists of available icons, see <https://fontawesome.com/icons>
-#'   and <https://getbootstrap.com/docs/3.3/components/#glyphicons>
 #'
 #' @examples
 #' # add an icon to a submit button
-#' submitButton("Update View", icon = icon("redo"))
+#' submitButton("Update View", icon = icon("refresh"))
 #'
 #' navbarPage("App Title",
 #'   tabPanel("Plot", icon = icon("bar-chart-o")),
@@ -1269,26 +1551,48 @@ downloadLink <- function(outputId, label="Download", class=NULL, ...) {
 #' )
 #' @export
 icon <- function(name, class = NULL, lib = "font-awesome", ...) {
+  prefixes <- list(
+    "font-awesome" = "fa",
+    "glyphicon" = "glyphicon"
+  )
+  prefix <- prefixes[[lib]]
 
-  # A NULL name allows for a generic <i> not tied to any library
-  if (is.null(name)) {
-    lib <- "none"
+  # determine stylesheet
+  if (is.null(prefix)) {
+    stop("Unknown font library '", lib, "' specified. Must be one of ",
+         paste0('"', names(prefixes), '"', collapse = ", "))
   }
 
-  switch(
-    lib %||% "",
-    "none" = iconTag(name, class = class, ...),
-    "font-awesome" = fontawesome::fa_i(name = name, class = class, ...),
-    "glyphicon" = iconTag(
-      name, class = "glyphicon", class = paste0("glyphicon-", name),
-      class = class, ...
-    ),
-    stop("Unknown icon library: ", lib, ". See `?icon` for supported libraries.")
-  )
+  # build the icon class (allow name to be null so that other functions
+  # e.g. buildTabset can pass an explicit class value)
+  iconClass <- ""
+  if (!is.null(name)) {
+    prefix_class <- prefix
+    if (prefix_class == "fa" && name %in% font_awesome_brands) {
+      prefix_class <- "fab"
+    }
+    iconClass <- paste0(prefix_class, " ", prefix, "-", name)
+  }
+  if (!is.null(class))
+    iconClass <- paste(iconClass, class)
+
+  iconTag <- tags$i(class = iconClass, role = "presentation", `aria-label` = paste(name, "icon"), ...)
+
+  # font-awesome needs an additional dependency (glyphicon is in bootstrap)
+  if (lib == "font-awesome") {
+    htmlDependencies(iconTag) <- htmlDependency(
+      "font-awesome", "5.13.0", "www/shared/fontawesome", package = "shiny",
+      stylesheet = c(
+        "css/all.min.css",
+        "css/v4-shims.min.css"
+      )
+    )
+  }
+
+  htmltools::browsable(iconTag)
 }
 
-iconTag <- function(name, ...) {
-  htmltools::browsable(
-    tags$i(..., role = "presentation", `aria-label` = paste(name, "icon"))
-  )
+# Helper funtion to extract the class from an icon
+iconClass <- function(icon) {
+  if (!is.null(icon)) icon$attribs$class
 }

R/conditions.R

@@ -133,7 +133,7 @@ captureStackTraces <- function(expr) {
 createStackTracePromiseDomain <- function() {
   # These are actually stateless, we wouldn't have to create a new one each time
   # if we didn't want to. They're pretty cheap though.
-
+  
   d <- promises::new_promise_domain(
     wrapOnFulfilled = function(onFulfilled) {
       force(onFulfilled)
@@ -217,7 +217,7 @@ doCaptureStack <- function(e) {
 #' @rdname stacktrace
 #' @export
 withLogErrors <- function(expr,
-  full = get_devmode_option("shiny.fullstacktrace", FALSE),
+  full = getOption("shiny.fullstacktrace", FALSE),
   offset = getOption("shiny.stacktraceoffset", TRUE)) {
 
   withCallingHandlers(
@@ -228,9 +228,7 @@ withLogErrors <- function(expr,
       if (promises::is.promise(result)) {
         result <- promises::catch(result, function(cond) {
           # Don't print shiny.silent.error (i.e. validation errors)
-          if (cnd_inherits(cond, "shiny.silent.error")) {
-            return()
-          }
+          if (inherits(cond, "shiny.silent.error")) return()
           if (isTRUE(getOption("show.error.messages"))) {
             printError(cond, full = full, offset = offset)
           }
@@ -241,7 +239,7 @@ withLogErrors <- function(expr,
     },
     error = function(cond) {
       # Don't print shiny.silent.error (i.e. validation errors)
-      if (cnd_inherits(cond, "shiny.silent.error")) return()
+      if (inherits(cond, "shiny.silent.error")) return()
       if (isTRUE(getOption("show.error.messages"))) {
         printError(cond, full = full, offset = offset)
       }
@@ -266,34 +264,34 @@ withLogErrors <- function(expr,
 #' @rdname stacktrace
 #' @export
 printError <- function(cond,
-  full = get_devmode_option("shiny.fullstacktrace", FALSE),
+  full = getOption("shiny.fullstacktrace", FALSE),
   offset = getOption("shiny.stacktraceoffset", TRUE)) {
-
-  warning(call. = FALSE, immediate. = TRUE, sprintf("Error in %s: %s",
+  
+  warning(call. = FALSE, immediate. = TRUE, sprintf("Error in %s: %s", 
     getCallNames(list(conditionCall(cond))), conditionMessage(cond)))
-
+  
   printStackTrace(cond, full = full, offset = offset)
 }
 
 #' @rdname stacktrace
 #' @export
 printStackTrace <- function(cond,
-  full = get_devmode_option("shiny.fullstacktrace", FALSE),
+  full = getOption("shiny.fullstacktrace", FALSE),
   offset = getOption("shiny.stacktraceoffset", TRUE)) {
 
   should_drop <- !full
   should_strip <- !full
   should_prune <- !full
-
+  
   stackTraceCalls <- c(
     attr(cond, "deep.stack.trace", exact = TRUE),
     list(attr(cond, "stack.trace", exact = TRUE))
   )
-
+  
   stackTraceParents <- lapply(stackTraceCalls, attr, which = "parents", exact = TRUE)
   stackTraceCallNames <- lapply(stackTraceCalls, getCallNames)
   stackTraceCalls <- lapply(stackTraceCalls, offsetSrcrefs, offset = offset)
-
+  
   # Use dropTrivialFrames logic to remove trailing bits (.handleSimpleError, h)
   if (should_drop) {
     # toKeep is a list of logical vectors, of which elements (stack frames) to keep
@@ -303,7 +301,7 @@ printStackTrace <- function(cond,
     stackTraceCallNames <- mapply(stackTraceCallNames, FUN = `[`, toKeep, SIMPLIFY = FALSE)
     stackTraceParents <- mapply(stackTraceParents, FUN = `[`, toKeep, SIMPLIFY = FALSE)
   }
-
+  
   delayedAssign("all_true", {
     # List of logical vectors that are all TRUE, the same shape as
     # stackTraceCallNames. Delay the evaluation so we don't create it unless
@@ -312,7 +310,7 @@ printStackTrace <- function(cond,
       rep_len(TRUE, length(st))
     })
   })
-
+  
   # stripStackTraces and lapply(stackTraceParents, pruneStackTrace) return lists
   # of logical vectors. Use mapply(FUN = `&`) to boolean-and each pair of the
   # logical vectors.
@@ -322,7 +320,7 @@ printStackTrace <- function(cond,
     FUN = `&`,
     SIMPLIFY = FALSE
   )
-
+  
   dfs <- mapply(seq_along(stackTraceCalls), rev(stackTraceCalls), rev(stackTraceCallNames), rev(toShow), FUN = function(i, calls, nms, index) {
     st <- data.frame(
       num = rev(which(index)),
@@ -331,7 +329,7 @@ printStackTrace <- function(cond,
       category = rev(getCallCategories(calls[index])),
       stringsAsFactors = FALSE
     )
-
+    
     if (i != 1) {
       message("From earlier call:")
     }
@@ -359,10 +357,85 @@ printStackTrace <- function(cond,
 
     st
   }, SIMPLIFY = FALSE)
-
+  
   invisible()
 }
 
+#' @details `extractStackTrace` takes a list of calls (e.g. as returned
+#'   from `conditionStackTrace(cond)`) and returns a data frame with one
+#'   row for each stack frame and the columns `num` (stack frame number),
+#'   `call` (a function name or similar), and `loc` (source file path
+#'   and line number, if available). It was deprecated after shiny 1.0.5 because
+#'   it doesn't support deep stack traces.
+#' @rdname stacktrace
+#' @export
+extractStackTrace <- function(calls,
+  full = getOption("shiny.fullstacktrace", FALSE),
+  offset = getOption("shiny.stacktraceoffset", TRUE)) {
+  
+  shinyDeprecated(NULL,
+    "extractStackTrace is deprecated. Please contact the Shiny team if you were using this functionality.",
+    version = "1.0.5")
+
+  srcrefs <- getSrcRefs(calls)
+  if (offset) {
+    # Offset calls vs. srcrefs by 1 to make them more intuitive.
+    # E.g. for "foo [bar.R:10]", line 10 of bar.R will be part of
+    # the definition of foo().
+    srcrefs <- c(utils::tail(srcrefs, -1), list(NULL))
+  }
+  calls <- setSrcRefs(calls, srcrefs)
+
+  callnames <- getCallNames(calls)
+
+  # Hide and show parts of the callstack based on ..stacktrace(on|off)..
+  if (full) {
+    toShow <- rep.int(TRUE, length(calls))
+  } else {
+    # Remove stop(), .handleSimpleError(), and h() calls from the end of
+    # the calls--they don't add any helpful information. But only remove
+    # the last *contiguous* block of them, and then, only if they are the
+    # last thing in the calls list.
+    hideable <- callnames %in% c("stop", ".handleSimpleError", "h")
+    # What's the last that *didn't* match stop/.handleSimpleError/h?
+    lastGoodCall <- max(which(!hideable))
+    toRemove <- length(calls) - lastGoodCall
+    # But don't remove more than 5 levels--that's an indication we might
+    # have gotten it wrong, I guess
+    if (toRemove > 0 && toRemove < 5) {
+      calls <- utils::head(calls, -toRemove)
+      callnames <- utils::head(callnames, -toRemove)
+    }
+
+    # This uses a ref-counting scheme. It might make sense to switch this
+    # to a toggling scheme, so the most recent ..stacktrace(on|off)..
+    # directive wins, regardless of what came before it.
+    # Also explicitly remove ..stacktraceon.. because it can appear with
+    # score > 0 but still should never be shown.
+    score <- rep.int(0, length(callnames))
+    score[callnames == "..stacktraceoff.."] <- -1
+    score[callnames == "..stacktraceon.."] <- 1
+    toShow <- (1 + cumsum(score)) > 0 & !(callnames %in% c("..stacktraceon..", "..stacktraceoff..", "..stacktracefloor.."))
+
+    # doTryCatch, tryCatchOne, and tryCatchList are not informative--they're
+    # just internals for tryCatch
+    toShow <- toShow & !(callnames %in% c("doTryCatch", "tryCatchOne", "tryCatchList"))
+  }
+  calls <- calls[toShow]
+
+  calls <- rev(calls) # Show in traceback() order
+  index <- rev(which(toShow))
+  width <- floor(log10(max(index))) + 1
+
+  data.frame(
+    num = index,
+    call = getCallNames(calls),
+    loc = getLocs(calls),
+    category = getCallCategories(calls),
+    stringsAsFactors = FALSE
+  )
+}
+
 stripStackTraces <- function(stackTraces, values = FALSE) {
   score <- 1L  # >=1: show, <=0: hide
   lapply(seq_along(stackTraces), function(i) {
@@ -386,19 +459,19 @@ stripOneStackTrace <- function(stackTrace, truncateFloor, startingScore) {
       prefix <- rep_len(FALSE, indexOfFloor)
     }
   }
-
+  
   if (length(stackTrace) == 0) {
     return(list(score = startingScore, character(0)))
   }
-
+  
   score <- rep.int(0L, length(stackTrace))
   score[stackTrace == "..stacktraceon.."] <- 1L
   score[stackTrace == "..stacktraceoff.."] <- -1L
   score <- startingScore + cumsum(score)
-
+  
   toShow <- score > 0 & !(stackTrace %in% c("..stacktraceon..", "..stacktraceoff..", "..stacktracefloor.."))
-
-
+  
+  
   list(score = utils::tail(score, 1), trace = c(prefix, toShow))
 }
 
@@ -413,32 +486,23 @@ pruneStackTrace <- function(parents) {
   # sufficient; we also need to drop nodes that are the last child, but one of
   # their ancestors is not.
   is_dupe <- duplicated(parents, fromLast = TRUE)
-
+  
   # The index of the most recently seen node that was actually kept instead of
   # dropped.
   current_node <- 0
-
+  
   # Loop over the parent indices. Anything that is not parented by current_node
   # (a.k.a. last-known-good node), or is a dupe, can be discarded. Anything that
   # is kept becomes the new current_node.
-  #
-  # jcheng 2022-03-18: Two more reasons a node can be kept:
-  #   1. parent is 0
-  #   2. parent is i
-  # Not sure why either of these situations happen, but they're common when
-  # interacting with rlang/dplyr errors. See issue rstudio/shiny#3250 for repro
-  # cases.
   include <- vapply(seq_along(parents), function(i) {
-    if ((!is_dupe[[i]] && parents[[i]] == current_node) ||
-        parents[[i]] == 0 ||
-        parents[[i]] == i) {
+    if (!is_dupe[[i]] && parents[[i]] == current_node) {
       current_node <<- i
       TRUE
     } else {
       FALSE
     }
   }, FUN.VALUE = logical(1))
-
+  
   include
 }
 
@@ -451,7 +515,7 @@ dropTrivialFrames <- function(callnames) {
   # What's the last that *didn't* match stop/.handleSimpleError/h?
   lastGoodCall <- max(which(!hideable))
   toRemove <- length(callnames) - lastGoodCall
-
+  
   c(
     rep_len(TRUE, length(callnames) - toRemove),
     rep_len(FALSE, toRemove)
@@ -466,12 +530,48 @@ offsetSrcrefs <- function(calls, offset = TRUE) {
     # E.g. for "foo [bar.R:10]", line 10 of bar.R will be part of
     # the definition of foo().
     srcrefs <- c(utils::tail(srcrefs, -1), list(NULL))
+    
     calls <- setSrcRefs(calls, srcrefs)
   }
-
+  
   calls
 }
 
+#' @details `formatStackTrace` is similar to `extractStackTrace`, but
+#'   it returns a preformatted character vector instead of a data frame. It was
+#'   deprecated after shiny 1.0.5 because it doesn't support deep stack traces.
+#' @param indent A string to prefix every line of the stack trace.
+#' @rdname stacktrace
+#' @export
+formatStackTrace <- function(calls, indent = "    ",
+  full = getOption("shiny.fullstacktrace", FALSE),
+  offset = getOption("shiny.stacktraceoffset", TRUE)) {
+
+  shinyDeprecated(NULL,
+    "extractStackTrace is deprecated. Please contact the Shiny team if you were using this functionality.",
+    version = "1.0.5")
+  
+  st <- extractStackTrace(calls, full = full, offset = offset)
+  if (nrow(st) == 0) {
+    return(character(0))
+  }
+
+  width <- floor(log10(max(st$num))) + 1
+  paste0(
+    indent,
+    formatC(st$num, width = width),
+    ": ",
+    mapply(paste0(st$call, st$loc), st$category, FUN = function(name, category) {
+      if (category == "pkg")
+        crayon::silver(name)
+      else if (category == "user")
+        crayon::blue$bold(name)
+      else
+        crayon::white(name)
+    })
+  )
+}
+
 getSrcRefs <- function(calls) {
   lapply(calls, function(call) {
     attr(call, "srcref", exact = TRUE)

R/deprecated.R

@@ -1,57 +1,44 @@
-
 #' Print message for deprecated functions in Shiny
 #'
 #' To disable these messages, use `options(shiny.deprecation.messages=FALSE)`.
 #'
-#' @param version Shiny version when the function was deprecated
-#' @param what Function with possible arguments
-#' @param with Possible function with arguments that should be used instead
-#' @param details Additional information to be added after a new line to the displayed message
+#' @param new Name of replacement function.
+#' @param msg Message to print. If used, this will override the default message.
+#' @param old Name of deprecated function.
+#' @param version The last version of Shiny before the item was deprecated.
 #' @keywords internal
-shinyDeprecated <- function(
-  version,
-  what,
-  with = NULL,
-  details = NULL,
-  type = c("deprecated", "superseded")
-) {
-  if (is_false(getOption("shiny.deprecation.messages"))) {
+shinyDeprecated <- function(new=NULL, msg=NULL,
+                            old=as.character(sys.call(sys.parent()))[1L],
+                            version = NULL) {
+
+  if (getOption("shiny.deprecation.messages") %||% TRUE == FALSE)
     return(invisible())
+
+  if (is.null(msg)) {
+    msg <- paste(old, "is deprecated.")
+    if (!is.null(new)) {
+      msg <- paste(msg, "Please use", new, "instead.",
+        "To disable this message, run options(shiny.deprecation.messages=FALSE)")
+    }
   }
 
-  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.")
-  }
-  if (!is.null(details)) {
-    msg <- paste0(msg, "\n", details)
+  if (!is.null(version)) {
+    msg <- paste0(msg, " (Last used in version ", version, ")")
   }
 
-  # lifecycle::deprecate_soft(when, what, with = with, details = details, id = id, env = env)
-  rlang::inform(message = msg, .frequency = "always", .frequency_id = msg, .file = stderr())
+  # Similar to .Deprecated(), but print a message instead of warning
+  message(msg)
 }
 
 
-deprecatedEnvQuotedMessage <- function() {
-  if (!in_devmode()) return(invisible())
-  if (is_false(getOption("shiny.deprecation.messages"))) return(invisible())
-
-  # 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.7.0.",
-    " Please use quosures from `rlang` instead.\n",
-    "See <https://github.com/rstudio/shiny/issues/3108> for more information.\n",
-    "Function call:\n",
-    grandparent_txt
-  )
-  # Call less often as users do not have much control over this warning
-  rlang::inform(message = msg, .frequency = "regularly", .frequency_id = msg, .file = stderr())
+deprecatedEnvQuotedMessage <- function(env_arg = "env", quoted_arg = "quoted") {
+  # Enable this message in a future version of Shiny, perhaps in a dev_edition()
+  # mode.
+  # shinyDeprecated(msg = paste(
+  #   sprintf("The `%s` and `%s` arguments are deprecated.", env_arg, quoted_arg),
+  #   "Please use quosures from rlang instead.",
+  #   "See https://github.com/rstudio/shiny/issues/3108 for more information."
+  # ))
 }
 
 
@@ -69,13 +56,10 @@ diskCache <- function(
   evict = c("lru", "fifo"),
   destroy_on_finalize = FALSE,
   missing = key_missing(),
-  exec_missing = deprecated(),
-  logfile = NULL
-) {
-  shinyDeprecated("1.6.0", "diskCache()", "cachem::cache_disk()")
-  if (is_present(exec_missing)) {
-    shinyDeprecated("1.6.0", "diskCache(exec_missing =)")
-  }
+  exec_missing = FALSE,
+  logfile = NULL)
+{
+  shinyDeprecated("cachem::cache_disk", version = "1.5.1")
 
   cachem::cache_disk(
     dir = dir,
@@ -102,13 +86,10 @@ memoryCache <- function(
   max_n = Inf,
   evict = c("lru", "fifo"),
   missing = key_missing(),
-  exec_missing = deprecated(),
+  exec_missing = FALSE,
   logfile = NULL)
 {
-  shinyDeprecated("1.6.0", "diskCache()", "cachem::cache_mem()")
-  if (is_present(exec_missing)) {
-    shinyDeprecated("1.6.0", "diskCache(exec_missing =)")
-  }
+  shinyDeprecated("cachem::cache_mem", version = "1.5.1")
 
   cachem::cache_mem(
     max_size = max_size,

R/devmode.R

@@ -1,360 +0,0 @@
-#' Shiny Developer Mode
-#'
-#' @description \lifecycle{experimental}
-#'
-#'   Developer Mode enables a number of [options()] to make a developer's life
-#'   easier, like enabling non-minified JS and printing messages about
-#'   deprecated functions and options.
-#'
-#'   Shiny Developer Mode can be enabled by calling `devmode(TRUE)` and disabled
-#'   by calling `devmode(FALSE)`.
-#'
-#'   Please see the function descriptions for more details.
-#'
-#' @describeIn devmode Function to set two options to enable/disable Shiny
-#'   Developer Mode and Developer messages
-#' @param devmode Logical value which should be set to `TRUE` to enable Shiny
-#'   Developer Mode
-#' @param verbose Logical value which should be set to `TRUE` display Shiny
-#'   Developer messages
-#' @export
-#' @examples
-#' # Enable Shiny Developer mode
-#' devmode()
-#'
-devmode <- function(
-  devmode = getOption("shiny.devmode", TRUE),
-  verbose = getOption("shiny.devmode.verbose", TRUE)
-) {
-  options(
-    shiny.devmode = devmode,
-    shiny.devmode.verbose = verbose
-  )
-}
-
-
-#' @describeIn devmode Determines if Shiny is in Developer Mode. If the
-#'   `getOption("shiny.devmode")` is set to `TRUE` and not in testing inside
-#'   `testthat`, then Shiny Developer Mode is enabled.
-#' @section Avoiding direct dependency on shiny:
-#'
-#'   The methods explained in this help file act independently from the rest of
-#'   Shiny but are included to provide blue prints for your own packages. If
-#'   your package already has (or is willing to take) a dependency on Shiny, we
-#'   recommend using the exported Shiny methods for consistent behavior. Note
-#'   that if you use exported Shiny methods, it will cause the Shiny package to
-#'   load. This may be undesirable if your code will be used in (for example) R
-#'   Markdown documents that do not have a Shiny runtime (`runtime: shiny`).
-#'
-#'   If your package can **not** take a dependency on Shiny, we recommending
-#'   re-implementing these two functions:
-#'
-#' \enumerate{
-#' \item `in_devmode()`:
-#'
-#'   This function should return `TRUE` if `getOption("shiny.devmode")` is set.
-#'   In addition, we strongly recommend that it also checks to make sure
-#'   `testthat` is not testing.
-#'
-#' ```r
-#' in_devmode <- function() {
-#'   isTRUE(getOption("shiny.devmode", FALSE)) &&
-#'     !identical(Sys.getenv("TESTTHAT"), "true")
-#' }
-#' ```
-#'
-#' \item `get_devmode_option(name, default, devmode_default, devmode_message)`:
-#'
-#' This function is similar to `getOption(name, default)`, but when the option
-#' is not set, the default value changes depending on the Dev Mode.
-#' `get_devmode_option()` should be implemented as follows:
-#'
-#' * If not in Dev Mode:
-#'   * Return `getOption(name, default)`.
-#' * If in Dev Mode:
-#'   * Get the global option `getOption(name)` value.
-#'   * If the global option value is set:
-#'     * Return the value.
-#'   * If the global option value is not set:
-#'     * Notify the developer that the Dev Mode default value will be used.
-#'     * Return the Dev Mode default value.
-#'
-#' When notifying the developer that the default value has changed, we strongly
-#' recommend displaying a message (`devmode_message`) to `stderr()` once every 8
-#' hours using [rlang::inform()]. This will keep the author up to date as to
-#' which Dev Mode options are being altered. To allow developers a chance to
-#' disable Dev Mode messages, the message should be skipped if
-#' `getOption("shiny.devmode.verbose", TRUE)` is not `TRUE`.
-#'
-#' ```r
-#' get_devmode_option <- function(name, default = NULL, devmode_default, devmode_message) {
-#'   if (!in_devmode()) {
-#'     # Dev Mode disabled, act like `getOption()`
-#'     return(getOption(name, default = default))
-#'   }
-#'
-#'   # Dev Mode enabled, update the default value for `getOption()`
-#'   getOption(name, default = {
-#'     # Notify developer
-#'     if (
-#'       !missing(devmode_message) &&
-#'       !is.null(devmode_message) &&
-#'       getOption("shiny.devmode.verbose", TRUE)
-#'     ) {
-#'       rlang::inform(
-#'         message = devmode_message,
-#'         .frequency = "regularly",
-#'         .frequency_id = devmode_message,
-#'         .file = stderr()
-#'       )
-#'     }
-#'
-#'     # Return Dev Mode default value `devmode_default`
-#'     devmode_default
-#'   })
-#' }
-#' ```
-#' }
-#'
-#' The remaining functions in this file are used for author convenience and are
-#' not recommended for all reimplementation situations.
-#' @export
-#' @examples
-#' in_devmode() # TRUE/FALSE?
-#'
-in_devmode <- function() {
-  isTRUE(getOption("shiny.devmode", FALSE)) &&
-    # !testthat::is_testing()
-    !identical(Sys.getenv("TESTTHAT"), "true")
-}
-
-#' @describeIn devmode Temporarily set Shiny Developer Mode and Developer
-#'   message verbosity
-#' @param code Code to execute with the temporary Dev Mode options set
-#' @export
-#' @examples
-#' # Execute code in a temporary shiny dev mode
-#' with_devmode(TRUE, in_devmode()) # TRUE
-#'
-with_devmode <- function(
-  devmode,
-  code,
-  verbose = getOption("shiny.devmode.verbose", TRUE)
-) {
-  withr::with_options(
-    list(
-      shiny.devmode = devmode,
-      shiny.devmode.verbose = verbose
-    ),
-    code
-  )
-}
-
-
-#' @describeIn devmode If Shiny Developer Mode and verbosity are enabled,
-#'   displays a message once every 8 hrs (by default)
-#' @param message Developer Mode message to be sent to [rlang::inform()]
-#' @param .frequency Frequency of the Developer Mode message used with
-#'   [rlang::inform()]. Defaults to once every 8 hours.
-#' @param .frequency_id [rlang::inform()] message identifier. Defaults to
-#'   `message`.
-#' @param .file Output connection for [rlang::inform()]. Defaults to [stderr()]
-#' @param ... Parameters passed to [rlang::inform()]
-devmode_inform <- function(
-  message,
-  .frequency = "regularly",
-  .frequency_id = message,
-  .file = stderr(),
-  ...
-) {
-
-  if (!(
-    in_devmode() &&
-      isTRUE(getOption("shiny.devmode.verbose", TRUE))
-  )) {
-    return()
-  }
-  if (is.null(message)) {
-    return()
-  }
-
-  rlang::inform(
-    message = paste0("shiny devmode - ", message),
-    .frequency = .frequency,
-    .frequency_id = .frequency_id,
-    .file = .file,
-    ...
-  )
-}
-
-
-
-
-#' @include map.R
-registered_devmode_options <- Map$new()
-
-#' @describeIn devmode Registers a Shiny Developer Mode option with an updated
-#'   value and Developer message. This registration method allows package
-#'   authors to write one message in a single location.
-#'
-#'   For example, the following Shiny Developer Mode options are registered:
-#'
-#' ```r
-#' # Reload the Shiny app when a sourced R file changes
-#' register_devmode_option(
-#'   "shiny.autoreload",
-#'   "Turning on shiny autoreload. To disable, call `options(shiny.autoreload = FALSE)`",
-#'   devmode_default = TRUE
-#' )
-#'
-#' # Use the unminified Shiny JavaScript file, `shiny.js`
-#' register_devmode_option(
-#'   "shiny.minified",
-#'   "Using full shiny javascript file. To use the minified version, call `options(shiny.minified = TRUE)`",
-#'   devmode_default = FALSE
-#' )
-#'
-#' # Display the full stack trace when errors occur during Shiny app execution
-#' register_devmode_option(
-#'   "shiny.fullstacktrace",
-#'   "Turning on full stack trace. To disable, call `options(shiny.fullstacktrace = FALSE)`",
-#'   devmode_default = TRUE
-#' )
-#' ```
-#'
-#' Other known, non-Shiny Developer Mode options:
-#'
-#' * Sass:
-#' ```r
-#' # Display the full stack trace when errors occur during Shiny app execution
-#' register_devmode_option(
-#'   "sass.cache",
-#'   "Turning off sass cache. To use default caching, call `options(sass.cache = TRUE)`",
-#'   devmode_default = FALSE
-#' )
-#' ```
-#'
-#' @param name Name of option to look for in `options()`
-#' @param default Default value to return if `in_devmode()` returns
-#'   `TRUE` and the specified option is not set in [`options()`].
-#' @param devmode_message Message to display once every 8 hours when utilizing
-#'   the `devmode_default` value.  If `devmode_message` is missing, the
-#'   registered `devmode_message` value be used.
-#' @param devmode_default Default value to return if `in_devmode()` returns
-#'   `TRUE` and the specified option is not set in [`options()`]. For
-#'   `get_devmode_option()`, if `devmode_default` is missing, the
-#'   registered `devmode_default` value will be used.
-#' @export
-#' @examples
-#' # Ex: Within shiny, we register the option "shiny.minified"
-#' #   to default to `FALSE` when in Dev Mode
-#' \dontrun{register_devmode_option(
-#'   "shiny.minified",
-#'   devmode_message = paste0(
-#'     "Using full shiny javascript file. ",
-#'     "To use the minified version, call `options(shiny.minified = TRUE)`"
-#'   ),
-#'   devmode_default = FALSE
-#' )}
-#'
-register_devmode_option <- function(
-  name,
-  devmode_message = NULL,
-  devmode_default = NULL
-) {
-  if (!is.null(devmode_message)) {
-    stopifnot(length(devmode_message) == 1 && is.character(devmode_message))
-  }
-  registered_devmode_options$set(
-    name,
-    list(devmode_default = devmode_default, devmode_message = devmode_message)
-  )
-}
-
-
-#' @describeIn devmode Provides a consistent way to change the expected
-#'   [getOption()] behavior when Developer Mode is enabled. This method is very
-#'   similar to [getOption()] where the globally set option takes precedence.
-#'   See section "Avoiding direct dependency on shiny" for
-#'   `get_devmode_option()` implementation details.
-#'
-#'   **Package developers:** Register your Dev Mode option using
-#'   `register_devmode_option()` to avoid supplying the same `devmode_default`
-#'   and `devmode_message` values throughout your package. (This requires a
-#'   \pkg{shiny} dependency.)
-#' @export
-#' @examples
-#' # Used within `shiny::runApp(launch.browser)`
-#' get_devmode_option("shiny.minified", TRUE) # TRUE if Dev mode is off
-#' is_minified <- with_devmode(TRUE, {
-#'   get_devmode_option("shiny.minified", TRUE)
-#' })
-#' is_minified # FALSE
-#'
-get_devmode_option <- function(
-  name,
-  default = NULL,
-  devmode_default = missing_arg(),
-  devmode_message = missing_arg()
-) {
-  getOption(
-    name,
-    local({
-      if (!in_devmode()) {
-        # typical case
-        return(default)
-      }
-
-      info <- registered_devmode_options$get(name)
-      if (is.null(info)) {
-        # Not registered,
-        # Warn and return default value
-        rlang::warn(
-          message = paste0(
-            "`get_devmode_option(name)` could not find `name = \"", name, "\"`. ",
-            "Returning `default` value"
-          )
-        )
-        return(default)
-      }
-
-      # display message
-      devmode_inform(
-        maybe_missing(
-          # use provided `devmode_message` value
-          devmode_message,
-          # If `devmode_message` is missing, display registered `devmode_message`
-          default = info$devmode_message
-        )
-      )
-
-      # return value
-      maybe_missing(
-        # use provided `devmode_default` value
-        devmode_default,
-        # if `devmode_default` is missing, provide registered `devmode_default`
-        default = info$devmode_default
-      )
-    })
-  )
-}
-
-
-
-register_devmode_option(
-  "shiny.autoreload",
-  "Turning on shiny autoreload. To disable, call `options(shiny.autoreload = FALSE)`",
-  TRUE
-)
-
-register_devmode_option(
-  "shiny.minified",
-  "Using full shiny javascript file. To use the minified version, call `options(shiny.minified = TRUE)`",
-  FALSE
-)
-
-register_devmode_option(
-  "shiny.fullstacktrace",
-  "Turning on full stack trace. To disable, call `options(shiny.fullstacktrace = FALSE)`",
-  TRUE
-)

R/font-awesome.R

@@ -0,0 +1,445 @@
+font_awesome_brands <- c(
+  "500px",
+  "accessible-icon",
+  "accusoft",
+  "acquisitions-incorporated",
+  "adn",
+  "adobe",
+  "adversal",
+  "affiliatetheme",
+  "airbnb",
+  "algolia",
+  "alipay",
+  "amazon",
+  "amazon-pay",
+  "amilia",
+  "android",
+  "angellist",
+  "angrycreative",
+  "angular",
+  "app-store",
+  "app-store-ios",
+  "apper",
+  "apple",
+  "apple-pay",
+  "artstation",
+  "asymmetrik",
+  "atlassian",
+  "audible",
+  "autoprefixer",
+  "avianex",
+  "aviato",
+  "aws",
+  "bandcamp",
+  "battle-net",
+  "behance",
+  "behance-square",
+  "bimobject",
+  "bitbucket",
+  "bitcoin",
+  "bity",
+  "black-tie",
+  "blackberry",
+  "blogger",
+  "blogger-b",
+  "bluetooth",
+  "bluetooth-b",
+  "bootstrap",
+  "btc",
+  "buffer",
+  "buromobelexperte",
+  "buy-n-large",
+  "buysellads",
+  "canadian-maple-leaf",
+  "cc-amazon-pay",
+  "cc-amex",
+  "cc-apple-pay",
+  "cc-diners-club",
+  "cc-discover",
+  "cc-jcb",
+  "cc-mastercard",
+  "cc-paypal",
+  "cc-stripe",
+  "cc-visa",
+  "centercode",
+  "centos",
+  "chrome",
+  "chromecast",
+  "cloudscale",
+  "cloudsmith",
+  "cloudversify",
+  "codepen",
+  "codiepie",
+  "confluence",
+  "connectdevelop",
+  "contao",
+  "cotton-bureau",
+  "cpanel",
+  "creative-commons",
+  "creative-commons-by",
+  "creative-commons-nc",
+  "creative-commons-nc-eu",
+  "creative-commons-nc-jp",
+  "creative-commons-nd",
+  "creative-commons-pd",
+  "creative-commons-pd-alt",
+  "creative-commons-remix",
+  "creative-commons-sa",
+  "creative-commons-sampling",
+  "creative-commons-sampling-plus",
+  "creative-commons-share",
+  "creative-commons-zero",
+  "critical-role",
+  "css3",
+  "css3-alt",
+  "cuttlefish",
+  "d-and-d",
+  "d-and-d-beyond",
+  "dailymotion",
+  "dashcube",
+  "delicious",
+  "deploydog",
+  "deskpro",
+  "dev",
+  "deviantart",
+  "dhl",
+  "diaspora",
+  "digg",
+  "digital-ocean",
+  "discord",
+  "discourse",
+  "dochub",
+  "docker",
+  "draft2digital",
+  "dribbble",
+  "dribbble-square",
+  "dropbox",
+  "drupal",
+  "dyalog",
+  "earlybirds",
+  "ebay",
+  "edge",
+  "elementor",
+  "ello",
+  "ember",
+  "empire",
+  "envira",
+  "erlang",
+  "ethereum",
+  "etsy",
+  "evernote",
+  "expeditedssl",
+  "facebook",
+  "facebook-f",
+  "facebook-messenger",
+  "facebook-square",
+  "fantasy-flight-games",
+  "fedex",
+  "fedora",
+  "figma",
+  "firefox",
+  "firefox-browser",
+  "first-order",
+  "first-order-alt",
+  "firstdraft",
+  "flickr",
+  "flipboard",
+  "fly",
+  "font-awesome",
+  "font-awesome-alt",
+  "font-awesome-flag",
+  "font-awesome-logo-full",
+  "fonticons",
+  "fonticons-fi",
+  "fort-awesome",
+  "fort-awesome-alt",
+  "forumbee",
+  "foursquare",
+  "free-code-camp",
+  "freebsd",
+  "fulcrum",
+  "galactic-republic",
+  "galactic-senate",
+  "get-pocket",
+  "gg",
+  "gg-circle",
+  "git",
+  "git-alt",
+  "git-square",
+  "github",
+  "github-alt",
+  "github-square",
+  "gitkraken",
+  "gitlab",
+  "gitter",
+  "glide",
+  "glide-g",
+  "gofore",
+  "goodreads",
+  "goodreads-g",
+  "google",
+  "google-drive",
+  "google-play",
+  "google-plus",
+  "google-plus-g",
+  "google-plus-square",
+  "google-wallet",
+  "gratipay",
+  "grav",
+  "gripfire",
+  "grunt",
+  "gulp",
+  "hacker-news",
+  "hacker-news-square",
+  "hackerrank",
+  "hips",
+  "hire-a-helper",
+  "hooli",
+  "hornbill",
+  "hotjar",
+  "houzz",
+  "html5",
+  "hubspot",
+  "ideal",
+  "imdb",
+  "instagram",
+  "instagram-square",
+  "intercom",
+  "internet-explorer",
+  "invision",
+  "ioxhost",
+  "itch-io",
+  "itunes",
+  "itunes-note",
+  "java",
+  "jedi-order",
+  "jenkins",
+  "jira",
+  "joget",
+  "joomla",
+  "js",
+  "js-square",
+  "jsfiddle",
+  "kaggle",
+  "keybase",
+  "keycdn",
+  "kickstarter",
+  "kickstarter-k",
+  "korvue",
+  "laravel",
+  "lastfm",
+  "lastfm-square",
+  "leanpub",
+  "less",
+  "line",
+  "linkedin",
+  "linkedin-in",
+  "linode",
+  "linux",
+  "lyft",
+  "magento",
+  "mailchimp",
+  "mandalorian",
+  "markdown",
+  "mastodon",
+  "maxcdn",
+  "mdb",
+  "medapps",
+  "medium",
+  "medium-m",
+  "medrt",
+  "meetup",
+  "megaport",
+  "mendeley",
+  "microblog",
+  "microsoft",
+  "mix",
+  "mixcloud",
+  "mixer",
+  "mizuni",
+  "modx",
+  "monero",
+  "napster",
+  "neos",
+  "nimblr",
+  "node",
+  "node-js",
+  "npm",
+  "ns8",
+  "nutritionix",
+  "odnoklassniki",
+  "odnoklassniki-square",
+  "old-republic",
+  "opencart",
+  "openid",
+  "opera",
+  "optin-monster",
+  "orcid",
+  "osi",
+  "page4",
+  "pagelines",
+  "palfed",
+  "patreon",
+  "paypal",
+  "penny-arcade",
+  "periscope",
+  "phabricator",
+  "phoenix-framework",
+  "phoenix-squadron",
+  "php",
+  "pied-piper",
+  "pied-piper-alt",
+  "pied-piper-hat",
+  "pied-piper-pp",
+  "pied-piper-square",
+  "pinterest",
+  "pinterest-p",
+  "pinterest-square",
+  "playstation",
+  "product-hunt",
+  "pushed",
+  "python",
+  "qq",
+  "quinscape",
+  "quora",
+  "r-project",
+  "raspberry-pi",
+  "ravelry",
+  "react",
+  "reacteurope",
+  "readme",
+  "rebel",
+  "red-river",
+  "reddit",
+  "reddit-alien",
+  "reddit-square",
+  "redhat",
+  "renren",
+  "replyd",
+  "researchgate",
+  "resolving",
+  "rev",
+  "rocketchat",
+  "rockrms",
+  "safari",
+  "salesforce",
+  "sass",
+  "schlix",
+  "scribd",
+  "searchengin",
+  "sellcast",
+  "sellsy",
+  "servicestack",
+  "shirtsinbulk",
+  "shopify",
+  "shopware",
+  "simplybuilt",
+  "sistrix",
+  "sith",
+  "sketch",
+  "skyatlas",
+  "skype",
+  "slack",
+  "slack-hash",
+  "slideshare",
+  "snapchat",
+  "snapchat-ghost",
+  "snapchat-square",
+  "soundcloud",
+  "sourcetree",
+  "speakap",
+  "speaker-deck",
+  "spotify",
+  "squarespace",
+  "stack-exchange",
+  "stack-overflow",
+  "stackpath",
+  "staylinked",
+  "steam",
+  "steam-square",
+  "steam-symbol",
+  "sticker-mule",
+  "strava",
+  "stripe",
+  "stripe-s",
+  "studiovinari",
+  "stumbleupon",
+  "stumbleupon-circle",
+  "superpowers",
+  "supple",
+  "suse",
+  "swift",
+  "symfony",
+  "teamspeak",
+  "telegram",
+  "telegram-plane",
+  "tencent-weibo",
+  "the-red-yeti",
+  "themeco",
+  "themeisle",
+  "think-peaks",
+  "trade-federation",
+  "trello",
+  "tripadvisor",
+  "tumblr",
+  "tumblr-square",
+  "twitch",
+  "twitter",
+  "twitter-square",
+  "typo3",
+  "uber",
+  "ubuntu",
+  "uikit",
+  "umbraco",
+  "uniregistry",
+  "unity",
+  "untappd",
+  "ups",
+  "usb",
+  "usps",
+  "ussunnah",
+  "vaadin",
+  "viacoin",
+  "viadeo",
+  "viadeo-square",
+  "viber",
+  "vimeo",
+  "vimeo-square",
+  "vimeo-v",
+  "vine",
+  "vk",
+  "vnv",
+  "vuejs",
+  "waze",
+  "weebly",
+  "weibo",
+  "weixin",
+  "whatsapp",
+  "whatsapp-square",
+  "whmcs",
+  "wikipedia-w",
+  "windows",
+  "wix",
+  "wizards-of-the-coast",
+  "wolf-pack-battalion",
+  "wordpress",
+  "wordpress-simple",
+  "wpbeginner",
+  "wpexplorer",
+  "wpforms",
+  "wpressr",
+  "xbox",
+  "xing",
+  "xing-square",
+  "y-combinator",
+  "yahoo",
+  "yammer",
+  "yandex",
+  "yandex-international",
+  "yarn",
+  "yelp",
+  "yoast",
+  "youtube",
+  "youtube-square",
+  "zhihu"
+)

R/globals.R

@@ -1,21 +1,66 @@
 # A scope where we can put mutable global state
 .globals <- new.env(parent = emptyenv())
 
+register_s3_method <- function(pkg, generic, class, fun = NULL) {
+  stopifnot(is.character(pkg), length(pkg) == 1)
+  stopifnot(is.character(generic), length(generic) == 1)
+  stopifnot(is.character(class), length(class) == 1)
+
+  if (is.null(fun)) {
+    fun <- get(paste0(generic, ".", class), envir = parent.frame())
+  } else {
+    stopifnot(is.function(fun))
+  }
+
+  if (pkg %in% loadedNamespaces()) {
+    registerS3method(generic, class, fun, envir = asNamespace(pkg))
+  }
+
+  # Always register hook in case pkg is loaded at some
+  # point the future (or, potentially, but less commonly,
+  # unloaded & reloaded)
+  setHook(
+    packageEvent(pkg, "onLoad"),
+    function(...) {
+      registerS3method(generic, class, fun, envir = asNamespace(pkg))
+    }
+  )
+}
+
+register_upgrade_message <- function(pkg, version) {
+
+  msg <- sprintf(
+    "This version of Shiny is designed to work with '%s' >= %s.
+    Please upgrade via install.packages('%s').",
+    pkg, version, pkg
+  )
+
+  if (pkg %in% loadedNamespaces() && !is_available(pkg, version)) {
+    packageStartupMessage(msg)
+  }
+
+  # Always register hook in case pkg is loaded at some
+  # point the future (or, potentially, but less commonly,
+  # unloaded & reloaded)
+  setHook(
+    packageEvent(pkg, "onLoad"),
+    function(...) {
+      if (!is_available(pkg, version)) packageStartupMessage(msg)
+    }
+  )
+}
+
 .onLoad <- function(libname, pkgname) {
   # R's lazy-loading package scheme causes the private seed to be cached in the
   # package itself, making our PRNG completely deterministic. This line resets
   # the private seed during load.
   withPrivateSeed(set.seed(NULL))
 
-  # Create this at the top level, but since the object is from a different
-  # package, we don't want to bake it into the built binary package.
-  restoreCtxStack <<- fastmap::faststack()
-
   # Make sure these methods are available to knitr if shiny is loaded but not
   # attached.
-  s3_register("knitr::knit_print", "reactive")
-  s3_register("knitr::knit_print", "shiny.appobj")
-  s3_register("knitr::knit_print", "shiny.render.function")
+  register_s3_method("knitr", "knit_print", "reactive")
+  register_s3_method("knitr", "knit_print", "shiny.appobj")
+  register_s3_method("knitr", "knit_print", "shiny.render.function")
 
   # Shiny 1.4.0 bumps jQuery 1.x to 3.x, which caused a problem
   # with static-rendering of htmlwidgets, and htmlwidgets 1.5

R/graph.R

@@ -4,7 +4,7 @@
 # @param version The version of the package
 check_suggested <- function(package, version = NULL) {
 
-  if (is_installed(package, version)) {
+  if (is_available(package, version)) {
     return()
   }
 
@@ -94,7 +94,13 @@ reactlogShow <- function(time = TRUE) {
   check_reactlog()
   reactlog::reactlog_show(reactlog(), time = time)
 }
-
+#' @describeIn reactlog This function is deprecated. You should use [reactlogShow()]
+#' @export
+# legacy purposes
+showReactLog <- function(time = TRUE) {
+  shinyDeprecated(new = "`reactlogShow`", version = "1.2.0")
+  reactlogShow(time = time)
+}
 #' @describeIn reactlog Resets the entire reactlog stack.  Useful for debugging and removing all prior reactive history.
 #' @export
 reactlogReset <- function() {
@@ -115,28 +121,22 @@ check_reactlog <- function() {
 }
 # read reactlog version from description file
 # prevents version mismatch in code and description file
-reactlog_version <- local({
-  version <- NULL
-  function() {
-    if (!is.null(version)) return(version)
+reactlog_version <- function() {
+  desc <- read.dcf(system.file("DESCRIPTION", package = "shiny", mustWork = TRUE))
+  suggests <- desc[1,"Suggests"][[1]]
+  suggests_pkgs <- strsplit(suggests, "\n")[[1]]
 
-    desc <- read.dcf(system_file("DESCRIPTION", package = "shiny"))
-    suggests <- desc[1,"Suggests"][[1]]
-    suggests_pkgs <- strsplit(suggests, "\n")[[1]]
-
-    reactlog_info <- suggests_pkgs[grepl("reactlog", suggests_pkgs)]
-    if (length(reactlog_info) == 0) {
-      stop("reactlog can not be found in shiny DESCRIPTION file")
-    }
-
-    reactlog_info <- sub("^[^\\(]*\\(", "", reactlog_info)
-    reactlog_info <- sub("\\)[^\\)]*$", "", reactlog_info)
-    reactlog_info <- sub("^[>= ]*", "", reactlog_info)
-
-    version <<- package_version(reactlog_info)
-    version
+  reactlog_info <- suggests_pkgs[grepl("reactlog", suggests_pkgs)]
+  if (length(reactlog_info) == 0) {
+    stop("reactlog can not be found in shiny DESCRIPTION file")
   }
-})
+
+  reactlog_info <- sub("^[^\\(]*\\(", "", reactlog_info)
+  reactlog_info <- sub("\\)[^\\)]*$", "", reactlog_info)
+  reactlog_info <- sub("^[>= ]*", "", reactlog_info)
+
+  package_version(reactlog_info)
+}
 
 
 RLog <- R6Class(
@@ -211,7 +211,7 @@ RLog <- R6Class(
     reset = function() {
       .globals$reactIdCounter <- 0L
 
-      self$logStack <- fastmap::faststack()
+      self$logStack <- Stack$new()
       self$msg <- MessageLogger$new(option = private$msgOption)
 
       # setup dummy and missing react information
@@ -518,7 +518,7 @@ MessageLogger = R6Class(
       return(txt)
     },
     singleLine = function(txt) {
-      gsub("([^\\])\\n", "\\1\\\\n", txt)
+      gsub("[^\\]\\n", "\\\\n", txt)
     },
     valueStr = function(valueStr) {
       paste0(
@@ -559,4 +559,5 @@ MessageLogger = R6Class(
   )
 )
 
+#' @include stack.R
 rLog <- RLog$new("shiny.reactlog", "shiny.reactlog.console")

R/html-deps.R

@@ -40,14 +40,11 @@ createWebDependency <- function(dependency, scrubFile = TRUE) {
 
 # Given a Shiny tag object, process singletons and dependencies. Returns a list
 # with rendered HTML and dependency objects.
-# This implementation is very similar to renderTags(), but ignores
-# <head> handling (it should only be used after the user session has started)
 processDeps <- function(tags, session) {
-  tags <- utils::getFromNamespace("tagify", "htmltools")(tags)
-  ui <- takeSingletons(tags, session$singletons, desingleton = FALSE)$ui
+  ui <- takeSingletons(tags, session$singletons, desingleton=FALSE)$ui
   ui <- surroundSingletons(ui)
   dependencies <- lapply(
-    resolveDependencies(findDependencies(ui, tagify = FALSE)),
+    resolveDependencies(findDependencies(ui)),
     createWebDependency
   )
   names(dependencies) <- NULL

R/htmltools.R

@@ -0,0 +1,11 @@
+#' @import htmltools
+#' @export tags p h1 h2 h3 h4 h5 h6 a br div span pre code img strong em hr
+#' @export tag tagList tagAppendAttributes tagHasAttribute tagGetAttribute tagAppendChild tagAppendChildren tagSetChildren
+#' @export HTML
+#' @export includeHTML includeText includeMarkdown includeCSS includeScript
+#' @export singleton is.singleton
+#' @export validateCssUnit
+#' @export htmlTemplate
+#' @export suppressDependencies
+#' @export withTags
+NULL

R/image-interact-opts.R

@@ -20,6 +20,7 @@
 #'   `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")
@@ -75,12 +76,8 @@ hoverOpts <- function(id, delay = 300,
 #'   `imageOutput`/`plotOutput` calls may share the same `id`
 #'   value; brushing one image or plot will cause any other brushes with the
 #'   same `id` to disappear.
-#' @param fill Fill color of the brush. If `'auto'`, it derives from the link
-#'   color of the plot's HTML container (if **thematic** is enabled, and `accent`
-#'   is a non-`'auto'` value, that color is used instead).
-#' @param stroke Outline color of the brush. If `'auto'`, it derives from the
-#'   foreground color of the plot's HTML container (if **thematic** is enabled,
-#'   and `fg` is a non-`'auto'` value, that color is used instead).
+#' @param fill Fill color of the brush.
+#' @param stroke Outline color of the brush.
 #' @param opacity Opacity of the brush
 #' @param delay How long to delay (in milliseconds) when debouncing or
 #'   throttling, before sending the brush data to the server.
@@ -110,13 +107,6 @@ brushOpts <- function(id, fill = "#9cf", stroke = "#036",
   if (is.null(id))
     stop("id must not be NULL")
 
-  if (identical(fill, "auto")) {
-    fill <- getThematicOption("accent", "auto")
-  }
-  if (identical(stroke, "auto")) {
-    stroke <- getThematicOption("fg", "auto")
-  }
-
   list(
     id = id,
     fill = fill,
@@ -129,13 +119,3 @@ brushOpts <- function(id, fill = "#9cf", stroke = "#036",
     resetOnNew = resetOnNew
   )
 }
-
-getThematicOption <- function(name = "", default = NULL, resolve = FALSE) {
-  if (isNamespaceLoaded("thematic")) {
-    # TODO: use :: once thematic is on CRAN
-    tgo <- utils::getFromNamespace("thematic_get_option", "thematic")
-    tgo(name = name, default = default, resolve = resolve)
-  } else {
-    default
-  }
-}

R/image-interact.R

@@ -267,7 +267,6 @@ 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)
 
@@ -393,7 +392,6 @@ 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:
@@ -416,43 +414,11 @@ 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/imageutils.R

@@ -1,14 +1,19 @@
 startPNG <- function(filename, width, height, res, ...) {
-  pngfun <- if ((getOption('shiny.useragg') %||% TRUE) && is_installed("ragg")) {
-    ragg::agg_png
+  # shiny.useragg is an experimental option that isn't officially supported or
+  # documented. It's here in the off chance that someone really wants
+  # to use ragg (say, instead of showtext, for custom font rendering).
+  # In the next shiny release, this option will likely be superseded in
+  # favor of a fully customizable graphics device option
+  if ((getOption('shiny.useragg') %||% FALSE) && is_available("ragg")) {
+    pngfun <- ragg::agg_png
   } else if (capabilities("aqua")) {
     # i.e., png(type = 'quartz')
-    grDevices::png
-  } else if ((getOption('shiny.usecairo') %||% TRUE) && is_installed("Cairo")) {
-    Cairo::CairoPNG
+    pngfun <- grDevices::png
+  } else if ((getOption('shiny.usecairo') %||% TRUE) && is_available("Cairo")) {
+    pngfun <- Cairo::CairoPNG
   } else {
     # i.e., png(type = 'cairo')
-    grDevices::png
+    pngfun <- grDevices::png
   }
 
   args <- rlang::list2(filename=filename, width=width, height=height, res=res, ...)
@@ -18,7 +23,8 @@ startPNG <- function(filename, width, height, res, ...) {
   # devices allow their bg arg to be overridden by par(bg=...), which thematic does prior
   # to plot-time, but it shouldn't hurt to inform other the device directly as well
   if (is.null(args$bg) && isNamespaceLoaded("thematic")) {
-    args$bg <- getThematicOption("bg", "white")
+    # TODO: use :: once thematic is on CRAN
+    args$bg <- utils::getFromNamespace("thematic_get_option", "thematic")("bg", "white", resolve = FALSE)
     # auto vals aren't resolved until plot time, so if we see one, resolve it
     if (isTRUE("auto" == args$bg)) {
       args$bg <- getCurrentOutputInfo()[["bg"]]()
@@ -52,31 +58,33 @@ startPNG <- function(filename, width, height, res, ...) {
   grDevices::dev.cur()
 }
 
-#' Capture a plot as a PNG file.
+#' Run a plotting function and save the output as a PNG
 #'
-#' The PNG graphics device used is determined in the following order:
-#'   * If the ragg package is installed (and the `shiny.useragg` is not
-#'    set to `FALSE`), then use [ragg::agg_png()].
-#'   * If a quartz device is available (i.e., `capabilities("aqua")` is
-#'    `TRUE`), then use `png(type = "quartz")`.
-#'   * If the Cairo package is installed (and the `shiny.usecairo` option
-#'    is not set to `FALSE`), then use [Cairo::CairoPNG()].
-#'   * Otherwise, use [grDevices::png()]. In this case, Linux and Windows
-#'    may not antialias some point shapes, resulting in poor quality output.
+#' This function returns the name of the PNG file that it generates. In
+#' essence, it calls `png()`, then `func()`, then `dev.off()`.
+#' So `func` must be a function that will generate a plot when used this
+#' way.
+#'
+#' For output, it will try to use the following devices, in this order:
+#' quartz (via [grDevices::png()]), then [Cairo::CairoPNG()],
+#' and finally [grDevices::png()]. This is in order of quality of
+#' output. Notably, plain `png` output on Linux and Windows may not
+#' antialias some point shapes, resulting in poor quality output.
+#'
+#' In some cases, `Cairo()` provides output that looks worse than
+#' `png()`. To disable Cairo output for an app, use
+#' `options(shiny.usecairo=FALSE)`.
 #'
 #' @param func A function that generates a plot.
 #' @param filename The name of the output file. Defaults to a temp file with
 #'   extension `.png`.
 #' @param width Width in pixels.
 #' @param height Height in pixels.
-#' @param res Resolution in pixels per inch. This value is passed to the
-#'   graphics device. Note that this affects the resolution of PNG rendering in
+#' @param res Resolution 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 ... Arguments to be passed through to the graphics device. These can
-#'   be used to set the width, height, background color, etc.
-#'
-#' @return A path to the newly generated PNG file.
-#'
+#' @param ... Arguments to be passed through to [grDevices::png()].
+#'   These can be used to set the width, height, background color, etc.
 #' @export
 plotPNG <- function(func, filename=tempfile(fileext='.png'),
                     width=400, height=400, res=72, ...) {
@@ -87,6 +95,7 @@ plotPNG <- function(func, filename=tempfile(fileext='.png'),
   filename
 }
 
+#' @importFrom grDevices dev.set dev.cur
 createGraphicsDevicePromiseDomain <- function(which = dev.cur()) {
   force(which)
 

R/input-action.R

@@ -54,7 +54,7 @@ actionButton <- function(inputId, label, icon = NULL, width = NULL, ...) {
   value <- restoreInput(id = inputId, default = NULL)
 
   tags$button(id=inputId,
-    style = css(width = validateCssUnit(width)),
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
     type="button",
     class="btn btn-default action-button",
     `data-val` = value,

R/input-checkbox.R

@@ -36,7 +36,7 @@ checkboxInput <- function(inputId, label, value = FALSE, width = NULL) {
     inputTag$attribs$checked <- "checked"
 
   div(class = "form-group shiny-input-container",
-    style = css(width = validateCssUnit(width)),
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
     div(class = "checkbox",
       tags$label(inputTag, tags$span(label))
     )

R/input-checkboxgroup.R

@@ -94,14 +94,10 @@ checkboxGroupInput <- function(inputId, label, choices = NULL, selected = NULL,
     divClass <- paste(divClass, "shiny-input-container-inline")
 
   # return label and select tag
-  inputLabel <- shinyInputLabel(inputId, label)
   tags$div(id = inputId,
-    style = css(width = validateCssUnit(width)),
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
     class = divClass,
-    # https://www.w3.org/TR/wai-aria-practices/examples/checkbox/checkbox-1/checkbox-1.html
-    role = "group",
-    `aria-labelledby` = inputLabel$attribs$id,
-    inputLabel,
+    shinyInputLabel(inputId, label),
     options
   )
 }

R/input-date.R

@@ -105,7 +105,7 @@ dateInput <- function(inputId, label, value = NULL, min = NULL, max = NULL,
 
   tags$div(id = inputId,
     class = "shiny-date-input form-group shiny-input-container",
-    style = css(width = validateCssUnit(width)),
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
 
     shinyInputLabel(inputId, label),
     tags$input(type = "text",
@@ -133,15 +133,15 @@ dateInput <- function(inputId, label, value = NULL, min = NULL, max = NULL,
 }
 
 
+datePickerVersion <- "1.9.0"
+
 datePickerDependency <- function(theme) {
   list(
     htmlDependency(
       name = "bootstrap-datepicker-js",
-      version = version_bs_date_picker,
-      src = "www/shared/datepicker",
-      package = "shiny",
-      script = if (getOption("shiny.minified", TRUE)) "js/bootstrap-datepicker.min.js"
-               else                                   "js/bootstrap-datepicker.js",
+      version = datePickerVersion,
+      src = c(href = "shared/datepicker"),
+      script = "js/bootstrap-datepicker.min.js",
       # Need to enable noConflict mode. See #1346.
       head = "<script>(function() {
         var datepicker = $.fn.datepicker.noConflict();
@@ -157,20 +157,19 @@ datePickerCSS <- function(theme) {
   if (!is_bs_theme(theme)) {
     return(htmlDependency(
       name = "bootstrap-datepicker-css",
-      version = version_bs_date_picker,
-      src = "www/shared/datepicker",
-      package = "shiny",
+      version = datePickerVersion,
+      src = c(href = "shared/datepicker"),
       stylesheet = "css/bootstrap-datepicker3.min.css"
     ))
   }
 
-  scss_file <- system_file(package = "shiny", "www/shared/datepicker/scss/build3.scss")
+  scss_file <- system.file(package = "shiny", "www/shared/datepicker/scss/build3.scss")
 
   bslib::bs_dependency(
     input = sass::sass_file(scss_file),
     theme = theme,
     name = "bootstrap-datepicker",
-    version = version_bs_date_picker,
-    cache_key_extra = get_package_version("shiny")
+    version = datePickerVersion,
+    cache_key_extra = shinyPackageVersion()
   )
 }

R/input-daterange.R

@@ -92,7 +92,7 @@ dateRangeInput <- function(inputId, label, start = NULL, end = NULL,
   attachDependencies(
     div(id = inputId,
       class = "shiny-date-range-input form-group shiny-input-container",
-      style = css(width = validateCssUnit(width)),
+      style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
 
       shinyInputLabel(inputId, label),
       # input-daterange class is needed for dropdown behavior

R/input-file.R

@@ -23,18 +23,7 @@
 #' @param buttonLabel The label used on the button. Can be text or an HTML tag
 #'   object.
 #' @param placeholder The text to show before a file has been uploaded.
-#' @param capture What source to use for capturing image, audio or video data.
-#'   This attribute facilitates user access to a device's media capture 
-#'   mechanism, such as a camera, or microphone, from within a file upload 
-#'   control.
 #'
-#'   A value of `user` indicates that the user-facing camera and/or microphone
-#'   should be used. A value of `environment` specifies that the outward-facing
-#'   camera and/or microphone should be used.
-#'
-#'   By default on most phones, this will accept still photos or video. For
-#'   still photos only, also use `accept="image/*"`. For video only, use
-#'   `accept="video/*"`.
 #' @examples
 #' ## Only run examples in interactive R sessions
 #' if (interactive()) {
@@ -84,8 +73,7 @@
 #'
 #' @export
 fileInput <- function(inputId, label, multiple = FALSE, accept = NULL,
-  width = NULL, buttonLabel = "Browse...", placeholder = "No file selected",
-  capture = NULL) {
+  width = NULL, buttonLabel = "Browse...", placeholder = "No file selected") {
 
   restoredValue <- restoreInput(id = inputId, default = NULL)
 
@@ -113,12 +101,9 @@ fileInput <- function(inputId, label, multiple = FALSE, accept = NULL,
   if (length(accept) > 0)
     inputTag$attribs$accept <- paste(accept, collapse=',')
 
-  if (!is.null(capture)) {
-    inputTag$attribs$capture <- capture
-  }
 
   div(class = "form-group shiny-input-container",
-    style = css(width = validateCssUnit(width)),
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
     shinyInputLabel(inputId, label),
 
     div(class = "input-group",

R/input-numeric.R

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

R/input-password.R

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

R/input-radiobuttons.R

@@ -104,14 +104,10 @@ radioButtons <- function(inputId, label, choices = NULL, selected = NULL,
   divClass <- "form-group shiny-input-radiogroup shiny-input-container"
   if (inline) divClass <- paste(divClass, "shiny-input-container-inline")
 
-  inputLabel <- shinyInputLabel(inputId, label)
   tags$div(id = inputId,
-    style = css(width = validateCssUnit(width)),
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
     class = divClass,
-    # https://www.w3.org/TR/2017/WD-wai-aria-practices-1.1-20170628/examples/radio/radio-1/radio-1.html
-    role = "radiogroup",
-    `aria-labelledby` = inputLabel$attribs$id,
-    inputLabel,
+    shinyInputLabel(inputId, label),
     options
   )
 }

R/input-select.R

@@ -116,7 +116,7 @@ selectInput <- function(inputId, label, choices, selected = NULL,
   # return label and select tag
   res <- div(
     class = "form-group shiny-input-container",
-    style = css(width = validateCssUnit(width)),
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
     shinyInputLabel(inputId, label),
     div(selectTag)
   )
@@ -197,12 +197,6 @@ selectizeInput <- function(inputId, ..., options = NULL, width = NULL) {
 
 # given a select input and its id, selectize it
 selectizeIt <- function(inputId, select, options, nonempty = FALSE) {
-  if (length(options) == 0) {
-    # For NULL and empty unnamed list, replace with an empty named list, so that
-    # it will get translated to {} in JSON later on.
-    options <- empty_named_list()
-  }
-
   # Make sure accessibility plugin is included
   if (!('selectize-plugin-a11y' %in% options$plugins)) {
     options$plugins <- c(options$plugins, list('selectize-plugin-a11y'))
@@ -210,10 +204,18 @@ selectizeIt <- function(inputId, select, options, nonempty = FALSE) {
 
   res <- checkAsIs(options)
 
-  deps <- list(selectizeDependency())
+  selectizeDep <- selectizeDependency()
 
   if ('drag_drop' %in% options$plugins) {
-    deps[[length(deps) + 1]] <- jqueryuiDependency()
+    selectizeDep <- c(
+      selectizeDep,
+      htmlDependency(
+        'jqueryui',
+        '1.12.1',
+        c(href = 'shared/jqueryui'),
+        script = 'jquery-ui.min.js'
+      )
+    )
   }
 
   # Insert script on same level as <select> tag
@@ -223,11 +225,11 @@ selectizeIt <- function(inputId, select, options, nonempty = FALSE) {
       type = 'application/json',
       `data-for` = inputId, `data-nonempty` = if (nonempty) '',
       `data-eval` = if (length(res$eval)) HTML(toJSON(res$eval)),
-      HTML(toJSON(res$options))
+      if (length(res$options)) HTML(toJSON(res$options)) else '{}'
     )
   )
 
-  attachDependencies(select, deps)
+  attachDependencies(select, selectizeDep)
 }
 
 
@@ -236,14 +238,19 @@ selectizeDependency <- function() {
 }
 
 selectizeDependencyFunc <- function(theme) {
+  selectizeVersion <- "0.12.4"
   if (!is_bs_theme(theme)) {
-    return(selectizeStaticDependency(version_selectize))
+    return(selectizeStaticDependency(selectizeVersion))
   }
 
-  selectizeDir <- system_file(package = "shiny", "www/shared/selectize/")
-  bs_version <- bslib::theme_version(theme)
+  selectizeDir <- system.file(package = "shiny", "www/shared/selectize/")
   stylesheet <- file.path(
-    selectizeDir, "scss", paste0("selectize.bootstrap", bs_version, ".scss")
+    selectizeDir, "scss",
+    if ("3" %in% bslib::theme_version(theme)) {
+      "selectize.bootstrap3.scss"
+    } else {
+      "selectize.bootstrap4.scss"
+    }
   )
   # It'd be cleaner to ship the JS in a separate, href-based,
   # HTML dependency (which we currently do for other themable widgets),
@@ -259,18 +266,16 @@ selectizeDependencyFunc <- function(theme) {
     input = sass::sass_file(stylesheet),
     theme = theme,
     name = "selectize",
-    version = version_selectize,
-    cache_key_extra = get_package_version("shiny"),
+    version = selectizeVersion,
+    cache_key_extra = shinyPackageVersion(),
     .dep_args = list(script = script)
   )
 }
 
 selectizeStaticDependency <- function(version) {
   htmlDependency(
-    "selectize",
-    version,
-    src = "www/shared/selectize",
-    package = "shiny",
+    "selectize", version,
+    src = c(href = "shared/selectize"),
     stylesheet = "css/selectize.bootstrap3.css",
     script = c(
       "js/selectize.min.js",

R/input-slider.R

@@ -1,24 +1,25 @@
 #' Slider Input Widget
 #'
-#' Constructs a slider widget to select a number, date, or date-time from a
-#' range.
+#' Constructs a slider widget to select a numeric value from a range.
 #'
 #' @inheritParams textInput
-#' @param min,max The minimum and maximum values (inclusive) that can be
-#'   selected.
-#' @param value The initial value of the slider, either a number, a date
-#'   (class Date), or a date-time (class POSIXt). A length one vector will
-#'   create a regular slider; a length two vector will create a double-ended
-#'   range slider. Must lie between `min` and `max`.
+#' @param min The minimum value (inclusive) that can be selected.
+#' @param max The maximum value (inclusive) that can be selected.
+#' @param value The initial value of the slider. A numeric vector of length one
+#'   will create a regular slider; a numeric vector of length two will create a
+#'   double-ended range slider. A warning will be issued if the value doesn't
+#'   fit between `min` and `max`.
 #' @param step Specifies the interval between each selectable value on the
-#'   slider. Either `NULL`, the default, which uses a heuristic to determine the
-#'   step size or a single number. If the values are dates, `step` is in days;
-#'   if the values are date-times, `step` is in seconds.
+#'   slider (if `NULL`, a heuristic is used to determine the step size). If
+#'   the values are dates, `step` is in days; if the values are times
+#'   (POSIXt), `step` is in seconds.
 #' @param round `TRUE` to round all values to the nearest integer;
 #'   `FALSE` if no rounding is desired; or an integer to round to that
 #'   number of digits (for example, 1 will round to the nearest 10, and -2 will
 #'   round to the nearest .01). Any rounding will be applied after snapping to
 #'   the nearest step.
+#' @param format Deprecated.
+#' @param locale Deprecated.
 #' @param ticks `FALSE` to hide tick marks, `TRUE` to show them
 #'   according to some simple heuristics.
 #' @param animate `TRUE` to show simple animation controls with default
@@ -71,15 +72,22 @@
 #' }
 #'
 #' @section Server value:
-#' A number, date, or date-time (depending on the class of `value`), or
-#' in the case of slider range, a vector of two numbers/dates/date-times.
+#' A number, or in the case of slider range, a vector of two numbers.
 #'
 #' @export
 sliderInput <- function(inputId, label, min, max, value, step = NULL,
-                        round = FALSE, ticks = TRUE, animate = FALSE,
-                        width = NULL, sep = ",", pre = NULL, post = NULL,
-                        timeFormat = NULL, timezone = NULL, dragRange = TRUE) {
-  validate_slider_value(min, max, value, "sliderInput")
+                        round = FALSE, format = NULL, locale = NULL,
+                        ticks = TRUE, animate = FALSE, width = NULL, sep = ",",
+                        pre = NULL, post = NULL, timeFormat = NULL,
+                        timezone = NULL, dragRange = TRUE) {
+  if (!missing(format)) {
+    shinyDeprecated(msg = "The `format` argument to sliderInput is deprecated. Use `sep`, `pre`, and `post` instead.",
+                    version = "0.10.2.2")
+  }
+  if (!missing(locale)) {
+    shinyDeprecated(msg = "The `locale` argument to sliderInput is deprecated. Use `sep`, `pre`, and `post` instead.",
+                    version = "0.10.2.2")
+  }
 
   dataType <- getSliderType(min, max, value)
 
@@ -167,7 +175,7 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
   })
 
   sliderTag <- div(class = "form-group shiny-input-container",
-    style = css(width = validateCssUnit(width)),
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
     shinyInputLabel(inputId, label),
     do.call(tags$input, sliderProps)
   )
@@ -201,21 +209,19 @@ 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",
-      version_ion_range_slider,
-      src = "www/shared/ionrangeslider",
-      package = "shiny",
+      "ionrangeslider-javascript", ionRangeSliderVersion,
+      src = c(href = "shared/ionrangeslider"),
       script = "js/ion.rangeSlider.min.js"
     ),
     htmlDependency(
-      "strftime",
-      version_strftime,
-      src = "www/shared/strftime",
-      package = "shiny",
+      "strftime", "0.9.2",
+      src = c(href = "shared/strftime"),
       script = "strftime-min.js"
     ),
     bslib::bs_dependency_defer(ionRangeSliderDependencyCSS)
@@ -226,24 +232,36 @@ ionRangeSliderDependencyCSS <- function(theme) {
   if (!is_bs_theme(theme)) {
     return(htmlDependency(
       "ionrangeslider-css",
-      version_ion_range_slider,
-      src = "www/shared/ionrangeslider",
-      package = "shiny",
+      ionRangeSliderVersion,
+      src = c(href = "shared/ionrangeslider"),
       stylesheet = "css/ion.rangeSlider.css"
     ))
   }
 
-  bslib::bs_dependency(
-    input = list(
-      list(accent = "$component-active-bg"),
-      sass::sass_file(
-        system_file(package = "shiny", "www/shared/ionrangeslider/scss/shiny.scss")
-      )
+  # 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,
     theme = theme,
     name = "ionRangeSlider",
-    version = version_ion_range_slider,
-    cache_key_extra = get_package_version("shiny")
+    version = ionRangeSliderVersion,
+    cache_key_extra = shinyPackageVersion()
   )
 }
 
@@ -278,37 +296,6 @@ findStepSize <- function(min, max, step) {
   }
 }
 
-# Throw a warning if ever `value` is not in the [`min`, `max`] range
-validate_slider_value <- function(min, max, value, fun) {
-  if (length(min)   != 1 || is_na(min) ||
-      length(max)   != 1 || is_na(max) ||
-      length(value) <  1 || length(value) > 2 || any(is.na(value)))
-  {
-    stop(call. = FALSE,
-      sprintf("In %s(): `min`, `max`, and `value` cannot be NULL, NA, or empty.", fun)
-    )
-  }
-
-  if (min(value) < min) {
-    warning(call. = FALSE,
-      sprintf(
-        "In %s(): `value` should be greater than or equal to `min` (value = %s, min = %s).",
-        fun, paste(value, collapse = ", "), min
-      )
-    )
-  }
-
-  if (max(value) > max) {
-    warning(
-      noBreaks. = TRUE, call. = FALSE,
-      sprintf(
-        "In %s(): `value` should be less than or equal to `max` (value = %s, max = %s).",
-        fun, paste(value, collapse = ", "), max
-      )
-    )
-  }
-}
-
 
 #' @rdname sliderInput
 #'

R/input-submit.R

@@ -10,7 +10,7 @@
 #' [actionButton()] instead of `submitButton` when you
 #' want to delay a reaction.
 #' See [this
-#' article](https://shiny.rstudio.com/articles/action-buttons.html) for more information (including a demo of how to "translate"
+#' article](http://shiny.rstudio.com/articles/action-buttons.html) for more information (including a demo of how to "translate"
 #' code using a `submitButton` to code using an `actionButton`).
 #'
 #' In essence, the presence of a submit button stops all inputs from
@@ -58,7 +58,7 @@ submitButton <- function(text = "Apply Changes", icon = NULL, width = NULL) {
     tags$button(
       type="submit",
       class="btn btn-primary",
-      style = css(width = validateCssUnit(width)),
+      style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
       list(icon, text)
     )
   )

R/input-text.R

@@ -40,7 +40,7 @@ textInput <- function(inputId, label, value = "", width = NULL,
   value <- restoreInput(id = inputId, default = value)
 
   div(class = "form-group shiny-input-container",
-    style = css(width = validateCssUnit(width)),
+    style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
     shinyInputLabel(inputId, label),
     tags$input(id = inputId, type="text", class="form-control", value=value,
       placeholder = placeholder)

R/input-textarea.R

@@ -50,13 +50,17 @@ textAreaInput <- function(inputId, label, value = "", width = NULL, height = NUL
     resize <- match.arg(resize, c("both", "none", "vertical", "horizontal"))
   }
 
-  style <- css(
+  style <- paste(
     # The width is specified on the parent div.
-    width = if (!is.null(width)) "width: 100%;",
-    height = validateCssUnit(height),
-    resize = resize
+    if (!is.null(width)) paste0("width: ",  "100%",  ";"),
+    if (!is.null(height)) paste0("height: ", validateCssUnit(height), ";"),
+    if (!is.null(resize)) paste0("resize: ", resize, ";")
   )
 
+  # Workaround for tag attribute=character(0) bug:
+  #   https://github.com/rstudio/htmltools/issues/65
+  if (length(style) == 0) style <- NULL
+
   div(class = "form-group shiny-input-container",
     shinyInputLabel(inputId, label),
     style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),

R/input-utils.R

@@ -41,7 +41,7 @@ normalizeChoicesArgs <- function(choices, choiceNames, choiceValues,
     if (length(choiceNames) != length(choiceValues)) {
       stop("`choiceNames` and `choiceValues` must have the same length.")
     }
-    if (any_named(choiceNames) || any_named(choiceValues)) {
+    if (anyNamed(choiceNames) || anyNamed(choiceValues)) {
       stop("`choiceNames` and `choiceValues` must not be named.")
     }
   } else {

R/insert-tab.R

@@ -112,13 +112,35 @@
 #'
 #' }
 #' @export
-insertTab <- function(inputId, tab, target = NULL,
-                      position = c("after", "before"), select = FALSE,
+insertTab <- function(inputId, tab, target,
+                      position = c("before", "after"), select = FALSE,
                       session = getDefaultReactiveDomain()) {
-  bslib::nav_insert(
-    inputId, tab, target,
-    match.arg(position), select, session
-  )
+  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)
 }
 
 #' @param menuName This argument should only be used when you want to
@@ -137,21 +159,63 @@ insertTab <- function(inputId, tab, target = NULL,
 #' @export
 prependTab <- function(inputId, tab, select = FALSE, menuName = NULL,
                        session = getDefaultReactiveDomain()) {
-  bslib::nav_prepend(inputId, tab, menu_title = menuName, select = select, session = session)
+  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)
 }
 
 #' @rdname insertTab
 #' @export
 appendTab <- function(inputId, tab, select = FALSE, menuName = NULL,
                       session = getDefaultReactiveDomain()) {
-  bslib::nav_append(inputId, tab, menu_title = menuName, select = select, session = session)
+  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)
 }
 
 #' @rdname insertTab
 #' @export
 removeTab <- function(inputId, target,
                       session = getDefaultReactiveDomain()) {
-  bslib::nav_remove(inputId, target, session)
+  force(target)
+  inputId <- session$ns(inputId)
+
+  callback <- function() {
+    session$sendRemoveTab(
+      inputId = inputId,
+      target = target)
+  }
+  session$onFlush(callback, once = TRUE)
 }
 
 

R/jqueryui.R

@@ -79,8 +79,8 @@ absolutePanel <- function(...,
   if (isTRUE(draggable)) {
     divTag <- tagAppendAttributes(divTag, class='draggable')
     return(tagList(
+      singleton(tags$head(tags$script(src='shared/jqueryui/jquery-ui.min.js'))),
       divTag,
-      jqueryuiDependency(),
       tags$script('$(".draggable").draggable();')
     ))
   } else {
@@ -99,14 +99,3 @@ fixedPanel <- function(...,
                 width=width, height=height, draggable=draggable, cursor=match.arg(cursor),
                 fixed=TRUE)
 }
-
-
-jqueryuiDependency <- function() {
-  htmlDependency(
-    'jqueryui',
-    '1.12.1',
-    src = 'www/shared/jqueryui',
-    package = 'shiny',
-    script = 'jquery-ui.min.js'
-  )
-}

R/knitr.R

@@ -4,7 +4,6 @@
 #' themselves in knitr/rmarkdown documents.
 #'
 #' @name knitr_methods
-#' @keywords internal
 #' @param x Object to knit_print
 #' @param ... Additional knit_print arguments
 NULL
@@ -63,7 +62,7 @@ knit_print.shiny.appobj <- function(x, ...) {
 #' @param inline Whether the object is printed inline.
 knit_print.shiny.render.function <- function(x, ..., inline = FALSE) {
   x <- htmltools::as.tags(x, inline = inline)
-  output <- knitr::knit_print(tagList(x), ..., inline = inline)
+  output <- knitr::knit_print(tagList(x))
   attr(output, "knit_cacheable") <- FALSE
   attr(output, "knit_meta") <- append(attr(output, "knit_meta"),
                                       shiny_rmd_warning())
@@ -77,5 +76,5 @@ knit_print.reactive <- function(x, ..., inline = FALSE) {
   renderFunc <- if (inline) renderText else renderPrint
   knitr::knit_print(renderFunc({
     x()
-  }), ..., inline = inline)
+  }), inline = inline)
 }

R/map.R

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

R/middleware.R

@@ -348,7 +348,7 @@ HandlerManager <- R6Class("HandlerManager",
                   httpResponse(status = 500L,
                     content_type = "text/html; charset=UTF-8",
                     content = as.character(htmltools::htmlTemplate(
-                      system_file("template", "error.html", package = "shiny"),
+                      system.file("template", "error.html", package = "shiny"),
                       message = conditionMessage(err)
                     ))
                   )
@@ -426,7 +426,7 @@ HandlerManager <- R6Class("HandlerManager",
 )
 
 maybeInjectAutoreload <- function(resp) {
-  if (get_devmode_option("shiny.autoreload", FALSE) &&
+  if (getOption("shiny.autoreload", FALSE) &&
       isTRUE(grepl("^text/html($|;)", resp$content_type)) &&
       is.character(resp$content)) {
 

R/mock-session.R

@@ -1,5 +1,5 @@
 # Promise helpers taken from:
-#   https://github.com/rstudio/promises/blob/main/tests/testthat/common.R
+#   https://github.com/rstudio/promises/blob/master/tests/testthat/common.R
 # Block until all pending later tasks have executed
 wait_for_it <- function() {
   while (!later::loop_empty()) {
@@ -9,6 +9,8 @@ wait_for_it <- function() {
 
 # Block until the promise is resolved/rejected. If resolved, return the value.
 # If rejected, throw (yes throw, not return) the error.
+#' @importFrom promises %...!%
+#' @importFrom promises %...>%
 extract <- function(promise) {
   promise_value <- NULL
   error <- NULL
@@ -259,7 +261,7 @@ MockShinySession <- R6Class(
       private$file_generators <- fastmap()
 
       private$timer <- MockableTimerCallbacks$new()
-      self$progressStack <- fastmap::faststack()
+      self$progressStack <- Stack$new()
 
       self$userData <- new.env(parent=emptyenv())
 

R/modal.R

@@ -151,25 +151,18 @@ removeModal <- function(session = getDefaultReactiveDomain()) {
 #' }
 #' @export
 modalDialog <- function(..., title = NULL, footer = modalButton("Dismiss"),
-  size = c("m", "s", "l", "xl"), easyClose = FALSE, fade = TRUE) {
+  size = c("m", "s", "l"), easyClose = FALSE, fade = TRUE) {
 
   size <- match.arg(size)
 
-  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,
+  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",
 
     div(
       class = "modal-dialog",
-      class = switch(size, s = "modal-sm", m = NULL, l = "modal-lg", xl = "modal-xl"),
+      class = switch(size, s = "modal-sm", m = NULL, l = "modal-lg"),
       div(class = "modal-content",
         if (!is.null(title)) div(class = "modal-header",
           tags$h4(class = "modal-title", title)
@@ -178,26 +171,14 @@ modalDialog <- function(..., title = NULL, footer = modalButton("Dismiss"),
         if (!is.null(footer)) div(class = "modal-footer", footer)
       )
     ),
-    # 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();
-      }"
-    ))
+    tags$script("$('#shiny-modal').modal().focus();")
   )
 }
 
 #' @export
 #' @rdname modalDialog
 modalButton <- function(label, icon = NULL) {
-  tags$button(
-    type = "button",
-    class = "btn btn-default",
-    `data-dismiss` = "modal",
-    `data-bs-dismiss` = "modal",
-    validateIcon(icon), label
+  tags$button(type = "button", class = "btn btn-default",
+    `data-dismiss` = "modal", validateIcon(icon), label
   )
 }

R/modules.R

@@ -66,7 +66,7 @@ find_ancestor_session <- function(x, depth = 20) {
 #' Shiny's module feature lets you break complicated UI and server logic into
 #' smaller, self-contained pieces. Compared to large monolithic Shiny apps,
 #' modules are easier to reuse and easier to reason about. See the article at
-#' <https://shiny.rstudio.com/articles/modules.html> to learn more.
+#' <http://shiny.rstudio.com/articles/modules.html> to learn more.
 #'
 #' Starting in Shiny 1.5.0, we recommend using `moduleServer` instead of
 #' [`callModule()`], because the syntax is a little easier
@@ -80,7 +80,7 @@ find_ancestor_session <- function(x, depth = 20) {
 #'   almost always be used).
 #'
 #' @return The return value, if any, from executing the module server function
-#' @seealso <https://shiny.rstudio.com/articles/modules.html>
+#' @seealso <http://shiny.rstudio.com/articles/modules.html>
 #'
 #' @examples
 #' # Define the UI for a module

R/progress.R

@@ -76,10 +76,8 @@ Progress <- R6Class(
       min = 0, max = 1,
       style = getShinyOption("progress.style", default = "notification"))
     {
-      if (is.null(session))
-        rlang::abort("Can only use Progress$new() inside a Shiny app")
       if (is.null(session$progressStack))
-        rlang::abort("`session` is not a ShinySession object.")
+        stop("'session' is not a ShinySession object.")
 
       private$session <- session
       private$id <- createUniqueId(8)

R/react.R

@@ -5,7 +5,7 @@ processId <- local({
   cached <- NULL
   function() {
     if (is.null(cached)) {
-      cached <<- rlang::hash(list(
+      cached <<- digest::digest(list(
         Sys.info(),
         Sys.time()
       ))
@@ -65,7 +65,7 @@ Context <- R6Class(
         that have been registered with onInvalidate()."
 
       if (!identical(.pid, processId())) {
-        rlang::abort("Reactive context was created in one process and invalidated from another.")
+        stop("Reactive context was created in one process and invalidated from another")
       }
 
       if (.invalidated)
@@ -87,7 +87,7 @@ Context <- R6Class(
         immediately."
 
       if (!identical(.pid, processId())) {
-        rlang::abort("Reactive context was created in one process and accessed from another.")
+        stop("Reactive context was created in one process and accessed from another")
       }
 
       if (.invalidated)
@@ -140,13 +140,9 @@ ReactiveEnvironment <- R6Class(
         if (isTRUE(getOption('shiny.suppressMissingContextError'))) {
           return(getDummyContext())
         } else {
-          rlang::abort(c(
-            'Operation not allowed without an active reactive context.',
-            paste0(
-              'You tried to do something that can only be done from inside a ',
-              'reactive consumer.'
-            )
-          ))
+          stop('Operation not allowed without an active reactive context. ',
+               '(You tried to do something that can only be done from inside a ',
+               'reactive expression or observer.)')
         }
       }
       return(.currentContext)
@@ -206,8 +202,7 @@ getCurrentContext <- function() {
   .getReactiveEnvironment()$currentContext()
 }
 hasCurrentContext <- function() {
-  !is.null(.getReactiveEnvironment()$.currentContext) ||
-    isTRUE(getOption("shiny.suppressMissingContextError"))
+  !is.null(.getReactiveEnvironment()$.currentContext)
 }
 
 getDummyContext <- function() {

R/reactives.R

@@ -105,7 +105,9 @@ ReactiveVal <- R6Class(
       invisible(TRUE)
     },
     freeze = function(session = getDefaultReactiveDomain()) {
-      checkReactiveDomain(session)
+      if (is.null(session)) {
+        stop("Can't freeze a reactiveVal without a reactive domain")
+      }
       rLog$freezeReactiveVal(private$reactId, session)
       session$onFlushed(function() {
         self$thaw(session)
@@ -236,23 +238,17 @@ freezeReactiveVal <- function(x) {
   }
 
   domain <- getDefaultReactiveDomain()
-  checkReactiveDomain(domain)
-
+  if (is.null(domain)) {
+    stop("freezeReactiveVal() must be called when a default reactive domain is active.")
+  }
   if (!inherits(x, "reactiveVal")) {
-    rlang::abort("`x` must be a reactiveVal.")
+    stop("x must be a reactiveVal object")
   }
 
   attr(x, ".impl", exact = TRUE)$freeze(domain)
   invisible()
 }
 
-checkReactiveDomain <- function(x) {
-  if (is.null(x)) {
-    rlang::abort("Can't freeze reactive values without a reactive domain.")
-  }
-}
-
-
 #' @export
 format.reactiveVal <- function(x, ...) {
   attr(x, ".impl", exact = TRUE)$format(...)
@@ -568,9 +564,9 @@ ReactiveValues <- R6Class(
 #' @seealso [isolate()] and [is.reactivevalues()].
 #' @export
 reactiveValues <- function(...) {
-  args <- list2(...)
+  args <- list(...)
   if ((length(args) > 0) && (is.null(names(args)) || any(names(args) == "")))
-    rlang::abort("All arguments passed to reactiveValues() must be named.")
+    stop("All arguments passed to reactiveValues() must be named.")
 
   values <- .createReactiveValues(ReactiveValues$new())
 
@@ -581,7 +577,7 @@ reactiveValues <- function(...) {
 
 checkName <- function(x) {
   if (!is.character(x) || length(x) != 1) {
-    rlang::abort("Must use single string to index into reactivevalues.")
+    stop("Must use single string to index into reactivevalues")
   }
 }
 
@@ -623,14 +619,6 @@ is.reactivevalues <- function(x) inherits(x, 'reactivevalues')
 #' @export
 `$.reactivevalues` <- function(x, name) {
   checkName(name)
-
-  if (!hasCurrentContext()) {
-    rlang::abort(c(
-      paste0("Can't access reactive value '", name, "' outside of reactive consumer."),
-      i = "Do you need to wrap inside reactive() or observe()?"
-    ))
-  }
-
   .subset2(x, 'impl')$get(.subset2(x, 'ns')(name))
 }
 
@@ -640,7 +628,7 @@ is.reactivevalues <- function(x) inherits(x, 'reactivevalues')
 #' @export
 `$<-.reactivevalues` <- function(x, name, value) {
   if (.subset2(x, 'readonly')) {
-    rlang::abort(paste0("Can't modify read-only reactive value '", name, "'"))
+    stop("Attempted to assign value to a read-only reactivevalues object")
   }
   checkName(name)
   .subset2(x, 'impl')$set(.subset2(x, 'ns')(name), value)
@@ -652,12 +640,12 @@ is.reactivevalues <- function(x) inherits(x, 'reactivevalues')
 
 #' @export
 `[.reactivevalues` <- function(values, name) {
-  rlang::abort("Can't index reactivevalues with `[`.")
+  stop("Single-bracket indexing of reactivevalues object is not allowed.")
 }
 
 #' @export
 `[<-.reactivevalues` <- function(values, name, value) {
-  rlang::abort("Can't index reactivevalues with `[`.")
+  stop("Single-bracket indexing of reactivevalues object is not allowed.")
 }
 
 #' @export
@@ -673,15 +661,16 @@ names.reactivevalues <- function(x) {
 
 #' @export
 `names<-.reactivevalues` <- function(x, value) {
-  rlang::abort("Can't assign names to reactivevalues.")
+  stop("Can't assign names to reactivevalues object")
 }
 
 #' @export
 as.list.reactivevalues <- function(x, all.names=FALSE, ...) {
-  shinyDeprecated(
-    "0.4.0", "as.list.reactivevalues()", "reactiveValuesToList()",
-    details = "Please see ?reactiveValuesToList for more information."
-  )
+  shinyDeprecated("reactiveValuesToList",
+    msg = paste("'as.list.reactivevalues' is deprecated. ",
+      "Use reactiveValuesToList instead.",
+      "\nPlease see ?reactiveValuesToList for more information.",
+      sep = ""))
 
   reactiveValuesToList(x, all.names)
 }
@@ -796,7 +785,9 @@ str.reactivevalues <- function(object, indent.str = " ", ...) {
 #' @export
 freezeReactiveValue <- function(x, name) {
   domain <- getDefaultReactiveDomain()
-  checkReactiveDomain(domain)
+  if (is.null(domain)) {
+    stop("freezeReactiveValue() must be called when a default reactive domain is active.")
+  }
 
   domain$freezeValue(x, name)
   invisible()
@@ -828,10 +819,9 @@ Observable <- R6Class(
                           domain = getDefaultReactiveDomain(),
                           ..stacktraceon = TRUE) {
       if (length(formals(func)) > 0)
-        rlang::abort(c(
-          "Can't make a reactive expression from a function that takes arguments.",
-          "Only functions without parameters can become reactive expressions."
-        ))
+        stop("Can't make a reactive expression from a function that takes one ",
+             "or more parameters; only functions without parameters can be ",
+             "reactive.")
 
       # This is to make sure that the function labels that show in the profiler
       # and in stack traces doesn't contain whitespace. See
@@ -875,7 +865,8 @@ Observable <- R6Class(
         invisible(.value)
     },
     format = function() {
-      simpleExprToFunction(fn_body(.origFunc), "reactive")
+      label <- sprintf('reactive(%s)', paste(deparse(body(.origFunc)), collapse='\n'))
+      strsplit(label, "\n")[[1]]
     },
     .updateValue = function() {
       ctx <- Context$new(.domain, .label, type = 'observable',
@@ -944,15 +935,14 @@ Observable <- R6Class(
 #' See the [Shiny tutorial](https://shiny.rstudio.com/tutorial/) for
 #' more information about reactive expressions.
 #'
-#' @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 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 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,56 +951,46 @@ Observable <- R6Class(
 #' @return a function, wrapped in a S3 class "reactive"
 #'
 #' @examples
-#' library(rlang)
 #' values <- reactiveValues(A=1)
 #'
 #' reactiveB <- reactive({
 #'   values$A + 1
 #' })
-#' # View the values from the R console with isolate()
-#' isolate(reactiveB())
-#' # 2
+#'
+#' # Can use quoted expressions
+#' reactiveC <- reactive(quote({ values$A + 2 }), quoted = TRUE)
 #'
 #' # 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.
+#' expr_q <- quote({ values$A + 3 })
+#' reactiveD <- reactive(expr_q, quoted = TRUE)
+#'
+#' # View the values from the R console with isolate()
+#' isolate(reactiveB())
 #' 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()
 
-  func <- installExprFunction(x, "func", env, quoted, wrappedWithLabel = FALSE)
-  # Attach a label and a reference to the original user source for debugging
-  userExpr <- fn_body(func)
-  label <- exprToLabel(userExpr, "reactive", label)
+  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()
 
-  o <- Observable$new(func, label, domain, ..stacktraceon = ..stacktraceon)
+  # Attach a label and a reference to the original user source for debugging
+  label <- exprToLabel(get_expr(x), "reactive", label)
+
+  o <- Observable$new(fun, label, domain, ..stacktraceon = ..stacktraceon)
   structure(
     o$getValue,
     observable = o,
-    cacheHint = list(userExpr = zap_srcref(userExpr)),
+    cacheHint = list(userExpr = zap_srcref(get_expr(x))),
     class = c("reactiveExpr", "reactive", "function")
   )
 }
@@ -1081,7 +1061,7 @@ execCount <- function(x) {
   else if (inherits(x, 'Observer'))
     return(x$.execCount)
   else
-    rlang::abort("Unexpected argument to execCount().")
+    stop('Unexpected argument to execCount')
 }
 
 # Internal utility functions for extracting things out of reactives.
@@ -1121,10 +1101,8 @@ Observer <- R6Class(
                           domain = getDefaultReactiveDomain(),
                           autoDestroy = TRUE, ..stacktraceon = TRUE) {
       if (length(formals(observerFunc)) > 0)
-        rlang::abort(c(
-          "Can't make an observer from a function that takes arguments.",
-          "Only functions without arguments can become observers."
-        ))
+        stop("Can't make an observer from a function that takes parameters; ",
+             "only functions without parameters can be reactive.")
       if (grepl("\\s", label, perl = TRUE)) {
         funcLabel <- "<observer>"
       } else {
@@ -1203,7 +1181,7 @@ Observer <- R6Class(
             # validation = function(e) NULL,
             # shiny.output.cancel = function(e) NULL
 
-            if (cnd_inherits(e, "shiny.silent.error")) {
+            if (inherits(e, "shiny.silent.error")) {
               return()
             }
 
@@ -1335,7 +1313,12 @@ Observer <- R6Class(
 #'
 #' @param x An expression (quoted or unquoted). Any return value will be
 #'   ignored.
-#' @inheritParams reactive
+#' @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 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.
@@ -1394,21 +1377,18 @@ Observer <- R6Class(
 #'   print(values$A + 1)
 #' })
 #'
-#' # To store expressions for later conversion to observe, use rlang::quo()
-#' myquo <- rlang::quo({ print(values$A + 3) })
-#' obsC <- rlang::inject(observe(!!myquo))
+#' # Can use quoted expressions
+#' obsC <- observe(quote({ print(values$A + 2) }), quoted = TRUE)
 #'
-#' # (Legacy) Can use quoted expressions
-#' obsD <- observe(quote({ print(values$A + 2) }), quoted = TRUE)
+#' # To store expressions for later conversion to observe, use quote()
+#' expr_q <- quote({ print(values$A + 3) })
+#' obsD <- observe(expr_q, 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,
@@ -1419,11 +1399,18 @@ observe <- function(
 {
   check_dots_empty()
 
-  func <- installExprFunction(x, "func", env, quoted)
-  label <- funcToLabel(func, "observe", label)
+  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'))
+  }
 
   o <- Observer$new(
-    func,
+    fun,
     label = label,
     suspended = suspended,
     priority = priority,
@@ -1916,7 +1903,7 @@ reactivePoll <- function(intervalMillis, session, checkFunc, valueFunc) {
 #' @export
 reactiveFileReader <- function(intervalMillis, session, filePath, readFunc, ...) {
   filePath <- coerceToFunc(filePath)
-  extraArgs <- list2(...)
+  extraArgs <- list(...)
 
   reactivePoll(
     intervalMillis, session,
@@ -2035,11 +2022,7 @@ maskReactiveContext <- function(expr) {
 
 #' Event handler
 #'
-#' Respond to "event-like" reactive inputs, values, and expressions. As of Shiny
-#' 1.6.0, we recommend using [bindEvent()] instead of `eventReactive()` and
-#' `observeEvent()`. This is because `bindEvent()` can be composed with
-#' [bindCache()], and because it can also be used with `render` functions (like
-#' [renderText()] and [renderPlot()]).
+#' Respond to "event-like" reactive inputs, values, and expressions.
 #'
 #' Shiny's reactive programming framework is primarily designed for calculated
 #' values (reactive expressions) and side-effect-causing actions (observers)
@@ -2061,17 +2044,13 @@ maskReactiveContext <- function(expr) {
 #' response to an event. (Note that "recalculate a value" does not generally
 #' count as performing an action--see `eventReactive` for that.) The first
 #' argument is the event you want to respond to, and the second argument is a
-#' function that should be called whenever the event occurs. Note that
-#' `observeEvent()` is equivalent to using `observe() %>% bindEvent()` and as of
-#' Shiny 1.6.0, we recommend the latter.
+#' function that should be called whenever the event occurs.
 #'
 #' Use `eventReactive` to create a *calculated value* that only
 #' updates in response to an event. This is just like a normal
 #' [reactive expression][reactive] except it ignores all the usual
 #' invalidations that come from its reactive dependencies; it only invalidates
-#' in response to the given event. Note that
-#' `eventReactive()` is equivalent to using `reactive() %>% bindEvent()` and as of
-#' Shiny 1.6.0, we recommend the latter.
+#' in response to the given event.
 #'
 #' @section ignoreNULL and ignoreInit:
 #'
@@ -2105,7 +2084,6 @@ maskReactiveContext <- function(expr) {
 #' Even though `ignoreNULL` and `ignoreInit` can be used for similar
 #' purposes they are independent from one another. Here's the result of combining
 #' these:
-
 #'
 #' \describe{
 #'   \item{`ignoreNULL = TRUE` and `ignoreInit = FALSE`}{
@@ -2145,30 +2123,23 @@ 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 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 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 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.
@@ -2199,7 +2170,7 @@ maskReactiveContext <- function(expr) {
 #' @seealso [actionButton()]
 #'
 #' @examples
-#' ## Only run examples in interactive R sessions
+#' ## Only run this example in interactive R sessions
 #' if (interactive()) {
 #'
 #'   ## App 1: Sample usage
@@ -2218,12 +2189,6 @@ maskReactiveContext <- function(expr) {
 #'       observeEvent(input$button, {
 #'         cat("Showing", input$x, "rows\n")
 #'       })
-#'       # The observeEvent() above is equivalent to:
-#'       # observe({
-#'       #    cat("Showing", input$x, "rows\n")
-#'       #   }) %>%
-#'       #   bindEvent(input$button)
-#'
 #'       # Take a reactive dependency on input$button, but
 #'       # not on any of the stuff inside the function
 #'       df <- eventReactive(input$button, {
@@ -2243,12 +2208,6 @@ maskReactiveContext <- function(expr) {
 #'         print(paste("This will only be printed once; all",
 #'               "subsequent button clicks won't do anything"))
 #'       }, once = TRUE)
-#'       # The observeEvent() above is equivalent to:
-#'       # observe({
-#'       #   print(paste("This will only be printed once; all",
-#'       #         "subsequent button clicks won't do anything"))
-#'       #   }) %>%
-#'       #   bindEvent(input$go, once = TRUE)
 #'     }
 #'   )
 #'
@@ -2282,13 +2241,15 @@ observeEvent <- function(eventExpr, handlerExpr,
 {
   check_dots_empty()
 
-  eventQ <- exprToQuo(eventExpr, event.env, event.quoted)
-  handlerQ <- exprToQuo(handlerExpr, handler.env, handler.quoted)
+  eventExpr   <- get_quosure(eventExpr,   event.env,   event.quoted)
+  handlerExpr <- get_quosure(handlerExpr, handler.env, handler.quoted)
 
-  label <- quoToLabel(eventQ, "observeEvent", label)
+  if (is.null(label)) {
+    label <- sprintf('observeEvent(%s)', paste(deparse(get_expr(eventExpr)), collapse='\n'))
+  }
 
   handler <- inject(observe(
-    !!handlerQ,
+    !!handlerExpr,
     label = label,
     suspended = suspended,
     priority = priority,
@@ -2302,7 +2263,7 @@ observeEvent <- function(eventExpr, handlerExpr,
     ignoreInit = ignoreInit,
     once = once,
     label = label,
-    !!eventQ,
+    !!eventExpr,
     x = handler
   ))
 
@@ -2320,17 +2281,19 @@ eventReactive <- function(eventExpr, valueExpr,
 {
   check_dots_empty()
 
-  eventQ <- exprToQuo(eventExpr, event.env, event.quoted)
-  valueQ <- exprToQuo(valueExpr, value.env, value.quoted)
+  eventExpr <- get_quosure(eventExpr, event.env, event.quoted)
+  valueExpr <- get_quosure(valueExpr, value.env, value.quoted)
 
-  label <- quoToLabel(eventQ, "eventReactive", label)
+  if (is.null(label)) {
+    label <- sprintf('eventReactive(%s)', paste(deparse(get_expr(eventExpr)), collapse='\n'))
+  }
 
   invisible(inject(bindEvent(
     ignoreNULL = ignoreNULL,
     ignoreInit = ignoreInit,
     label = label,
-    !!eventQ,
-    x = reactive(!!valueQ, domain = domain, label = label)
+    !!eventExpr,
+    x = reactive(!!valueExpr, domain = domain, label = label)
   )))
 }
 
@@ -2472,11 +2435,11 @@ debounce <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
 
       # Ensure r() is called only after setting firstRun to FALSE since r()
       # may throw an error
-      try(r(), silent = TRUE)
+      r()
       return()
     }
     # This ensures r() is still tracked after firstRun
-    try(r(), silent = TRUE)
+    r()
 
     # The value (or possibly millis) changed. Start or reset the timer.
     v$when <- getDomainTimeMs(domain) + millis()
@@ -2509,7 +2472,7 @@ debounce <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
   # commenting it out and studying the unit test failure that results.
   primer <- observe({
     primer$destroy()
-    try(er(), silent = TRUE)
+    er()
   }, label = "debounce primer", domain = domain, priority = priority)
 
   er
@@ -2551,7 +2514,7 @@ throttle <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
   }
 
   # Responsible for tracking when f() changes.
-  observeEvent(try(r(), silent = TRUE), {
+  observeEvent(r(), {
     if (v$pending) {
       # In a blackout period and someone already scheduled; do nothing
     } else if (blackoutMillisLeft() > 0) {

R/reexports.R

@@ -1,6 +1,6 @@
 ####
-# Generated by `./tools/documentation/updateReexports.R`: do not edit by hand
-# Please call `source('tools/documentation/updateReexports.R')` from the root folder to update`
+# Generated by `./tools/updateReexports.R`: do not edit by hand
+# Please call `source('tools/updateReexports.R') from the root folder to update`
 ####
 
 
@@ -90,20 +90,17 @@ htmltools::em
 #' @export
 htmltools::hr
 
+
+# htmltools tag.Rd -------------------------------------------------------------
+
 #' @importFrom htmltools tag
 #' @export
 htmltools::tag
 
-
-# htmltools tagList.Rd ---------------------------------------------------------
-
 #' @importFrom htmltools tagList
 #' @export
 htmltools::tagList
 
-
-# htmltools tagAppendAttributes.Rd ---------------------------------------------
-
 #' @importFrom htmltools tagAppendAttributes
 #' @export
 htmltools::tagAppendAttributes
@@ -116,9 +113,6 @@ htmltools::tagHasAttribute
 #' @export
 htmltools::tagGetAttribute
 
-
-# htmltools tagAppendChild.Rd --------------------------------------------------
-
 #' @importFrom htmltools tagAppendChild
 #' @export
 htmltools::tagAppendChild

R/render-cached-plot.R

@@ -9,7 +9,7 @@
 #' changes.
 #'
 #' `cacheKeyExpr` is an expression which, when evaluated, returns an object
-#' which will be serialized and hashed using the [rlang::hash()]
+#' which will be serialized and hashed using the [digest::digest()]
 #' function to generate a string that will be used as a cache key. This key is
 #' used to identify the contents of the plot: if the cache key is the same as a
 #' previous time, it assumes that the plot is the same and can be retrieved from
@@ -33,7 +33,7 @@
 #' to normal R objects before returning them. Your expression could even
 #' serialize and hash that information in an efficient way and return a string,
 #' which will in turn be hashed (very quickly) by the
-#' [rlang::hash()] function.
+#' [digest::digest()] function.
 #'
 #' Internally, the result from `cacheKeyExpr` is combined with the name of
 #' the output (if you assign it to `output$plot1`, it will be combined
@@ -181,7 +181,7 @@
 #' # At the top of app.R, this set the application-scoped cache to be a disk
 #' # cache that can be shared among multiple concurrent R processes, and is
 #' # deleted when the system reboots.
-#' shinyOptions(cache = cachem::cache_disk(file.path(dirname(tempdir()), "myapp-cache")))
+#' shinyOptions(cache = cachem::cache_disk(file.path(dirname(tempdir()), "myapp-cache"))
 #'
 #' # At the top of app.R, this set the application-scoped cache to be a disk
 #' # cache that can be shared among multiple concurrent R processes, and

R/render-plot.R

@@ -34,19 +34,19 @@
 #'   When rendering an inline plot, you must provide numeric values (in pixels)
 #'   to both \code{width} and \code{height}.
 #' @param res Resolution of resulting plot, in pixels per inch. This value is
-#'   passed to [plotPNG()]. Note that this affects the resolution of PNG
+#'   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. 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 [plotPNG()].
+#' @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 ... Arguments to be passed through to [grDevices::png()].
 #'   These can be used to set the width, height, background color, etc.
-#' @inheritParams renderUI
+#' @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.
 #' @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,18 +58,15 @@
 #'   interactive R Markdown document.
 #' @export
 renderPlot <- function(expr, width = 'auto', height = 'auto', res = 72, ...,
-                       alt = NA,
+                       alt = "Plot object",
                        env = parent.frame(), quoted = FALSE,
                        execOnResize = FALSE, outputArgs = list()
 ) {
 
-  func <- installExprFunction(
-    expr, "func", env, quoted,
-    label = "renderPlot",
-    # This ..stacktraceon is matched by a ..stacktraceoff.. when plotFunc
-    # is called
-    ..stacktraceon = TRUE
-  )
+  expr <- get_quosure(expr, env, quoted)
+  # This ..stacktraceon is matched by a ..stacktraceoff.. when plotFunc
+  # is called
+  func <- quoToFunction(expr, "renderPlot", ..stacktraceon = TRUE)
 
   args <- list(...)
 
@@ -187,7 +184,7 @@ renderPlot <- function(expr, width = 'auto', height = 'auto', res = 72, ...,
     outputFunc,
     renderFunc,
     outputArgs,
-    cacheHint = list(userExpr = installedFuncExpr(func), res = res)
+    cacheHint = list(userExpr = get_expr(expr), res = res)
   )
   class(markedFunc) <- c("shiny.renderPlot", class(markedFunc))
   markedFunc
@@ -215,7 +212,7 @@ resizeSavedPlot <- function(name, session, result, width, height, alt, pixelrati
     src = session$fileUrl(name, outfile, contentType = "image/png"),
     width = width,
     height = height,
-    alt = result$alt,
+    alt = alt,
     coordmap = coordmap,
     error = attr(coordmap, "error", exact = TRUE)
   )
@@ -291,7 +288,6 @@ 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
             )
           }
@@ -306,10 +302,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 = result$alt,
+        alt = alt,
         coordmap = result$coordmap,
         # Get coordmap error message if present
         error = attr(result$coordmap, "error", exact = TRUE)
@@ -343,24 +339,6 @@ 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)
@@ -612,7 +590,7 @@ getGgplotCoordmap <- function(p, width, height, res) {
 find_panel_info <- function(b) {
   # Structure of ggplot objects changed after 2.1.0. After 2.2.1, there was a
   # an API for extracting the necessary information.
-  ggplot_ver <- get_package_version("ggplot2")
+  ggplot_ver <- utils::packageVersion("ggplot2")
 
   if (ggplot_ver > "2.2.1") {
     find_panel_info_api(b)

R/render-table.R

@@ -1,12 +1,10 @@
 #' Table Output
 #'
-#' @description
-#' The `tableOuptut()`/`renderTable()` pair creates a reactive table that is
-#' suitable for display small matrices and data frames. The columns are
-#' formatted with [xtable::xtable()].
+#' Creates a reactive table that is suitable for assigning to an `output`
+#' slot.
 #'
-#' See [renderDataTable()] for data frames that are too big to fit on a single
-#' page.
+#' The corresponding HTML output tag should be `div` and have the CSS
+#' class name `shiny-html-output`.
 #'
 #' @param expr An expression that returns an R object that can be used with
 #'   [xtable::xtable()].
@@ -42,28 +40,13 @@
 #'   (i.e. they either evaluate to `NA` or `NaN`).
 #' @param ... Arguments to be passed through to [xtable::xtable()]
 #'   and [xtable::print.xtable()].
-#' @inheritParams renderUI
+#' @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.
 #' @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.
 #' @export
-#' @examples
-#' ## Only run this example in interactive R sessions
-#' if (interactive()) {
-#'   # table example
-#'   shinyApp(
-#'     ui = fluidPage(
-#'       fluidRow(
-#'         column(12,
-#'           tableOutput('table')
-#'         )
-#'       )
-#'     ),
-#'     server = function(input, output) {
-#'       output$table <- renderTable(iris)
-#'     }
-#'   )
-#' }
 renderTable <- function(expr, striped = FALSE, hover = FALSE,
                         bordered = FALSE, spacing = c("s", "xs", "m", "l"),
                         width = "auto", align = NULL,
@@ -72,7 +55,8 @@ renderTable <- function(expr, striped = FALSE, hover = FALSE,
                         env = parent.frame(), quoted = FALSE,
                         outputArgs=list())
 {
-  func <- installExprFunction(expr, "func", env, quoted, label = "renderTable")
+  expr <- get_quosure(expr, env, quoted)
+  func <- quoToFunction(expr, "renderTable")
 
   if (!is.function(spacing)) spacing <- match.arg(spacing)
 

R/run-url.R

@@ -23,10 +23,10 @@
 #' @examples
 #' ## Only run this example in interactive R sessions
 #' if (interactive()) {
-#'   runUrl('https://github.com/rstudio/shiny_example/archive/main.tar.gz')
+#'   runUrl('https://github.com/rstudio/shiny_example/archive/master.tar.gz')
 #'
 #'   # Can run an app from a subdirectory in the archive
-#'   runUrl("https://github.com/rstudio/shiny_example/archive/main.zip",
+#'   runUrl("https://github.com/rstudio/shiny_example/archive/master.zip",
 #'     subdir = "inst/shinyapp/")
 #' }
 runUrl <- function(url, filetype = NULL, subdir = NULL, destdir = NULL, ...) {
@@ -121,8 +121,7 @@ runGist <- function(gist, destdir = NULL, ...) {
 #' @param username GitHub username. If `repo` is of the form
 #'   `"username/repo"`, `username` will be taken from `repo`.
 #' @param ref Desired git reference. Could be a commit, tag, or branch name.
-#'   Defaults to `"HEAD"`, which means the default branch on GitHub, typically
-#'   `"main"` or `"master"`.
+#'   Defaults to `"master"`.
 #' @export
 #' @examples
 #' ## Only run this example in interactive R sessions
@@ -134,7 +133,7 @@ runGist <- function(gist, destdir = NULL, ...) {
 #'   runGitHub("shiny_example", "rstudio", subdir = "inst/shinyapp/")
 #' }
 runGitHub <- function(repo, username = getOption("github.user"),
-                      ref = "HEAD", subdir = NULL, destdir = NULL, ...) {
+                      ref = "master", subdir = NULL, destdir = NULL, ...) {
 
   if (grepl('/', repo)) {
     res <- strsplit(repo, '/')[[1]]

R/runapp.R

@@ -22,13 +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 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.
+#'   use a random port.
 #' @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. The value of this parameter can also be a
+#'   interactive sessions only. This value of this parameter can also be a
 #'   function to call with the application's URL.
 #' @param host The IPv4 address that the application should listen on. Defaults
 #'   to the `shiny.host` option, if set, or `"127.0.0.1"` if not. See
@@ -86,7 +83,8 @@
 #' @export
 runApp <- function(appDir=getwd(),
                    port=getOption('shiny.port'),
-                   launch.browser = getOption('shiny.launch.browser', interactive()),
+                   launch.browser=getOption('shiny.launch.browser',
+                                            interactive()),
                    host=getOption('shiny.host', '127.0.0.1'),
                    workerId="", quiet=FALSE,
                    display.mode=c("auto", "normal", "showcase"),
@@ -304,8 +302,7 @@ 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
-          # 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)) {
+          if (!port %in% c(3659, 4045, 6000, 6665:6669, 6697)) {
             break
           }
         }
@@ -464,10 +461,11 @@ stopApp <- function(returnValue = invisible()) {
 #' @export
 runExample <- function(example=NA,
                        port=getOption("shiny.port"),
-                       launch.browser = getOption('shiny.launch.browser', interactive()),
+                       launch.browser=getOption('shiny.launch.browser',
+                                                interactive()),
                        host=getOption('shiny.host', '127.0.0.1'),
                        display.mode=c("auto", "normal", "showcase")) {
-  examplesDir <- system_file('examples', package='shiny')
+  examplesDir <- system.file('examples', package='shiny')
   dir <- resolve(examplesDir, example)
   if (is.null(dir)) {
     if (is.na(example)) {

R/serializers.R

@@ -5,6 +5,7 @@
 #'   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

@@ -41,12 +41,12 @@ inputHandlers <- Map$new()
 #' })
 #'
 #' ## On the Javascript side, the associated input binding must have a corresponding getType method:
-#' # getType: function(el) {
-#' #   return "mypackage.validint";
-#' # }
+#' getType: function(el) {
+#'   return "mypackage.validint";
+#' }
 #'
 #' }
-#' @seealso [removeInputHandler()] [applyInputHandlers()]
+#' @seealso [removeInputHandler()]
 #' @export
 registerInputHandler <- function(type, fun, force=FALSE){
   if (inputHandlers$containsKey(type) && !force){
@@ -181,7 +181,7 @@ registerInputHandler("shiny.datetime", function(val, ...){
 
 registerInputHandler("shiny.action", function(val, shinysession, name) {
   # mark up the action button value with a special class so we can recognize it later
-  class(val) <- c("shinyActionButtonValue", class(val))
+  class(val) <- c(class(val), "shinyActionButtonValue")
   val
 })
 

R/server.R

@@ -29,9 +29,7 @@ registerClient <- function(client) {
 
 #' Define Server Functionality
 #'
-#' @description \lifecycle{superseded}
-#'
-#' @description Defines the server-side logic of the Shiny application. This generally
+#' Defines the server-side logic of the Shiny application. This generally
 #' involves creating functions that map user inputs to various kinds of output.
 #' In older versions of Shiny, it was necessary to call `shinyServer()` in
 #' the `server.R` file, but this is no longer required as of Shiny 0.10.
@@ -49,7 +47,7 @@ registerClient <- function(client) {
 #' optional `session` parameter, which is used when greater control is
 #' needed.
 #'
-#' See the [tutorial](https://shiny.rstudio.com/tutorial/) for more
+#' See the [tutorial](http://rstudio.github.com/shiny/tutorial/) for more
 #' on how to write a server function.
 #'
 #' @param func The server function for this application. See the details section
@@ -78,17 +76,6 @@ registerClient <- function(client) {
 #' @export
 #' @keywords internal
 shinyServer <- function(func) {
-  if (in_devmode()) {
-    shinyDeprecated(
-      "0.10.0", "shinyServer()",
-      details = paste0(
-        "When removing `shinyServer()`, ",
-        "ensure that the last expression returned from server.R ",
-        "is the function normally supplied to `shinyServer(func)`."
-      )
-    )
-  }
-
   .globals$server <- list(func)
   invisible(func)
 }
@@ -128,7 +115,7 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
   appvars <- new.env()
   appvars$server <- NULL
 
-  sys.www.root <- system_file('www', package='shiny')
+  sys.www.root <- system.file('www', package='shiny')
 
   # This value, if non-NULL, must be present on all HTTP and WebSocket
   # requests as the Shiny-Shared-Secret header or else access will be
@@ -150,7 +137,7 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
       }
 
       if (identical(ws$request$PATH_INFO, "/autoreload/")) {
-        if (!get_devmode_option("shiny.autoreload", FALSE)) {
+        if (!getOption("shiny.autoreload", FALSE)) {
           ws$close()
           return(TRUE)
         }
@@ -331,7 +318,7 @@ argsForServerFunc <- function(serverFunc, session) {
 getEffectiveBody <- function(func) {
   if (is.null(func))
     NULL
-  else if (isS4(func) && inherits(func, "functionWithTrace"))
+  else if (isS4(func) && class(func) == "functionWithTrace")
     body(func@original)
   else
     body(func)
@@ -385,7 +372,7 @@ startApp <- function(appObj, port, host, quiet) {
     list(
       # Always handle /session URLs dynamically, even if / is a static path.
       "session" = excludeStaticPath(),
-      "shared" = system_file(package = "shiny", "www", "shared")
+      "shared" = system.file(package = "shiny", "www", "shared")
     ),
     .globals$resourcePaths
   )

R/shiny-options.R

@@ -88,16 +88,12 @@ getShinyOption <- function(name, default = NULL) {
 #' \item{shiny.host (defaults to `"127.0.0.1"`)}{The IP address that Shiny should listen on. See
 #'   [runApp()] for more information.}
 #' \item{shiny.jquery.version (defaults to `3`)}{The major version of jQuery to use.
-#'   Currently only values of `3` or `1` are supported. If `1`, then jQuery 1.12.4 is used. If `3`,
-#'   then jQuery `r version_jquery` is used.}
+#' Currently only values of `3` or `1` are supported. If `1`, then jQuery 1.12.4 is used. If `3`,
+#' then jQuery 3.5.1 is used.}
 #' \item{shiny.json.digits (defaults to `16`)}{The number of digits to use when converting
 #'   numbers to JSON format to send to the client web browser.}
 #' \item{shiny.launch.browser (defaults to `interactive()`)}{A boolean which controls the default behavior
 #'   when an app is run. See [runApp()] for more information.}
-#' \item{shiny.mathjax.url (defaults to `"https://mathjax.rstudio.com/latest/MathJax.js"`)}{
-#'   The URL that should be used to load MathJax, via [withMathJax()].}
-#' \item{shiny.mathjax.config (defaults to `"config=TeX-AMS-MML_HTMLorMML"`)}{The querystring
-#'   used to load MathJax, via [withMathJax()].}
 #' \item{shiny.maxRequestSize (defaults to 5MB)}{This is a number which specifies the maximum
 #'   web request size, which serves as a size limit for file uploads.}
 #' \item{shiny.minified (defaults to `TRUE`)}{By default
@@ -129,9 +125,6 @@ getShinyOption <- function(name, default = NULL) {
 #'   console.}
 #' \item{shiny.testmode (defaults to `FALSE`)}{If `TRUE`, then various features for testing Shiny
 #'   applications are enabled.}
-#' \item{shiny.snapshotsortc (defaults to `FALSE`)}{If `TRUE`, test snapshot keys
-#'   for \pkg{shinytest} will be sorted consistently using the C locale.  Snapshots
-#'   retrieved by \pkg{shinytest2} will always sort using the C locale.}
 #' \item{shiny.trace (defaults to `FALSE`)}{Print messages sent between the R server and the web
 #'   browser client to the R console. This is useful for debugging. Possible
 #'   values are `"send"` (only print messages sent to the client),
@@ -140,16 +133,9 @@ getShinyOption <- function(name, default = NULL) {
 #'   messages).}
 #' \item{shiny.autoload.r (defaults to `TRUE`)}{If `TRUE`, then the R/
 #'   of a shiny app will automatically be sourced.}
-#' \item{shiny.useragg (defaults to `TRUE`)}{Set to `FALSE` to prevent PNG rendering via the
-#'   ragg package. See [plotPNG()] for more information.}
-#' \item{shiny.usecairo (defaults to `TRUE`)}{Set to `FALSE` to prevent PNG rendering via the
-#'   Cairo package. See [plotPNG()] for more information.}
-#' \item{shiny.devmode (defaults to `NULL`)}{Option to enable Shiny Developer Mode. When set,
-#'   different default `getOption(key)` values will be returned. See [devmode()] for more details.}
-### Not documenting as 'shiny.devmode.verbose' is for niche use only
-# ' \item{shiny.devmode.verbose (defaults to `TRUE`)}{If `TRUE`, will display messages printed
-# '   about which options are being set. See [devmode()] for more details. }
-### (end not documenting 'shiny.devmode.verbose')
+#' \item{shiny.usecairo (defaults to `TRUE`)}{This is used to disable graphical rendering by the
+#'   Cairo package, if it is installed. See [plotPNG()] for more
+#'   information.}
 #' }
 #'
 #'
@@ -186,7 +172,7 @@ getShinyOption <- function(name, default = NULL) {
 #' @aliases shiny-options
 #' @export
 shinyOptions <- function(...) {
-  newOpts <- list2(...)
+  newOpts <- list(...)
 
   if (length(newOpts) > 0) {
     # If we're within a session, modify at the session level.

R/shiny-package.R

@@ -1,36 +0,0 @@
-# See also R/reexports.R
-
-## usethis namespace: start
-## usethis namespace: end
-#' @importFrom lifecycle deprecated is_present
-#' @importFrom grDevices dev.set dev.cur
-#' @importFrom fastmap fastmap
-#' @importFrom promises %...!%
-#' @importFrom promises %...>%
-#' @importFrom promises
-#'    promise promise_resolve promise_reject is.promising
-#'    as.promise
-#' @importFrom rlang
-#'    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
-#' @import httpuv
-#' @import xtable
-#' @import R6
-#' @import mime
-NULL
-
-# It's necessary to Depend on methods so Rscript doesn't fail. It's necessary
-# to import(methods) in NAMESPACE so R CMD check doesn't complain. This
-# approach isn't foolproof because Rscript -e pkgname::func() doesn't actually
-# cause methods to be attached, but it's not a problem for shiny::runApp()
-# since we call require(shiny) as part of loading the app.
-#' @import methods
-NULL

R/shiny.R

@@ -1,4 +1,4 @@
-#' @include utils.R
+#' @include utils.R stack.R
 NULL
 
 #' Web Application Framework for R
@@ -8,7 +8,7 @@ NULL
 #' prebuilt widgets make it possible to build beautiful, responsive, and
 #' powerful applications with minimal effort.
 #'
-#' The Shiny tutorial at <https://shiny.rstudio.com/tutorial/> explains
+#' The Shiny tutorial at <http://shiny.rstudio.com/tutorial/> explains
 #' the framework in depth, walks you through building a simple application, and
 #' includes extensive annotated examples.
 #'
@@ -17,6 +17,24 @@ NULL
 #' @name shiny-package
 #' @aliases shiny
 #' @docType package
+#' @import htmltools httpuv xtable digest R6 mime
+NULL
+
+# It's necessary to Depend on methods so Rscript doesn't fail. It's necessary
+# to import(methods) in NAMESPACE so R CMD check doesn't complain. This
+# approach isn't foolproof because Rscript -e pkgname::func() doesn't actually
+# cause methods to be attached, but it's not a problem for shiny::runApp()
+# since we call require(shiny) as part of loading the app.
+#' @import methods
+NULL
+
+#' @importFrom digest digest
+#' @importFrom promises promise promise_resolve promise_reject is.promising
+#'   as.promise
+#' @importFrom rlang quo enquo as_function get_expr get_env new_function enquos
+#'   eval_tidy expr pairlist2 new_quosure enexpr as_quosure is_quosure inject
+#'   enquos0 zap_srcref %||% is_na
+#' @importFrom ellipsis check_dots_empty check_dots_unnamed
 NULL
 
 createUniqueId <- function(bytes, prefix = "", suffix = "") {
@@ -193,14 +211,6 @@ workerId <- local({
 #'   An environment for app authors and module/package authors to store whatever
 #'   session-specific data they want.
 #' }
-#' \item{user}{
-#'   User's log-in information. Useful for identifying users on hosted platforms
-#'   such as RStudio Connect and Shiny Server.
-#' }
-#' \item{groups}{
-#'   The `user`'s relevant group information. Useful for determining what
-#'   privileges the user should or shouldn't have.
-#' }
 #' \item{resetBrush(brushId)}{
 #'   Resets/clears the brush with the given `brushId`, if it exists on
 #'   any `imageOutput` or `plotOutput` in the app.
@@ -288,7 +298,7 @@ NULL
 #'
 #' The `NS` function creates namespaced IDs out of bare IDs, by joining
 #' them using `ns.sep` as the delimiter. It is intended for use in Shiny
-#' modules. See <https://shiny.rstudio.com/articles/modules.html>.
+#' modules. See <http://shiny.rstudio.com/articles/modules.html>.
 #'
 #' Shiny applications use IDs to identify inputs and outputs. These IDs must be
 #' unique within an application, as accidentally using the same input/output ID
@@ -305,7 +315,7 @@ NULL
 #' @param id The id string to be namespaced (optional).
 #' @return If `id` is missing, returns a function that expects an id string
 #'   as its only argument and returns that id with the namespace prepended.
-#' @seealso <https://shiny.rstudio.com/articles/modules.html>
+#' @seealso <http://shiny.rstudio.com/articles/modules.html>
 #' @export
 NS <- function(namespace, id = NULL) {
   if (length(namespace) == 0)
@@ -343,8 +353,8 @@ ShinySession <- R6Class(
     websocket = 'ANY',
     invalidatedOutputValues = 'Map',
     invalidatedOutputErrors = 'Map',
-    inputMessageQueue = 'fastqueue',     # A list of inputMessages to send when flushed
-    cycleStartActionQueue = 'fastqueue', # A list of actions to perform to start a cycle
+    inputMessageQueue = list(), # A list of inputMessages to send when flushed
+    cycleStartActionQueue = list(), # A list of actions to perform to start a cycle
     .outputs = list(),          # Keeps track of all the output observer objects
     .outputOptions = list(),     # Options for each of the output observer objects
     progressKeys = 'character',
@@ -403,7 +413,7 @@ ShinySession <- R6Class(
     sendMessage = function(...) {
       # This function is a wrapper for $write
       msg <- list(...)
-      if (any_unnamed(msg)) {
+      if (anyUnnamed(msg)) {
         stop("All arguments to sendMessage must be named.")
       }
       private$write(toJSON(msg))
@@ -478,35 +488,6 @@ ShinySession <- R6Class(
           # "json" unless requested otherwise. The only other valid value is
           # "rds".
           format <- params$format %||% "json"
-          # Machines can test their snapshot under different locales.
-          # R CMD check runs under the `C` locale.
-          # However, before this parameter, existing snapshots were most likely not
-          #   under the `C` locale is would cause failures. This parameter allows
-          #   users to opt-in to the `C` locale.
-          # From ?sort:
-          #   However, there are some caveats with the radix sort:
-          #     If ‘x’ is a ‘character’ vector, all elements must share the
-          #   same encoding. Only UTF-8 (including ASCII) and Latin-1
-          #   encodings are supported. Collation always follows the "C"
-          #   locale.
-          # {shinytest2} will always set `sortC=1`
-          # {shinytest} does not have `sortC` functionality.
-          #    Users should set `options(shiny.snapshotsortc = TRUE)` within their app.
-          # The sortingMethod should always be `radix` going forward.
-          sortMethod <-
-            if (!is.null(params$sortC)) {
-              if (params$sortC != "1") {
-                stop("The `sortC` parameter can only be `1` or not supplied")
-              }
-              "radix"
-            } else {
-              # Allow users to set an option for {shinytest2}.
-              if (isTRUE(getShinyOption("snapshotsortc", default = FALSE))) {
-                "radix"
-              } else {
-                "auto"
-              }
-            }
 
           values <- list()
 
@@ -549,7 +530,7 @@ ShinySession <- R6Class(
               }
             )
 
-            values$input <- sortByName(values$input, method = sortMethod)
+            values$input <- sortByName(values$input)
           }
 
           if (!is.null(params$output)) {
@@ -577,7 +558,7 @@ ShinySession <- R6Class(
               }
             )
 
-            values$output <- sortByName(values$output, method = sortMethod)
+            values$output <- sortByName(values$output)
           }
 
           if (!is.null(params$export)) {
@@ -598,7 +579,7 @@ ShinySession <- R6Class(
               )
             }
 
-            values$export <- sortByName(values$export, method = sortMethod)
+            values$export <- sortByName(values$export)
           }
 
           # Make sure input, output, and export are all named lists (at this
@@ -651,8 +632,9 @@ ShinySession <- R6Class(
     startCycle = function() {
       # TODO: This should check for busyCount == 0L, and remove the checks from
       # the call sites
-      if (private$cycleStartActionQueue$size() > 0) {
-        head <- private$cycleStartActionQueue$remove()
+      if (private$busyCount == 0L && length(private$cycleStartActionQueue) > 0) {
+        head <- private$cycleStartActionQueue[[1L]]
+        private$cycleStartActionQueue <- private$cycleStartActionQueue[-1L]
 
         # After we execute the current cycleStartAction (head), there may be
         # more items left on the queue. If the current busyCount > 0, then that
@@ -671,13 +653,7 @@ ShinySession <- R6Class(
         # busyCount, it's possible we're calling startCycle spuriously; that's
         # OK, it's essentially a no-op in that case.
         on.exit({
-          if (private$busyCount == 0L && private$cycleStartActionQueue$size() > 0L) {
-            later::later(function() {
-              if (private$busyCount == 0L) {
-                private$startCycle()
-              }
-            })
-          }
+          later::later(private$startCycle)
         }, add = TRUE)
 
         head()
@@ -709,8 +685,6 @@ ShinySession <- R6Class(
       self$closed <- FALSE
       # TODO: Put file upload context in user/app-specific dir if possible
 
-      private$inputMessageQueue     <- fastmap::fastqueue()
-      private$cycleStartActionQueue <- fastmap::fastqueue()
       private$invalidatedOutputValues <- Map$new()
       private$invalidatedOutputErrors <- Map$new()
       private$fileUploadContext <- FileUploadContext$new()
@@ -721,7 +695,7 @@ ShinySession <- R6Class(
       private$.input      <- ReactiveValues$new(dedupe = FALSE, label = "input")
       private$.clientData <- ReactiveValues$new(dedupe = TRUE, label = "clientData")
       private$timingRecorder <- ShinyServerTimingRecorder$new()
-      self$progressStack <- fastmap::faststack()
+      self$progressStack <- Stack$new()
       self$files <- Map$new()
       self$downloads <- Map$new()
       self$userData <- new.env(parent = emptyenv())
@@ -748,12 +722,7 @@ ShinySession <- R6Class(
       private$testMode <- getShinyOption("testmode", default = FALSE)
       private$enableTestSnapshot()
 
-      # This `withReactiveDomain` is used only to satisfy the reactlog, so that
-      # it knows to scope this reactiveVal to this session.
-      # https://github.com/rstudio/shiny/pull/3182
-      withReactiveDomain(self,
-        private$currentThemeDependency <- reactiveVal(0, label = "Theme Counter")
-      )
+      private$currentThemeDependency <- reactiveVal(0)
 
       private$registerSessionEndCallbacks()
 
@@ -854,7 +823,7 @@ ShinySession <- R6Class(
             dots <- eval(substitute(alist(...)))
           }
 
-          if (any_unnamed(dots))
+          if (anyUnnamed(dots))
             stop("exportTestValues: all arguments must be named.")
 
           names(dots) <- ns(names(dots))
@@ -942,7 +911,7 @@ ShinySession <- R6Class(
 
         # Copy `values` from scopeState to state, adding namespace
         if (length(scopeState$values) != 0) {
-          if (any_unnamed(scopeState$values)) {
+          if (anyUnnamed(scopeState$values)) {
             stop("All scope values in must be named.")
           }
 
@@ -1143,12 +1112,7 @@ ShinySession <- R6Class(
                   structure(list(), class = "try-error", condition = cond)
                 } else if (inherits(cond, "shiny.output.cancel")) {
                   structure(list(), class = "cancel-output")
-                } else if (cnd_inherits(cond, "shiny.silent.error")) {
-                  # The error condition might have been chained by
-                  # foreign code, e.g. dplyr. Find the original error.
-                  while (!inherits(cond, "shiny.silent.error")) {
-                    cond <- cond$parent
-                  }
+                } else if (inherits(cond, "shiny.silent.error")) {
                   # Don't let shiny.silent.error go through the normal stop
                   # path of try, because we don't want it to print. But we
                   # do want to try to return the same looking result so that
@@ -1212,10 +1176,7 @@ ShinySession <- R6Class(
           private$.outputOptions[[name]] <- list()
       }
       else {
-        rlang::abort(c(
-          paste0("Unexpected ", class(func)[[1]], " object for output$", name),
-          i = "Did you forget to use a render function?"
-        ))
+        stop(paste("Unexpected", class(func), "output for", name))
       }
     },
     getOutput = function(name) {
@@ -1245,7 +1206,7 @@ ShinySession <- R6Class(
           length(private$progressKeys) != 0 ||
           length(private$invalidatedOutputValues) != 0 ||
           length(private$invalidatedOutputErrors) != 0 ||
-          private$inputMessageQueue$size() != 0
+          length(private$inputMessageQueue) != 0
         )
       }
 
@@ -1277,8 +1238,8 @@ ShinySession <- R6Class(
         private$invalidatedOutputValues <- Map$new()
         errors <- as.list(private$invalidatedOutputErrors)
         private$invalidatedOutputErrors <- Map$new()
-        inputMessages <- private$inputMessageQueue$as_list()
-        private$inputMessageQueue$reset()
+        inputMessages <- private$inputMessageQueue
+        private$inputMessageQueue <- list()
 
         if (isTRUE(private$testMode)) {
           private$storeOutputValues(mergeVectors(values, errors))
@@ -1296,7 +1257,7 @@ ShinySession <- R6Class(
     # does not guarantee) inputs and reactive values from changing underneath
     # async observers as they run.
     cycleStartAction = function(callback) {
-      private$cycleStartActionQueue$add(callback)
+      private$cycleStartActionQueue <- c(private$cycleStartActionQueue, list(callback))
       # If no observers are running in this session, we're safe to proceed.
       # Otherwise, startCycle() will be called later, via decrementBusyCount().
       if (private$busyCount == 0L) {
@@ -1339,7 +1300,7 @@ ShinySession <- R6Class(
 
     getCurrentTheme = function() {
       private$currentThemeDependency()
-      getCurrentTheme()
+      getShinyOption("bootstrapTheme")
     },
 
     setCurrentTheme = function(theme) {
@@ -1347,25 +1308,8 @@ ShinySession <- R6Class(
       # bootstrapTheme, (2) re-executes any registered theme dependencies, and
       # (3) sends the resulting dependencies to the client.
 
-      if (!is_bs_theme(theme)) {
-        stop("`session$setCurrentTheme()` expects a `bslib::bs_theme()` object.", call. = FALSE)
-      }
-
-      # Switching Bootstrap versions has weird & complex consequences
-      # for the JS logic, so we forbid it
-      current_version <- bslib::theme_version(getCurrentTheme())
-      next_version <- bslib::theme_version(theme)
-      if (!identical(current_version, next_version)) {
-        stop(
-          "session$setCurrentTheme() cannot be used to change the Bootstrap version ",
-          "from ", current_version, " to ", next_version, ". ",
-          "Try using `bs_theme(version = ", next_version, ")` for initial theme.",
-          call. = FALSE
-        )
-      }
-
       # Note that this will automatically scope to the session.
-      setCurrentTheme(theme)
+      shinyOptions(bootstrapTheme = theme)
 
       # Invalidate
       private$currentThemeDependency(isolate(private$currentThemeDependency()) + 1)
@@ -1427,7 +1371,8 @@ ShinySession <- R6Class(
     sendInputMessage = function(inputId, message) {
       data <- list(id = inputId, message = message)
 
-      private$inputMessageQueue$add(data)
+      # Add to input message queue
+      private$inputMessageQueue[[length(private$inputMessageQueue) + 1]] <- data
       # Needed so that Shiny knows to actually flush the input message queue
       self$requestFlush()
     },
@@ -1525,7 +1470,7 @@ ShinySession <- R6Class(
           # invocation of getCurrentOutputInfo()$width() and saves it; future
           # invocations of getCurrentOutputInfo()$width() use the existing
           # reactive and save it.
-          tmp_info[[prop]] <<- function() {
+          tmp_info[[prop]] <- function() {
             if (is.null(r)) {
               r <<- reactive(label = prop_name, {
                 wrapfun(self$clientData[[prop_name]])
@@ -1735,7 +1680,7 @@ ShinySession <- R6Class(
         dots <- eval(substitute(alist(...)))
       }
 
-      if (any_unnamed(dots))
+      if (anyUnnamed(dots))
         stop("exportTestValues: all arguments must be named.")
 
       # Create a named list where each item is a list with an expression and
@@ -1748,7 +1693,7 @@ ShinySession <- R6Class(
     },
 
     getTestSnapshotUrl = function(input = TRUE, output = TRUE, export = TRUE,
-                                  format = "json", sortC = FALSE) {
+                                  format = "json") {
       reqString <- function(group, value) {
         if (isTRUE(value))
           paste0(group, "=1")
@@ -1762,7 +1707,6 @@ ShinySession <- R6Class(
         reqString("input", input),
         reqString("output", output),
         reqString("export", export),
-        reqString("sortC", sortC),
         paste0("format=", format),
         sep = "&"
       )
@@ -2162,6 +2106,16 @@ ShinySession <- R6Class(
         })
       }
     }
+  ),
+  active = list(
+    session = function() {
+      shinyDeprecated(
+        msg = paste("Attempted to access deprecated shinysession$session object.",
+                    "Please just access the shinysession object directly."),
+        version = "0.11.1"
+      )
+      self
+    }
   )
 )
 
@@ -2198,7 +2152,7 @@ ShinySession <- R6Class(
   if (getOption("shiny.allowoutputreads", FALSE)) {
     .subset2(x, 'impl')$getOutput(name)
   } else {
-    rlang::abort(paste0("Can't read output '", name, "'"))
+    stop("Reading from shinyoutput object is not allowed.")
   }
 }
 
@@ -2207,12 +2161,12 @@ ShinySession <- R6Class(
 
 #' @export
 `[.shinyoutput` <- function(values, name) {
-  rlang::abort("Can't index shinyoutput with `[`.")
+  stop("Single-bracket indexing of shinyoutput object is not allowed.")
 }
 
 #' @export
 `[<-.shinyoutput` <- function(values, name, value) {
-  rlang::abort("Can't index shinyoutput with `[[`.")
+  stop("Single-bracket indexing of shinyoutput object is not allowed.")
 }
 
 #' Set options for an output object.
@@ -2564,19 +2518,3 @@ markdown <- function(mds, extensions = TRUE, .noWS = NULL, ...) {
   html <- rlang::exec(commonmark::markdown_html, glue::trim(mds), extensions = extensions, ...)
   htmltools::HTML(html, .noWS = .noWS)
 }
-
-
-# Check that an object is a ShinySession object, and give an informative error.
-# The default label is the caller function's name.
-validate_session_object <- function(session, label = as.character(sys.call(sys.parent())[[1]])) {
-  if (missing(session) ||
-      !inherits(session, c("ShinySession", "MockShinySession", "session_proxy")))
-  {
-    stop(call. = FALSE,
-      sprintf(
-        "`session` must be a 'ShinySession' object. Did you forget to pass `session` to `%s()`?",
-        label
-      )
-    )
-  }
-}

R/shinyapp.R

@@ -113,10 +113,7 @@ shinyApp <- function(ui, server, onStart=NULL, options=list(),
 #' @export
 shinyAppDir <- function(appDir, options=list()) {
   if (!utils::file_test('-d', appDir)) {
-    rlang::abort(
-      paste0("No Shiny application exists at the path \"", appDir, "\""),
-      class = "invalidShinyAppDir"
-    )
+    stop("No Shiny application exists at the path \"", appDir, "\"")
   }
 
   # In case it's a relative path, convert to absolute (so we're not adversely
@@ -128,10 +125,7 @@ shinyAppDir <- function(appDir, options=list()) {
   } else if (file.exists.ci(appDir, "app.R")) {
     shinyAppDir_appR("app.R", appDir, options = options)
   } else {
-    rlang::abort(
-      "App dir must contain either app.R or server.R.",
-      class = "invalidShinyAppDir"
-    )
+    stop("App dir must contain either app.R or server.R.")
   }
 }
 
@@ -193,7 +187,7 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
     staticPaths <- list()
   }
 
-  fallbackWWWDir <- system_file("www-dir", package = "shiny")
+  fallbackWWWDir <- system.file("www-dir", package = "shiny")
 
   serverSource <- cachedFuncWithFile(appDir, "server.R", case.sensitive = FALSE,
     function(serverR) {
@@ -286,7 +280,7 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
 #
 # The return value is a function that halts monitoring when called.
 initAutoReloadMonitor <- function(dir) {
-  if (!get_devmode_option("shiny.autoreload", FALSE)) {
+  if (!getOption("shiny.autoreload", FALSE)) {
     return(function(){})
   }
 
@@ -339,7 +333,7 @@ initAutoReloadMonitor <- function(dir) {
 #' @param appDir The application directory. If `appDir` is `NULL` or
 #'   not supplied, the nearest enclosing directory that is a Shiny app, starting
 #'   with the current directory, is used.
-#' @param renv The environment in which the files in the `R/` directory should
+#' @param renv The environmeny in which the files in the `R/` directory should
 #'   be evaluated.
 #' @param globalrenv The environment in which `global.R` should be evaluated. If
 #'   `NULL`, `global.R` will not be evaluated at all.
@@ -455,7 +449,7 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
     staticPaths <- list()
   }
 
-  fallbackWWWDir <- system_file("www-dir", package = "shiny")
+  fallbackWWWDir <- system.file("www-dir", package = "shiny")
 
   oldwd <- NULL
   monitorHandle <- NULL

R/shinyui.R

@@ -14,11 +14,7 @@ NULL
 #' # now we can just write "static" content without withMathJax()
 #' div("more math here $$\\sqrt{2}$$")
 withMathJax <- function(...) {
-  path <- paste0(
-    getOption("shiny.mathjax.url", "https://mathjax.rstudio.com/latest/MathJax.js"),
-    "?",
-    getOption("shiny.mathjax.config", "config=TeX-AMS-MML_HTMLorMML")
-  )
+  path <- 'https://mathjax.rstudio.com/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML'
   tagList(
     tags$head(
       singleton(tags$script(src = path, type = 'text/javascript'))
@@ -43,7 +39,7 @@ renderPage <- function(ui, showcase=0, testMode=FALSE) {
 
     # Put the body into the default template
     ui <- htmlTemplate(
-      system_file("template", "default.html", package = "shiny"),
+      system.file("template", "default.html", package = "shiny"),
       lang = lang,
       body = ui,
       # this template is a complete HTML document
@@ -51,89 +47,66 @@ renderPage <- function(ui, showcase=0, testMode=FALSE) {
     )
   }
 
+  jquery <- function() {
+    version <- getOption("shiny.jquery.version", 3)
+    if (version == 3) {
+      return(htmlDependency(
+        "jquery", "3.5.1",
+        c(href = "shared"),
+        script = "jquery.min.js"
+      ))
+    }
+    if (version == 1) {
+      return(htmlDependency(
+        "jquery", "1.12.4",
+        c(href = "shared/legacy"),
+        script = "jquery.min.js"
+      ))
+    }
+    stop("Unsupported version of jQuery: ", version)
+  }
+
   shiny_deps <- c(
-    list(jqueryDependency()),
+    list(jquery()),
     shinyDependencies()
   )
 
   if (testMode) {
     # Add code injection listener if in test mode
     shiny_deps[[length(shiny_deps) + 1]] <-
-      htmlDependency(
-        "shiny-testmode",
-        get_package_version("shiny"),
-        src = "www/shared",
-        package = "shiny",
-        script = "shiny-testmode.js",
-        all_files = FALSE
-      )
+      htmlDependency("shiny-testmode", shinyPackageVersion(),
+                     c(href="shared"), script = "shiny-testmode.js")
   }
 
   html <- renderDocument(ui, shiny_deps, processDep = createWebDependency)
   enc2utf8(paste(collapse = "\n", html))
 }
 
-jqueryDependency <- function() {
-  version <- getOption("shiny.jquery.version", 3)
-  if (version == 3) {
-    return(htmlDependency(
-      "jquery", version_jquery,
-      src = "www/shared",
-      package = "shiny",
-      script = "jquery.min.js",
-      all_files = FALSE
-    ))
-  }
-  if (version == 1) {
-    return(htmlDependency(
-      "jquery", "1.12.4",
-      src = "www/shared/legacy",
-      package = "shiny",
-      script = "jquery.min.js",
-      all_files = FALSE
-    ))
-  }
-  stop("Unsupported version of jQuery: ", version)
-}
-
 shinyDependencies <- function() {
   list(
     bslib::bs_dependency_defer(shinyDependencyCSS),
     htmlDependency(
       name = "shiny-javascript",
-      version = get_package_version("shiny"),
-      src = "www/shared",
-      package = "shiny",
-      script =
-        if (isTRUE(
-          get_devmode_option(
-            "shiny.minified",
-            TRUE
-          )
-        ))
-          "shiny.min.js"
-        else
-          "shiny.js",
-      all_files = FALSE
+      version = shinyPackageVersion(),
+      src = c(href = "shared"),
+      script = if (getOption("shiny.minified", TRUE)) "shiny.min.js" else "shiny.js"
     )
   )
 }
 
 shinyDependencyCSS <- function(theme) {
-  version <- get_package_version("shiny")
+  version <- shinyPackageVersion()
 
   if (!is_bs_theme(theme)) {
     return(htmlDependency(
       name = "shiny-css",
       version = version,
-      src = "www/shared",
-      package = "shiny",
-      stylesheet = "shiny.min.css",
-      all_files = FALSE
+      src = c(href = "shared"),
+      stylesheet = "shiny.min.css"
     ))
   }
 
-  scss_home <- system_file("www/shared/shiny_scss", package = "shiny")
+  scss_home <- system.file("www/shared/shiny_scss", package = "shiny")
   scss_files <- file.path(scss_home, c("bootstrap.scss", "shiny.scss"))
   scss_files <- lapply(scss_files, sass::sass_file)
 
@@ -148,9 +121,7 @@ shinyDependencyCSS <- function(theme) {
 
 #' Create a Shiny UI handler
 #'
-#' @description \lifecycle{superseded}
-#'
-#' @description Historically this function was used in ui.R files to register a user
+#' Historically this function was used in ui.R files to register a user
 #' interface with Shiny. It is no longer required as of Shiny 0.10; simply
 #' ensure that the last expression to be returned from ui.R is a user interface.
 #' This function is kept for backwards compatibility with older applications. It
@@ -161,17 +132,6 @@ shinyDependencyCSS <- function(theme) {
 #' @keywords internal
 #' @export
 shinyUI <- function(ui) {
-  if (in_devmode()) {
-    shinyDeprecated(
-      "0.10.0", "shinyUI()",
-      details = paste0(
-        "When removing `shinyUI()`, ",
-        "ensure that the last expression returned from ui.R is a user interface ",
-        "normally supplied to `shinyUI(ui)`."
-      )
-    )
-  }
-
   .globals$ui <- list(ui)
   ui
 }

R/shinywrappers.R

@@ -2,23 +2,12 @@ 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
@@ -48,7 +37,7 @@ utils::globalVariables('func', add = TRUE)
 #'   is able to serve JS and CSS resources.
 #' @return The `renderFunc` function, with annotations.
 #'
-#' @seealso [createRenderFunction()]
+#' @seealso [createRenderFunction()], [quoToFunction()]
 #' @export
 markRenderFunction <- function(
   uiFunc,
@@ -58,12 +47,6 @@ 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
@@ -111,7 +94,6 @@ 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
     })
@@ -151,27 +133,10 @@ print.shiny.render.function <- function(x, ...) {
   cat_line("<shiny.render.function>")
 }
 
-#' Implement custom render functions
+#' Implement render functions
 #'
-#' 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).
+#' This function is a wrapper for [markRenderFunction()] which provides support
+#' for async computation via promises.
 #'
 #' @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
@@ -188,24 +153,16 @@ print.shiny.render.function <- function(x, ...) {
 #' @return An annotated render function, ready to be assigned to an
 #'   `output` slot.
 #'
+#' @seealso [quoToFunction()], [markRenderFunction()].
+#'
 #' @examples
-#' # 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)
+#' # 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")
 #'
 #'   createRenderFunction(
 #'     func,
@@ -217,38 +174,10 @@ print.shiny.render.function <- function(x, ...) {
 #' }
 #'
 #' # Test render function from the console
-#' reactiveConsole(TRUE)
-#'
-#' v <- reactiveVal("basic")
-#' r <- renderTriple({ v() })
+#' a <- 1
+#' r <- renderTriple({ a + 1 })
+#' a <- 2
 #' 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,
@@ -387,7 +316,9 @@ markOutputAttrs <- function(renderFunc, snapshotExclude = NULL,
 #'   the output, see [plotPNG()].
 #'
 #' @param expr An expression that returns a list.
-#' @inheritParams renderUI
+#' @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.
 #' @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`;
@@ -466,10 +397,11 @@ 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())
 {
-  func <- installExprFunction(expr, "func", env, quoted, label = "renderImage")
+  expr <- get_quosure(expr, env, quoted)
+  func <- quoToFunction(expr, "renderImage")
 
   # missing() must be used directly within the function with the given arg
   if (missing(deleteFile)) {
@@ -591,7 +523,9 @@ isTemp <- function(path, tempDir = tempdir(), mustExist) {
 #' function return [invisible()].
 #'
 #' @param expr An expression to evaluate.
-#' @inheritParams renderUI
+#' @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.
 #' @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
@@ -602,7 +536,8 @@ isTemp <- function(path, tempDir = tempdir(), mustExist) {
 renderPrint <- function(expr, env = parent.frame(), quoted = FALSE,
                         width = getOption('width'), outputArgs=list())
 {
-  func <- installExprFunction(expr, "func", env, quoted, label = "renderPrint")
+  expr <- get_quosure(expr, env, quoted)
+  func <- quoToFunction(expr, "renderPrint")
 
   # Set a promise domain that sets the console width
   #   and captures output
@@ -634,7 +569,7 @@ renderPrint <- function(expr, env = parent.frame(), quoted = FALSE,
     outputArgs,
     cacheHint = list(
       label = "renderPrint",
-      origUserExpr = installedFuncExpr(func)
+      origUserExpr = get_expr(expr)
     )
   )
 }
@@ -684,10 +619,11 @@ 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=" ") {
 
-  func <- installExprFunction(expr, "func", env, quoted, label = "renderText")
+  expr <- get_quosure(expr, env, quoted)
+  func <- quoToFunction(expr, "renderText")
 
   createRenderFunction(
     func,
@@ -708,13 +644,9 @@ 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.
-#' @template param-env
-#' @templateVar x expr
-#' @templateVar env env
-#' @templateVar quoted quoted
-#' @template param-quoted
-#' @templateVar x expr
-#' @templateVar quoted quoted
+#' @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.
 #' @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.
@@ -743,7 +675,8 @@ renderText <- function(expr, env = parent.frame(), quoted = FALSE,
 renderUI <- function(expr, env = parent.frame(), quoted = FALSE,
                      outputArgs = list())
 {
-  func <- installExprFunction(expr, "func", env, quoted, label = "renderUI")
+  expr <- get_quosure(expr, env, quoted)
+  func <- quoToFunction(expr, "renderUI")
 
   createRenderFunction(
     func,
@@ -777,10 +710,10 @@ renderUI <- function(expr, env = parent.frame(), quoted = FALSE,
 #'   that file path. (Reactive values and functions may be used from this
 #'   function.)
 #' @param contentType A string of the download's
-#'   [content type](https://en.wikipedia.org/wiki/Internet_media_type), for
-#'   example `"text/csv"` or `"image/png"`. If `NULL`, the content type 
-#'   will be guessed based on the filename extension, or 
-#'   `application/octet-stream` if the extension is unknown.
+#'   [content type](http://en.wikipedia.org/wiki/Internet_media_type), for
+#'   example `"text/csv"` or `"image/png"`. If `NULL` or
+#'   `NA`, the content type will be guessed based on the filename
+#'   extension, or `application/octet-stream` if the extension is unknown.
 #' @param outputArgs A list of arguments to be passed through to the implicit
 #'   call to [downloadButton()] when `downloadHandler` is used
 #'   in an interactive R Markdown document.
@@ -810,7 +743,7 @@ renderUI <- function(expr, env = parent.frame(), quoted = FALSE,
 #' shinyApp(ui, server)
 #' }
 #' @export
-downloadHandler <- function(filename, content, contentType=NULL, outputArgs=list()) {
+downloadHandler <- function(filename, content, contentType=NA, outputArgs=list()) {
   renderFunc <- function(shinysession, name, ...) {
     shinysession$registerDownload(name, filename, contentType, content)
   }
@@ -819,41 +752,28 @@ downloadHandler <- function(filename, content, contentType=NULL, outputArgs=list
   )
 }
 
-#' Table output with the JavaScript DataTables library
-#'
-#' @description
-#' `r lifecycle::badge("superseded")` Please use
-#' \href{https://rstudio.github.io/DT/shiny.html}{\code{DT::renderDataTable()}}.
-#' (Shiny 0.11.1)
+#' Table output with the JavaScript library DataTables
 #'
 #' 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
-#' using Shiny as the server infrastructure.
-#'
-#' This function only provides the server-side version of DataTables (using R
-#' to process the data object on the server side). There is a separate
-#' [DT](https://github.com/rstudio/DT) that allows you to create both
-#' server-side and client-side DataTables, and supports additional features.
-#' Learn more at <https://rstudio.github.io/DT/shiny.html>.
+#' matrix), which will be rendered with the DataTables library. Paging,
+#' searching, filtering, and sorting can be done on the R side using Shiny as
+#' the server infrastructure.
 #'
+#' For the `options` argument, the character elements that have the class
+#' `"AsIs"` (usually returned from [base::I()]) will be evaluated in
+#' JavaScript. This is useful when the type of the option value is not supported
+#' in JSON, e.g., a JavaScript function, which can be obtained by evaluating a
+#' character string. Note this only applies to the root-level elements of the
+#' options list, and the `I()` notation does not work for lower-level
+#' elements in the list.
 #' @param expr An expression that returns a data frame or a matrix.
-#' @inheritParams renderTable
 #' @param options A list of initialization options to be passed to DataTables,
-#'   or a function to return such a list.  You can find a complete list of
-#'   options at <https://datatables.net/reference/option/>.
-#'
-#'   Any top-level strings with class `"AsIs"` (as created by [I()]) will be
-#'   evaluated in JavaScript. This is useful when the type of the option value
-#'   is not supported in JSON, e.g., a JavaScript function, which can be
-#'   obtained by  evaluating a character string. This only applies to the
-#'   root-level elements of options list, and does not worked for lower-level
-#'   elements in the list.
+#'   or a function to return such a list.
 #' @param searchDelay The delay for searching, in milliseconds (to avoid too
 #'   frequent search requests).
 #' @param callback A JavaScript function to be applied to the DataTable object.
 #'   This is useful for DataTables plug-ins, which often require the DataTable
-#'   instance to be available.
+#'   instance to be available (<http://datatables.net/extensions/>).
 #' @param escape Whether to escape HTML entities in the table: `TRUE` means
 #'   to escape the whole table, and `FALSE` means not to escape it.
 #'   Alternatively, you can specify numeric column indices or column names to
@@ -861,8 +781,17 @@ downloadHandler <- function(filename, content, contentType=NULL, outputArgs=list
 #'   `c(1, 3, 4)`, or `c(-1, -3)` (all columns except the first and
 #'   third), or `c('Species', 'Sepal.Length')`.
 #' @param outputArgs A list of arguments to be passed through to the implicit
-#'   call to `dataTableOutput()` when `renderDataTable()` is used
+#'   call to [dataTableOutput()] when `renderDataTable` is used
 #'   in an interactive R Markdown document.
+#'
+#' @references <http://datatables.net>
+#' @note This function only provides the server-side version of DataTables
+#'   (using R to process the data object on the server side). There is a
+#'   separate package \pkg{DT} (<https://github.com/rstudio/DT>) that allows
+#'   you to create both server-side and client-side DataTables, and supports
+#'   additional DataTables features. Consider using `DT::renderDataTable()`
+#'   and `DT::dataTableOutput()` (see
+#'   <http://rstudio.github.io/DT/shiny.html> for more information).
 #' @export
 #' @inheritParams renderPlot
 #' @examples
@@ -892,15 +821,8 @@ renderDataTable <- function(expr, options = NULL, searchDelay = 500,
                             env = parent.frame(), quoted = FALSE,
                             outputArgs=list())
 {
-
-  if (in_devmode()) {
-    shinyDeprecated(
-      "0.11.1", "shiny::renderDataTable()", "DT::renderDataTable()",
-      details = "See <https://rstudio.github.io/DT/shiny.html> for more information"
-    )
-  }
-
-  func <- installExprFunction(expr, "func", env, quoted, label = "renderDataTable")
+  expr <- get_quosure(expr, env, quoted)
+  func <- quoToFunction(expr, "renderDataTable")
 
   renderFunc <- function(shinysession, name, ...) {
     if (is.function(options)) options <- options()
@@ -953,7 +875,7 @@ renderDataTable <- function(expr, options = NULL, searchDelay = 500,
 DT10Names <- function() {
   rbind(
     utils::read.table(
-      system_file('www/shared/datatables/upgrade1.10.txt', package = 'shiny'),
+      system.file('www/shared/datatables/upgrade1.10.txt', package = 'shiny'),
       stringsAsFactors = FALSE
     ),
     c('aoColumns', 'Removed')  # looks like an omission on the upgrade guide
@@ -988,3 +910,64 @@ checkDT9 <- function(options) {
   names(options)[i] <- nms10
   options
 }
+
+# Deprecated functions ------------------------------------------------------
+
+#' Deprecated reactive functions
+#' @name deprecatedReactives
+#' @keywords internal
+NULL
+
+#' Plot output (deprecated)
+#'
+#' `reactivePlot` has been replaced by [renderPlot()].
+#' @param func A function.
+#' @param width Width.
+#' @param height Height.
+#' @param ... Other arguments to pass on.
+#' @rdname deprecatedReactives
+#' @export
+reactivePlot <- function(func, width='auto', height='auto', ...) {
+  shinyDeprecated(new="renderPlot")
+  renderPlot({ func() }, width=width, height=height, ...)
+}
+
+#' Table output (deprecated)
+#'
+#' `reactiveTable` has been replaced by [renderTable()].
+#' @rdname deprecatedReactives
+#' @export
+reactiveTable <- function(func, ...) {
+  shinyDeprecated(new="renderTable")
+  renderTable({ func() })
+}
+
+#' Print output (deprecated)
+#'
+#' `reactivePrint` has been replaced by [renderPrint()].
+#' @rdname deprecatedReactives
+#' @export
+reactivePrint <- function(func) {
+  shinyDeprecated(new="renderPrint")
+  renderPrint({ func() })
+}
+
+#' UI output (deprecated)
+#'
+#' `reactiveUI` has been replaced by [renderUI()].
+#' @rdname deprecatedReactives
+#' @export
+reactiveUI <- function(func) {
+  shinyDeprecated(new="renderUI")
+  renderUI({ func() })
+}
+
+#' Text output (deprecated)
+#'
+#' `reactiveText` has been replaced by [renderText()].
+#' @rdname deprecatedReactives
+#' @export
+reactiveText <- function(func) {
+  shinyDeprecated(new="renderText")
+  renderText({ func() })
+}

R/showcase.R

@@ -32,40 +32,26 @@ licenseLink <- function(licenseName) {
 showcaseHead <- function() {
 
   deps  <- list(
-    jqueryuiDependency(),
-    htmlDependency(
-      "showdown",
-      "0.3.1",
-      src = "www/shared/showdown/compressed",
-      package="shiny",
-      script = "showdown.js"
-    ),
-    htmlDependency(
-      "highlight.js",
-      "6.2",
-      src = "www/shared/highlight",
-      package="shiny",
-      script = "highlight.pack.js",
-      stylesheet = "rstudio.css"
-    ),
-    htmlDependency(
-      "showcase",
-      "0.1.0",
-      src = "www/shared",
-      package = "shiny",
-      script = "shiny-showcase.js",
-      stylesheet = "shiny-showcase.css",
-      all_files = FALSE
-    )
+    htmlDependency("jqueryui", "1.12.1", c(href="shared/jqueryui"),
+      script = "jquery-ui.min.js"),
+    htmlDependency("showdown", "0.3.1", c(href="shared/showdown/compressed"),
+      script = "showdown.js"),
+    htmlDependency("highlight.js", "6.2", c(href="shared/highlight"),
+      script = "highlight.pack.js")
   )
 
   mdfile <- file.path.ci(getwd(), 'Readme.md')
-  html <- tagList(
+  html <- with(tags, tagList(
+    script(src="shared/shiny-showcase.js"),
+    link(rel="stylesheet", type="text/css",
+         href="shared/highlight/rstudio.css"),
+    link(rel="stylesheet", type="text/css",
+         href="shared/shiny-showcase.css"),
     if (file.exists(mdfile))
-      tags$script(type="text/markdown", id="showcase-markdown-content",
+      script(type="text/markdown", id="showcase-markdown-content",
         paste(readUTF8(mdfile), collapse="\n"))
     else ""
-  )
+  ))
 
   return(attachDependencies(html, deps))
 }
@@ -97,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", "data-bs-toggle"="tab", paste0(prefix, file)))
+           "data-toggle"="tab", paste0(prefix, file)))
     )
   })
 }
@@ -106,7 +92,7 @@ navTabsDropdown <- function(files) {
   if (length(files) > 0) {
     with(tags,
       li(role="presentation", class="dropdown",
-        a(class="dropdown-toggle", `data-toggle`="dropdown", `data-bs-toggle`="dropdown", href="#",
+        a(class="dropdown-toggle", `data-toggle`="dropdown", href="#",
           role="button", `aria-haspopup`="true", `aria-expanded`="false",
           "www", span(class="caret")
         ),
@@ -148,7 +134,7 @@ showcaseCodeTabs <- function(codeLicense) {
     a(id="showcase-code-position-toggle",
       class="btn btn-default btn-sm",
       onclick="toggleCodePosition()",
-      icon("level-up-alt"),
+      icon("level-up"),
       "show with app"),
     ul(class="nav nav-tabs",
        navTabsHelper(rFiles),

R/stack.R

@@ -0,0 +1,70 @@
+# A Stack object backed by a list. The backing list will grow or shrink as
+# the stack changes in size.
+Stack <- R6Class(
+  'Stack',
+  portable = FALSE,
+  class = FALSE,
+  public = list(
+
+    initialize = function(init = 20L) {
+      # init is the initial size of the list. It is also used as the minimum
+      # size of the list as it shrinks.
+      private$stack <- vector("list", init)
+      private$init <- init
+    },
+
+    push = function(..., .list = NULL) {
+      args <- c(list(...), .list)
+      new_size <- count + length(args)
+
+      # Grow if needed; double in size
+      while (new_size > length(stack)) {
+        stack[length(stack) * 2] <<- list(NULL)
+      }
+      stack[count + seq_along(args)] <<- args
+      count <<- new_size
+
+      invisible(self)
+    },
+
+    pop = function() {
+      if (count == 0L)
+        return(NULL)
+
+      value <- stack[[count]]
+      stack[count] <<- list(NULL)
+      count <<- count - 1L
+
+      # Shrink list if < 1/4 of the list is used, down to a minimum size of `init`
+      len <- length(stack)
+      if (len > init && count < len/4) {
+        new_len <- max(init, ceiling(len/2))
+        stack <<- stack[seq_len(new_len)]
+      }
+
+      value
+    },
+
+    peek = function() {
+      if (count == 0L)
+        return(NULL)
+      stack[[count]]
+    },
+
+    size = function() {
+      count
+    },
+
+    # Return the entire stack as a list, where the first item in the list is the
+    # oldest item in the stack, and the last item is the most recently added.
+    as_list = function() {
+      stack[seq_len(count)]
+    }
+  ),
+
+  private = list(
+    stack = NULL,   # A list that holds the items
+    count = 0L,     # Current number of items in the stack
+    init = 20L      # Initial and minimum size of the stack
+  )
+)

R/staticimports.R

@@ -1,216 +0,0 @@
-# Generated by staticimports; do not edit by hand.
-# ======================================================================
-# Imported from pkg:staticimports
-# ======================================================================
-
-# Given a vector, return TRUE if any elements are named, FALSE otherwise.
-# For zero-length vectors, always return FALSE.
-any_named <- function(x) {
-  if (length(x) == 0) return(FALSE)
-  nms <- names(x)
-  !is.null(nms) && any(nzchar(nms))
-}
-
-# Given a vector, return TRUE if any elements are unnamed, FALSE otherwise.
-# For zero-length vectors, always return FALSE.
-any_unnamed <- function(x) {
-  if (length(x) == 0) return(FALSE)
-  nms <- names(x)
-  is.null(nms) || !all(nzchar(nms))
-}
-
-# Borrowed from pkgload:::dev_meta, with some modifications.
-# Returns TRUE if `pkg` was loaded with `devtools::load_all()`.
-devtools_loaded <- function(pkg) {
-  ns <- .getNamespace(pkg)
-  if (is.null(ns) || is.null(ns$.__DEVTOOLS__)) {
-    return(FALSE)
-  }
-  TRUE
-}
-
-get_package_version <- function(pkg) {
-  # `utils::packageVersion()` can be slow, so first try the fast path of
-  # checking if the package is already loaded.
-  ns <- .getNamespace(pkg)
-  if (is.null(ns)) {
-    utils::packageVersion(pkg)
-  } else {
-    as.package_version(ns$.__NAMESPACE__.$spec[["version"]])
-  }
-}
-
-is_installed <- function(pkg, version = NULL) {
-  installed <- isNamespaceLoaded(pkg) || nzchar(system_file_cached(package = pkg))
-  if (is.null(version)) {
-    return(installed)
-  }
-  installed && isTRUE(get_package_version(pkg) >= version)
-}
-
-register_upgrade_message <- function(pkg, version, error = FALSE) {
-
-  msg <- sprintf(
-    "This version of '%s' is designed to work with '%s' >= %s.
-    Please upgrade via install.packages('%s').",
-    environmentName(environment(register_upgrade_message)),
-    pkg, version, pkg
-  )
-
-  cond <- if (error) stop else packageStartupMessage
-
-  if (pkg %in% loadedNamespaces() && !is_installed(pkg, version)) {
-    cond(msg)
-  }
-
-  # Always register hook in case pkg is loaded at some
-  # point the future (or, potentially, but less commonly,
-  # unloaded & reloaded)
-  setHook(
-    packageEvent(pkg, "onLoad"),
-    function(...) {
-      if (!is_installed(pkg, version)) cond(msg)
-    }
-  )
-}
-
-# Simplified version rlang:::s3_register() that just uses
-# warning() instead of rlang::warn() when registration fails
-# https://github.com/r-lib/rlang/blob/main/R/compat-s3-register.R
-s3_register <- function(generic, class, method = NULL) {
-  stopifnot(is.character(generic), length(generic) == 1)
-  stopifnot(is.character(class), length(class) == 1)
-
-  pieces <- strsplit(generic, "::")[[1]]
-  stopifnot(length(pieces) == 2)
-  package <- pieces[[1]]
-  generic <- pieces[[2]]
-
-  caller <- parent.frame()
-
-  get_method_env <- function() {
-    top <- topenv(caller)
-    if (isNamespace(top)) {
-      asNamespace(environmentName(top))
-    } else {
-      caller
-    }
-  }
-  get_method <- function(method, env) {
-    if (is.null(method)) {
-      get(paste0(generic, ".", class), envir = get_method_env())
-    } else {
-      method
-    }
-  }
-
-  register <- function(...) {
-    envir <- asNamespace(package)
-
-    # Refresh the method each time, it might have been updated by
-    # `devtools::load_all()`
-    method_fn <- get_method(method)
-    stopifnot(is.function(method_fn))
-
-    # Only register if generic can be accessed
-    if (exists(generic, envir)) {
-      registerS3method(generic, class, method_fn, envir = envir)
-    } else {
-      warning(
-        "Can't find generic `", generic, "` in package ", package,
-        " register S3 method. Do you need to update ", package,
-        " to the latest version?", call. = FALSE
-      )
-    }
-  }
-
-  # Always register hook in case package is later unloaded & reloaded
-  setHook(packageEvent(package, "onLoad"), function(...) {
-    register()
-  })
-
-  # Avoid registration failures during loading (pkgload or regular).
-  # Check that environment is locked because the registering package
-  # might be a dependency of the package that exports the generic. In
-  # that case, the exports (and the generic) might not be populated
-  # yet (#1225).
-  if (isNamespaceLoaded(package) && environmentIsLocked(asNamespace(package))) {
-    register()
-  }
-
-  invisible()
-}
-
-# Borrowed from pkgload::shim_system.file, with some modifications. This behaves
-# like `system.file()`, except that (1) for packages loaded with
-# `devtools::load_all()`, it will return the path to files in the package's
-# inst/ directory, and (2) for other packages, the directory lookup is cached.
-# Also, to keep the implementation simple, it doesn't support specification of
-# lib.loc or mustWork.
-system_file <- function(..., package = "base") {
-  if (!devtools_loaded(package))  {
-    return(system_file_cached(..., package = package))
-  }
-
-  if (!is.null(names(list(...)))) {
-    stop("All arguments other than `package` must be unnamed.")
-  }
-
-  # If package was loaded with devtools (the package loaded with load_all),
-  # also search for files under inst/, and don't cache the results (it seems
-  # more likely that the package path will change during the development
-  # process)
-  pkg_path <- find.package(package)
-
-  # First look in inst/
-  files_inst <- file.path(pkg_path, "inst", ...)
-  present_inst <- file.exists(files_inst)
-
-  # For any files that weren't present in inst/, look in the base path
-  files_top <- file.path(pkg_path, ...)
-  present_top <- file.exists(files_top)
-
-  # Merge them together. Here are the different possible conditions, and the
-  # desired result. NULL means to drop that element from the result.
-  #
-  # files_inst:   /inst/A  /inst/B  /inst/C  /inst/D
-  # present_inst:    T        T        F        F
-  # files_top:      /A       /B       /C       /D
-  # present_top:     T        F        T        F
-  # result:       /inst/A  /inst/B    /C       NULL
-  #
-  files <- files_top
-  files[present_inst] <- files_inst[present_inst]
-  # Drop cases where not present in either location
-  files <- files[present_inst | present_top]
-  if (length(files) == 0) {
-    return("")
-  }
-  # Make sure backslashes are replaced with slashes on Windows
-  normalizePath(files, winslash = "/")
-}
-
-# A wrapper for `system.file()`, which caches the results, because
-# `system.file()` can be slow. Note that because of caching, if
-# `system_file_cached()` is called on a package that isn't installed, then the
-# package is installed, and then `system_file_cached()` is called again, it will
-# still return "".
-system_file_cached <- local({
-  pkg_dir_cache <- character()
-
-  function(..., package = "base") {
-    if (!is.null(names(list(...)))) {
-      stop("All arguments other than `package` must be unnamed.")
-    }
-
-    not_cached <- is.na(match(package, names(pkg_dir_cache)))
-    if (not_cached) {
-      pkg_dir <- system.file(package = package)
-      pkg_dir_cache[[package]] <<- pkg_dir
-    } else {
-      pkg_dir <- pkg_dir_cache[[package]]
-    }
-
-    file.path(pkg_dir, ...)
-  }
-})

R/update-input.R

@@ -34,9 +34,7 @@
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateTextInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL, placeholder = NULL) {
-  validate_session_object(session)
-
+updateTextInput <- function(session, inputId, label = NULL, value = NULL, placeholder = NULL) {
   message <- dropNulls(list(label=label, value=value, placeholder=placeholder))
   session$sendInputMessage(inputId, message)
 }
@@ -108,9 +106,7 @@ updateTextAreaInput <- updateTextInput
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateCheckboxInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL) {
-  validate_session_object(session)
-
+updateCheckboxInput <- function(session, inputId, label = NULL, value = NULL) {
   message <- dropNulls(list(label=label, value=value))
   session$sendInputMessage(inputId, message)
 }
@@ -169,9 +165,7 @@ updateCheckboxInput <- function(session = getDefaultReactiveDomain(), inputId, l
 #' }
 #' @rdname updateActionButton
 #' @export
-updateActionButton <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, icon = NULL) {
-  validate_session_object(session)
-
+updateActionButton <- function(session, inputId, label = NULL, icon = NULL) {
   if (!is.null(icon)) icon <- as.character(validateIcon(icon))
   message <- dropNulls(list(label=label, icon=icon))
   session$sendInputMessage(inputId, message)
@@ -212,10 +206,8 @@ updateActionLink <- updateActionButton
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateDateInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL,
-                            min = NULL, max = NULL)
-{
-  validate_session_object(session)
+updateDateInput <- function(session, inputId, label = NULL, value = NULL,
+                            min = NULL, max = NULL) {
 
   value <- dateYMD(value, "value")
   min   <- dateYMD(min, "min")
@@ -259,11 +251,9 @@ updateDateInput <- function(session = getDefaultReactiveDomain(), inputId, label
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateDateRangeInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL,
+updateDateRangeInput <- function(session, inputId, label = NULL,
                                  start = NULL, end = NULL, min = NULL,
-                                 max = NULL)
-{
-  validate_session_object(session)
+                                 max = NULL) {
 
   start <- dateYMD(start, "start")
   end <- dateYMD(end, "end")
@@ -283,7 +273,7 @@ updateDateRangeInput <- function(session = getDefaultReactiveDomain(), inputId,
 #' Change the selected tab on the client
 #'
 #' @param session The `session` object passed to function given to
-#'   `shinyServer`. Default is `getDefaultReactiveDomain()`.
+#'   `shinyServer`.
 #' @param inputId The id of the `tabsetPanel`, `navlistPanel`,
 #' or `navbarPage` object.
 #' @inheritParams tabsetPanel
@@ -319,9 +309,7 @@ updateDateRangeInput <- function(session = getDefaultReactiveDomain(), inputId,
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateTabsetPanel <- function(session = getDefaultReactiveDomain(), inputId, selected = NULL) {
-  validate_session_object(session)
-
+updateTabsetPanel <- function(session, inputId, selected = NULL) {
   message <- dropNulls(list(value = selected))
   session$sendInputMessage(inputId, message)
 }
@@ -369,11 +357,9 @@ updateNavlistPanel <- updateTabsetPanel
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateNumericInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL,
+updateNumericInput <- function(session, inputId, label = NULL, value = NULL,
     min = NULL, max = NULL, step = NULL) {
 
-  validate_session_object(session)
-
   message <- dropNulls(list(
     label = label, value = formatNoSci(value),
     min = formatNoSci(min), max = formatNoSci(max), step = formatNoSci(step)
@@ -418,11 +404,9 @@ updateNumericInput <- function(session = getDefaultReactiveDomain(), inputId, la
 #'   )
 #' }
 #' @export
-updateSliderInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL,
+updateSliderInput <- function(session, inputId, label = NULL, value = NULL,
   min = NULL, max = NULL, step = NULL, timeFormat = NULL, timezone = NULL)
 {
-  validate_session_object(session)
-
   # If no min/max/value is provided, we won't know the
   # type, and this will return an empty string
   dataType <- getSliderType(min, max, value)
@@ -455,8 +439,6 @@ updateSliderInput <- function(session = getDefaultReactiveDomain(), inputId, lab
 updateInputOptions <- function(session, inputId, label = NULL, choices = NULL,
                                selected = NULL, inline = FALSE, type = NULL,
                                choiceNames = NULL, choiceValues = NULL) {
-  validate_session_object(session)
-
   if (is.null(type)) stop("Please specify the type ('checkbox' or 'radio')")
 
   args <- normalizeChoicesArgs(choices, choiceNames, choiceValues, mustExist = FALSE)
@@ -514,12 +496,9 @@ updateInputOptions <- function(session, inputId, label = NULL, choices = NULL,
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateCheckboxGroupInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL,
+updateCheckboxGroupInput <- function(session, inputId, label = NULL,
   choices = NULL, selected = NULL, inline = FALSE,
-  choiceNames = NULL, choiceValues = NULL)
-{
-  validate_session_object(session)
-
+  choiceNames = NULL, choiceValues = NULL) {
   updateInputOptions(session, inputId, label, choices, selected,
                      inline, "checkbox", choiceNames, choiceValues)
 }
@@ -560,12 +539,9 @@ updateCheckboxGroupInput <- function(session = getDefaultReactiveDomain(), input
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateRadioButtons <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, choices = NULL,
+updateRadioButtons <- function(session, inputId, label = NULL, choices = NULL,
                                selected = NULL, inline = FALSE,
-                               choiceNames = NULL, choiceValues = NULL)
-{
-  validate_session_object(session)
-
+                               choiceNames = NULL, choiceValues = NULL) {
   # you must select at least one radio button
   if (is.null(selected)) {
     if (!is.null(choices)) selected <- choices[[1]]
@@ -615,11 +591,8 @@ updateRadioButtons <- function(session = getDefaultReactiveDomain(), inputId, la
 #' shinyApp(ui, server)
 #' }
 #' @export
-updateSelectInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, choices = NULL,
-                              selected = NULL)
-{
-  validate_session_object(session)
-
+updateSelectInput <- function(session, inputId, label = NULL, choices = NULL,
+                              selected = NULL) {
   choices <- if (!is.null(choices)) choicesWithNames(choices)
   if (!is.null(selected)) selected <- as.character(selected)
   options <- if (!is.null(choices)) selectOptions(choices, selected, inputId, FALSE)
@@ -634,12 +607,9 @@ updateSelectInput <- function(session = getDefaultReactiveDomain(), inputId, lab
 #'   `choices` into the page at once (i.e., only use the client-side
 #'   version of \pkg{selectize.js})
 #' @export
-updateSelectizeInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, choices = NULL,
+updateSelectizeInput <- function(session, inputId, label = NULL, choices = NULL,
                                  selected = NULL, options = list(),
-                                 server = FALSE)
-{
-  validate_session_object(session)
-
+                                 server = FALSE) {
   if (length(options)) {
     res <- checkAsIs(options)
     cfg <- tags$script(
@@ -752,15 +722,12 @@ updateSelectizeInput <- function(session = getDefaultReactiveDomain(), inputId,
 #' @rdname updateSelectInput
 #' @inheritParams varSelectInput
 #' @export
-updateVarSelectInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, data = NULL, selected = NULL) {
-  validate_session_object(session)
-
+updateVarSelectInput <- function(session, inputId, label = NULL, data = NULL, selected = NULL) {
   if (is.null(data)) {
     choices <- NULL
   } else {
     choices <- colnames(data)
   }
-
   updateSelectInput(
     session = session,
     inputId = inputId,
@@ -771,11 +738,7 @@ updateVarSelectInput <- function(session = getDefaultReactiveDomain(), inputId,
 }
 #' @rdname updateSelectInput
 #' @export
-updateVarSelectizeInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL,
-                                    data = NULL, selected = NULL, options = list(), server = FALSE)
-{
-  validate_session_object(session)
-
+updateVarSelectizeInput <- function(session, inputId, label = NULL, data = NULL, selected = NULL, options = list(), server = FALSE) {
   if (is.null(data)) {
     choices <- NULL
   } else {

R/utils-lang.R

@@ -51,199 +51,60 @@ formalsAndBody <- function(x) {
 }
 
 
-#' @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)
-}
-
-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)
+# 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())
     }
-    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
-}
+    x <- new_quosure(x, env)
 
-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)
+  } else {
+    x <- eval(substitute(substitute(x)), parent.frame())
 
-  # 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({})
-  }
-
-  # `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")
+    # 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))
     }
-  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)
-  )
+  x
 }

R/utils.R

@@ -2,11 +2,6 @@
 #' @include map.R
 NULL
 
-# @staticimports pkg:staticimports
-#   is_installed get_package_version system_file
-#   s3_register register_upgrade_message
-#   any_named any_unnamed
-
 #' Make a random number generator repeatable
 #'
 #' Given a function that generates random data, returns a wrapped version of
@@ -131,6 +126,34 @@ dropNullsOrEmpty <- function(x) {
   x[!vapply(x, nullOrEmpty, FUN.VALUE=logical(1))]
 }
 
+# Given a vector/list, return TRUE if any elements are named, FALSE otherwise.
+anyNamed <- function(x) {
+  # Zero-length vector
+  if (length(x) == 0) return(FALSE)
+
+  nms <- names(x)
+
+  # List with no name attribute
+  if (is.null(nms)) return(FALSE)
+
+  # List with name attribute; check for any ""
+  any(nzchar(nms))
+}
+
+# Given a vector/list, return TRUE if any elements are unnamed, FALSE otherwise.
+anyUnnamed <- function(x) {
+  # Zero-length vector
+  if (length(x) == 0) return(FALSE)
+
+  nms <- names(x)
+
+  # List with no name attribute
+  if (is.null(nms)) return(TRUE)
+
+  # List with name attribute; check for any ""
+  any(!nzchar(nms))
+}
+
 
 # Given a vector/list, returns a named vector/list (the labels will be blank).
 asNamed <- function(x) {
@@ -141,16 +164,12 @@ asNamed <- function(x) {
   x
 }
 
-empty_named_list <- function() {
-  list(a = 1)[0]
-}
-
 # Given two named vectors, join them together, and keep only the last element
 # with a given name in the resulting vector. If b has any elements with the same
 # name as elements in a, the element in a is dropped. Also, if there are any
 # duplicated names in a or b, only the last one with that name is kept.
 mergeVectors <- function(a, b) {
-  if (any_unnamed(a) || any_unnamed(b)) {
+  if (anyUnnamed(a) || anyUnnamed(b)) {
     stop("Vectors must be either NULL or have names for all elements")
   }
 
@@ -162,27 +181,15 @@ mergeVectors <- function(a, b) {
 # Sort a vector by the names of items. If there are multiple items with the
 # same name, preserve the original order of those items. For empty
 # vectors/lists/NULL, return the original value.
-sortByName <- function(x, method = "auto") {
-  if (any_unnamed(x))
+sortByName <- function(x) {
+  if (anyUnnamed(x))
     stop("All items must be named")
 
   # Special case for empty vectors/lists, and NULL
   if (length(x) == 0)
     return(x)
 
-  # Must provide consistent sort order
-  #  https://github.com/rstudio/shinytest/issues/409
-  # Using a flag in the snapshot url to determine the method
-  # `method="radix"` uses `C` locale, which is consistent across platforms
-  # Even if two platforms share `en_us.UTF-8`, they may not sort consistently
-  #  https://blog.zhimingwang.org/macos-lc_collate-hunt
-  #  (macOS) $ LC_ALL=en_US.UTF-8 sort <<<$'python-dev\npython3-dev'
-  #  python-dev
-  #  python3-dev
-  #  (Linux) $ LC_ALL=en_US.UTF-8 sort <<<$'python-dev\npython3-dev'
-  #  python3-dev
-  #  python-dev
-  x[order(names(x), method = method)]
+  x[order(names(x))]
 }
 
 # Sort a vector. If a character vector, sort using C locale, which is consistent
@@ -195,6 +202,10 @@ sort_c <- function(x, ...) {
   sort(x, method = "radix", ...)
 }
 
+# Base R isFALSE function was added in R 3.5.0.
+is_false <- function(x) {
+  identical(x, FALSE)
+}
 
 # Wrapper around list2env with a NULL check. In R <3.2.0, if an empty unnamed
 # list is passed to list2env(), it errors. But an empty named list is OK. For
@@ -393,6 +404,164 @@ 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)
+  # Use new_function() instead of as_function(), because as_function() adds an
+  # extra parent environment. (This may not actually be a problem, though.)
+  func <- new_function(NULL, get_expr(q), get_env(q))
+  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.
@@ -484,7 +653,7 @@ shinyCallingHandlers <- function(expr) {
   withCallingHandlers(captureStackTraces(expr),
     error = function(e) {
       # Don't intercept shiny.silent.error (i.e. validation errors)
-      if (cnd_inherits(e, "shiny.silent.error"))
+      if (inherits(e, "shiny.silent.error"))
         return()
 
       handle <- getOption('shiny.error')
@@ -942,39 +1111,52 @@ reactiveStop <- function(message = "", class = NULL) {
 
 #' Validate input values and other conditions
 #'
-#' @description
-#' `validate()` provides convenient mechanism for validating that an output
-#' has all the inputs necessary for successful rendering. It takes any number
-#' of (unnamed) arguments, each representing a condition to test. If any
-#' of condition fails (i.e. is not ["truthy"][isTruthy]), a special type of
-#' error is signaled to stop execution. If this error is not handled by
-#' application-specific code, it is displayed to the user by Shiny.
+#' For an output rendering function (e.g. [renderPlot()]), you may
+#' need to check that certain input values are available and valid before you
+#' can render the output. `validate` gives you a convenient mechanism for
+#' doing so.
 #'
-#' If you use `validate()` in a [reactive()] validation failures will
-#' automatically propagate to outputs that use the reactive.
+#' The `validate` function takes any number of (unnamed) arguments, each of
+#' which represents a condition to test. If any of the conditions represent
+#' failure, then a special type of error is signaled which stops execution. If
+#' this error is not handled by application-specific code, it is displayed to
+#' the user by Shiny.
 #'
-#' @section `need()`:
-#' An easy way to provide arguments to `validate()` is to use `need()`, which
-#' takes an expression and a string. If the expression is not
-#' ["truthy"][isTruthy] then the string will be used as the error message.
+#' An easy way to provide arguments to `validate` is to use the `need`
+#' function, which takes an expression and a string; if the expression is
+#' considered a failure, then the string will be used as the error message. The
+#' `need` function considers its expression to be a failure if it is any of
+#' the following:
 #'
-#' If "truthiness" is flexible for your use case, you'll need to explicitly
-#' generate a logical values. For example, if you want allow `NA` but not
-#' `NULL`, you can `!is.null(input$foo)`.
-#'
-#' If you need validation logic that differs significantly from `need()`, you
-#' can create your own validation test functions. A passing test should return
-#' `NULL`. A failing test should return either a string providing the error
-#' to display to the user, or if the failure should happen silently, `FALSE`.
-#'
-#' Alternatively you can use `validate()` within an `if` statement, which is
-#' particularly useful for more complex conditions:
-#'
-#' ```
-#' if (input$x < 0 && input$choice == "positive") {
-#'   validate("If choice is positive then x must be greater than 0")
+#' \itemize{
+#'   \item{`FALSE`}
+#'   \item{`NULL`}
+#'   \item{`""`}
+#'   \item{An empty atomic vector}
+#'   \item{An atomic vector that contains only missing values}
+#'   \item{A logical vector that contains all `FALSE` or missing values}
+#'   \item{An object of class `"try-error"`}
+#'   \item{A value that represents an unclicked [actionButton()]}
 #' }
-#' ```
+#'
+#' If any of these values happen to be valid, you can explicitly turn them to
+#' logical values. For example, if you allow `NA` but not `NULL`, you
+#' can use the condition `!is.null(input$foo)`, because `!is.null(NA)
+#' == TRUE`.
+#'
+#' If you need validation logic that differs significantly from `need`, you
+#' can create other validation test functions. A passing test should return
+#' `NULL`. A failing test should return an error message as a
+#' single-element character vector, or if the failure should happen silently,
+#' `FALSE`.
+#'
+#' Because validation failure is signaled as an error, you can use
+#' `validate` in reactive expressions, and validation failures will
+#' automatically propagate to outputs that use the reactive expression. In
+#' other words, if reactive expression `a` needs `input$x`, and two
+#' outputs use `a` (and thus depend indirectly on `input$x`), it's
+#' not necessary for the outputs to validate `input$x` explicitly, as long
+#' as `a` does validate it.
 #'
 #' @param ... A list of tests. Each test should equal `NULL` for success,
 #'   `FALSE` for silent failure, or a string for failure with an error
@@ -989,7 +1171,7 @@ reactiveStop <- function(message = "", class = NULL) {
 #'
 #' ui <- fluidPage(
 #'   checkboxGroupInput('in1', 'Check some letters', choices = head(LETTERS)),
-#'   selectizeInput('in2', 'Select a state', choices = c("", state.name)),
+#'   selectizeInput('in2', 'Select a state', choices = state.name),
 #'   plotOutput('plot')
 #' )
 #'
@@ -1007,7 +1189,7 @@ reactiveStop <- function(message = "", class = NULL) {
 #'
 #' }
 validate <- function(..., errorClass = character(0)) {
-  results <- sapply(list2(...), function(x) {
+  results <- sapply(list(...), function(x) {
     # Detect NULL or NA
     if (is.null(x))
       return(NA_character_)
@@ -1051,7 +1233,7 @@ need <- function(expr, message = paste(label, "must be provided"), label) {
 
 #' Check for required values
 #'
-#' Ensure that values are available (["truthy"][isTruthy]) before proceeding
+#' Ensure that values are available ("truthy"--see Details) before proceeding
 #' with a calculation or action. If any of the given values is not truthy, the
 #' operation is stopped by raising a "silent" exception (not logged by Shiny,
 #' nor displayed in the Shiny app's UI).
@@ -1060,13 +1242,11 @@ need <- function(expr, message = paste(label, "must be provided"), label) {
 #' is to call it like a statement (ignoring its return value) before attempting
 #' operations using the required values:
 #'
-#' ```
-#' rv <- reactiveValues(state = FALSE)
+#' \preformatted{rv <- reactiveValues(state = FALSE)
 #' r <- reactive({
 #'   req(input$a, input$b, rv$state)
 #'   # Code that uses input$a, input$b, and/or rv$state...
-#' })
-#' ```
+#' })}
 #'
 #' In this example, if `r()` is called and any of `input$a`,
 #' `input$b`, and `rv$state` are `NULL`, `FALSE`, `""`,
@@ -1075,21 +1255,54 @@ need <- function(expr, message = paste(label, "must be provided"), label) {
 #'
 #' The second is to use it to wrap an expression that must be truthy:
 #'
-#' ```
-#' output$plot <- renderPlot({
+#' \preformatted{output$plot <- renderPlot({
 #'   if (req(input$plotType) == "histogram") {
 #'     hist(dataset())
 #'   } else if (input$plotType == "scatter") {
 #'     qplot(dataset(), aes(x = x, y = y))
 #'   }
-#' })
-#' ```
+#' })}
 #'
 #' In this example, `req(input$plotType)` first checks that
 #' `input$plotType` is truthy, and if so, returns it. This is a convenient
 #' way to check for a value "inline" with its first use.
 #'
-#' @section Using `req(FALSE)`:
+#' **Truthy and falsy values**
+#'
+#' The terms "truthy" and "falsy" generally indicate whether a value, when
+#' coerced to a [base::logical()], is `TRUE` or `FALSE`. We use
+#' the term a little loosely here; our usage tries to match the intuitive
+#' notions of "Is this value missing or available?", or "Has the user provided
+#' an answer?", or in the case of action buttons, "Has the button been
+#' clicked?".
+#'
+#' For example, a `textInput` that has not been filled out by the user has
+#' a value of `""`, so that is considered a falsy value.
+#'
+#' To be precise, `req` considers a value truthy *unless* it is one
+#' of:
+#'
+#' \itemize{
+#'   \item{`FALSE`}
+#'   \item{`NULL`}
+#'   \item{`""`}
+#'   \item{An empty atomic vector}
+#'   \item{An atomic vector that contains only missing values}
+#'   \item{A logical vector that contains all `FALSE` or missing values}
+#'   \item{An object of class `"try-error"`}
+#'   \item{A value that represents an unclicked [actionButton()]}
+#' }
+#'
+#' Note in particular that the value `0` is considered truthy, even though
+#' `as.logical(0)` is `FALSE`.
+#'
+#' If the built-in rules for truthiness do not match your requirements, you can
+#' always work around them. Since `FALSE` is falsy, you can simply provide
+#' the results of your own checks to `req`:
+#'
+#' `req(input$a != 0)`
+#'
+#' **Using `req(FALSE)`**
 #'
 #' You can use `req(FALSE)` (i.e. no condition) if you've already performed
 #' all the checks you needed to by that point and just want to stop the reactive
@@ -1097,7 +1310,7 @@ need <- function(expr, message = paste(label, "must be provided"), label) {
 #' if you have a complicated condition to check for (or perhaps if you'd like to
 #' divide your condition into nested `if` statements).
 #'
-#' @section Using `cancelOutput = TRUE`:
+#' **Using `cancelOutput = TRUE`**
 #'
 #' When `req(..., cancelOutput = TRUE)` is used, the "silent" exception is
 #' also raised, but it is treated slightly differently if one or more outputs are
@@ -1116,6 +1329,7 @@ need <- function(expr, message = paste(label, "must be provided"), label) {
 #' @param cancelOutput If `TRUE` and an output is being evaluated, stop
 #'   processing as usual but instead of clearing the output, leave it in
 #'   whatever state it happens to be in.
+#' @param x An expression whose truthiness value we want to determine
 #' @return The first value that was passed in.
 #' @export
 #' @examples
@@ -1205,40 +1419,14 @@ cancelOutput <- function() {
 #
 # Can be used to facilitate short-circuit eval on dots.
 dotloop <- function(fun_, ...) {
-  for (i in seq_len(nargs() - 1)) {
+  for (i in 1:(nargs()-1)) {
     fun_(eval(as.symbol(paste0("..", i))))
   }
   invisible()
 }
 
-#' Truthy and falsy values
-#'
-#' The terms "truthy" and "falsy" generally indicate whether a value, when
-#' coerced to a [base::logical()], is `TRUE` or `FALSE`. We use
-#' the term a little loosely here; our usage tries to match the intuitive
-#' notions of "Is this value missing or available?", or "Has the user provided
-#' an answer?", or in the case of action buttons, "Has the button been
-#' clicked?".
-#'
-#' For example, a `textInput` that has not been filled out by the user has
-#' a value of `""`, so that is considered a falsy value.
-#'
-#' To be precise, a value is truthy *unless* it is one of:
-#'
-#' * `FALSE`
-#' * `NULL`
-#' * `""`
-#' * An empty atomic vector
-#' * An atomic vector that contains only missing values
-#' * A logical vector that contains all `FALSE` or missing values
-#' * An object of class `"try-error"`
-#' * A value that represents an unclicked [actionButton()]
-#'
-#' Note in particular that the value `0` is considered truthy, even though
-#' `as.logical(0)` is `FALSE`.
-#'
-#' @param x An expression whose truthiness value we want to determine
 #' @export
+#' @rdname req
 isTruthy <- function(x) {
   if (inherits(x, 'try-error'))
     return(FALSE)
@@ -1315,7 +1503,7 @@ checkEncoding <- function(file) {
   if (identical(charToRaw(readChar(file, 3L, TRUE)), charToRaw('\UFEFF'))) {
     warning('You should not include the Byte Order Mark (BOM) in ', file, '. ',
             'Please re-save it in UTF-8 without BOM. See ',
-            'https://shiny.rstudio.com/articles/unicode.html for more info.')
+            'http://shiny.rstudio.com/articles/unicode.html for more info.')
     return('UTF-8-BOM')
   }
   x <- readChar(file, size, useBytes = TRUE)
@@ -1427,31 +1615,21 @@ 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, dots = TRUE) {
+wrapFunctionLabel <- function(func, name, ..stacktraceon = FALSE) {
   if (name == "name" || name == "func" || name == "relabelWrapper") {
     stop("Invalid name for wrapFunctionLabel: ", name)
   }
   assign(name, func, environment())
   registerDebugHook(name, environment(), name)
 
-  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())
+  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 {
-    # 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())
+    body <- expr({ (!!name)(!!quote(...)) })
   }
+  relabelWrapper <- new_function(pairlist2(... =), body, environment())
 
   # Preserve the original function that was passed in; is used for caching.
   attr(relabelWrapper, "wrappedFunc") <- func
@@ -1601,10 +1779,7 @@ getSliderType <- function(min, max, value) {
     else                            "number"
   }))
   if (length(type) > 1) {
-    rlang::abort(c(
-      "Type mismatch for `min`, `max`, and `value`.",
-      "All values must either be numeric, Date, or POSIXt."
-    ))
+    stop("Type mismatch for `min`, `max`, and `value`. Each must be Date, POSIXt, or number.")
   }
   type[[1]]
 }
@@ -1705,20 +1880,24 @@ findEnclosingApp <- function(path = ".") {
   }
 }
 
-# Until `rlang::cnd_inherits()` is on CRAN
-cnd_inherits <- function(cnd, class) {
-  cnd_some(cnd, ~ inherits(.x, class))
-}
-cnd_some <- function(.cnd, .p, ...) {
-  .p <- rlang::as_function(.p)
-
-  while (rlang::is_condition(.cnd)) {
-    if (.p(.cnd, ...)) {
-      return(TRUE)
-    }
-
-    .cnd <- .cnd$parent
+# Check if a package is installed, and if version is specified,
+# that we have at least that version
+is_available <- function(package, version = NULL) {
+  installed <- nzchar(system.file(package = package))
+  if (is.null(version)) {
+    return(installed)
   }
-
-  FALSE
+  installed && isTRUE(utils::packageVersion(package) >= version)
 }
+
+
+# cached version of utils::packageVersion("shiny")
+shinyPackageVersion <- local({
+  version <- NULL
+  function() {
+    if (is.null(version)) {
+      version <<- utils::packageVersion("shiny")
+    }
+    version
+  }
+})

R/version_bs_date_picker.R

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

R/version_ion_range_slider.R

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

R/version_jquery.R

@@ -1,2 +0,0 @@
-# Generated by tools/updatejQuery.R; do not edit by hand
-version_jquery <- "3.6.0"

R/version_selectize.R

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

R/version_strftime.R

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

README.md

@@ -2,63 +2,58 @@
 
 <!-- badges: start -->
 [![CRAN](https://www.r-pkg.org/badges/version/shiny)](https://CRAN.R-project.org/package=shiny)
-[![R build status](https://github.com/rstudio/shiny/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/rstudio/shiny/actions)
+[![R build status](https://github.com/rstudio/shiny/workflows/R-CMD-check/badge.svg)](https://github.com/rstudio/shiny/actions)
 [![RStudio community](https://img.shields.io/badge/community-shiny-blue?style=social&logo=rstudio&logoColor=75AADB)](https://community.rstudio.com/new-topic?category=shiny&tags=shiny)
 
 <!-- badges: end -->
 
-Easily build rich and productive interactive web apps in R &mdash; no HTML/CSS/JavaScript required.
+Shiny is a new package from RStudio that makes it incredibly easy to build interactive web applications with R.
+
+For an introduction and examples, visit the [Shiny Dev Center](http://shiny.rstudio.com/).
+
+If you have general questions about using Shiny, please use the [RStudio Community website](https://community.rstudio.com). For bug reports, please use the [issue tracker](https://github.com/rstudio/shiny/issues).
 
 ## Features
 
-* An intuitive and extensible [reactive programming](https://en.wikipedia.org/wiki/Reactive_programming) model which makes it easy to transform existing R code into a "live app" where outputs automatically react to new user input.
-  * Compared to event-based programming, reactivity allows Shiny to do the minimum amount of work when input(s) change, and allows humans to more easily reason about complex [MVC logic](https://en.wikipedia.org/wiki/Model%E2%80%93view%E2%80%93controller).
-* A prebuilt set of highly sophisticated, customizable, and easy-to-use widgets (e.g., plots, tables, sliders, dropdowns, date pickers, and more).
-* An attractive default look based on [Bootstrap](https://getbootstrap.com/) which can also be easily customized with the [bslib](https://github.com/rstudio/bslib) package or avoided entirely with more direct R bindings to HTML/CSS/JavaScript.
-* Seamless integration with [R Markdown](https://shiny.rstudio.com/articles/interactive-docs.html), making it easy to embed numerous applications natively within a larger dynamic document.
-* Tools for improving and monitoring performance, including native support for [async programming](https://www.rstudio.com/blog/shiny-1-1-0/), [caching](https://talks.cpsievert.me/20201117), [load testing](https://rstudio.github.io/shinyloadtest/), and more.
-* [Modules](https://shiny.rstudio.com/articles/modules.html): a framework for reducing code duplication and complexity.
-* An ability to [bookmark application state](https://shiny.rstudio.com/articles/bookmarking-state.html) and/or [generate code to reproduce output(s)](https://github.com/rstudio/shinymeta).
-* A rich ecosystem of extension packages for more [custom widgets](http://www.htmlwidgets.org/), [input validation](https://github.com/rstudio/shinyvalidate), [unit testing](https://github.com/rstudio/shinytest), and more.
+* Build useful web applications with only a few lines of code&mdash;no JavaScript required.
+* Shiny applications are automatically "live" in the same way that spreadsheets are live. Outputs change instantly as users modify inputs, without requiring a reload of the browser.
+* Shiny user interfaces can be built entirely using R, or can be written directly in HTML, CSS, and JavaScript for more flexibility.
+* Works in any R environment (Console R, Rgui for Windows or Mac, ESS, StatET, RStudio, etc.).
+* Attractive default UI theme based on [Bootstrap](http://getbootstrap.com/).
+* A highly customizable slider widget with built-in support for animation.
+* Prebuilt output widgets for displaying plots, tables, and printed output of R objects.
+* Fast bidirectional communication between the web browser and R using the [httpuv](https://github.com/rstudio/httpuv) package.
+* Uses a [reactive](http://en.wikipedia.org/wiki/Reactive_programming) programming model that eliminates messy event handling code, so you can focus on the code that really matters.
+* Develop and redistribute your own Shiny widgets that other developers can easily drop into their own applications (coming soon!).
 
 ## Installation
 
-To install the stable version from CRAN:
+To install the stable version from CRAN, simply run the following from an R console:
 
 ```r
 install.packages("shiny")
 ```
 
-## Getting Started
-
-Once installed, load the library and run an example:
+To install the latest development builds directly from GitHub, run this instead:
 
 ```r
-library(shiny)
-# Launches an app, with the app's source code included
-runExample("06_tabsets")
-# Lists more prepackaged examples
-runExample()
+if (!require("remotes"))
+  install.packages("remotes")
+remotes::install_github("rstudio/shiny")
 ```
 
-For more examples and inspiration, check out the [Shiny User Gallery](https://shiny.rstudio.com/gallery/).
+## Getting Started
 
-For help with learning fundamental Shiny programming concepts, check out the [Mastering Shiny](https://mastering-shiny.org/) book and the [Shiny Tutorial](https://shiny.rstudio.com/tutorial/). The former is currently more up-to-date with modern Shiny features, whereas the latter takes a deeper, more visual, dive into fundamental concepts.
+To learn more we highly recommend you check out the [Shiny Tutorial](http://shiny.rstudio.com/tutorial/). The tutorial explains the framework in-depth, walks you through building a simple application, and includes extensive annotated examples.
 
-## Getting Help
+## Development notes
 
-To ask a question about Shiny, please use the [RStudio Community website](https://community.rstudio.com/new-topic?category=shiny&tags=shiny).
+The Javascript code in Shiny is minified using tools that run on Node.js. See the tools/ directory for more information.
 
-For bug reports, please use the [issue tracker](https://github.com/rstudio/shiny/issues) and also keep in mind that by [writing a good bug report](https://github.com/rstudio/shiny/wiki/Writing-Good-Bug-Reports), you're more likely to get help with your problem.
+## Guidelines for contributing
 
-## Contributing
-
-We welcome contributions to the **shiny** package. Please see our [CONTRIBUTING.md](https://github.com/rstudio/shiny/blob/main/.github/CONTRIBUTING.md) file for detailed guidelines of how to contribute.
+We welcome contributions to the **shiny** package. Please see our [CONTRIBUTING.md](https://github.com/rstudio/shiny/blob/master/.github/CONTRIBUTING.md) file for detailed guidelines of how to contribute.
 
 ## License
 
 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

@@ -1,15 +0,0 @@
-{
-  "presets": [
-    "@babel/preset-typescript",
-    [
-      "@babel/preset-env",
-      {
-        "useBuiltIns": "usage",
-        "corejs": "3.12"
-      }
-    ]
-  ],
-  "ignore":[
-    "node_modules/core-js"
-  ]
-}

inst/app_template/tests/shinytest.R

@@ -0,0 +1,2 @@
+library(shinytest)
+expect_pass(testApp("../", suffix = osName()))

inst/app_template/tests/shinytest/mytest.R

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

inst/app_template/tests/testthat.R

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

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

@@ -1,3 +1,5 @@
+context("exampleModuleServer")
+
 # See ?testServer for more information
 testServer(exampleModuleServer, {
   # Set initial value of a button

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

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

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

@@ -1,18 +0,0 @@
-library(shinytest2)
-
-test_that("Initial snapshot values are consistent", {
-  app <- AppDriver$new(name = "init")
-  app$expect_values()
-}){{
-if (isTRUE(module)) {
-HTML('
-
-
-test_that("Module values are consistent", {
-  app <- AppDriver$new(name = "mod")
-  app$click("examplemodule1-button")
-  app$click("examplemodule1-button")
-  app$expect_values()
-})')
-}
-}}

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

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

inst/www/shared/bootstrap/accessibility/css/bootstrap-accessibility.css

@@ -0,0 +1 @@
+.btn:focus{outline:dotted 2px #000}div.active:focus{outline:dotted 1px #000}a:focus{outline:dotted 1px #000}.close:hover,.close:focus{outline:dotted 1px #000}.nav>li>a:hover,.nav>li>a:focus{outline:dotted 1px #000}.carousel-indicators li,.carousel-indicators li.active{height:18px;width:18px;border-width:2px;position:relative;box-shadow:0px 0px 0px 1px #808080}.carousel-indicators.active li{background-color:rgba(100,149,253,0.6)}.carousel-indicators.active li.active{background-color:white}.carousel-tablist-highlight{display:block;position:absolute;outline:2px solid transparent;background-color:transparent;box-shadow:0px 0px 0px 1px transparent}.carousel-tablist-highlight.focus{outline:2px solid #6495ED;background-color:rgba(0,0,0,0.4)}a.carousel-control:focus{outline:2px solid #6495ED;background-image:linear-gradient(to right, transparent 0px, rgba(0,0,0,0.5) 100%);box-shadow:0px 0px 0px 1px #000000}.carousel-pause-button{position:absolute;top:-30em;left:-300em;display:block}.carousel-pause-button.focus{top:0.5em;left:0.5em}.carousel:hover .carousel-caption,.carousel.contrast .carousel-caption{background-color:rgba(0,0,0,0.5);z-index:10}.alert-success{color:#2d4821}.alert-info{color:#214c62}.alert-warning{color:#6c4a00;background-color:#f9f1c6}.alert-danger{color:#d2322d}.alert-danger:hover{color:#a82824}

inst/www/shared/bootstrap/accessibility/css/bootstrap-accessibility.min.css

@@ -1 +0,0 @@
-.btn:focus{outline:none 2px #000}.btn:focus-visible{outline:auto 2px #000}div.active:focus{outline:none 1px #000}div.active:focus-visible{outline:auto 1px #000}a:focus{outline:none 1px #000}a:focus-visible{outline:auto 1px #000}.close:hover,.close:focus{outline:none 1px #000}.close:focus-visible{outline:auto 1px #000}.nav>li>a:hover,.nav>li>a:focus{outline:none 1px #000}.nav>li>a:focus-visible{outline:auto 1px #000}.carousel-indicators li,.carousel-indicators li.active{height:18px;width:18px;border-width:2px;position:relative;box-shadow:0px 0px 0px 1px #808080}.carousel-indicators.active li{background-color:rgba(100,149,253,0.6)}.carousel-indicators.active li.active{background-color:white}.carousel-tablist-highlight{display:block;position:absolute;outline:2px solid transparent;background-color:transparent;box-shadow:0px 0px 0px 1px transparent}.carousel-tablist-highlight.focus{outline:2px solid #6495ED;background-color:rgba(0,0,0,0.4)}a.carousel-control:focus{outline:2px solid #6495ED;background-image:linear-gradient(to right, transparent 0px, rgba(0,0,0,0.5) 100%);box-shadow:0px 0px 0px 1px #000000}.carousel-pause-button{position:absolute;top:-30em;left:-300em;display:block}.carousel-pause-button.focus{top:0.5em;left:0.5em}.carousel:hover .carousel-caption,.carousel.contrast .carousel-caption{background-color:rgba(0,0,0,0.5);z-index:10}.alert-success{color:#2d4821}.alert-info{color:#214c62}.alert-warning{color:#6c4a00;background-color:#f9f1c6}.alert-danger{color:#d2322d}.alert-danger:hover{color:#a82824}