Compare commits

..

6 Commits
main ... vfill

Author SHA1 Message Date
cpsievert
3f3399568f Sync package version (GitHub Actions) 2022-10-20 19:09:43 +00:00
Carson
f50076f2f9 bump version 2022-10-20 14:01:02 -05:00
Carson
c4e314ae04 Merge branch 'main' into vfill 2022-10-20 13:56:25 -05:00
Carson
b4a8236df5 Don't require latest bslib 2022-10-20 13:49:05 -05:00
Carson
a3743e2c90 Require dev version of bslib 2022-10-06 13:58:32 -05:00
Carson
0e401d268d plotOutput(), imageOutput(), and uiOutput() are now more capable of vertically stretching to a suitable container like fillPage() 2022-09-26 10:14:06 -05:00
511 changed files with 33570 additions and 37760 deletions

View File

@@ -21,17 +21,19 @@
^TODO-promises.md$
^manualtests$
^\.github$
^\.yarn$
^\.vscode$
^\.madgerc$
^\.prettierrc\.yml$
^babel\.config\.json$
^jest\.config\.js$
^package\.json$
^tsconfig\.json$
^package-lock\.json$
^yarn\.lock$
^node_modules$
^coverage$
^.ignore$
^eslint\.config\.mjs$
^_dev$
^.claude$
^README-npm\.md$
^CRAN-SUBMISSION$
^LICENSE\.md$
^\.browserslistrc$
^\.eslintrc\.yml$
^\.yarnrc\.yml$

8
.browserslistrc Normal file
View File

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

108
.eslintrc.yml Normal file
View File

@@ -0,0 +1,108 @@
root: true
env:
browser: true
es6: true
extends:
- 'eslint:recommended'
- 'plugin:@typescript-eslint/recommended'
- 'plugin:jest/recommended'
- '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

View File

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

View File

@@ -5,8 +5,7 @@ echo "Updating package.json version to match DESCRIPTION Version"
Rscript ./tools/updatePackageJsonVersion.R
if [ -n "$(git status --porcelain package.json)" ]
then
echo "package.json has changed after running ./tools/updatePackageJsonVersion.R. Re-running 'npm run build'"
npm run build
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."

View File

@@ -6,9 +6,9 @@ on:
push:
branches: [main, rc-**]
pull_request:
branches:
branches: [main]
schedule:
- cron: "0 5 * * 1" # every monday
- cron: '0 5 * * 1' # every monday
name: Package checks
@@ -17,9 +17,7 @@ jobs:
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
with:
# On R 4.2, Cairo has difficulty installing
# Remove this line when https://github.com/s-u/Cairo/issues/52 is merged
extra-packages: Cairo=?ignore

12
.gitignore vendored
View File

@@ -9,16 +9,20 @@
shinyapps/
README.html
.*.Rnb.cached
/_dev/
.sass_cache_keys
tools/yarn-error.log
# TypeScript
# 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
.claude/settings.local.json

View File

@@ -1,5 +1,6 @@
{
"recommendations": [
"arcanis.vscode-zipfs",
"dbaeumer.vscode-eslint",
"esbenp.prettier-vscode"
]

View File

@@ -1,12 +1,13 @@
{
"search.exclude": {
"**/.yarn": true,
"**/.pnp.*": true
},
"prettier.prettierPath": "./node_modules/prettier",
"typescript.enablePromptUseWorkspaceTsdk": true,
"[r]": {
"files.trimTrailingWhitespace": true,
"files.insertFinalNewline": true,
"editor.formatOnSave": false,
},
"[typescript]": {
"editor.defaultFormatter": "esbenp.prettier-vscode",
@@ -14,10 +15,4 @@
"files.trimTrailingWhitespace": true,
"files.insertFinalNewline": true,
},
"[json]": {
"editor.formatOnSave": true,
"editor.defaultFormatter": "esbenp.prettier-vscode",
"files.trimTrailingWhitespace": true,
"files.insertFinalNewline": true,
},
}

File diff suppressed because one or more lines are too long

File diff suppressed because one or more lines are too long

783
.yarn/releases/yarn-3.2.3.cjs vendored Executable file

File diff suppressed because one or more lines are too long

9
.yarnrc.yml Normal file
View File

@@ -0,0 +1,9 @@
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-3.2.3.cjs

View File

@@ -1,130 +1,118 @@
Type: Package
Package: shiny
Type: Package
Title: Web Application Framework for R
Version: 1.12.1.9000
Version: 1.7.2.9001
Authors@R: c(
person("Winston", "Chang", , "winston@posit.co", role = "aut",
comment = c(ORCID = "0000-0002-1576-2126")),
person("Joe", "Cheng", , "joe@posit.co", role = "aut"),
person("JJ", "Allaire", , "jj@posit.co", role = "aut"),
person("Carson", "Sievert", , "carson@posit.co", role = c("aut", "cre"),
comment = c(ORCID = "0000-0002-4958-2844")),
person("Barret", "Schloerke", , "barret@posit.co", role = "aut",
comment = c(ORCID = "0000-0001-9986-114X")),
person("Garrick", "Aden-Buie", , "garrick@adenbuie.com", role = "aut",
comment = c(ORCID = "0000-0002-7111-0077")),
person("Yihui", "Xie", , "yihui@posit.co", role = "aut"),
person("Jeff", "Allen", role = "aut"),
person("Jonathan", "McPherson", , "jonathan@posit.co", role = "aut"),
person("Winston", "Chang", role = c("aut", "cre"), email = "winston@rstudio.com", comment = c(ORCID = "0000-0002-1576-2126")),
person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"),
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("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"),
person("Alan", "Dipert", role = "aut"),
person("Barbara", "Borges", role = "aut"),
person("Posit Software, PBC", role = c("cph", "fnd"),
comment = c(ROR = "03wc8by49")),
person(, "jQuery Foundation", role = "cph",
comment = "jQuery library and jQuery UI library"),
person(, "jQuery contributors", role = c("ctb", "cph"),
comment = "jQuery library; authors listed in inst/www/shared/jquery-AUTHORS.txt"),
person(, "jQuery UI contributors", role = c("ctb", "cph"),
comment = "jQuery UI library; authors listed in inst/www/shared/jqueryui/AUTHORS.txt"),
person(family = "RStudio", role = "cph"),
person(family = "jQuery Foundation", role = "cph",
comment = "jQuery library and jQuery UI library"),
person(family = "jQuery contributors", role = c("ctb", "cph"),
comment = "jQuery library; authors listed in inst/www/shared/jquery-AUTHORS.txt"),
person(family = "jQuery UI contributors", role = c("ctb", "cph"),
comment = "jQuery UI library; authors listed in inst/www/shared/jqueryui/AUTHORS.txt"),
person("Mark", "Otto", role = "ctb",
comment = "Bootstrap library"),
comment = "Bootstrap library"),
person("Jacob", "Thornton", role = "ctb",
comment = "Bootstrap library"),
person(, "Bootstrap contributors", role = "ctb",
comment = "Bootstrap library"),
person(, "Twitter, Inc", role = "cph",
comment = "Bootstrap library"),
comment = "Bootstrap library"),
person(family = "Bootstrap contributors", role = "ctb",
comment = "Bootstrap library"),
person(family = "Twitter, Inc", role = "cph",
comment = "Bootstrap library"),
person("Prem Nawaz", "Khan", role = "ctb",
comment = "Bootstrap accessibility plugin"),
comment = "Bootstrap accessibility plugin"),
person("Victor", "Tsaran", role = "ctb",
comment = "Bootstrap accessibility plugin"),
comment = "Bootstrap accessibility plugin"),
person("Dennis", "Lembree", role = "ctb",
comment = "Bootstrap accessibility plugin"),
comment = "Bootstrap accessibility plugin"),
person("Srinivasu", "Chakravarthula", role = "ctb",
comment = "Bootstrap accessibility plugin"),
comment = "Bootstrap accessibility plugin"),
person("Cathy", "O'Connor", role = "ctb",
comment = "Bootstrap accessibility plugin"),
person(, "PayPal, Inc", role = "cph",
comment = "Bootstrap accessibility plugin"),
comment = "Bootstrap accessibility plugin"),
person(family = "PayPal, Inc", role = "cph",
comment = "Bootstrap accessibility plugin"),
person("Stefan", "Petre", role = c("ctb", "cph"),
comment = "Bootstrap-datepicker library"),
comment = "Bootstrap-datepicker library"),
person("Andrew", "Rowls", role = c("ctb", "cph"),
comment = "Bootstrap-datepicker library"),
comment = "Bootstrap-datepicker library"),
person("Brian", "Reavis", role = c("ctb", "cph"),
comment = "selectize.js library"),
comment = "selectize.js library"),
person("Salmen", "Bejaoui", role = c("ctb", "cph"),
comment = "selectize-plugin-a11y library"),
comment = "selectize-plugin-a11y library"),
person("Denis", "Ineshin", role = c("ctb", "cph"),
comment = "ion.rangeSlider library"),
comment = "ion.rangeSlider library"),
person("Sami", "Samhuri", role = c("ctb", "cph"),
comment = "Javascript strftime library"),
person(, "SpryMedia Limited", role = c("ctb", "cph"),
comment = "DataTables library"),
comment = "Javascript strftime library"),
person(family = "SpryMedia Limited", role = c("ctb", "cph"),
comment = "DataTables library"),
person("John", "Fraser", role = c("ctb", "cph"),
comment = "showdown.js library"),
person("John", "Gruber", role = c("ctb", "cph"),
comment = "showdown.js library"),
person("Ivan", "Sagalaev", role = c("ctb", "cph"),
comment = "highlight.js library"),
person("R Core Team", role = c("ctb", "cph"),
comment = "tar implementation from R")
)
comment = "highlight.js library"),
person(family = "R Core Team", role = c("ctb", "cph"),
comment = "tar implementation from R")
)
Description: Makes it incredibly easy to build interactive web
applications with R. Automatic "reactive" binding between inputs and
outputs and extensive prebuilt widgets make it possible to build
beautiful, responsive, and powerful applications with minimal effort.
License: MIT + file LICENSE
URL: https://shiny.posit.co/, https://github.com/rstudio/shiny
BugReports: https://github.com/rstudio/shiny/issues
License: GPL-3 | file LICENSE
Depends:
methods,
R (>= 3.0.2)
R (>= 3.0.2),
methods
Imports:
bslib (>= 0.6.0),
cachem (>= 1.1.0),
cli,
commonmark (>= 2.0.0),
fastmap (>= 1.1.1),
fontawesome (>= 0.4.0),
glue (>= 1.3.2),
grDevices,
htmltools (>= 0.5.4),
httpuv (>= 1.5.2),
jsonlite (>= 0.9.16),
later (>= 1.0.0),
lifecycle (>= 0.2.0),
mime (>= 0.3),
otel,
promises (>= 1.5.0),
R6 (>= 2.0),
rlang (>= 0.4.10),
sourcetools,
tools,
utils,
grDevices,
httpuv (>= 1.5.2),
mime (>= 0.3),
jsonlite (>= 0.9.16),
xtable,
fontawesome (>= 0.2.1),
htmltools (>= 0.5.2),
R6 (>= 2.0),
sourcetools,
later (>= 1.0.0),
promises (>= 1.1.0),
tools,
crayon,
rlang (>= 0.4.10),
fastmap (>= 1.1.0),
withr,
xtable
commonmark (>= 1.7),
glue (>= 1.3.2),
bslib (>= 0.3.0),
cachem,
ellipsis,
lifecycle (>= 0.2.0)
Suggests:
Cairo (>= 1.5-5),
coro (>= 1.1.0),
datasets,
DT,
dygraphs,
future,
ggplot2,
Cairo (>= 1.5-5),
testthat (>= 3.0.0),
knitr (>= 1.6),
magrittr,
markdown,
mirai,
otelsdk (>= 0.2.0),
ragg,
reactlog (>= 1.0.0),
rmarkdown,
sass,
ggplot2,
reactlog (>= 1.0.0),
magrittr,
yaml,
future,
dygraphs,
ragg,
showtext,
testthat (>= 3.2.1),
watcher,
yaml
Config/Needs/check: shinytest2
Config/testthat/edition: 3
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.3.3
sass
URL: https://shiny.rstudio.com/
BugReports: https://github.com/rstudio/shiny/issues
Collate:
'globals.R'
'app-state.R'
@@ -139,13 +127,10 @@ Collate:
'map.R'
'utils.R'
'bootstrap.R'
'busy-indicators-spinners.R'
'busy-indicators.R'
'cache-utils.R'
'deprecated.R'
'devmode.R'
'diagnose.R'
'extended-task.R'
'fileupload.R'
'graph.R'
'reactives.R'
@@ -183,15 +168,6 @@ Collate:
'modal.R'
'modules.R'
'notifications.R'
'otel-attr-srcref.R'
'otel-collect.R'
'otel-enable.R'
'otel-error.R'
'otel-label.R'
'otel-reactive-update.R'
'otel-session.R'
'otel-shiny.R'
'otel-with.R'
'priorityqueue.R'
'progress.R'
'react.R'
@@ -219,7 +195,6 @@ Collate:
'test.R'
'update-input.R'
'utils-lang.R'
'utils-tags.R'
'version_bs_date_picker.R'
'version_ion_range_slider.R'
'version_jquery.R'
@@ -227,3 +202,10 @@ Collate:
'version_selectize.R'
'version_strftime.R'
'viewer.R'
RoxygenNote: 7.2.1
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
RdMacros: lifecycle
Config/testthat/edition: 3
Config/Needs/check:
rstudio/shinytest2

1016
LICENSE

File diff suppressed because it is too large Load Diff

View File

@@ -1,21 +0,0 @@
# MIT License
Copyright (c) 2025 shiny authors
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.

File diff suppressed because it is too large Load Diff

View File

@@ -19,7 +19,6 @@ S3method("[[",shinyoutput)
S3method("[[<-",reactivevalues)
S3method("[[<-",shinyoutput)
S3method("names<-",reactivevalues)
S3method(as.list,Map)
S3method(as.list,reactivevalues)
S3method(as.shiny.appobj,character)
S3method(as.shiny.appobj,list)
@@ -44,7 +43,6 @@ S3method(bindEvent,reactiveExpr)
S3method(bindEvent,shiny.render.function)
S3method(format,reactiveExpr)
S3method(format,reactiveVal)
S3method(length,Map)
S3method(names,reactivevalues)
S3method(print,reactive)
S3method(print,reactivevalues)
@@ -55,7 +53,6 @@ S3method(str,reactivevalues)
export("conditionStackTrace<-")
export(..stacktraceoff..)
export(..stacktraceon..)
export(ExtendedTask)
export(HTML)
export(MockShinySession)
export(NS)
@@ -78,7 +75,6 @@ export(br)
export(browserViewer)
export(brushOpts)
export(brushedPoints)
export(busyIndicatorOptions)
export(callModule)
export(captureStackTraces)
export(checkboxGroupInput)
@@ -165,7 +161,6 @@ export(isTruthy)
export(isolate)
export(key_missing)
export(loadSupport)
export(localOtelCollect)
export(mainPanel)
export(makeReactiveBinding)
export(markRenderFunction)
@@ -193,7 +188,6 @@ export(onRestore)
export(onRestored)
export(onSessionEnded)
export(onStop)
export(onUnhandledError)
export(outputOptions)
export(p)
export(pageWithSidebar)
@@ -217,7 +211,6 @@ export(reactiveVal)
export(reactiveValues)
export(reactiveValuesToList)
export(reactlog)
export(reactlogAddMark)
export(reactlogReset)
export(reactlogShow)
export(registerInputHandler)
@@ -320,7 +313,6 @@ export(updateTextInput)
export(updateVarSelectInput)
export(updateVarSelectizeInput)
export(urlModal)
export(useBusyIndicators)
export(validate)
export(validateCssUnit)
export(varSelectInput)
@@ -330,7 +322,6 @@ export(verticalLayout)
export(wellPanel)
export(withLogErrors)
export(withMathJax)
export(withOtelCollect)
export(withProgress)
export(withReactiveDomain)
export(withTags)
@@ -341,6 +332,8 @@ import(httpuv)
import(methods)
import(mime)
import(xtable)
importFrom(ellipsis,check_dots_empty)
importFrom(ellipsis,check_dots_unnamed)
importFrom(fastmap,fastmap)
importFrom(fastmap,is.key_missing)
importFrom(fastmap,key_missing)
@@ -389,20 +382,15 @@ importFrom(lifecycle,is_present)
importFrom(promises,"%...!%")
importFrom(promises,"%...>%")
importFrom(promises,as.promise)
importFrom(promises,hybrid_then)
importFrom(promises,is.promise)
importFrom(promises,is.promising)
importFrom(promises,new_promise_domain)
importFrom(promises,promise)
importFrom(promises,promise_reject)
importFrom(promises,promise_resolve)
importFrom(promises,with_promise_domain)
importFrom(rlang,"%||%")
importFrom(rlang,"fn_body<-")
importFrom(rlang,"fn_fmls<-")
importFrom(rlang,as_function)
importFrom(rlang,as_quosure)
importFrom(rlang,check_dots_empty)
importFrom(rlang,check_dots_unnamed)
importFrom(rlang,enexpr)
importFrom(rlang,enquo)
importFrom(rlang,enquo0)

580
NEWS.md
View File

@@ -1,387 +1,21 @@
# shiny (development version)
# shiny 1.12.1
## New features
* `withOtelCollect()` and `localOtelCollect()` temporarily control
OpenTelemetry collection levels during reactive expression creation,
allowing you to enable or disable telemetry collection for specific modules
or sections of code. (#4333)
## Bug fixes and minor improvements
* OpenTelemetry code attributes now include both the preferred attribute names
(`code.file.path`, `code.line.number`, `code.column.number`) and the
deprecated names (`code.filepath`, `code.lineno`, `code.column`) to follow
OpenTelemetry semantic conventions while maintaining backward compatibility.
The deprecated names will be removed in a future release after Logfire
supports the preferred names. (#4325)
* `ExtendedTask` now captures the OpenTelemetry recording state at
initialization time rather than at invocation time, ensuring consistent span
recording behavior regardless of runtime configuration changes. (#4334)
* Timer tests are now skipped on CRAN. (#4327)
# shiny 1.12.0
## OpenTelemetry support
* Shiny now supports [OpenTelemetry](https://opentelemetry.io/) via
[`{otel}`](https://otel.r-lib.org/index.html). By default, if
`otel::is_tracing_enabled()` returns `TRUE`, then `{shiny}` records all
OpenTelemetry spans. See [`{otelsdk}`'s Collecting Telemetry
Data](https://otelsdk.r-lib.org/reference/collecting.html) for more details
on configuring OpenTelemetry. (#4269, #4300)
* Supported values for `options(shiny.otel.collect)` (or
`Sys.getenv("SHINY_OTEL_COLLECT")`):
* `"none"` - No Shiny OpenTelemetry tracing.
* `"session"` - Adds session start/end spans.
* `"reactive_update"` - Spans for any synchronous/asynchronous reactive
update. (Includes `"session"` features).
* `"reactivity"` - Spans for all reactive expressions. (Includes
`"reactive_update"` features).
* `"all"` [default] - All Shiny OpenTelemetry tracing. Currently equivalent
to `"reactivity"`.
* OpenTelemetry spans are recorded for:
* `session_start`: Wraps the calling of the `server()` function. Also
contains HTTP request within the attributes.
* `session_end`: Wraps the calling of the `onSessionEnded()` handlers.
* `reactive_update`: Signals the start of when Shiny knows something is to
be calculated. This span ends when there are no more reactive updates
(promises or synchronous) to be calculated.
* `reactive`, `observe`, `output`: Captures the calculation (including any
async promise chains) of a reactive expression (`reactive()`), an observer
(`observe()`), or an output render function (`render*()`).
* `reactive debounce`, `reactive throttle`: Captures the calculation
(including any async promise chains) of a `debounce()`d or `throttle()`d
reactive expression.
* `reactiveFileReader`, `reactivePoll`: Captures the calculation
(including any async promise chains) of a `reactiveFileReader()` or
`reactivePoll()`.
* `ExtendedTask`: Captures the calculation (including any async promise
chains) of an `ExtendedTask`.
* OpenTelemetry Logs are recorded for:
* `Set reactiveVal <name>` - When a `reactiveVal()` is set
* `Set reactiveValues <name>$<key>` - When a `reactiveValues()` element is
set
* Fatal or unhandled errors - When an error occurs that causes the session
to end, or when an unhandled error occurs in a reactive context. Contains
the error within the attributes. To unsanitize the error message being
collected, set `options(shiny.otel.sanitize.errors = FALSE)`.
* `Set ExtendedTask <name> <value>` - When an `ExtendedTask`'s respective
reactive value (e.g., `status`, `value`, and `error`) is set.
* `<ExtendedTask name> add to queue` - When an `ExtendedTask` is added to
the task queue.
* All OpenTelemetry logs and spans will contain a `session.id` attribute
containing the active session ID.
## New features
* `updateActionButton()` and `updateActionLink()` now accept values other than
`shiny::icon()` for the `icon` argument (e.g., `fontawesome::fa()`,
`bsicons::bs_icon()`, etc). (#4249)
## Bug fixes and minor improvements
* Showcase mode now uses server-side markdown rendering with the
`{commonmark}` package, providing support for GitHub Flavored Markdown
features (tables, strikethrough, autolinks, task lists). While most existing
README.md files should continue to work as expected, some minor rendering
differences may occur due to the change in markdown processor. (#4202,
#4201)
* `debounce()`, `reactiveFileReader()`, `reactivePoll()`, `reactiveValues()`,
and `throttle()` now attempt to retrieve the assigned name for the default
label if the srcref is available. If a value cannot easily be produced, a
default label is used instead. (#4269, #4300)
* The default label for items described below will now attempt to retrieve the
assigned name if the srcref is available. If a value can not easily be
produced, a default label will be used instead. This should improve the
OpenTelemetry span labels and the reactlog experience. (#4269, #4300)
* `reactiveValues()`, `reactivePoll()`, `reactiveFileReader()`, `debounce()`,
`throttle()`, `observe()`
* Combinations of `bindEvent()` and `reactive()` / `observe()`
* Combination of `bindCache()` and `reactive()`
* `updateActionButton()` and `updateActionLink()` now correctly render HTML
content passed to the `label` argument. (#4249)
* `updateSelectizeInput()` no longer creates multiple remove buttons when
`options = list(plugins="remove_button")` is used. (#4275)
* `dateRangeInput()`/`updateDateRangeInput()` now correctly considers the time
zones of date-time objects (POSIXct) passed to the `start`, `end`, `min` and
`max` arguments. (thanks @ismirsehregal, #4318)
## Breaking changes
* The return value of `actionButton()` and `actionLink()` now wraps `label`
and `icon` in an additional HTML container element. This allows
`updateActionButton()` and `updateActionLink()` to distinguish between the
`label` and `icon` when making updates, and allows spacing between `label`
and `icon` to be more easily customized via CSS.
# shiny 1.11.1
This is a patch release primarily for addressing the bugs introduced in v1.11.0.
## Bug fixes
* Fixed an issue where `InputBinding` implementations that don't pass a value to their `subscribe` callback were no longer notifying Shiny of input changes. (#4243)
* `updateActionButton()` and `updateActionLink()` once again handle `label` updates correctly. (#4245)
# shiny 1.11.0
## Improvements
* When auto-reload is enabled, Shiny now reloads the entire app when support files, like Shiny modules, additional script files, or web assets, change. To enable auto-reload, call `devmode(TRUE)` to enable Shiny's developer mode, or set `options(shiny.autoreload = TRUE)` to specifically enable auto-reload. You can choose which files are watched for changes with the `shiny.autoreload.pattern` option. (#4184)
* When busy indicators are enabled (i.e., `useBusyIndicators()`), Shiny now:
* Shows a spinner on recalculating htmlwidgets that have previously rendered an error (including `req()` and `validate()`). (#4172)
* Shows a spinner on `tableOutput()`. (#4172)
* Places a minimum height on recalculating outputs so that the spinner is always visible. (#4172)
* Shiny now uses `{cli}` instead of `{crayon}` for rich log messages. (thanks @olivroy, #4170)
* `renderPlot()` was updated to accommodate changes in ggplot2 v4.0.0. (#4226)
* When adding the new tab via `insertTab()` or `bslib::nav_insert()`, the underlying JavaScript no longer renders content twice. (#4179)
## New features
* `textInput()`, `textAreaInput()`, `numericInput()` and `passwordInput()` all gain an `updateOn` option. `updateOn = "change"` is the default and previous behavior, where the input value updates immediately whenever the value changes. With `updateOn = "blur"`, the input value will update only when the text input loses focus or when the user presses Enter (or Cmd/Ctrl + Enter for `textAreaInput()`). (#4183)
* `textAreaInput()` gains a `autoresize` option, which automatically resizes the text area to fit its content. (#4210)
* The family of `update*Input()` functions can now render HTML content passed to the `label` argument (e.g., `updateInputText(label = tags$b("New label"))`). (#3996)
* `ExtendedTask` now catches synchronous values and errors and returns them via `$result()`. Previously, the extended task function was required to always return a promise. This change makes it easier to use `ExtendedTask` with a function that may return early or do some synchronous work before returning a promise. (#4225)
* The `callback` argument of Shiny.js' `InputBinding.subscribe()` method gains support for a value of `"event"`. This makes it possible for an input binding to use event priority when updating the value (i.e., send immediately and always resend, even if the value hasn't changed). (#4211)
## Changes
* Shiny no longer suspends input changes when _any_ `<input type="submit">` or `<button type="submit">` is on the page. Instead, it now only suspends when a `submitButton()` is present. If you have reason for creating a submit button from custom HTML, add a CSS class of `shiny-submit-button` to the button. (#4209)
* Shiny's JavaScript assets are now compiled to ES2021 instead of ES5. (#4066)
* Upgraded jQuery from 3.6.0 to 3.7.1. (#3969)
* Updated jQuery UI from 1.13.2 to 1.14.1. (#4175)
## Bug fixes
* The Shiny Client Console (enabled with `shiny::devmode()`) no longer displays duplicate warning or error message. (#4177)
* Synchronous errors that occur inside a `ExtendedTask` no longer stop the session. (#4225)
* Calling `removeModal()` immediately after `showModal()` no longer fails to remove the modal (this would sometimes happen if the remove message was received while the modal was in the process of being revealed). (#4173)
* `runExample("08_html")` now (correctly) requests to 'shiny.min.css', eliminating a network request failure. (#4220)
* `shiny::shinyAppTemplate()` no longer errors without a call to `library(shiny)`. (#3870)
# shiny 1.10.0
## New features and improvements
* When busy indicators are enabled (i.e., `useBusyIndicators()` is in the UI), Shiny now:
* Shows the pulse indicator when dynamic UI elements are recalculating and no other spinners are visible in the app. (#4137)
* Makes the pulse indicator slightly smaller by default and improves its appearance to better blend with any background. (#4122)
* Improve collection of deep stack traces (stack traces that are tracked across steps in an async promise chain) with `{coro}` async generators such as `{elmer}` chat streams. Previously, Shiny treated each iteration of an async generator as a distinct deep stack, leading to pathologically long stack traces; now, Shiny only keeps/prints unique deep stack trace, discarding duplicates. (#4156)
* Added an example to the `ExtendedTask` documentation. (@daattali #4087)
## Bug fixes
* Fixed a bug in `conditionalPanel()` that would cause the panel to repeatedly show/hide itself when the provided condition was not boolean. (@kamilzyla, #4127)
* Fixed a bug with `sliderInput()` when used as a range slider that made it impossible to change the slider value when both handles were at the maximum value. (#4131)
* `dateInput()` and `dateRangeInput()` no longer send immediate updates to the server when the user is typing a date input. Instead, it waits until the user presses Enter or clicks out of the field to send the update, avoiding spurious and incorrect date values. Note that an update is still sent immediately when the field is cleared. (#3664)
* Fixed a bug in `onBookmark()` hook that caused elements to not be excluded from URL bookmarking. (#3762)
* Fixed a bug with stack trace capturing that caused reactives with very long async promise chains (hundreds/thousands of steps) to become extremely slow. Chains this long are unlikely to be written by hand, but `{coro}` async generators and `{elmer}` async streaming were easily creating problematically long chains. (#4155)
* Duplicate input and output IDs -- e.g. using `"debug"` for two inputs or two outputs -- or shared IDs -- e.g. using `"debug"` as the `inputId` for an input and an output -- now result in a console warning message, but not an error. When `devmode()` is enabled, an informative message is shown in the Shiny Client Console. We recommend all Shiny devs enable `devmode()` when developing Shiny apps locally. (#4101)
* Updating the choices of a `selectizeInput()` via `updateSelectizeInput()` with `server = TRUE` no longer retains the selected choice as a deselected option if the current value is not part of the new choices. (@dvg-p4 #4142)
* Fixed a bug where stack traces from `observeEvent()` were being stripped of stack frames too aggressively. (#4163)
# shiny 1.9.1
## Bug fixes
* Fixed a bug introduced in v1.9.0 where the boundaries of hover/click/brush regions on plots were being incorrectly scaled when browser zoom was used. (#4111)
# shiny 1.9.0
## New busy indication feature
Add the new `useBusyIndicators()` function to any UI definition to:
1. Add a spinner overlay on calculating/recalculating outputs.
2. Show a page-level pulsing banner when Shiny is busy calculating something (e.g., a download, side-effect, etc), but no calculating/recalculating outputs are visible.
In a future version of Shiny, busy indication will be enabled by default, so we encourage you to try it out now, provide feedback, and report any issues.
In addition, various properties of the spinners and pulse can be customized with `busyIndicatorOptions()`. For more details, see `?busyIndicatorOptions`. (#4040, #4104)
## New features and improvements
* The client-side TypeScript code for Shiny has been refactored so that the `Shiny` object is now an instance of class `ShinyClass`. (#4063)
* In TypeScript, the `Shiny` object has a new property `initializedPromise`, which is a Promise-like object that can be `await`ed or chained with `.then()`. This Promise-like object corresponds to the `shiny:sessioninitialized` JavaScript event, but is easier to use because it can be used both before and after the events have occurred. (#4063)
* Output bindings now include the `.recalculating` CSS class when they are first bound, up until the first render. This makes it possible/easier to show progress indication when the output is calculating for the first time. (#4039)
* A new `shiny.client_devmode` option controls client-side devmode features, in particular the client-side error console introduced in shiny 1.8.1, independently of the R-side features of `shiny::devmode()`. This usage is primarily intended for automatic use in Shinylive. (#4073)
* Added function `reactlogAddMark()` to programmatically add _mark_ed locations in the reactlog log without the requirement of keyboard bindings during an idle reactive moment. (#4103)
## Bug fixes
* `downloadButton()` and `downloadLink()` are now disabled up until they are fully initialized. This prevents the user from clicking the button/link before the download is ready. (#4041)
* Output bindings that are removed, invalidated, then inserted again (while invalidated) now correctly include the `.recalculating` CSS class. (#4039)
* Fixed a recent issue with `uiOutput()` and `conditionalPanel()` not properly lower opacity when recalculation (in a Bootstrap 5 context). (#4027)
* Image outputs that were scaled by CSS had certain regions that were unresponsive to hover/click/brush handlers. (#3234)
# shiny 1.8.1.1
* In v1.8.1, shiny.js starting throwing an error when input/output bindings have duplicate IDs. This error is now only thrown when `shiny::devmode(TRUE)` is enabled, so the issue is still made discoverable through the JS error console, but avoids unnecessarily breaking apps that happen to work with duplicate IDs. (#4019)
# shiny 1.8.1
## New features and improvements
* Added `ExtendedTask`, a new simple way to launch long-running asynchronous tasks that are truly non-blocking. That is, even _within_ a session, an `ExtendedTask` won't block the main thread from flushing the reactive graph (i.e., UI updates won't be blocked). `ExtendedTask` pairs nicely with new `bslib::input_task_button()` and `bslib::bind_task_button()` functions, which help give user feedback and prevent extra button clicks. (#3958)
* Added a JavaScript error dialog, reporting errors that previously were only discoverable by opening the browser's devtools open. Since this dialog is mainly useful for debugging and development, it must be enabled with `shiny::devmode()`. (#3931)
* `runExample()` now uses the `{bslib}` package to generate a better looking result. It also gains a `package` argument so that other packages can leverage this same function to run Shiny app examples. For more, see `?runExample`. (#3963, #4005)
* Added `onUnhandledError()` to register a function that will be called when an unhandled error occurs in a Shiny app. Note that this handler doesn't stop the error or prevent the session from closing, but it can be used to log the error or to clean up session-specific resources. (thanks @JohnCoene, #3993)
## Changes
* `renderDataTable()`/`dataTableOutput()` are officially deprecated in favor of [their `{DT}` equivalents](https://rstudio.github.io/DT/shiny.html). Migrating to `{DT}`, in most cases, just requires changing `renderDataTable()` to `DT::renderDT()` and `dataTableOutput()` to `DT::DTOutput()`. Also, to promote migration, when a recent version of `{DT}` is available, `renderDataTable()`/`dataTableOutput()` now automatically use their `{DT}` equivalent (and provide a message that they are doing so). If this happens to degrade an existing app, set `options(shiny.legacy.datatable = TRUE)` to get the old (i.e., non-`{DT}`) implementation. (#3998)
* Both `conditionalPanel()` and `uiOutput()` are now styled with `display: contents` by default in Shiny apps that use Bootstrap 5. This means that the elements they contain are positioned as if they were direct children of the parent container holding the `conditionalPanel()` or `uiOutput()`. This is probably what most users intend when they use these functions, but it may break apps that applied styles directly to the container elements created by these two functions. In that case, you may include CSS rules to set `display: block` for the `.shiny-panel-conditional` or `.shiny-html-output` classes. (#3957, #3960)
## Bug fixes
* Notifications are now constrained to the width of the viewport for window widths smaller the default notification panel size. (#3949)
* Fixed #2392: `downloadButton()` now visibly returns its HTML tag so that it renders correctly in R Markdown and Quarto output. (Thanks to @fennovj, #2672)
* Calling `updateSelectizeInput()` with `choices` and `selected` now clears the current selection before updating the choices and selected value. (#3967)
* Loading a Shiny app in a package-like directory will no longer warn if autoloading is disabled by the presence of an `R/_disable_autoload.R` file. (Thanks to @krlmlr and @tanho63, #3513)
# shiny 1.8.0
## Breaking changes
* Closed #3899: The JS function `Shiny.bindAll()` is now asynchronous. This change is driven by the recent push toward making dynamic UI rendering asynchronous, which is necessary for [shinylive](https://shinylive.io/r) (and should've happened when it was first introduced in Shiny v1.7.5). The vast majority of existing `Shiny.bindAll()` uses should continue to work as before, but some cases may break if downstream code relies on it being synchronous (i.e., blocking the main thread). In this case, consider placing any downstream code in a `.then()` callback (or `await` the result in a `async` function). (#3929)
* Since `renderContent()` calls `bindAll()` (after it inserts content), it now returns a `Promise<void>` instead of `void`, which can be useful if downstream code needs to wait for the binding to complete.
## New features and improvements
* Updated `selectizeInput()`'s selectize.js dependency from v0.12.4 to v0.15.2. In addition to many bug fixes and improvements, this update also adds several new [plugin options](https://selectize.dev/docs/demos/plugins). (#3875)
* Shiny's CSS styling (for things like `showNotification()`, `withProgress()`, `inputPanel()`, etc.), has been updated with `{bslib}`'s upcoming CSS-only dark mode feature in mind. (#3882, #3914)
* Default styles for `showNotification()` were tweaked slightly to improve accessibility, sizing, and padding. (#3913)
* Shiny inputs and `{htmlwidgets}` are no longer treated as draggable inside of `absolutePanel()`/`fixedPanel()` with `draggable = TRUE`. As a result, interactions like zooming and panning now work as expected with widgets like `{plotly}` and `{leaflet}` when they appear in a draggable panel. (#3752, #3933)
* For `InputBinding`s, the `.receiveMessage()` method can now be asynchronous or synchronous (previously it could only be synchronous). (#3930)
## Bug fixes
* `fileInput()` no longer has unwanted round corners applied to the `buttonLabel`. (#3879)
* Fixed #3898: `wrapFunctionLabel()` no longer throws an error if the `name` is longer than 10000 bytes. (#3903)
# shiny 1.7.5.1
## Bug fixes
* On r-devel (R > 4.3.1), `isTruthy(NULL)` now returns `FALSE` (as it does with older versions of R). (#3906)
# shiny 1.7.5
## Possibly breaking changes
* For `reactiveValues()` objects, whenever the `$names()` or `$values()` methods are called, the keys are now returned in the order that they were inserted. (#3774)
* The value provided to `options(shiny.json.digits)` is now interpreted as number of _digits after the decimal_ instead of _significant digits_. To treat the value as significant digits, wrap it in `I()` (e.g., `options(shiny.json.digits = I(4))`). This new default behavior not only helps with reducing digits in testing snapshots, but is also more consistent with `{jsonlite}`'s default behavior. (#3819)
## New features and improvements
* Closed #789: Dynamic UI is now rendered asynchronously, thanks in part to the newly exported `Shiny.renderDependenciesAsync()`, `Shiny.renderHtmlAsync()`, and `Shiny.renderContentAsync()`. Importantly, this means `<script>` tags are now loaded asynchronously (the old way used `XMLHttpRequest`, which is synchronous). In addition, `Shiny` now manages a queue of async tasks (exposed via `Shiny.shinyapp.taskQueue`) so that order of execution is preserved. (#3666)
* Fixes #3840: `updateSliderInput()` now warns when attempting to set invalid `min`, `max`, or `value` values. Sending an invalid update message to an input no longer causes other update messages to fail. (#3843)
* `sliderInput()` now has a larger target area for clicking or tapping on the slider handle or range. (#3859)
* Closed #2956: Component authors can now prevent Shiny from creating an input binding on specific elements by adding the `data-shiny-no-bind-input` attribute to the element. The attribute may have any or no value; its presence will prevent binding. This feature is primarily useful for input component authors who want to use standard HTML input elements without causing Shiny to create an input binding for them. Additionally, Shiny now adds custom classes to its inputs. For example, `checkboxInput()` now has a `shiny-input-checkbox` class. These custom classes may be utilized in future updates to Shiny's input binding logic. (#3861)
* `Map` objects are now initialized at load time instead of build time. This avoids potential problems that could arise from storing `fastmap` objects into the built Shiny package. (#3775)
## Bug fixes
* Fixed #3771: Sometimes the error `ion.rangeSlider.min.js: i.stopPropagation is not a function` would appear in the JavaScript console. (#3772)
* Fixed #3833: When `width` is provided to `textAreaInput()`, we now correctly set the width of the `<textarea>` element. (#3838)
# shiny 1.7.4.1
## Full changelog
* Closed #3849: In R-devel, a warning was raised when Shiny was loaded because `as.numeric_version()` was called with a number instead of a string. (#3850)
# shiny 1.7.4
shiny 1.7.2.9000
================
## Full changelog
### Breaking changes
* Closed #3719: Output container sizes, which are available via [`session$clientData` and `getCurrentOutputInfo()`](https://shiny.rstudio.com/articles/client-data.html), no longer round to the nearest pixel (i.e., they are now more exact, possibly fractional values). (#3720)
* Closed #3704, #3735, and #3740: `renderPlot()` no longer generates an error (or segfault) when it executes before the output is visible. Instead, it'll now use the graphics device's default size for it's initial size. Relatedly, `plotPNG()` now ignores `NULL` values for `width`/`height` (and uses the device's default `width`/`height` instead). (#3739)
### New features and improvements
* `plotOutput()`, `imageOutput()`, and `uiOutput()` gain a `fill` argument. If `TRUE` (the default for `plotOutput()`), the output container is allowed to grow/shrink to fit a fill container (created via `htmltools::bindFillRole()`) with an opinionated height. This means `plotOutput()` will grow/shrink by default [inside of `bslib::card_body_fill()`](https://rstudio.github.io/bslib/articles/cards.html#responsive-sizing), but `imageOutput()` and `uiOutput()` will have to opt-in to similar behavior with `fill = TRUE`. (#3715)
* Closed #3687: Updated jQuery-UI to v1.13.2. (#3697)
* Internal: Added clearer and strict TypeScript type definitions (#3644)
# shiny 1.7.3
### Bug fixes
* Shiny 1.7.0 changed the `icon(lib="fontawesome")` implementation from a bundled copy of fontawesome, to the {fontawesome} package. This led to issue #3688, where icons that were previously working, were now breaking. That's because {fontawesome} 0.3.0 and earlier did not have support for icon names used in Font Awesome 5 and earlier, only the newest icon names used in Font Awesome 6. Now, {fontawesome} 0.4.0 has restored support for those older icon names, and Shiny 1.7.2.1 has updated its {fontawesome} requirement to >=0.4.0.
* Closed #3687: Updated jQuery-UI to v1.13.2. (#3697)
# shiny 1.7.2
shiny 1.7.2
===========
## Full changelog
@@ -432,7 +66,8 @@ In addition, various properties of the spinners and pulse can be customized with
* 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
shiny 1.7.1
===========
## Bug Fixes
@@ -441,7 +76,8 @@ In addition, various properties of the spinners and pulse can be customized with
* Re-arranged conditions for testthat 1.0.0 compatibility. (#3512)
# shiny 1.7.0
shiny 1.7.0
===========
## Full changelog
@@ -498,13 +134,14 @@ In addition, various properties of the spinners and pulse can be customized with
* Updated to jQuery 3.6.0. (#3311)
# shiny 1.6.0
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/theming.html#dynamic) or some other "real-time" theming tool like `bslib::bs_themer()`.
* 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.
@@ -536,7 +173,7 @@ This release focuses on improvements in three main areas:
* Fixed #2951: screen readers correctly announce labels and date formats for `dateInput()` and `dateRangeInput()` widgets. (#2978)
* Closed #2847: `selectInput()` is reasonably accessible for screen readers even when `selectize` option is set to TRUE. To improve `selectize.js` accessibility, we have added [selectize-plugin-a11y](https://github.com/SalmenBejaoui/selectize-plugin-a11y) by default. (#2993)
* Closed #2847: `selectInput()` is reasonably accessible for screen readers even when `selectize` option is set to TRUE. To improve `selectize.js` accessibility, we have added [selectize-plugin-a11y](https://github.com/SLMNBJ/selectize-plugin-a11y) by default. (#2993)
* Closed #612: Added `alt` argument to `renderPlot()` and `renderCachedPlot()` to specify descriptive texts for `plotOutput()` objects, which is essential for screen readers. By default, alt text is set to the static text, "Plot object," but even dynamic text can be made with reactive function. (#3006, thanks @trafficonese and @leonawicz for the original PR and discussion via #2494)
@@ -607,7 +244,8 @@ This release focuses on improvements in three main areas:
* Removed es5-shim library, which was internally used within `selectInput()` for ECMAScript 5 compatibility. (#2993)
# shiny 1.5.0
shiny 1.5.0
===========
## Full changelog
@@ -660,17 +298,20 @@ This release focuses on improvements in three main areas:
* Updated from Font-Awesome 5.3.1 to 5.13.0, which includes icons related to COVID-19. For upgrade notes, see https://github.com/FortAwesome/Font-Awesome/blob/master/UPGRADING.md. (#2891)
# shiny 1.4.0.2
shiny 1.4.0.2
===========
Minor patch release: fixed some timing-dependent tests failed intermittently on CRAN build machines.
# shiny 1.4.0.1
shiny 1.4.0.1
===========
Minor patch release to account for changes to the grid package that will be upcoming in the R 4.0 release (#2776).
# shiny 1.4.0
shiny 1.4.0
===========
## Full changelog
@@ -733,7 +374,8 @@ Minor patch release to account for changes to the grid package that will be upco
* Fixed #2329, #1817: These bugs were reported as fixed in Shiny 1.3.0 but were not actually fixed because some JavaScript changes were accidentally not included in the release. The fix resolves issues that occur when `withProgressBar()` or bookmarking are combined with the [networkD3](https://christophergandrud.github.io/networkD3/) package's Sankey plot.
# shiny 1.3.2
shiny 1.3.2
===========
### Bug fixes
@@ -742,7 +384,8 @@ Minor patch release to account for changes to the grid package that will be upco
* Fixed #2280: Shiny applications that used a www/index.html file did not serve up the index file. (#2382)
# shiny 1.3.1
shiny 1.3.1
===========
## Full changelog
@@ -751,7 +394,8 @@ Minor patch release to account for changes to the grid package that will be upco
* Fixed a performance issue introduced in v1.3.0 when using large nested lists within Shiny. (#2377)
# shiny 1.3.0
shiny 1.3.0
===========
## Full changelog
@@ -782,7 +426,8 @@ Minor patch release to account for changes to the grid package that will be upco
* Fixed #2247: `renderCachedPlot` now supports using promises for either `expr` or `cacheKeyExpr`. (Shiny v1.2.0 supported async `expr`, but only if `cacheKeyExpr` was async as well; now you can use any combination of sync/async for `expr` and `cacheKeyExpr`.) #2261
# shiny 1.2.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.
@@ -798,7 +443,7 @@ This release features plot caching, an important new tool for improving performa
### Minor new features and improvements
* Upgrade FontAwesome from 4.7.0 to 5.3.1 and made `icon` tags browsable, which means they will display in a web browser or RStudio viewer by default (#2186). Note that if your application or library depends on FontAwesome directly using custom CSS, you may need to make some or all of the changes recommended in [Upgrade from Version 4](https://docs.fontawesome.com/v5/web/setup/upgrade-from-v4). Font Awesome icons can also now be used in static R Markdown documents.
* Upgrade FontAwesome from 4.7.0 to 5.3.1 and made `icon` tags browsable, which means they will display in a web browser or RStudio viewer by default (#2186). Note that if your application or library depends on FontAwesome directly using custom CSS, you may need to make some or all of the changes recommended in [Upgrade from Version 4](https://fontawesome.com/how-to-use/on-the-web/setup/upgrading-from-version-4). Font Awesome icons can also now be used in static R Markdown documents.
* Address #174: Added `datesdisabled` and `daysofweekdisabled` as new parameters to `dateInput()`. This resolves #174 and exposes the underlying arguments of [Bootstrap Datepicker](http://bootstrap-datepicker.readthedocs.io/en/latest/options.html#datesdisabled). `datesdisabled` expects a character vector with values in `yyyy/mm/dd` format and `daysofweekdisabled` expects an integer vector with day interger ids (Sunday=0, Saturday=6). The default value for both is `NULL`, which leaves all days selectable. Thanks, @nathancday! (#2147)
@@ -847,7 +492,8 @@ This release features plot caching, an important new tool for improving performa
* Addressed #1864 by changing `optgroup` documentation to use `list` instead of `c`. (#2084)
# shiny 1.1.0
shiny 1.1.0
===========
This is a significant release for Shiny, with a major new feature that was nearly a year in the making: support for asynchronous operations! Until now, R's single-threaded nature meant that performing long-running calculations or tasks from Shiny would bring your app to a halt for other users of that process. This release of Shiny deeply integrates the [promises](https://rstudio.github.io/promises/) package to allow you to execute some tasks asynchronously, including as part of reactive expressions and outputs. See the [promises](https://rstudio.github.io/promises/) documentation to learn more.
@@ -897,7 +543,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://posit.co/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://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)
* 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)
@@ -920,7 +566,8 @@ This is a significant release for Shiny, with a major new feature that was nearl
In some rare cases, interrupting an application (by pressing Ctrl-C or Esc) may result in the message `Error in execCallbacks(timeoutSecs) : c++ exception (unknown reason)`. Although this message sounds alarming, it is harmless, and will go away in a future version of the later package (more information [here](https://github.com/r-lib/later/issues/55)).
# shiny 1.0.5
shiny 1.0.5
===========
## Full changelog
@@ -933,7 +580,8 @@ In some rare cases, interrupting an application (by pressing Ctrl-C or Esc) may
* Fixed #1824: HTTP HEAD requests on static files caused the application to stop. (#1825)
# shiny 1.0.4
shiny 1.0.4
===========
There are three headlining features in this release of Shiny. It is now possible to add and remove tabs from a `tabPanel`; there is a new function, `onStop()`, which registers callbacks that execute when an application exits; and `fileInput`s now can have files dragged and dropped on them. In addition to these features, this release has a number of minor features and bug fixes. See the full changelog below for more details.
@@ -994,7 +642,8 @@ There are three headlining features in this release of Shiny. It is now possible
* Fixed #1474: A `browser()` call in an observer could cause an error in the RStudio IDE on Windows. (#1802)
# shiny 1.0.3
shiny 1.0.3
================
This is a hotfix release of Shiny. With previous versions of Shiny, when running an application on the newly-released version of R, 3.4.0, it would print a message: `Warning in body(fun) : argument is not a function`. This has no effect on the application, but because the message could be alarming to users, we are releasing a new version of Shiny that fixes this issue.
@@ -1007,7 +656,8 @@ This is a hotfix release of Shiny. With previous versions of Shiny, when running
* Fixed #1676: On R 3.4.0, running a Shiny application gave a warning: `Warning in body(fun) : argument is not a function`. (#1677)
# shiny 1.0.2
shiny 1.0.2
================
This is a hotfix release of Shiny. The primary reason for this release is because the web host for MathJax JavaScript library is scheduled to be shut down in the next few weeks. After it is shut down, Shiny applications that use MathJax will no longer be able to load the MathJax library if they are run with Shiny 1.0.1 and below. (If you don't know whether your application uses MathJax, it probably does not.) For more information about why the MathJax CDN is shutting down, see https://www.mathjax.org/cdn-shutting-down/.
@@ -1026,7 +676,8 @@ This is a hotfix release of Shiny. The primary reason for this release is becaus
* Fixed #1653: wrong code example in documentation. (#1658)
# shiny 1.0.1
shiny 1.0.1
================
This is a maintenance release of Shiny, mostly aimed at fixing bugs and introducing minor features. The most notable additions in this version of Shiny are the introduction of the `reactiveVal()` function (it's like `reactiveValues()`, but it only stores a single value), and that the choices of `radioButtons()` and `checkboxGroupInput()` can now contain HTML content instead of just plain text.
@@ -1096,7 +747,8 @@ in shiny apps. For more info, see the documentation (`?updateQueryString` and `?
* Closed #1500: Updated ion.rangeSlider to 2.1.6. (#1540)
# shiny 1.0.0
shiny 1.0.0
===========
Shiny has reached a milestone: version 1.0.0! In the last year, we've added two major features that we considered essential for a 1.0.0 release: bookmarking, and support for testing Shiny applications. As usual, this version of Shiny also includes many minor features and bug fixes.
@@ -1161,7 +813,8 @@ Now there's an official way to slow down reactive values and expressions that in
* Updated to Font Awesome 4.7.0.
# shiny 0.14.2
shiny 0.14.2
============
This is a maintenance release of Shiny, with some bug fixes and minor new features.
@@ -1189,7 +842,8 @@ This is a maintenance release of Shiny, with some bug fixes and minor new featur
* Fixed a bug where, in versions of R before 3.2, Shiny applications could crash due to a bug in R's implementation of `list2env()`. (#1446)
# shiny 0.14.1
shiny 0.14.1
============
This is a maintenance release of Shiny, with some bug fixes and minor new features.
@@ -1219,7 +873,8 @@ This is a maintenance release of Shiny, with some bug fixes and minor new featur
* Updated to jQuery UI 1.12.1. Previously, Shiny included a build of 1.11.4 which was missing the datepicker component due to a conflict with the bootstrap-datepicker used by Shiny's `dateInput()` and `dateRangeInput()`. (#1374)
# shiny 0.14
shiny 0.14
==========
A new Shiny release is upon us! There are many new exciting features, bug fixes, and library updates. We'll just highlight the most important changes here, but you can browse through the full changelog below for details. This will likely be the last release before shiny 1.0, so get out your party hats!
@@ -1240,7 +895,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.posit.co/r/reference/shiny/latest/shownotification.html).
[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).
## Progress indicators
@@ -1249,7 +904,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.posit.co/r/reference/shiny/latest/withprogress.html) or the more complicated, but more powerful, [`Progress` object-oriented API](https://shiny.posit.co/r/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](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).
## Reconnection
@@ -1263,7 +918,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.posit.co/r/reference/shiny/latest/modaldialog.html).
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).
## `insertUI` and `removeUI`
@@ -1271,7 +926,7 @@ 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.posit.co/r/reference/shiny/latest/insertui.html) and [`removeUI`](https://shiny.posit.co/r/reference/shiny/latest/insertui.html).
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).
## Documentation for connecting to an external database
@@ -1305,7 +960,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.posit.co/r/reference/shiny/latest/rendertable.html).
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).
## Full changelog
@@ -1418,12 +1073,14 @@ There are many more minor features, small improvements, and bug fixes than we ca
* Updated to jQuery 1.12.4.
# shiny 0.13.2
shiny 0.13.2
============
* Updated documentation for `htmlTemplate`.
# shiny 0.13.1
shiny 0.13.1
============
* `flexCol` did not work on RStudio for Windows or Linux.
@@ -1432,7 +1089,8 @@ There are many more minor features, small improvements, and bug fixes than we ca
* BREAKING CHANGE: The long-deprecated ability to pass functions (rather than expressions) to reactive() and observe() has finally been removed.
# shiny 0.13.0
shiny 0.13.0
============
* Fixed #962: plot interactions did not work with the development version of ggplot2 (after ggplot2 1.0.1).
@@ -1483,7 +1141,8 @@ There are many more minor features, small improvements, and bug fixes than we ca
* Added support for the new htmltools 0.3 feature `htmlTemplate`. It's now possible to use regular HTML markup to design your UI, but still use R expressions to define inputs, outputs, and HTML widgets.
# shiny 0.12.2
shiny 0.12.2
============
* GitHub changed URLs for gists from .tar.gz to .zip, so `runGist` was updated to work with the new URLs.
@@ -1506,14 +1165,16 @@ There are many more minor features, small improvements, and bug fixes than we ca
* Shiny now correctly handles HTTP HEAD requests. (#876)
# shiny 0.12.1
shiny 0.12.1
============
* Fixed an issue where unbindAll() causes subsequent bindAll() to be ignored for previously bound outputs. (#856)
* Undeprecate `dataTableOutput` and `renderDataTable`, which had been deprecated in favor of the new DT package. The DT package is a bit too new and has a slightly different API, we were too hasty in deprecating the existing Shiny functions.
# shiny 0.12.0
shiny 0.12.0
============
In addition to the changes listed below (in the *Full Changelog* section), there is an infrastructure change that could affect existing Shiny apps.
@@ -1569,7 +1230,8 @@ Shiny 0.12.0 deprecated Shiny's dataTableOutput and renderDataTable functions an
* renderDataTable() and dataTableOutput() have been deprecated in shiny and will be removed in future versions of shiny. Please use the DT package instead: http://rstudio.github.io/DT/ (#807)
# shiny 0.11.1
shiny 0.11.1
============
* Major client-side performance improvements for pages that have many conditionalPanels, tabPanels, and plotOutputs. (#693, #717, #723)
@@ -1596,7 +1258,8 @@ Shiny 0.12.0 deprecated Shiny's dataTableOutput and renderDataTable functions an
* downloadHandler content callback functions are now invoked with a temp file name that has the same extension as the final filename that will be used by the download. This is to deal with the fact that some file writing functions in R will auto-append the extension for their file type (pdf, zip).
# shiny 0.11
shiny 0.11
==========
Shiny 0.11 switches away from the Bootstrap 2 web framework to the next version, Bootstrap 3. This is in part because Bootstrap 2 is no longer being developed, and in part because it allows us to tap into the ecosystem of Bootstrap 3 themes.
@@ -1674,17 +1337,20 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Password input fields can now be used, with `passwordInput()`. (#672)
# shiny 0.10.2.2
shiny 0.10.2.2
==============
* Remove use of `rstudio::viewer` in a code example, for R CMD check.
# shiny 0.10.2.1
shiny 0.10.2.1
==============
* Changed some examples to use \donttest instead of \dontrun.
# shiny 0.10.2
shiny 0.10.2
============
* The minimal version of R required for the shiny package is 3.0.0 now.
@@ -1717,7 +1383,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Added `position` parameter to `navbarPage`.
# shiny 0.10.1
shiny 0.10.1
============
* Added Unicode support for Windows. Shiny apps running on Windows must use the UTF-8 encoding for ui.R and server.R (also the optional global.R) if they contain non-ASCII characters. See this article for details and examples: http://shiny.rstudio.com/gallery/unicode-characters.html (#516)
@@ -1730,7 +1397,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Added support for option groups in the select/selectize inputs. When the `choices` argument for `selectInput()`/`selectizeInput()` is a list of sub-lists and any sub-list is of length greater than 1, the HTML tag `<optgroup>` will be used. See an example at http://shiny.rstudio.com/gallery/option-groups-for-selectize-input.html (#542)
# shiny 0.10.0
shiny 0.10.0
============
* BREAKING CHANGE: By default, observers now terminate themselves if they were created during a session and that session ends. See ?domains for more details.
@@ -1767,12 +1435,14 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* `runGitHub()` can also take a value of the form "username/repo" in its first argument, e.g. both runGitHub("shiny_example", "rstudio") and runGitHub("rstudio/shiny_example") are valid ways to run the GitHub repo.
# shiny 0.9.1
shiny 0.9.1
===========
* Fixed warning 'Error in Context$new : could not find function "loadMethod"' that was happening to dependent packages on "R CMD check".
# shiny 0.9.0
shiny 0.9.0
===========
* BREAKING CHANGE: Added a `host` parameter to runApp() and runExample(), which defaults to the shiny.host option if it is non-NULL, or "127.0.0.1" otherwise. This means that by default, Shiny applications can only be accessed on the same machine from which they are served. To allow other clients to connect, as in previous versions of Shiny, use "0.0.0.0" (or the IP address of one of your network interfaces, if you care to be explicit about it).
@@ -1845,7 +1515,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Dots are now legal characters for inputId/outputId. (Thanks, Kevin Lindquist. #358)
# shiny 0.8.0
shiny 0.8.0
===========
* Debug hooks are registered on all user-provided functions and (reactive) expressions (e.g., in renderPlot()), which makes it possible to set breakpoints in these functions using the latest version of the RStudio IDE, and the RStudio visual debugging tools can be used to debug Shiny apps. Internally, the registration is done via installExprFunction(), which is a new function introduced in this version to replace exprToFunction() so that the registration can be automatically done.
@@ -1864,7 +1535,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* The minimal required version for the httpuv package was increased to 1.2 (on CRAN now).
# shiny 0.7.0
shiny 0.7.0
===========
* Stopped sending websocket subprotocol. This fixes a compatibility issue with Google Chrome 30.
@@ -1893,7 +1565,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Add shiny.sharedSecret option, to require the HTTP header Shiny-Shared-Secret to be set to the given value.
# shiny 0.6.0
shiny 0.6.0
===========
* `tabsetPanel()` can be directed to start with a specific tab selected.
@@ -1924,7 +1597,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Shiny apps can be run without a server.r and ui.r file.
# shiny 0.5.0
shiny 0.5.0
===========
* Switch from websockets package for handling websocket connections to httpuv.
@@ -1941,14 +1615,16 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Fix bug #55, where `renderTable()` would throw error with an empty data frame.
# shiny 0.4.1
shiny 0.4.1
===========
* Fix bug where width and height weren't passed along properly from `reactivePlot` to `renderPlot`.
* Fix bug where infinite recursion would happen when `reactivePlot` was passed a function for width or height.
# shiny 0.4.0
shiny 0.4.0
===========
* Added suspend/resume capability to observers.
@@ -1963,7 +1639,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Fixed a bug where empty values in a numericInput were sent to the R process as 0. They are now sent as NA.
# shiny 0.3.1
shiny 0.3.1
===========
* Fix issue #91: bug where downloading files did not work.
@@ -1972,7 +1649,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Reactive functions now preserve the visible/invisible state of their returned values.
# shiny 0.3.0
shiny 0.3.0
===========
* Reactive functions are now evaluated lazily.
@@ -1997,44 +1675,52 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Fix issue #64, where pressing Enter in a textbox would cause a form to submit.
# shiny 0.2.4
shiny 0.2.4
===========
* `runGist` has been updated to use the new download URLs from https://gist.github.com.
* Shiny now uses `CairoPNG()` for output, when the Cairo package is available. This provides better-looking output on Linux and Windows.
# shiny 0.2.3
shiny 0.2.3
===========
* Ignore request variables for routing purposes
# shiny 0.2.2
shiny 0.2.2
===========
* Fix CRAN warning (assigning to global environment)
# shiny 0.2.1
shiny 0.2.1
===========
* [BREAKING] Modify API of `downloadHandler`: The `content` function now takes a file path, not writable connection, as an argument. This makes it much easier to work with APIs that only write to file paths, not connections.
# shiny 0.2.0
shiny 0.2.0
===========
* Fix subtle name resolution bug--the usual symptom being S4 methods not being invoked correctly when called from inside of ui.R or server.R
# shiny 0.1.14
shiny 0.1.14
===========
* Fix slider animator, which broke in 0.1.10
# shiny 0.1.13
shiny 0.1.13
===========
* Fix temp file leak in reactivePlot
# shiny 0.1.12
shiny 0.1.12
===========
* Fix problems with runGist on Windows
@@ -2043,7 +1729,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Add CSS hooks for app-wide busy indicators
# shiny 0.1.11
shiny 0.1.11
===========
* Fix input binding with IE8 on Shiny Server
@@ -2052,7 +1739,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Allow dynamic sizing of reactivePlot (i.e. using a function instead of a fixed value)
# shiny 0.1.10
shiny 0.1.10
===========
* Support more MIME types when serving out of www
@@ -2065,7 +1753,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Fix plot rendering with IE8 on Shiny Server
# shiny 0.1.9
shiny 0.1.9
===========
* Much less flicker when updating plots
@@ -2074,7 +1763,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Add `includeText`, `includeHTML`, and `includeMarkdown` functions for putting text, HTML, and Markdown content from external files in the application's UI.
# shiny 0.1.8
shiny 0.1.8
===========
* Add `runGist` function for conveniently running a Shiny app that is published on gist.github.com.
@@ -2087,7 +1777,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Add `bootstrapPage` function for creating new Bootstrap based layouts from scratch.
# shiny 0.1.7
shiny 0.1.7
===========
* Fix issue #26: Shiny.OutputBindings not correctly exported.
@@ -2096,7 +1787,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Transcode JSON into UTF-8 (prevents non-ASCII reactivePrint values from causing errors on Windows).
# shiny 0.1.6
shiny 0.1.6
===========
* Import package dependencies, instead of attaching them (with the exception of websockets, which doesn't currently work unless attached).
@@ -2105,7 +1797,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* bindAll was not correctly sending initial values to the server; fixed.
# shiny 0.1.5
shiny 0.1.5
===========
* BREAKING CHANGE: JS APIs Shiny.bindInput and Shiny.bindOutput removed and replaced with Shiny.bindAll; Shiny.unbindInput and Shiny.unbindOutput removed and replaced with Shiny.unbindAll.
@@ -2120,7 +1813,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* htmlOutput (CSS class `shiny-html-output`) can contain inputs and outputs.
# shiny 0.1.4
shiny 0.1.4
===========
* Allow Bootstrap tabsets to act as reactive inputs; their value indicates which tab is active
@@ -2133,7 +1827,8 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Add Shiny.bindInputs(scope), .unbindInputs(scope), .bindOutputs(scope), and .unbindOutputs(scope) JS API calls to allow dynamic binding/unbinding of HTML elements
# shiny 0.1.3
shiny 0.1.3
===========
* Introduce Shiny.inputBindings.register JS API and InputBinding class, for creating custom input controls
@@ -2146,6 +1841,7 @@ Along with the release of Shiny 0.11, we've packaged up some Bootstrap 3 themes
* Fix issue #10: Plots in tabsets not rendered
# shiny 0.1.2
shiny 0.1.2
===========
* Initial private beta release!

View File

@@ -25,7 +25,6 @@
#' `- tests
#' |- testthat.R
#' `- testthat
#' |- setup-shinytest2.R
#' |- test-examplemodule.R
#' |- test-server.R
#' |- test-shinytest2.R
@@ -47,7 +46,6 @@
#' `tests/testthat/` directory using the
#' [shinytest2](https://rstudio.github.io/shinytest2/reference/test_app.html)
#' package.
#' * `tests/testthat/setup-shinytest2.R` is setup file to source your `./R` folder into the testing environment.
#' * `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
@@ -128,7 +126,7 @@ shinyAppTemplate <- function(path = NULL, examples = "default", dryrun = FALSE)
}
if ("tests" %in% examples) {
rlang::check_installed("shinytest2", "for {testthat} tests to work as expected", version = "0.2.0")
rlang::check_installed("shinytest2", "for {testthat} tests to work as expected")
}
# =======================================================

View File

@@ -159,8 +159,8 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
#' ```
#'
#' To use different settings for a session-scoped cache, you can set
#' `session$cache` at the top of your server function. By default, it will
#' create a 200 MB memory cache for each session, but you can replace it with
#' `self$cache` at the top of your server function. By default, it will create
#' a 200 MB memory cache for each session, but you can replace it with
#' something different. To use the session-scoped cache, you must also call
#' `bindCache()` with `cache="session"`. This will create a 100 MB cache for
#' the session:
@@ -177,7 +177,7 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
#' cache by putting this at the top of your app.R, server.R, or global.R:
#'
#' ```
#' shinyOptions(cache = cachem::cache_disk(file.path(dirname(tempdir()), "myapp-cache")))
#' shinyOptions(cache = cachem::cache_disk(file.path(dirname(tempdir()), "myapp-cache"))
#' ```
#'
#' This will create a subdirectory in your system temp directory named
@@ -231,8 +231,8 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
#' promises, but rather objects provided by the
#' \href{https://rstudio.github.io/promises/}{\pkg{promises}} package, which
#' are similar to promises in JavaScript. (See [promises::promise()] for more
#' information.) You can also use [mirai::mirai()] or [future::future()]
#' objects to run code in a separate process or even on a remote machine.
#' information.) You can also use [future::future()] objects to run code in a
#' separate process or even on a remote machine.
#'
#' If the value returns a promise, then anything that consumes the cached
#' reactive must expect it to return a promise.
@@ -453,7 +453,7 @@ utils::globalVariables(".GenericCallEnv", add = TRUE)
#' bindEvent(input$go)
#' # The cached, eventified reactive takes a reactive dependency on
#' # input$go, but doesn't use it for the cache key. It uses input$x and
#' # input$y for the cache key, but doesn't take a reactive dependency on
#' # input$y for the cache key, but doesn't take a reactive depdency on
#' # them, because the reactive dependency is superseded by addEvent().
#'
#' output$txt <- renderText(r())
@@ -478,12 +478,7 @@ bindCache.default <- function(x, ...) {
bindCache.reactiveExpr <- function(x, ..., cache = "app") {
check_dots_unnamed()
call_srcref <- get_call_srcref(-1)
label <- rassignSrcrefToLabel(
call_srcref,
defaultLabel = exprToLabel(substitute(x), "cachedReactive")
)
label <- exprToLabel(substitute(key), "cachedReactive")
domain <- reactive_get_domain(x)
# Convert the ... to a function that returns their evaluated values.
@@ -495,37 +490,24 @@ bindCache.reactiveExpr <- function(x, ..., cache = "app") {
cacheHint <- rlang::hash(extractCacheHint(x))
valueFunc <- wrapFunctionLabel(valueFunc, "cachedReactiveValueFunc", ..stacktraceon = TRUE)
x_classes <- class(x)
x_otel_attrs <- attr(x, "observable", exact = TRUE)$.otelAttrs
# Don't hold on to the reference for x, so that it can be GC'd
rm(x)
# Hacky workaround for issue with `%>%` preventing GC:
# https://github.com/tidyverse/magrittr/issues/229
if (exists(".GenericCallEnv") && exists(".", envir = .GenericCallEnv, inherits = FALSE)) {
rm(list = ".", envir = .GenericCallEnv, inherits = FALSE)
if (exists(".GenericCallEnv") && exists(".", envir = .GenericCallEnv)) {
rm(list = ".", envir = .GenericCallEnv)
}
with_no_otel_collect({
res <- reactive(label = label, domain = domain, {
cache <- resolve_cache_object(cache, domain)
hybrid_chain(
keyFunc(),
generateCacheFun(valueFunc, cache, cacheHint, cacheReadHook = identity, cacheWriteHook = identity)
)
})
res <- reactive(label = label, domain = domain, {
cache <- resolve_cache_object(cache, domain)
hybrid_chain(
keyFunc(),
generateCacheFun(valueFunc, cache, cacheHint, cacheReadHook = identity, cacheWriteHook = identity)
)
})
class(res) <- c("reactive.cache", class(res))
local({
impl <- attr(res, "observable", exact = TRUE)
impl$.otelAttrs <- append_otel_srcref_attrs(x_otel_attrs, call_srcref, fn_name = "bindCache")
})
if (has_otel_collect("reactivity")) {
res <- enable_otel_reactive_expr(res)
}
res
}
@@ -552,7 +534,6 @@ bindCache.shiny.render.function <- function(x, ..., cache = "app") {
)
}
# Passes over the otelAttrs from valueFunc to renderFunc
renderFunc <- addAttributes(renderFunc, renderFunctionAttributes(valueFunc))
class(renderFunc) <- c("shiny.render.function.cache", class(valueFunc))
renderFunc
@@ -604,7 +585,7 @@ bindCache.shiny.renderPlot <- function(x, ...,
observe({
doResizeCheck()
}, label = "plot-resize")
})
# TODO: Make sure this observer gets GC'd if output$foo is replaced.
# Currently, if you reassign output$foo, the observer persists until the
# session ends. This is generally bad programming practice and should be

View File

@@ -196,58 +196,31 @@ bindEvent.reactiveExpr <- function(x, ..., ignoreNULL = TRUE, ignoreInit = FALSE
valueFunc <- reactive_get_value_func(x)
valueFunc <- wrapFunctionLabel(valueFunc, "eventReactiveValueFunc", ..stacktraceon = TRUE)
call_srcref <- get_call_srcref(-1)
if (is.null(label)) {
label <- rassignSrcrefToLabel(
call_srcref,
defaultLabel = as_default_label(sprintf(
'bindEvent(%s, %s)',
attr(x, "observable", exact = TRUE)$.label,
quos_to_label(qs)
))
)
}
x_classes <- class(x)
x_otel_attrs <- attr(x, "observable", exact = TRUE)$.otelAttrs
label <- label %||%
sprintf('bindEvent(%s, %s)', attr(x, "observable", exact = TRUE)$.label, quos_to_label(qs))
# Don't hold on to the reference for x, so that it can be GC'd
rm(x)
initialized <- FALSE
with_no_otel_collect({
res <- reactive(label = label, domain = domain, ..stacktraceon = FALSE, {
hybrid_chain(
{
eventFunc()
},
function(value) {
if (ignoreInit && !initialized) {
initialized <<- TRUE
req(FALSE)
}
req(!ignoreNULL || !isNullEvent(value))
isolate(valueFunc())
res <- reactive(label = label, domain = domain, ..stacktraceon = FALSE, {
hybrid_chain(
eventFunc(),
function(value) {
if (ignoreInit && !initialized) {
initialized <<- TRUE
req(FALSE)
}
)
})
req(!ignoreNULL || !isNullEvent(value))
isolate(valueFunc())
}
)
})
class(res) <- c("reactive.event", x_classes)
local({
impl <- attr(res, "observable", exact = TRUE)
impl$.otelAttrs <- append_otel_srcref_attrs(x_otel_attrs, call_srcref, fn_name = "bindEvent")
})
if (has_otel_collect("reactivity")) {
res <- enable_otel_reactive_expr(res)
}
class(res) <- c("reactive.event", class(res))
res
}
@@ -276,7 +249,6 @@ bindEvent.shiny.render.function <- function(x, ..., ignoreNULL = TRUE, ignoreIni
)
}
# Passes over the otelAttrs from valueFunc to renderFunc
renderFunc <- addAttributes(renderFunc, renderFunctionAttributes(valueFunc))
class(renderFunc) <- c("shiny.render.function.event", class(valueFunc))
renderFunc
@@ -297,17 +269,7 @@ bindEvent.Observer <- function(x, ..., ignoreNULL = TRUE, ignoreInit = FALSE,
# Note that because the observer will already have been logged by this point,
# this updated label won't show up in the reactlog.
if (is.null(label)) {
call_srcref <- get_call_srcref(-1)
x$.label <- rassignSrcrefToLabel(
call_srcref,
defaultLabel = as_default_label(
sprintf('bindEvent(%s, %s)', x$.label, quos_to_label(qs))
)
)
} else {
x$.label <- label
}
x$.label <- label %||% sprintf('bindEvent(%s, %s)', x$.label, quos_to_label(qs))
initialized <- FALSE
@@ -340,13 +302,6 @@ bindEvent.Observer <- function(x, ..., ignoreNULL = TRUE, ignoreInit = FALSE,
)
class(x) <- c("Observer.event", class(x))
call_srcref <- get_call_srcref(-1)
x$.otelAttrs <- append_otel_srcref_attrs(x$.otelAttrs, call_srcref, fn_name = "bindEvent")
if (has_otel_collect("reactivity")) {
x <- enable_otel_observe(x)
}
invisible(x)
}

View File

@@ -99,13 +99,13 @@ saveShinySaveState <- function(state) {
# Encode the state to a URL. This does not save to disk.
encodeShinySaveState <- function(state) {
exclude <- c(state$exclude, "._bookmark_")
inputVals <- serializeReactiveValues(state$input, exclude, stateDir = NULL)
# Allow user-supplied onSave function to do things like add state$values.
if (!is.null(state$onSave))
isolate(state$onSave(state))
exclude <- c(state$exclude, "._bookmark_")
inputVals <- serializeReactiveValues(state$input, exclude, stateDir = NULL)
inputVals <- vapply(inputVals,
function(x) toJSON(x, strict_atomic = FALSE),
character(1),
@@ -452,10 +452,8 @@ RestoreInputSet <- R6Class("RestoreInputSet",
)
)
# This is a fastmap::faststack(); value is assigned in .onLoad().
restoreCtxStack <- NULL
on_load({
restoreCtxStack <- fastmap::faststack()
})
withRestoreContext <- function(ctx, expr) {
restoreCtxStack$push(ctx)
@@ -551,7 +549,7 @@ restoreInput <- function(id, default) {
#' `window.history.pushState(null, null, queryString)`.
#'
#' @param queryString The new query string to show in the location bar.
#' @param mode When the query string is updated, should the current history
#' @param mode When the query string is updated, should the the current history
#' entry be replaced (default), or should a new history entry be pushed onto
#' the history stack? The former should only be used in a live bookmarking
#' context. The latter is useful if you want to navigate between states using

View File

@@ -57,17 +57,18 @@ bootstrapPage <- function(..., title = NULL, theme = NULL, lang = NULL) {
ui <- attachDependencies(ui, bootstrapLib())
}
setLang(ui, lang)
setHtmlAttr(ui, "lang", lang)
}
setLang <- function(ui, lang) {
# Add lang attribute to be passed to renderPage function
attr(ui, "lang") <- lang
setHtmlAttr <- function(ui, attr_name, attr_value) {
attrs <- getHtmlAttrs(ui)
attrs[[attr_name]] <- attr_value
attr(ui, "html_attrs") <- attrs
ui
}
getLang <- function(ui) {
getHtmlAttrs <- function(ui) {
# Check if ui has lang attribute; otherwise, NULL
attr(ui, "lang", exact = TRUE)
attr(ui, "html_attrs", exact = TRUE)
}
#' Bootstrap libraries
@@ -172,10 +173,9 @@ setCurrentTheme <- function(theme) {
#' Register a theme dependency
#'
#' This function registers a function that returns an
#' [htmltools::htmlDependency()] or list of such objects. If
#' `session$setCurrentTheme()` is called, the function will be re-executed, and
#' the resulting html dependency will be sent to the client.
#' This function registers a function that returns an [htmlDependency()] or list
#' of such objects. If `session$setCurrentTheme()` is called, the function will
#' be re-executed, and the resulting html dependency will be sent to the client.
#'
#' Note that `func` should **not** be an anonymous function, or a function which
#' is defined within the calling function. This is so that,
@@ -332,10 +332,22 @@ fillPage <- function(..., padding = 0, title = NULL, bootstrap = TRUE,
...
)
ui <- setLang(ui, lang)
ui <- setHtmlAttr(ui, "lang", lang)
}
return(ui)
# vfill-container rules live in bslib which means something like
# fillPage(plotOutput("x")) won't work unless a bslib theme is used
setBodyAttr(ui, "class", "vfill-container")
}
setBodyAttr <- function(ui, attr_name, attr_value) {
attrs <- getBodyAttrs(ui)
attrs[[attr_name]] <- attr_value
attr(ui, "body_attrs") <- attrs
ui
}
getBodyAttrs <- function(ui) {
attr(ui, "body_attrs", exact = TRUE)
}
collapseSizes <- function(padding) {
@@ -375,7 +387,8 @@ collapseSizes <- function(padding) {
#' @param inverse `TRUE` to use a dark background and light text for the
#' navigation bar
#' @param collapsible `TRUE` to automatically collapse the navigation
#' elements into an expandable menu on mobile devices or narrow window widths.
#' elements into a menu when the width of the browser is less than 940 pixels
#' (useful for viewing on smaller touchscreen device)
#' @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
@@ -533,12 +546,7 @@ wellPanel <- function(...) {
#' }
#' @export
conditionalPanel <- function(condition, ..., ns = NS(NULL)) {
div(
class = "shiny-panel-conditional",
`data-display-if` = condition,
`data-ns-prefix` = ns(""),
...
)
div(`data-display-if`=condition, `data-ns-prefix`=ns(""), ...)
}
#' Create a help text element
@@ -797,9 +805,9 @@ verbatimTextOutput <- function(outputId, placeholder = FALSE) {
#' @name plotOutput
#' @rdname plotOutput
#' @export
imageOutput <- function(outputId, width = "100%", height="400px",
imageOutput <- function(outputId, width = NULL, height = NULL,
click = NULL, dblclick = NULL, hover = NULL, brush = NULL,
inline = FALSE, fill = FALSE) {
inline = FALSE) {
style <- if (!inline) {
# Using `css()` here instead of paste/sprintf so that NULL values will
@@ -812,6 +820,7 @@ imageOutput <- function(outputId, width = "100%", height="400px",
args <- list(
id = outputId,
class = "shiny-image-output",
class = if (is.null(height)) "vfill-item",
style = style
)
@@ -855,8 +864,7 @@ imageOutput <- function(outputId, width = "100%", height="400px",
}
container <- if (inline) span else div
res <- do.call(container, args)
bindFillRole(res, item = fill)
do.call(container, args)
}
#' Create an plot or image output element
@@ -924,11 +932,6 @@ imageOutput <- function(outputId, width = "100%", height="400px",
#' `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 Whether or not the returned tag should be treated as a fill item,
#' meaning that its `height` is allowed to grow/shrink to fit a fill container
#' with an opinionated height (see [htmltools::bindFillRole()]) with an
#' opinionated height. Examples of fill containers include `bslib::card()` and
#' `bslib::card_body_fill()`.
#' @inheritParams textOutput
#' @note The arguments `clickId` and `hoverId` only work for R base graphics
#' (see the \pkg{\link[graphics:graphics-package]{graphics}} package). They do
@@ -1097,13 +1100,13 @@ imageOutput <- function(outputId, width = "100%", height="400px",
#'
#' }
#' @export
plotOutput <- function(outputId, width = "100%", height="400px",
plotOutput <- function(outputId, width = NULL, height = NULL,
click = NULL, dblclick = NULL, hover = NULL, brush = NULL,
inline = FALSE, fill = !inline) {
inline = FALSE) {
# Result is the same as imageOutput, except for HTML class
res <- imageOutput(outputId, width, height, click, dblclick,
hover, brush, inline, fill)
hover, brush, inline)
res$attribs$class <- "shiny-plot-output"
res
@@ -1113,23 +1116,23 @@ plotOutput <- function(outputId, width = "100%", height="400px",
#' @rdname renderTable
#' @export
tableOutput <- function(outputId) {
div(id = outputId, class="shiny-html-output shiny-table-output")
div(id = outputId, class="shiny-html-output")
}
dataTableDependency <- list(
htmlDependency(
"datatables",
"1.10.22",
"1.10.5",
src = "www/shared/datatables",
package = "shiny",
script = "js/jquery.dataTables.min.js"
),
htmlDependency(
"datatables-bootstrap",
"1.10.22",
"1.10.5",
src = "www/shared/datatables",
package = "shiny",
stylesheet = "css/dataTables.bootstrap.css",
stylesheet = c("css/dataTables.bootstrap.css", "css/dataTables.extra.css"),
script = "js/dataTables.bootstrap.js"
)
)
@@ -1137,49 +1140,12 @@ dataTableDependency <- list(
#' @rdname renderDataTable
#' @export
dataTableOutput <- function(outputId) {
legacy <- useLegacyDataTable(from = "shiny::dataTableOutput()", to = "DT::DTOutput()")
if (legacy) {
attachDependencies(
div(id = outputId, class = "shiny-datatable-output"),
dataTableDependency
)
} else {
DT::DTOutput(outputId)
}
attachDependencies(
div(id = outputId, class="shiny-datatable-output"),
dataTableDependency
)
}
useLegacyDataTable <- function(from, to) {
legacy <- getOption("shiny.legacy.datatable")
# If option has been set, user knows what they're doing
if (!is.null(legacy)) {
return(legacy)
}
# If not set, use DT if a suitable version is available (and inform either way)
hasDT <- is_installed("DT", "0.32.1")
details <- NULL
if (hasDT) {
details <- paste0(c(
"Since you have a suitable version of DT (>= v0.32.1), ",
from,
" will automatically use ",
to,
" under-the-hood.\n",
"If this happens to break your app, set `options(shiny.legacy.datatable = TRUE)` ",
"to get the legacy datatable implementation (or `FALSE` to squelch this message).\n"
), collapse = "")
}
details <- paste0(details, "See <https://rstudio.github.io/DT/shiny.html> for more information.")
shinyDeprecated("1.8.1", from, to, details)
!hasDT
}
#' Create an HTML output element
#'
#' Render a reactive output variable as HTML within an application page. The
@@ -1189,16 +1155,12 @@ useLegacyDataTable <- function(from, to) {
#' `uiOutput` is intended to be used with `renderUI` on the server side. It is
#' currently just an alias for `htmlOutput`.
#'
#' @param outputId output variable to read the value from
#' @param outputId output variable to read the value from.
#' @param ... Other arguments to pass to the container tag function. This is
#' useful for providing additional classes for the tag.
#' @param fill If `TRUE`, the result of `container` is treated as _both_ a fill
#' item and container (see [htmltools::bindFillRole()]), which means both the
#' `container` as well as its immediate children (i.e., the result of
#' `renderUI()`) are allowed to grow/shrink to fit a fill container with an
#' opinionated height. Set `fill = "item"` or `fill = "container"` to treat
#' `container` as just a fill item or a fill container.
#' @inheritParams textOutput
#' @param fill Whether the output should be allowed to grow/shrink to the size
#' of the `container`. Ignored when `inline = TRUE`.
#' @return An HTML output element that can be included in a panel
#' @examples
#' htmlOutput("summary")
@@ -1214,10 +1176,12 @@ htmlOutput <- function(outputId, inline = FALSE,
if (any_unnamed(list(...))) {
warning("Unnamed elements in ... will be replaced with dynamic UI.")
}
res <- container(id = outputId, class = "shiny-html-output", ...)
bindFillRole(
res, item = isTRUE(fill) || isTRUE("item" == fill),
container = isTRUE(fill) || isTRUE("container" == fill)
container(
id = outputId,
class = "shiny-html-output",
class = if (fill && !inline) "vfill-container vfill-item",
...
)
}
@@ -1242,25 +1206,19 @@ uiOutput <- htmlOutput
#' @examples
#' \dontrun{
#' ui <- fluidPage(
#' p("Choose a dataset to download."),
#' selectInput("dataset", "Dataset", choices = c("mtcars", "airquality")),
#' downloadButton("downloadData", "Download")
#' )
#'
#' server <- function(input, output) {
#' # The requested dataset
#' data <- reactive({
#' get(input$dataset)
#' })
#' # Our dataset
#' data <- mtcars
#'
#' output$downloadData <- downloadHandler(
#' filename = function() {
#' # Use the selected dataset as the suggested file name
#' paste0(input$dataset, ".csv")
#' paste("data-", Sys.Date(), ".csv", sep="")
#' },
#' content = function(file) {
#' # Write the dataset to the `file` that will be downloaded
#' write.csv(data(), file)
#' write.csv(data, file)
#' }
#' )
#' }
@@ -1276,29 +1234,23 @@ downloadButton <- function(outputId,
class=NULL,
...,
icon = shiny::icon("download")) {
tags$a(id=outputId,
class='btn btn-default shiny-download-link disabled',
class=class,
href='',
target='_blank',
download=NA,
"aria-disabled"="true",
tabindex="-1",
validateIcon(icon),
label, ...)
aTag <- tags$a(id=outputId,
class=paste('btn btn-default shiny-download-link', class),
href='',
target='_blank',
download=NA,
validateIcon(icon),
label, ...)
}
#' @rdname downloadButton
#' @export
downloadLink <- function(outputId, label="Download", class=NULL, ...) {
tags$a(id=outputId,
class='shiny-download-link disabled',
class=class,
class=paste(c('shiny-download-link', class), collapse=" "),
href='',
target='_blank',
download=NA,
"aria-disabled"="true",
tabindex="-1",
label, ...)
}

View File

@@ -1,4 +0,0 @@
# Generated by tools/updateSpinnerTypes.R: do not edit by hand
.busySpinnerTypes <-
c("ring", "ring2", "ring3", "bars", "bars2", "bars3", "pulse",
"pulse2", "pulse3", "dots", "dots2", "dots3")

View File

@@ -1,294 +0,0 @@
#' Enable/disable busy indication
#'
#' Busy indicators provide a visual cue to users when the server is busy
#' calculating outputs or otherwise performing tasks (e.g., producing
#' downloads). When enabled, a spinner is shown on each
#' calculating/recalculating output, and a pulsing banner is shown at the top of
#' the page when the app is otherwise busy. Busy indication is enabled by
#' default for UI created with \pkg{bslib}, but must be enabled otherwise. To
#' enable/disable, include the result of this function in anywhere in the app's
#' UI.
#'
#' When both `spinners` and `pulse` are set to `TRUE`, the pulse is
#' automatically disabled when spinner(s) are active. When both `spinners` and
#' `pulse` are set to `FALSE`, no busy indication is shown (other than the
#' graying out of recalculating outputs).
#'
#' @param ... Currently ignored.
#' @param spinners Whether to show a spinner on each calculating/recalculating
#' output.
#' @param pulse Whether to show a pulsing banner at the top of the page when the
#' app is busy.
#' @param fade Whether to fade recalculating outputs. A value of `FALSE` is
#' equivalent to `busyIndicatorOptions(fade_opacity=1)`.
#'
#' @export
#' @seealso [busyIndicatorOptions()] for customizing the appearance of the busy
#' indicators.
#' @examplesIf rlang::is_interactive()
#'
#' library(bslib)
#'
#' ui <- page_fillable(
#' useBusyIndicators(),
#' card(
#' card_header(
#' "A plot",
#' input_task_button("simulate", "Simulate"),
#' class = "d-flex justify-content-between align-items-center"
#' ),
#' plotOutput("p"),
#' )
#' )
#'
#' server <- function(input, output) {
#' output$p <- renderPlot({
#' input$simulate
#' Sys.sleep(4)
#' plot(x = rnorm(100), y = rnorm(100))
#' })
#' }
#'
#' shinyApp(ui, server)
useBusyIndicators <- function(..., spinners = TRUE, pulse = TRUE, fade = TRUE) {
rlang::check_dots_empty()
attrs <- list("shinyBusySpinners" = spinners, "shinyBusyPulse" = pulse)
js <- vapply(names(attrs), character(1), FUN = function(key) {
if (attrs[[key]]) {
sprintf("document.documentElement.dataset.%s = 'true';", key)
} else {
sprintf("delete document.documentElement.dataset.%s;", key)
}
})
# TODO: it'd be nice if htmltools had something like a page_attrs() that allowed us
# to do this without needing to inject JS into the head.
res <- tags$script(HTML(paste(js, collapse = "\n")))
if (!fade) {
res <- tagList(res, fadeOptions(opacity = 1))
}
res
}
#' Customize busy indicator options
#'
#' @description
#' Shiny automatically includes busy indicators, which more specifically means:
#' 1. Calculating/recalculating outputs have a spinner overlay.
#' 2. Outputs fade out/in when recalculating.
#' 3. When no outputs are calculating/recalculating, but Shiny is busy
#' doing something else (e.g., a download, side-effect, etc), a page-level
#' pulsing banner is shown.
#'
#' This function allows you to customize the appearance of these busy indicators
#' by including the result of this function inside the app's UI. Note that,
#' unless `spinner_selector` (or `fade_selector`) is specified, the spinner/fade
#' customization applies to the parent element. If the customization should
#' instead apply to the entire page, set `spinner_selector = 'html'` and
#' `fade_selector = 'html'`.
#'
#' @param ... Currently ignored.
#' @param spinner_type The type of spinner. Pre-bundled types include:
#' '`r paste0(.busySpinnerTypes, collapse = "', '")`'.
#'
#' A path to a local SVG file can also be provided. The SVG should adhere to
#' the following rules:
#' * The SVG itself should contain the animation.
#' * It should avoid absolute sizes (the spinner's containing DOM element
#' size is set in CSS by `spinner_size`, so it should fill that container).
#' * It should avoid setting absolute colors (the spinner's containing DOM element
#' color is set in CSS by `spinner_color`, so it should inherit that color).
#' @param spinner_color The color of the spinner. This can be any valid CSS
#' color. Defaults to the app's "primary" color if Bootstrap is on the page.
#' @param spinner_size The size of the spinner. This can be any valid CSS size.
#' @param spinner_delay The amount of time to wait before showing the spinner.
#' This can be any valid CSS time and can be useful for not showing the spinner
#' if the computation finishes quickly.
#' @param spinner_selector A character string containing a CSS selector for
#' scoping the spinner customization. The default (`NULL`) will apply the
#' spinner customization to the parent element of the spinner.
#' @param fade_opacity The opacity (a number between 0 and 1) for recalculating
#' output. Set to 1 to "disable" the fade.
#' @param fade_selector A character string containing a CSS selector for
#' scoping the spinner customization. The default (`NULL`) will apply the
#' spinner customization to the parent element of the spinner.
#' @param pulse_background A CSS background definition for the pulse. The
#' default uses a
#' [linear-gradient](https://developer.mozilla.org/en-US/docs/Web/CSS/gradient/linear-gradient)
#' of the theme's indigo, purple, and pink colors.
#' @param pulse_height The height of the pulsing banner. This can be any valid
#' CSS size.
#' @param pulse_speed The speed of the pulsing banner. This can be any valid CSS
#' time.
#'
#' @export
#' @seealso [useBusyIndicators()] to disable/enable busy indicators.
#' @examplesIf rlang::is_interactive()
#'
#' library(bslib)
#'
#' card_ui <- function(id, spinner_type = id) {
#' card(
#' busyIndicatorOptions(spinner_type = spinner_type),
#' card_header(paste("Spinner:", spinner_type)),
#' plotOutput(shiny::NS(id, "plot"))
#' )
#' }
#'
#' card_server <- function(id, simulate = reactive()) {
#' moduleServer(
#' id = id,
#' function(input, output, session) {
#' output$plot <- renderPlot({
#' Sys.sleep(1)
#' simulate()
#' plot(x = rnorm(100), y = rnorm(100))
#' })
#' }
#' )
#' }
#'
#' ui <- page_fillable(
#' useBusyIndicators(),
#' input_task_button("simulate", "Simulate", icon = icon("refresh")),
#' layout_columns(
#' card_ui("ring"),
#' card_ui("bars"),
#' card_ui("dots"),
#' card_ui("pulse"),
#' col_widths = 6
#' )
#' )
#'
#' server <- function(input, output, session) {
#' simulate <- reactive(input$simulate)
#' card_server("ring", simulate)
#' card_server("bars", simulate)
#' card_server("dots", simulate)
#' card_server("pulse", simulate)
#' }
#'
#' shinyApp(ui, server)
#'
busyIndicatorOptions <- function(
...,
spinner_type = NULL,
spinner_color = NULL,
spinner_size = NULL,
spinner_delay = NULL,
spinner_selector = NULL,
fade_opacity = NULL,
fade_selector = NULL,
pulse_background = NULL,
pulse_height = NULL,
pulse_speed = NULL
) {
rlang::check_dots_empty()
res <- tagList(
spinnerOptions(
type = spinner_type,
color = spinner_color,
size = spinner_size,
delay = spinner_delay,
selector = spinner_selector
),
fadeOptions(opacity = fade_opacity, selector = fade_selector),
pulseOptions(
background = pulse_background,
height = pulse_height,
speed = pulse_speed
)
)
bslib::as.card_item(dropNulls(res))
}
spinnerOptions <- function(type = NULL, color = NULL, size = NULL, delay = NULL, selector = NULL) {
if (is.null(type) && is.null(color) && is.null(size) && is.null(delay) && is.null(selector)) {
return(NULL)
}
url <- NULL
if (!is.null(type)) {
stopifnot(is.character(type) && length(type) == 1)
if (file.exists(type) && grepl("\\.svg$", type)) {
typeRaw <- readBin(type, "raw", n = file.info(type)$size)
url <- sprintf("url('data:image/svg+xml;base64,%s')", rawToBase64(typeRaw))
} else {
type <- rlang::arg_match(type, .busySpinnerTypes)
url <- sprintf("url('spinners/%s.svg')", type)
}
}
# Options controlled via CSS variables.
css_vars <- htmltools::css(
"--shiny-spinner-url" = url,
"--shiny-spinner-color" = htmltools::parseCssColors(color),
"--shiny-spinner-size" = htmltools::validateCssUnit(size),
"--shiny-spinner-delay" = delay
)
id <- NULL
if (is.null(selector)) {
id <- paste0("spinner-options-", p_randomInt(100, 1000000))
selector <- sprintf(":has(> #%s)", id)
}
css <- HTML(paste0(selector, " {", css_vars, "}"))
tags$style(css, id = id)
}
fadeOptions <- function(opacity = NULL, selector = NULL) {
if (is.null(opacity) && is.null(selector)) {
return(NULL)
}
css_vars <- htmltools::css(
"--shiny-fade-opacity" = opacity
)
id <- NULL
if (is.null(selector)) {
id <- paste0("fade-options-", p_randomInt(100, 1000000))
selector <- sprintf(":has(> #%s)", id)
}
css <- HTML(paste0(selector, " {", css_vars, "}"))
tags$style(css, id = id)
}
pulseOptions <- function(background = NULL, height = NULL, speed = NULL) {
if (is.null(background) && is.null(height) && is.null(speed)) {
return(NULL)
}
css_vars <- htmltools::css(
"--shiny-pulse-background" = background,
"--shiny-pulse-height" = htmltools::validateCssUnit(height),
"--shiny-pulse-speed" = speed
)
tags$style(HTML(paste0(":root {", css_vars, "}")))
}
busyIndicatorDependency <- function() {
htmlDependency(
name = "shiny-busy-indicators",
version = get_package_version("shiny"),
src = "www/shared/busy-indicators",
package = "shiny",
stylesheet = "busy-indicators.css",
# TODO-future: In next release make spinners and pulse opt-out
# head = as.character(useBusyIndicators())
)
}

View File

@@ -75,18 +75,6 @@ getCallNames <- function(calls) {
})
}
# A stripped down version of getCallNames() that intentionally avoids deparsing expressions.
# Instead, it leaves expressions to be directly `rlang::hash()` (for de-duplication), which
# is much faster than deparsing then hashing.
getCallNamesForHash <- function(calls) {
lapply(calls, function(call) {
name <- call[[1L]]
if (is.function(name)) return("<Anonymous>")
if (typeof(name) == "promise") return("<Promise>")
name
})
}
getLocs <- function(calls) {
vapply(calls, function(call) {
srcref <- attr(call, "srcref", exact = TRUE)
@@ -134,9 +122,7 @@ getCallCategories <- function(calls) {
#' @rdname stacktrace
#' @export
captureStackTraces <- function(expr) {
# Use `promises::` as it shows up in the stack trace
promises::with_promise_domain(
createStackTracePromiseDomain(),
promises::with_promise_domain(createStackTracePromiseDomain(),
expr
)
}
@@ -144,49 +130,11 @@ captureStackTraces <- function(expr) {
#' @include globals.R
.globals$deepStack <- NULL
getCallStackDigest <- function(callStack, warn = FALSE) {
dg <- attr(callStack, "shiny.stack.digest", exact = TRUE)
if (!is.null(dg)) {
return(dg)
}
if (isTRUE(warn)) {
rlang::warn(
"Call stack doesn't have a cached digest; expensively computing one now",
.frequency = "once",
.frequency_id = "deepstack-uncached-digest-warning"
)
}
rlang::hash(getCallNamesForHash(callStack))
}
saveCallStackDigest <- function(callStack) {
attr(callStack, "shiny.stack.digest") <- getCallStackDigest(callStack, warn = FALSE)
callStack
}
# Appends a call stack to a list of call stacks, but only if it's not already
# in the list. The list is deduplicated by digest; ideally the digests on the
# list are cached before calling this function (you will get a warning if not).
appendCallStackWithDedupe <- function(lst, x) {
digests <- vapply(lst, getCallStackDigest, character(1), warn = TRUE)
xdigest <- getCallStackDigest(x, warn = TRUE)
stopifnot(all(nzchar(digests)))
stopifnot(length(xdigest) == 1)
stopifnot(nzchar(xdigest))
if (xdigest %in% digests) {
return(lst)
} else {
return(c(lst, list(x)))
}
}
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 <- new_promise_domain(
d <- promises::new_promise_domain(
wrapOnFulfilled = function(onFulfilled) {
force(onFulfilled)
# Subscription time
@@ -194,14 +142,13 @@ createStackTracePromiseDomain <- function() {
currentStack <- sys.calls()
currentParents <- sys.parents()
attr(currentStack, "parents") <- currentParents
currentStack <- saveCallStackDigest(currentStack)
currentDeepStack <- .globals$deepStack
}
function(...) {
# Fulfill time
if (deepStacksEnabled()) {
origDeepStack <- .globals$deepStack
.globals$deepStack <- appendCallStackWithDedupe(currentDeepStack, currentStack)
.globals$deepStack <- c(currentDeepStack, list(currentStack))
on.exit(.globals$deepStack <- origDeepStack, add = TRUE)
}
@@ -218,14 +165,13 @@ createStackTracePromiseDomain <- function() {
currentStack <- sys.calls()
currentParents <- sys.parents()
attr(currentStack, "parents") <- currentParents
currentStack <- saveCallStackDigest(currentStack)
currentDeepStack <- .globals$deepStack
}
function(...) {
# Fulfill time
if (deepStacksEnabled()) {
origDeepStack <- .globals$deepStack
.globals$deepStack <- appendCallStackWithDedupe(currentDeepStack, currentStack)
.globals$deepStack <- c(currentDeepStack, list(currentStack))
on.exit(.globals$deepStack <- origDeepStack, add = TRUE)
}
@@ -253,7 +199,6 @@ doCaptureStack <- function(e) {
calls <- sys.calls()
parents <- sys.parents()
attr(calls, "parents") <- parents
calls <- saveCallStackDigest(calls)
attr(e, "stack.trace") <- calls
}
if (deepStacksEnabled()) {
@@ -280,7 +225,7 @@ withLogErrors <- function(expr,
result <- captureStackTraces(expr)
# Handle expr being an async operation
if (is.promise(result)) {
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")) {
@@ -336,113 +281,86 @@ printStackTrace <- function(cond,
full = get_devmode_option("shiny.fullstacktrace", FALSE),
offset = getOption("shiny.stacktraceoffset", TRUE)) {
stackTraces <- c(
attr(cond, "deep.stack.trace", exact = TRUE),
list(attr(cond, "stack.trace", exact = TRUE))
)
# Stripping of stack traces is the one step where the different stack traces
# interact. So we need to do this in one go, instead of individually within
# printOneStackTrace.
if (!full) {
stripResults <- stripStackTraces(lapply(stackTraces, getCallNames))
} else {
# If full is TRUE, we don't want to strip anything
stripResults <- rep_len(list(TRUE), length(stackTraces))
}
mapply(
seq_along(stackTraces),
rev(stackTraces),
rev(stripResults),
FUN = function(i, trace, stripResult) {
if (is.integer(trace)) {
noun <- if (trace > 1L) "traces" else "trace"
message("[ reached getOption(\"shiny.deepstacktrace\") -- omitted ", trace, " more stack ", noun, " ]")
} else {
if (i != 1) {
message("From earlier call:")
}
printOneStackTrace(
stackTrace = trace,
stripResult = stripResult,
full = full,
offset = offset
)
}
# No mapply return value--we're just printing
NULL
},
SIMPLIFY = FALSE
)
invisible()
}
printOneStackTrace <- function(stackTrace, stripResult, full, offset) {
calls <- offsetSrcrefs(stackTrace, offset = offset)
callNames <- getCallNames(stackTrace)
parents <- attr(stackTrace, "parents", exact = TRUE)
should_drop <- !full
should_strip <- !full
should_prune <- !full
if (should_drop) {
toKeep <- dropTrivialFrames(callNames)
calls <- calls[toKeep]
callNames <- callNames[toKeep]
parents <- parents[toKeep]
stripResult <- stripResult[toKeep]
}
toShow <- rep(TRUE, length(callNames))
if (should_prune) {
toShow <- toShow & pruneStackTrace(parents)
}
if (should_strip) {
toShow <- toShow & stripResult
}
# If we're running in testthat, hide the parts of the stack trace that can
# vary based on how testthat was launched. It's critical that this is not
# happen at the same time as dropTrivialFrames, which happens before
# pruneStackTrace; because dropTrivialTestFrames removes calls from the top
# (or bottom? whichever is the oldest?) of the stack, it breaks `parents`
# which is based on absolute indices of calls. dropTrivialFrames gets away
# with this because it only removes calls from the opposite side of the stack.
toShow <- toShow & dropTrivialTestFrames(callNames)
st <- data.frame(
num = rev(which(toShow)),
call = rev(callNames[toShow]),
loc = rev(getLocs(calls[toShow])),
category = rev(getCallCategories(calls[toShow])),
stringsAsFactors = FALSE
stackTraceCalls <- c(
attr(cond, "deep.stack.trace", exact = TRUE),
list(attr(cond, "stack.trace", exact = TRUE))
)
if (nrow(st) == 0) {
message(" [No stack trace available]")
} else {
width <- floor(log10(max(st$num))) + 1
formatted <- paste0(
" ",
formatC(st$num, width = width),
": ",
mapply(paste0(st$call, st$loc), st$category, FUN = function(name, category) {
if (category == "pkg")
cli::col_silver(name)
else if (category == "user")
cli::style_bold(cli::col_blue(name))
else
cli::col_white(name)
}),
"\n"
)
cat(file = stderr(), formatted, sep = "")
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
toKeep <- lapply(stackTraceCallNames, dropTrivialFrames)
# We apply the list of logical vector indices to each data structure
stackTraceCalls <- mapply(stackTraceCalls, FUN = `[`, toKeep, SIMPLIFY = FALSE)
stackTraceCallNames <- mapply(stackTraceCallNames, FUN = `[`, toKeep, SIMPLIFY = FALSE)
stackTraceParents <- mapply(stackTraceParents, FUN = `[`, toKeep, SIMPLIFY = FALSE)
}
invisible(st)
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
# we need it, but if we need it twice then we don't pay to create it twice.
lapply(stackTraceCallNames, function(st) {
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.
toShow <- mapply(
if (should_strip) stripStackTraces(stackTraceCallNames) else all_true,
if (should_prune) lapply(stackTraceParents, pruneStackTrace) else all_true,
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)),
call = rev(nms[index]),
loc = rev(getLocs(calls[index])),
category = rev(getCallCategories(calls[index])),
stringsAsFactors = FALSE
)
if (i != 1) {
message("From earlier call:")
}
if (nrow(st) == 0) {
message(" [No stack trace available]")
} else {
width <- floor(log10(max(st$num))) + 1
formatted <- paste0(
" ",
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)
}),
"\n"
)
cat(file = stderr(), formatted, sep = "")
}
st
}, SIMPLIFY = FALSE)
invisible()
}
stripStackTraces <- function(stackTraces, values = FALSE) {
@@ -540,34 +458,6 @@ dropTrivialFrames <- function(callnames) {
)
}
dropTrivialTestFrames <- function(callnames) {
if (!identical(Sys.getenv("TESTTHAT_IS_SNAPSHOT"), "true")) {
return(rep_len(TRUE, length(callnames)))
}
hideable <- callnames %in% c(
"test",
"devtools::test",
"test_check",
"testthat::test_check",
"test_dir",
"testthat::test_dir",
"test_file",
"testthat::test_file",
"test_local",
"testthat::test_local"
)
# Remove everything from inception to calling the test
# It shouldn't matter how you get there, just that you're finally testing
toRemove <- max(which(hideable))
c(
rep_len(FALSE, toRemove),
rep_len(TRUE, length(callnames) - toRemove)
)
}
offsetSrcrefs <- function(calls, offset = TRUE) {
if (offset) {
srcrefs <- getSrcRefs(calls)

View File

@@ -1,6 +1,6 @@
#' Shiny Developer Mode
#'
#' @description `r lifecycle::badge("experimental")`
#' @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
@@ -128,12 +128,6 @@ in_devmode <- function() {
!identical(Sys.getenv("TESTTHAT"), "true")
}
in_client_devmode <- function() {
# Client-side devmode enables client-side only dev features without local
# devmode. Currently, the main feature is the client-side error console.
isTRUE(getOption("shiny.client_devmode", FALSE))
}
#' @describeIn devmode Temporarily set Shiny Developer Mode and Developer
#' message verbosity
#' @param code Code to execute with the temporary Dev Mode options set
@@ -196,10 +190,8 @@ devmode_inform <- function(
registered_devmode_options <- NULL
on_load({
registered_devmode_options <- Map$new()
})
#' @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
@@ -348,22 +340,21 @@ get_devmode_option <- function(
}
on_load({
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.autoreload",
"Turning on shiny autoreload. To disable, call `options(shiny.autoreload = FALSE)`",
TRUE
)
register_devmode_option(
"shiny.fullstacktrace",
"Turning on full stack trace. To disable, call `options(shiny.fullstacktrace = 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
)

View File

@@ -1,338 +0,0 @@
#' Task or computation that proceeds in the background
#'
#' @description In normal Shiny reactive code, whenever an observer, calc, or
#' output is busy computing, it blocks the current session from receiving any
#' inputs or attempting to proceed with any other computation related to that
#' session.
#'
#' The `ExtendedTask` class allows you to have an expensive operation that is
#' started by a reactive effect, and whose (eventual) results can be accessed
#' by a regular observer, calc, or output; but during the course of the
#' operation, the current session is completely unblocked, allowing the user
#' to continue using the rest of the app while the operation proceeds in the
#' background.
#'
#' Note that each `ExtendedTask` object does not represent a _single
#' invocation_ of its long-running function. Rather, it's an object that is
#' used to invoke the function with different arguments, keeps track of
#' whether an invocation is in progress, and provides ways to get at the
#' current status or results of the operation. A single `ExtendedTask` object
#' does not permit overlapping invocations: if the `invoke()` method is called
#' before the previous `invoke()` is completed, the new invocation will not
#' begin until the previous invocation has completed.
#'
#' @section `ExtendedTask` versus asynchronous reactives:
#'
#' Shiny has long supported [using
#' \{promises\}](https://rstudio.github.io/promises/articles/promises_06_shiny.html)
#' to write asynchronous observers, calcs, or outputs. You may be wondering
#' what the differences are between those techniques and this class.
#'
#' Asynchronous observers, calcs, and outputs are not--and have never
#' been--designed to let a user start a long-running operation, while keeping
#' that very same (browser) session responsive to other interactions. Instead,
#' they unblock other sessions, so you can take a long-running operation that
#' would normally bring the entire R process to a halt and limit the blocking
#' to just the session that started the operation. (For more details, see the
#' section on ["The Flush
#' Cycle"](https://rstudio.github.io/promises/articles/promises_06_shiny.html#the-flush-cycle).)
#'
#' `ExtendedTask`, on the other hand, invokes an asynchronous function (that
#' is, a function that quickly returns a promise) and allows even that very
#' session to immediately unblock and carry on with other user interactions.
#'
#' @section OpenTelemetry Integration:
#'
#' When an `ExtendedTask` is created, if OpenTelemetry tracing is enabled for
#' `"reactivity"` (see [withOtelCollect()]), the `ExtendedTask` will record
#' spans for each invocation of the task. The tracing level at `invoke()` time
#' does not affect whether spans are recorded; only the tracing level when
#' calling `ExtendedTask$new()` matters.
#'
#' The OTel span will be named based on the label created from the variable the
#' `ExtendedTask` is assigned to. If no label can be determined, the span will
#' be named `<anonymous>`. Similar to other Shiny OpenTelemetry spans, the span
#' will also include source reference attributes and session ID attributes.
#'
#' ```r
#' withOtelCollect("all", {
#' my_task <- ExtendedTask$new(function(...) { ... })
#' })
#'
#' # Span recorded for this invocation: ExtendedTask my_task
#' my_task$invoke(...)
#' ```
#'
#' @examplesIf rlang::is_interactive() && rlang::is_installed("mirai")
#' library(shiny)
#' library(bslib)
#' library(mirai)
#'
#' # Set background processes for running tasks
#' daemons(1)
#' # Reset when the app is stopped
#' onStop(function() daemons(0))
#'
#' ui <- page_fluid(
#' titlePanel("Extended Task Demo"),
#' p(
#' 'Click the button below to perform a "calculation"',
#' "that takes a while to perform."
#' ),
#' input_task_button("recalculate", "Recalculate"),
#' p(textOutput("result"))
#' )
#'
#' server <- function(input, output) {
#' rand_task <- ExtendedTask$new(function() {
#' mirai(
#' {
#' # Slow operation goes here
#' Sys.sleep(2)
#' sample(1:100, 1)
#' }
#' )
#' })
#'
#' # Make button state reflect task.
#' # If using R >=4.1, you can do this instead:
#' # rand_task <- ExtendedTask$new(...) |> bind_task_button("recalculate")
#' bind_task_button(rand_task, "recalculate")
#'
#' observeEvent(input$recalculate, {
#' # Invoke the extended in an observer
#' rand_task$invoke()
#' })
#'
#' output$result <- renderText({
#' # React to updated results when the task completes
#' number <- rand_task$result()
#' paste0("Your number is ", number, ".")
#' })
#' }
#'
#' shinyApp(ui, server)
#'
#' @export
ExtendedTask <- R6Class("ExtendedTask", portable = TRUE, cloneable = FALSE,
public = list(
#' @description
#' Creates a new `ExtendedTask` object. `ExtendedTask` should generally be
#' created either at the top of a server function, or at the top of a module
#' server function.
#'
#' @param func The long-running operation to execute. This should be an
#' asynchronous function, meaning, it should use the
#' [\{promises\}](https://rstudio.github.io/promises/) package, most
#' likely in conjunction with the
#' [\{mirai\}](https://mirai.r-lib.org) or
#' [\{future\}](https://rstudio.github.io/promises/articles/promises_04_futures.html)
#' package. (In short, the return value of `func` should be a
#' [`mirai`][mirai::mirai()], [`Future`][future::future()], `promise`,
#' or something else that [promises::as.promise()] understands.)
#'
#' It's also important that this logic does not read from any
#' reactive inputs/sources, as inputs may change after the function is
#' invoked; instead, if the function needs to access reactive inputs, it
#' should take parameters and the caller of the `invoke()` method should
#' read reactive inputs and pass them as arguments.
initialize = function(func) {
private$func <- func
# Do not show these private reactive values in otel spans
with_no_otel_collect({
private$rv_status <- reactiveVal("initial", label = "ExtendedTask$private$status")
private$rv_value <- reactiveVal(NULL, label = "ExtendedTask$private$value")
private$rv_error <- reactiveVal(NULL, label = "ExtendedTask$private$error")
})
private$invocation_queue <- fastmap::fastqueue()
domain <- getDefaultReactiveDomain()
# Set a label for the reactive values for easier debugging
# Go up an extra sys.call() to get the user's call to ExtendedTask$new()
# The first sys.call() is to `initialize(...)`
call_srcref <- get_call_srcref(-1)
label <- rassignSrcrefToLabel(
call_srcref,
defaultLabel = "<anonymous>"
)
private$otel_span_label <- otel_span_label_extended_task(label, domain = domain)
private$otel_log_label_add_to_queue <- otel_log_label_extended_task_add_to_queue(label, domain = domain)
private$otel_attrs <- c(
otel_srcref_attributes(call_srcref, "ExtendedTask"),
otel_session_id_attrs(domain)
) %||% list()
# Capture this value at init-time, not run-time
# This way, the span is only created if otel was enabled at time of creation... just like other spans
private$is_recording_otel <- has_otel_collect("reactivity")
},
#' @description
#' Starts executing the long-running operation. If this `ExtendedTask` is
#' already running (meaning, a previous call to `invoke()` is not yet
#' complete) then enqueues this invocation until after the current
#' invocation, and any already-enqueued invocation, completes.
#'
#' @param ... Parameters to use for this invocation of the underlying
#' function. If reactive inputs are needed by the underlying function,
#' they should be read by the caller of `invoke` and passed in as
#' arguments.
invoke = function(...) {
args <- rlang::dots_list(..., .ignore_empty = "none")
call <- rlang::caller_call(n = 0)
if (
isolate(private$rv_status()) == "running" ||
private$invocation_queue$size() > 0
) {
otel_log(
private$otel_log_add_to_queue_label,
severity = "debug",
attributes = c(
private$otel_attrs,
list(
queue_size = private$invocation_queue$size() + 1L
)
)
)
private$invocation_queue$add(list(args = args, call = call))
} else {
if (private$is_recording_otel) {
private$otel_span <- start_otel_span(
private$otel_span_label,
attributes = private$otel_attrs
)
otel::local_active_span(private$otel_span)
}
private$do_invoke(args, call = call)
}
invisible(NULL)
},
#' @description
#' This is a reactive read that invalidates the caller when the task's
#' status changes.
#'
#' Returns one of the following values:
#'
#' * `"initial"`: This `ExtendedTask` has not yet been invoked
#' * `"running"`: An invocation is currently running
#' * `"success"`: An invocation completed successfully, and a value can be
#' retrieved via the `result()` method
#' * `"error"`: An invocation completed with an error, which will be
#' re-thrown if you call the `result()` method
status = function() {
private$rv_status()
},
#' @description
#' Attempts to read the results of the most recent invocation. This is a
#' reactive read that invalidates as the task's status changes.
#'
#' The actual behavior differs greatly depending on the current status of
#' the task:
#'
#' * `"initial"`: Throws a silent error (like [`req(FALSE)`][req()]). If
#' this happens during output rendering, the output will be blanked out.
#' * `"running"`: Throws a special silent error that, if it happens during
#' output rendering, makes the output appear "in progress" until further
#' notice.
#' * `"success"`: Returns the return value of the most recent invocation.
#' * `"error"`: Throws whatever error was thrown by the most recent
#' invocation.
#'
#' This method is intended to be called fairly naively by any output or
#' reactive expression that cares about the output--you just have to be
#' aware that if the result isn't ready for whatever reason, processing will
#' stop in much the same way as `req(FALSE)` does, but when the result is
#' ready you'll get invalidated, and when you run again the result should be
#' there.
#'
#' Note that the `result()` method is generally not meant to be used with
#' [observeEvent()], [eventReactive()], [bindEvent()], or [isolate()] as the
#' invalidation will be ignored.
result = function() {
switch (private$rv_status(),
running = req(FALSE, cancelOutput = "progress"),
success = if (private$rv_value()$visible) {
private$rv_value()$value
} else {
invisible(private$rv_value()$value)
},
error = stop(private$rv_error()),
# default case (initial, cancelled)
req(FALSE)
)
}
),
private = list(
func = NULL,
# reactive value with "initial"|"running"|"success"|"error"
rv_status = NULL,
rv_value = NULL,
rv_error = NULL,
invocation_queue = NULL,
otel_span_label = NULL,
otel_log_label_add_to_queue = NULL,
otel_attrs = list(),
is_recording_otel = FALSE,
otel_span = NULL,
do_invoke = function(args, call = NULL) {
private$rv_status("running")
private$rv_value(NULL)
private$rv_error(NULL)
p <- promise_resolve(
maskReactiveContext(do.call(private$func, args))
)
p <- promises::then(
p,
onFulfilled = function(value, .visible) {
if (is_otel_span(private$otel_span)) {
private$otel_span$end(status_code = "ok")
private$otel_span <- NULL
}
private$on_success(list(value = value, visible = .visible))
},
onRejected = function(error) {
if (is_otel_span(private$otel_span)) {
private$otel_span$end(status_code = "error")
private$otel_span <- NULL
}
private$on_error(error, call = call)
}
)
promises::finally(p, onFinally = function() {
if (private$invocation_queue$size() > 0) {
next_call <- private$invocation_queue$remove()
private$do_invoke(next_call$args, next_call$call)
}
})
invisible(NULL)
},
on_error = function(err, call = NULL) {
cli::cli_warn(
"ERROR: An error occurred when invoking the ExtendedTask.",
parent = err,
call = call
)
private$rv_status("error")
private$rv_error(err)
},
on_success = function(value) {
private$rv_status("success")
private$rv_value(value)
}
)
)

View File

@@ -7,25 +7,19 @@
# the private seed during load.
withPrivateSeed(set.seed(NULL))
for (expr in on_load_exprs) {
eval(expr, envir = environment(.onLoad))
}
# 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")
# Shiny 1.4.0 bumps jQuery 1.x to 3.x, which caused a problem
# with static-rendering of htmlwidgets, and htmlwidgets 1.5
# includes a fix for this problem
# https://github.com/rstudio/shiny/issues/2630
register_upgrade_message("htmlwidgets", 1.5)
}
on_load_exprs <- list()
# Register an expression to be evaluated when the package is loaded (in the
# .onLoad function).
on_load <- function(expr) {
on_load_exprs[[length(on_load_exprs) + 1]] <<- substitute(expr)
}
on_load({
IS_SHINY_LOCAL_PKG <- exists(".__DEVTOOLS__")
})

185
R/graph.R
View File

@@ -1,3 +1,32 @@
# Check that the version of an suggested package satisfies the requirements
#
# @param package The name of the suggested package
# @param version The version of the package
check_suggested <- function(package, version = NULL) {
if (is_installed(package, version)) {
return()
}
msg <- paste0(
sQuote(package),
if (is.na(version %||% NA)) "" else paste0("(>= ", version, ")"),
" must be installed for this functionality."
)
if (interactive()) {
message(msg, "\nWould you like to install it?")
if (utils::menu(c("Yes", "No")) == 1) {
return(utils::install.packages(package))
}
}
stop(msg, call. = FALSE)
}
# domain is like session
@@ -19,7 +48,7 @@ reactIdStr <- function(num) {
#' dependencies and execution in your application.
#'
#' To use the reactive log visualizer, start with a fresh R session and
#' run the command `reactlog::reactlog_enable()`; then launch your
#' run the command `options(shiny.reactlog=TRUE)`; then launch your
#' application in the usual way (e.g. using [runApp()]). At
#' any time you can hit Ctrl+F3 (or for Mac users, Command+F3) in your
#' web browser to launch the reactive log visualization.
@@ -42,20 +71,16 @@ reactIdStr <- function(num) {
#' call `reactlogShow()` explicitly.
#'
#' For security and performance reasons, do not enable
#' `options(shiny.reactlog=TRUE)` (or `reactlog::reactlog_enable()`) in
#' production environments. When the option is enabled, it's possible
#' for any user of your app to see at least some of the source code of
#' your reactive expressions and observers. In addition, reactlog
#' should be considered a memory leak as it will constantly grow and
#' will never reset until the R session is restarted.
#' `shiny.reactlog` in production environments. When the option is
#' enabled, it's possible for any user of your app to see at least some
#' of the source code of your reactive expressions and observers.
#'
#' @name reactlog
NULL
#' @describeIn reactlog Return a list of reactive information. Can be used in
#' conjunction with [reactlog::reactlog_show] to later display the reactlog
#' graph.
#' @describeIn reactlog Return a list of reactive information. Can be used in conjunction with
#' [reactlog::reactlog_show] to later display the reactlog graph.
#' @export
reactlog <- function() {
rLog$asList()
@@ -70,34 +95,12 @@ reactlogShow <- function(time = TRUE) {
reactlog::reactlog_show(reactlog(), time = time)
}
#' @describeIn reactlog Resets the entire reactlog stack. Useful for debugging
#' and removing all prior reactive history.
#' @describeIn reactlog Resets the entire reactlog stack. Useful for debugging and removing all prior reactive history.
#' @export
reactlogReset <- function() {
rLog$reset()
}
#' @describeIn reactlog Adds "mark" entry into the reactlog stack. This is
#' useful for programmatically adding a marked entry in the reactlog, rather
#' than using your keyboard's key combination.
#'
#' For example, we can _mark_ the reactlog at the beginning of an
#' `observeEvent`'s calculation:
#' ```r
#' observeEvent(input$my_event_trigger, {
#' # Add a mark in the reactlog
#' reactlogAddMark()
#' # Run your regular event reaction code here...
#' ....
#' })
#' ```
#' @param session The Shiny session to assign the mark to. Defaults to the
#' current session.
#' @export
reactlogAddMark <- function(session = getDefaultReactiveDomain()) {
rLog$userMark(session)
}
# called in "/reactlog" middleware
renderReactlog <- function(sessionToken = NULL, time = TRUE) {
check_reactlog()
@@ -107,15 +110,34 @@ renderReactlog <- function(sessionToken = NULL, time = TRUE) {
time = time
)
}
check_reactlog <- function() {
if (!is_installed("reactlog", reactlog_min_version)) {
rlang::check_installed("reactlog", reactlog_min_version)
}
check_suggested("reactlog", reactlog_version())
}
# 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)
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
}
})
# Should match the (suggested) version in DESCRIPTION file
reactlog_min_version <- "1.0.0"
RLog <- R6Class(
"RLog",
@@ -123,6 +145,7 @@ RLog <- R6Class(
private = list(
option = "shiny.reactlog",
msgOption = "shiny.reactlog.console",
appendEntry = function(domain, logEntry) {
if (self$isLogging()) {
sessionToken <- if (is.null(domain)) NULL else domain$token
@@ -137,19 +160,20 @@ RLog <- R6Class(
public = list(
msg = "<MessageLogger>",
logStack = "<Stack>",
noReactIdLabel = "NoCtxReactId",
noReactId = reactIdStr("NoCtxReactId"),
dummyReactIdLabel = "DummyReactId",
dummyReactId = reactIdStr("DummyReactId"),
asList = function() {
ret <- self$logStack$as_list()
attr(ret, "version") <- "1"
ret
},
ctxIdStr = function(ctxId) {
if (is.null(ctxId) || identical(ctxId, "")) {
return(NULL)
}
if (is.null(ctxId) || identical(ctxId, "")) return(NULL)
paste0("ctx", ctxId)
},
namesIdStr = function(reactId) {
@@ -164,6 +188,7 @@ RLog <- R6Class(
keyIdStr = function(reactId, key) {
paste0(reactId, "$", key)
},
valueStr = function(value, n = 200) {
if (!self$isLogging()) {
# return a placeholder string to avoid calling str
@@ -173,9 +198,10 @@ RLog <- R6Class(
# only capture the first level of the object
utils::capture.output(utils::str(value, max.level = 1))
})
outputTxt <- paste0(output, collapse = "\n")
outputTxt <- paste0(output, collapse="\n")
msg$shortenString(outputTxt, n = n)
},
initialize = function(rlogOption = "shiny.reactlog", msgOption = "shiny.reactlog.console") {
private$option <- rlogOption
private$msgOption <- msgOption
@@ -195,6 +221,7 @@ RLog <- R6Class(
isLogging = function() {
isTRUE(getOption(private$option, FALSE))
},
define = function(reactId, value, label, type, domain) {
valueStr <- self$valueStr(value)
if (msg$hasReact(reactId)) {
@@ -225,10 +252,9 @@ RLog <- R6Class(
defineObserver = function(reactId, label, domain) {
self$define(reactId, value = NULL, label, "observer", domain)
},
dependsOn = function(reactId, depOnReactId, ctxId, domain) {
if (is.null(reactId)) {
return()
}
if (is.null(reactId)) return()
ctxId <- ctxIdStr(ctxId)
msg$log("dependsOn:", msg$reactStr(reactId), " on", msg$reactStr(depOnReactId), msg$ctxStr(ctxId))
private$appendEntry(domain, list(
@@ -241,6 +267,7 @@ RLog <- R6Class(
dependsOnKey = function(reactId, depOnReactId, key, ctxId, domain) {
self$dependsOn(reactId, self$keyIdStr(depOnReactId, key), ctxId, domain)
},
dependsOnRemove = function(reactId, depOnReactId, ctxId, domain) {
ctxId <- self$ctxIdStr(ctxId)
msg$log("dependsOnRemove:", msg$reactStr(reactId), " on", msg$reactStr(depOnReactId), msg$ctxStr(ctxId))
@@ -254,6 +281,7 @@ RLog <- R6Class(
dependsOnKeyRemove = function(reactId, depOnReactId, key, ctxId, domain) {
self$dependsOnRemove(reactId, self$keyIdStr(depOnReactId, key), ctxId, domain)
},
createContext = function(ctxId, label, type, prevCtxId, domain) {
ctxId <- self$ctxIdStr(ctxId)
prevCtxId <- self$ctxIdStr(prevCtxId)
@@ -264,9 +292,10 @@ RLog <- R6Class(
label = msg$shortenString(label),
type = type,
prevCtxId = prevCtxId,
srcref = as.vector(attr(label, "srcref")), srcfile = attr(label, "srcfile")
srcref = as.vector(attr(label, "srcref")), srcfile=attr(label, "srcfile")
))
},
enter = function(reactId, ctxId, type, domain) {
ctxId <- self$ctxIdStr(ctxId)
if (identical(type, "isolate")) {
@@ -309,6 +338,7 @@ RLog <- R6Class(
))
}
},
valueChange = function(reactId, value, domain) {
valueStr <- self$valueStr(value)
msg$log("valueChange:", msg$reactStr(reactId), msg$valueStr(valueStr))
@@ -330,6 +360,8 @@ RLog <- R6Class(
valueChangeKey = function(reactId, key, value, domain) {
self$valueChange(self$keyIdStr(reactId, key), value, domain)
},
invalidateStart = function(reactId, ctxId, type, domain) {
ctxId <- self$ctxIdStr(ctxId)
if (identical(type, "isolate")) {
@@ -372,6 +404,7 @@ RLog <- R6Class(
))
}
},
invalidateLater = function(reactId, runningCtx, millis, domain) {
msg$log("invalidateLater: ", millis, "ms", msg$reactStr(reactId), msg$ctxStr(runningCtx))
private$appendEntry(domain, list(
@@ -381,12 +414,14 @@ RLog <- R6Class(
millis = millis
))
},
idle = function(domain = NULL) {
msg$log("idle")
private$appendEntry(domain, list(
action = "idle"
))
},
asyncStart = function(domain = NULL) {
msg$log("asyncStart")
private$appendEntry(domain, list(
@@ -399,6 +434,7 @@ RLog <- R6Class(
action = "asyncStop"
))
},
freezeReactiveVal = function(reactId, domain) {
msg$log("freeze:", msg$reactStr(reactId))
private$appendEntry(domain, list(
@@ -409,6 +445,7 @@ RLog <- R6Class(
freezeReactiveKey = function(reactId, key, domain) {
self$freezeReactiveVal(self$keyIdStr(reactId, key), domain)
},
thawReactiveVal = function(reactId, domain) {
msg$log("thaw:", msg$reactStr(reactId))
private$appendEntry(domain, list(
@@ -419,60 +456,54 @@ RLog <- R6Class(
thawReactiveKey = function(reactId, key, domain) {
self$thawReactiveVal(self$keyIdStr(reactId, key), domain)
},
userMark = function(domain = NULL) {
msg$log("userMark")
private$appendEntry(domain, list(
action = "userMark"
))
}
)
)
MessageLogger <- R6Class(
MessageLogger = R6Class(
"MessageLogger",
portable = FALSE,
public = list(
depth = 0L,
reactCache = list(),
option = "shiny.reactlog.console",
initialize = function(option = "shiny.reactlog.console", depth = 0L) {
if (!missing(depth)) self$depth <- depth
if (!missing(option)) self$option <- option
},
isLogging = function() {
isTRUE(getOption(self$option))
},
isNotLogging = function() {
!isTRUE(getOption(self$option))
! isTRUE(getOption(self$option))
},
depthIncrement = function() {
if (self$isNotLogging()) {
return(NULL)
}
if (self$isNotLogging()) return(NULL)
self$depth <- self$depth + 1L
},
depthDecrement = function() {
if (self$isNotLogging()) {
return(NULL)
}
if (self$isNotLogging()) return(NULL)
self$depth <- self$depth - 1L
},
hasReact = function(reactId) {
if (self$isNotLogging()) {
return(FALSE)
}
if (self$isNotLogging()) return(FALSE)
!is.null(self$getReact(reactId))
},
getReact = function(reactId, force = FALSE) {
if (identical(force, FALSE) && self$isNotLogging()) {
return(NULL)
}
if (identical(force, FALSE) && self$isNotLogging()) return(NULL)
self$reactCache[[reactId]]
},
setReact = function(reactObj, force = FALSE) {
if (identical(force, FALSE) && self$isNotLogging()) {
return(NULL)
}
if (identical(force, FALSE) && self$isNotLogging()) return(NULL)
self$reactCache[[reactObj$reactId]] <- reactObj
},
shortenString = function(txt, n = 250) {
@@ -491,17 +522,13 @@ MessageLogger <- R6Class(
},
valueStr = function(valueStr) {
paste0(
" '", self$shortenString(self$singleLine(valueStr)), "'"
" '", self$shortenString(self$singleLine(valueStr)), "'"
)
},
reactStr = function(reactId) {
if (self$isNotLogging()) {
return(NULL)
}
if (self$isNotLogging()) return(NULL)
reactInfo <- self$getReact(reactId)
if (is.null(reactInfo)) {
return(" <UNKNOWN_REACTID>")
}
if (is.null(reactInfo)) return(" <UNKNOWN_REACTID>")
paste0(
" ", reactInfo$reactId, ":'", self$shortenString(self$singleLine(reactInfo$label)), "'"
)
@@ -510,15 +537,11 @@ MessageLogger <- R6Class(
self$ctxStr(ctxId = NULL, type = type)
},
ctxStr = function(ctxId = NULL, type = NULL) {
if (self$isNotLogging()) {
return(NULL)
}
if (self$isNotLogging()) return(NULL)
self$ctxPrevCtxStr(ctxId = ctxId, prevCtxId = NULL, type = type)
},
ctxPrevCtxStr = function(ctxId = NULL, prevCtxId = NULL, type = NULL, preCtxIdTxt = " in ") {
if (self$isNotLogging()) {
return(NULL)
}
if (self$isNotLogging()) return(NULL)
paste0(
if (!is.null(ctxId)) paste0(preCtxIdTxt, ctxId),
if (!is.null(prevCtxId)) paste0(" from ", prevCtxId),
@@ -526,9 +549,7 @@ MessageLogger <- R6Class(
)
},
log = function(...) {
if (self$isNotLogging()) {
return(NULL)
}
if (self$isNotLogging()) return(NULL)
msg <- paste0(
paste0(rep("= ", depth), collapse = ""), "- ", paste0(..., collapse = ""),
collapse = ""
@@ -538,6 +559,4 @@ MessageLogger <- R6Class(
)
)
on_load({
rLog <- RLog$new("shiny.reactlog", "shiny.reactlog.console")
})
rLog <- RLog$new("shiny.reactlog", "shiny.reactlog.console")

View File

@@ -14,7 +14,7 @@ NULL
#' depending on the values in the query string / hash (e.g. instead of basing
#' the conditional on an input or a calculated reactive, you can base it on the
#' query string). However, note that, if you're changing the query string / hash
#' programmatically from within the server code, you must use
#' programatically from within the server code, you must use
#' `updateQueryString(_yourNewQueryString_, mode = "push")`. The default
#' `mode` for `updateQueryString` is `"replace"`, which doesn't
#' raise any events, so any observers or reactives that depend on it will

View File

@@ -182,8 +182,8 @@ brushedPoints <- function(df, brush, xvar = NULL, yvar = NULL,
# $ xmax : num 3.78
# $ ymin : num 17.1
# $ ymax : num 20.4
# $ panelvar1: chr "6"
# $ panelvar2: chr "0
# $ panelvar1: int 6
# $ panelvar2: int 0
# $ coords_css:List of 4
# ..$ xmin: int 260
# ..$ xmax: int 298
@@ -367,8 +367,8 @@ nearPoints <- function(df, coordinfo, xvar = NULL, yvar = NULL,
# $ img_css_ratio:List of 2
# ..$ x: num 1.25
# ..$ y: num 1.25
# $ panelvar1 : chr "6"
# $ panelvar2 : chr "0"
# $ panelvar1 : int 6
# $ panelvar2 : int 0
# $ mapping :List of 4
# ..$ x : chr "wt"
# ..$ y : chr "mpg"

View File

@@ -11,13 +11,7 @@ startPNG <- function(filename, width, height, res, ...) {
grDevices::png
}
args <- list2(filename = filename, width = width, height = height, res = res, ...)
# It's possible for width/height to be NULL/numeric(0) (e.g., when using
# suspendWhenHidden=F w/ tabsetPanel(), see rstudio/shiny#1409), so when
# this happens let the device determine what the default size should be.
if (length(args$width) == 0) args$width <- NULL
if (length(args$height) == 0) args$height <- NULL
args <- rlang::list2(filename=filename, width=width, height=height, res=res, ...)
# Set a smarter default for the device's bg argument (based on thematic's global state).
# Note that, technically, this is really only needed for CairoPNG, since the other
@@ -70,10 +64,6 @@ startPNG <- function(filename, width, height, res, ...) {
#' * Otherwise, use [grDevices::png()]. In this case, Linux and Windows
#' may not antialias some point shapes, resulting in poor quality output.
#'
#' @details
#' A `NULL` value provided to `width` or `height` is ignored (i.e., the
#' default `width` or `height` of the graphics device is used).
#'
#' @param func A function that generates a plot.
#' @param filename The name of the output file. Defaults to a temp file with
#' extension `.png`.
@@ -100,7 +90,7 @@ plotPNG <- function(func, filename=tempfile(fileext='.png'),
createGraphicsDevicePromiseDomain <- function(which = dev.cur()) {
force(which)
new_promise_domain(
promises::new_promise_domain(
wrapOnFulfilled = function(onFulfilled) {
force(onFulfilled)
function(...) {

View File

@@ -7,8 +7,6 @@
#' @param label The contents of the button or link--usually a text label, but
#' you could also use any other HTML, like an image.
#' @param icon An optional [icon()] to appear on the button.
#' @param disabled If `TRUE`, the button will not be clickable. Use
#' [updateActionButton()] to dynamically enable/disable the button.
#' @param ... Named attributes to be applied to the button or link.
#'
#' @family input elements
@@ -51,29 +49,16 @@
#' * Event handlers (e.g., [observeEvent()], [eventReactive()]) won't execute on initial load.
#' * Input validation (e.g., [req()], [need()]) will fail on initial load.
#' @export
actionButton <- function(inputId, label, icon = NULL, width = NULL,
disabled = FALSE, ...) {
actionButton <- function(inputId, label, icon = NULL, width = NULL, ...) {
value <- restoreInput(id = inputId, default = NULL)
icon <- validateIcon(icon)
if (!is.null(icon)) {
icon <- span(icon, class = "action-icon")
}
if (!is.null(label)) {
label <- span(label, class = "action-label")
}
tags$button(
id = inputId,
tags$button(id=inputId,
style = css(width = validateCssUnit(width)),
type = "button",
class = "btn btn-default action-button",
type="button",
class="btn btn-default action-button",
`data-val` = value,
disabled = if (isTRUE(disabled)) NA else NULL,
icon, label,
list(validateIcon(icon), label),
...
)
}
@@ -83,40 +68,30 @@ actionButton <- function(inputId, label, icon = NULL, width = NULL,
actionLink <- function(inputId, label, icon = NULL, ...) {
value <- restoreInput(id = inputId, default = NULL)
icon <- validateIcon(icon)
if (!is.null(icon)) {
icon <- span(icon, class = "action-icon")
}
if (!is.null(label)) {
label <- span(label, class = "action-label")
}
tags$a(
id = inputId,
href = "#",
class = "action-button action-link",
tags$a(id=inputId,
href="#",
class="action-button",
`data-val` = value,
icon, label,
list(validateIcon(icon), label),
...
)
}
# Throw an informative warning if icon isn't html-ish
# Check that the icon parameter is valid:
# 1) Check if the user wants to actually add an icon:
# -- if icon=NULL, it means leave the icon unchanged
# -- if icon=character(0), it means don't add an icon or, more usefully,
# remove the previous icon
# 2) If so, check that the icon has the right format (this does not check whether
# it is a *real* icon - currently that would require a massive cross reference
# with the "font-awesome" and the "glyphicon" libraries)
validateIcon <- function(icon) {
if (length(icon) == 0) {
if (is.null(icon) || identical(icon, character(0))) {
return(icon)
} else if (inherits(icon, "shiny.tag") && icon$name == "i") {
return(icon)
} else {
stop("Invalid icon. Use Shiny's 'icon()' function to generate a valid icon")
}
if (!isTagLike(icon)) {
rlang::warn(
c(
"It appears that a non-HTML value was provided to `icon`.",
i = "Try using a `shiny::icon()` (or an equivalent) to get an icon."
),
class = "shiny-validate-icon"
)
}
icon
}

View File

@@ -31,7 +31,7 @@ checkboxInput <- function(inputId, label, value = FALSE, width = NULL) {
value <- restoreInput(id = inputId, default = value)
inputTag <- tags$input(id = inputId, type="checkbox", class = "shiny-input-checkbox")
inputTag <- tags$input(id = inputId, type="checkbox")
if (!is.null(value) && value)
inputTag$attribs$checked <- "checked"

View File

@@ -153,12 +153,6 @@ datePickerDependency <- function(theme) {
)
}
datePickerSass <- function() {
sass::sass_file(
system_file(package = "shiny", "www/shared/datepicker/scss/build3.scss")
)
}
datePickerCSS <- function(theme) {
if (!is_bs_theme(theme)) {
return(htmlDependency(
@@ -170,8 +164,10 @@ datePickerCSS <- function(theme) {
))
}
scss_file <- system_file(package = "shiny", "www/shared/datepicker/scss/build3.scss")
bslib::bs_dependency(
input = datePickerSass(),
input = sass::sass_file(scss_file),
theme = theme,
name = "bootstrap-datepicker",
version = version_bs_date_picker,

View File

@@ -2,13 +2,8 @@
#'
#' Create a file upload control that can be used to upload one or more files.
#'
#' Whenever a file upload completes, the corresponding input variable is set to
#' a dataframe. See the `Server value` section.
#'
#' Each time files are uploaded, they are written to a new random subdirectory
#' inside of R's process-level temporary directory. The Shiny user session keeps
#' track of all uploads in the session, and when the session ends, Shiny deletes
#' all of the subdirectories where files where uploaded to.
#' Whenever a file upload completes, the corresponding input variable is set
#' to a dataframe. See the `Server value` section.
#'
#' @family input elements
#'
@@ -16,21 +11,21 @@
#' @param multiple Whether the user should be allowed to select and upload
#' multiple files at once. **Does not work on older browsers, including
#' Internet Explorer 9 and earlier.**
#' @param accept A character vector of "unique file type specifiers" which gives
#' the browser a hint as to the type of file the server expects. Many browsers
#' use this prevent the user from selecting an invalid file.
#' @param accept A character vector of "unique file type specifiers" which
#' gives the browser a hint as to the type of file the server expects.
#' Many browsers use this prevent the user from selecting an invalid file.
#'
#' A unique file type specifier can be:
#' * A case insensitive extension like `.csv` or `.rds`.
#' * A valid MIME type, like `text/plain` or `application/pdf`
#' * One of `audio/*`, `video/*`, or `image/*` meaning any audio, video,
#' or image type, respectively.
#' or image type, respectively.
#' @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
#' 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
@@ -72,9 +67,7 @@
#' }
#'
#' @section Server value:
#'
#' A `data.frame` that contains one row for each selected file, and following
#' columns:
#' A `data.frame` that contains one row for each selected file, and following columns:
#' \describe{
#' \item{`name`}{The filename provided by the web browser. This is
#' **not** the path to read to get at the actual data that was uploaded
@@ -108,7 +101,6 @@ fileInput <- function(inputId, label, multiple = FALSE, accept = NULL,
inputTag <- tags$input(
id = inputId,
class = "shiny-input-file",
name = inputId,
type = "file",
# Don't use "display: none;" style, which causes keyboard accessibility issue; instead use the following workaround: https://css-tricks.com/places-its-tempting-to-use-display-none-but-dont/

View File

@@ -29,36 +29,22 @@
#' A numeric vector of length 1.
#'
#' @export
numericInput <- function(
inputId,
label,
value,
min = NA,
max = NA,
step = NA,
width = NULL,
...,
updateOn = c("change", "blur")
) {
rlang::check_dots_empty()
updateOn <- rlang::arg_match(updateOn)
numericInput <- function(inputId, label, value, min = NA, max = NA, step = NA,
width = NULL) {
value <- restoreInput(id = inputId, default = value)
# build input tag
inputTag <- tags$input(
id = inputId,
type = "number",
class = "shiny-input-number form-control",
value = formatNoSci(value),
`data-update-on` = updateOn
)
if (!is.na(min)) inputTag$attribs$min = min
if (!is.na(max)) inputTag$attribs$max = max
if (!is.na(step)) inputTag$attribs$step = step
inputTag <- tags$input(id = inputId, type = "number", class="form-control",
value = formatNoSci(value))
if (!is.na(min))
inputTag$attribs$min = min
if (!is.na(max))
inputTag$attribs$max = max
if (!is.na(step))
inputTag$attribs$step = step
div(
class = "form-group shiny-input-container",
div(class = "form-group shiny-input-container",
style = css(width = validateCssUnit(width)),
shinyInputLabel(inputId, label),
inputTag

View File

@@ -30,29 +30,12 @@
#' shinyApp(ui, server)
#' }
#' @export
passwordInput <- function(
inputId,
label,
value = "",
width = NULL,
placeholder = NULL,
...,
updateOn = c("change", "blur")
) {
rlang::check_dots_empty()
updateOn <- rlang::arg_match(updateOn)
div(
class = "form-group shiny-input-container",
passwordInput <- function(inputId, label, value = "", width = NULL,
placeholder = NULL) {
div(class = "form-group shiny-input-container",
style = css(width = validateCssUnit(width)),
shinyInputLabel(inputId, label),
tags$input(
id = inputId,
type = "password",
class = "shiny-input-password form-control",
value = value,
placeholder = placeholder,
`data-update-on` = updateOn
)
tags$input(id = inputId, type="password", class="form-control", value=value,
placeholder = placeholder)
)
}

View File

@@ -4,7 +4,7 @@
#' from a list of values.
#'
#' By default, `selectInput()` and `selectizeInput()` use the JavaScript library
#' \pkg{selectize.js} (<https://selectize.dev/>) instead of
#' \pkg{selectize.js} (<https://github.com/selectize/selectize.js>) instead of
#' the basic select input element. To use the standard HTML select input
#' element, use `selectInput()` with `selectize=FALSE`.
#'
@@ -106,7 +106,6 @@ selectInput <- function(inputId, label, choices, selected = NULL,
# create select tag and add options
selectTag <- tags$select(
id = inputId,
class = "shiny-input-select",
class = if (!selectize) "form-control",
size = size,
selectOptions(choices, selected, inputId, selectize)
@@ -173,7 +172,7 @@ needOptgroup <- function(choices) {
#' @rdname selectInput
#' @param ... Arguments passed to `selectInput()`.
#' @param options A list of options. See the documentation of \pkg{selectize.js}(<https://selectize.dev/docs/usage>)
#' @param options A list of options. See the documentation of \pkg{selectize.js}
#' for possible options (character option values inside [base::I()] will
#' be treated as literal JavaScript code; see [renderDataTable()]
#' for details).
@@ -241,8 +240,11 @@ selectizeDependencyFunc <- function(theme) {
return(selectizeStaticDependency(version_selectize))
}
selectizeDir <- system_file(package = "shiny", "www/shared/selectize/")
bs_version <- bslib::theme_version(theme)
stylesheet <- file.path(
selectizeDir, "scss", paste0("selectize.bootstrap", bs_version, ".scss")
)
# It'd be cleaner to ship the JS in a separate, href-based,
# HTML dependency (which we currently do for other themable widgets),
# but DT, crosstalk, and maybe other pkgs include selectize JS/CSS
@@ -250,11 +252,11 @@ selectizeDependencyFunc <- function(theme) {
# name, the JS/CSS would be loaded/included twice, which leads to
# strange issues, especially since we now include a 3rd party
# accessibility plugin https://github.com/rstudio/shiny/pull/3153
selectizeDir <- system_file(package = "shiny", "www/shared/selectize/")
script <- file.path(selectizeDir, selectizeScripts())
script <- file.path(
selectizeDir, c("js/selectize.min.js", "accessibility/js/selectize-plugin-a11y.min.js")
)
bslib::bs_dependency(
input = selectizeSass(bs_version),
input = sass::sass_file(stylesheet),
theme = theme,
name = "selectize",
version = version_selectize,
@@ -263,14 +265,6 @@ selectizeDependencyFunc <- function(theme) {
)
}
selectizeSass <- function(bs_version) {
selectizeDir <- system_file(package = "shiny", "www/shared/selectize/")
stylesheet <- file.path(
selectizeDir, "scss", paste0("selectize.bootstrap", bs_version, ".scss")
)
sass::sass_file(stylesheet)
}
selectizeStaticDependency <- function(version) {
htmlDependency(
"selectize",
@@ -278,18 +272,10 @@ selectizeStaticDependency <- function(version) {
src = "www/shared/selectize",
package = "shiny",
stylesheet = "css/selectize.bootstrap3.css",
script = selectizeScripts()
)
}
selectizeScripts <- function() {
isMinified <- isTRUE(get_devmode_option("shiny.minified", TRUE))
paste0(
c(
"js/selectize",
"accessibility/js/selectize-plugin-a11y"
),
if (isMinified) ".min.js" else ".js"
script = c(
"js/selectize.min.js",
"accessibility/js/selectize-plugin-a11y.min.js"
)
)
}
@@ -301,7 +287,7 @@ selectizeScripts <- function() {
#'
#' By default, `varSelectInput()` and `selectizeInput()` use the
#' JavaScript library \pkg{selectize.js}
#' (<https://selectize.dev/>) to instead of the basic
#' (<https://github.com/selectize/selectize.js>) to instead of the basic
#' select input element. To use the standard HTML select input element, use
#' `selectInput()` with `selectize=FALSE`.
#'
@@ -397,7 +383,7 @@ varSelectInput <- function(
#' @rdname varSelectInput
#' @param ... Arguments passed to `varSelectInput()`.
#' @param options A list of options. See the documentation of \pkg{selectize.js}(<https://selectize.dev/docs/usage>)
#' @param options A list of options. See the documentation of \pkg{selectize.js}
#' for possible options (character option values inside [base::I()] will
#' be treated as literal JavaScript code; see [renderDataTable()]
#' for details).

View File

@@ -222,15 +222,6 @@ ionRangeSliderDependency <- function() {
)
}
ionRangeSliderDependencySass <- function() {
list(
list(accent = "$component-active-bg"),
sass::sass_file(
system_file(package = "shiny", "www/shared/ionrangeslider/scss/shiny.scss")
)
)
}
ionRangeSliderDependencyCSS <- function(theme) {
if (!is_bs_theme(theme)) {
return(htmlDependency(
@@ -243,7 +234,12 @@ ionRangeSliderDependencyCSS <- function(theme) {
}
bslib::bs_dependency(
input = ionRangeSliderDependencySass(),
input = list(
list(accent = "$component-active-bg"),
sass::sass_file(
system_file(package = "shiny", "www/shared/ionrangeslider/scss/shiny.scss")
)
),
theme = theme,
name = "ionRangeSlider",
version = version_ion_range_slider,

View File

@@ -57,7 +57,7 @@ submitButton <- function(text = "Apply Changes", icon = NULL, width = NULL) {
div(
tags$button(
type="submit",
class="btn btn-primary shiny-submit-button",
class="btn btn-primary",
style = css(width = validateCssUnit(width)),
list(icon, text)
)

View File

@@ -10,14 +10,6 @@
#' @param placeholder A character string giving the user a hint as to what can
#' be entered into the control. Internet Explorer 8 and 9 do not support this
#' option.
#' @param ... Ignored, included to require named arguments and for future
#' feature expansion.
#' @param updateOn A character vector specifying when the input should be
#' updated. Options are `"change"` (default) and `"blur"`. Use `"change"` to
#' update the input immediately whenever the value changes. Use `"blur"`to
#' delay the input update until the input loses focus (the user moves away
#' from the input), or when Enter is pressed (or Cmd/Ctrl + Enter for
#' [textAreaInput()]).
#' @return A text input control that can be added to a UI definition.
#'
#' @family input elements
@@ -42,31 +34,15 @@
#' unless `value` is provided.
#'
#' @export
textInput <- function(
inputId,
label,
value = "",
width = NULL,
placeholder = NULL,
...,
updateOn = c("change", "blur")
) {
rlang::check_dots_empty()
updateOn <- rlang::arg_match(updateOn)
textInput <- function(inputId, label, value = "", width = NULL,
placeholder = NULL) {
value <- restoreInput(id = inputId, default = value)
div(
class = "form-group shiny-input-container",
div(class = "form-group shiny-input-container",
style = css(width = validateCssUnit(width)),
shinyInputLabel(inputId, label),
tags$input(
id = inputId,
type = "text",
class = "shiny-input-text form-control",
value = value,
placeholder = placeholder,
`data-update-on` = updateOn
)
tags$input(id = inputId, type="text", class="form-control", value=value,
placeholder = placeholder)
)
}

View File

@@ -16,8 +16,6 @@
#' @param resize Which directions the textarea box can be resized. Can be one of
#' `"both"`, `"none"`, `"vertical"`, and `"horizontal"`. The default, `NULL`,
#' will use the client browser's default setting for resizing textareas.
#' @param autoresize If `TRUE`, the textarea will automatically resize to fit
#' the input text.
#' @return A textarea input control that can be added to a UI definition.
#'
#' @family input elements
@@ -43,22 +41,8 @@
#' unless `value` is provided.
#'
#' @export
textAreaInput <- function(
inputId,
label,
value = "",
width = NULL,
height = NULL,
cols = NULL,
rows = NULL,
placeholder = NULL,
resize = NULL,
...,
autoresize = FALSE,
updateOn = c("change", "blur")
) {
rlang::check_dots_empty()
updateOn <- rlang::arg_match(updateOn)
textAreaInput <- function(inputId, label, value = "", width = NULL, height = NULL,
cols = NULL, rows = NULL, placeholder = NULL, resize = NULL) {
value <- restoreInput(id = inputId, default = value)
@@ -66,30 +50,23 @@ textAreaInput <- function(
resize <- match.arg(resize, c("both", "none", "vertical", "horizontal"))
}
classes <- "form-control"
if (autoresize) {
classes <- c(classes, "textarea-autoresize")
if (is.null(rows)) {
rows <- 1
}
}
style <- css(
# The width is specified on the parent div.
width = if (!is.null(width)) "width: 100%;",
height = validateCssUnit(height),
resize = resize
)
div(
class = "shiny-input-textarea form-group shiny-input-container",
style = css(width = validateCssUnit(width)),
div(class = "form-group shiny-input-container",
shinyInputLabel(inputId, label),
style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
tags$textarea(
id = inputId,
class = classes,
class = "form-control",
placeholder = placeholder,
style = css(
width = if (!is.null(width)) "100%",
height = validateCssUnit(height),
resize = resize
),
style = style,
rows = rows,
cols = cols,
`data-update-on` = updateOn,
value
)
)

View File

@@ -1,6 +1,6 @@
#' Insert and remove UI objects
#'
#' These functions allow you to dynamically add and remove arbitrary UI
#' These functions allow you to dynamically add and remove arbirary UI
#' into your app, whenever you want, as many times as you want.
#' Unlike [renderUI()], the UI generated with `insertUI()` is persistent:
#' once it's created, it stays there until removed by `removeUI()`. Each
@@ -11,7 +11,7 @@
#' function.
#'
#' It's particularly useful to pair `removeUI` with `insertUI()`, but there is
#' no restriction on what you can use it on. Any element that can be selected
#' no restriction on what you can use on. Any element that can be selected
#' through a jQuery selector can be removed through this function.
#'
#' @param selector A string that is accepted by jQuery's selector

View File

@@ -76,20 +76,16 @@ absolutePanel <- function(...,
style <- paste(paste(names(cssProps), cssProps, sep = ':', collapse = ';'), ';', sep='')
divTag <- tags$div(style=style, ...)
if (identical(draggable, FALSE)) {
if (isTRUE(draggable)) {
divTag <- tagAppendAttributes(divTag, class='draggable')
return(tagList(
divTag,
jqueryuiDependency(),
tags$script('$(".draggable").draggable();')
))
} else {
return(divTag)
}
# Add Shiny inputs and htmlwidgets to 'non-draggable' elements
# Cf. https://api.jqueryui.com/draggable/#option-cancel
dragOpts <- '{cancel: ".shiny-input-container,.html-widget,input,textarea,button,select,option"}'
dragJS <- sprintf('$(".draggable").draggable(%s);', dragOpts)
tagList(
tagAppendAttributes(divTag, class='draggable'),
jqueryuiDependency(),
tags$script(HTML(dragJS))
)
}
#' @rdname absolutePanel

11
R/map.R
View File

@@ -48,12 +48,9 @@ Map <- R6Class(
)
)
#' @export
as.list.Map <- function(x, ...) {
x$values()
as.list.Map <- function(map) {
map$values()
}
#' @export
length.Map <- function(x) {
x$size()
length.Map <- function(map) {
map$size()
}

View File

@@ -436,36 +436,29 @@ MockShinySession <- R6Class(
if (!is.function(func))
stop(paste("Unexpected", class(func), "output for", name))
with_no_otel_collect({
obs <- observe({
# We could just stash the promise, but we get an "unhandled promise error". This bypasses
prom <- NULL
tryCatch({
v <- private$withCurrentOutput(name, func(self, name))
if (!is.promise(v)){
# Make our sync value into a promise
prom <- promise_resolve(v)
} else {
prom <- v
}
}, error=function(e){
# Error running value()
prom <<- promise_reject(e)
})
private$outs[[name]]$promise <- hybrid_chain(
prom,
function(v){
list(val = v, err = NULL)
}, catch=function(e){
if (
!inherits(e, c("shiny.custom.error", "shiny.output.cancel", "shiny.output.progress", "shiny.silent.error"))
) {
self$unhandledError(e, close = FALSE)
}
list(val = NULL, err = e)
})
obs <- observe({
# We could just stash the promise, but we get an "unhandled promise error". This bypasses
prom <- NULL
tryCatch({
v <- private$withCurrentOutput(name, func(self, name))
if (!promises::is.promise(v)){
# Make our sync value into a promise
prom <- promises::promise(function(resolve, reject){ resolve(v) })
} else {
prom <- v
}
}, error=function(e){
# Error running value()
prom <<- promises::promise(function(resolve, reject){ reject(e) })
})
private$outs[[name]]$promise <- hybrid_chain(
prom,
function(v){
list(val = v, err = NULL)
}, catch=function(e){
list(val = NULL, err = e)
})
})
private$outs[[name]] <- list(obs = obs, func = func, promise = NULL)
},
@@ -567,26 +560,10 @@ MockShinySession <- R6Class(
rootScope = function() {
self
},
#' @description Add an unhandled error callback.
#' @param callback The callback to add, which should accept an error object
#' as its first argument.
#' @return A deregistration function.
onUnhandledError = function(callback) {
private$unhandledErrorCallbacks$register(callback)
},
#' @description Called by observers when a reactive expression errors.
#' @param e An error object.
#' @param close If `TRUE`, the session will be closed after the error is
#' handled, defaults to `FALSE`.
unhandledError = function(e, close = TRUE) {
if (close) {
class(e) <- c("shiny.error.fatal", class(e))
}
private$unhandledErrorCallbacks$invoke(e, onError = printError)
.globals$onUnhandledErrorCallbacks$invoke(e, onError = printError)
if (close) self$close()
unhandledError = function(e) {
self$close()
},
#' @description Freeze a value until the flush cycle completes.
#' @param x A `ReactiveValues` object.
@@ -643,9 +620,6 @@ MockShinySession <- R6Class(
flushedCBs = NULL,
# @field endedCBs `Callbacks` called when session ends.
endedCBs = NULL,
# @field unhandledErrorCallbacks `Callbacks` called when an unhandled error
# occurs.
unhandledErrorCallbacks = Callbacks$new(),
# @field timer `MockableTimerCallbacks` called at particular times.
timer = NULL,
# @field was_closed Set to `TRUE` once the session is closed.
@@ -718,7 +692,7 @@ MockShinySession <- R6Class(
stop("Nested calls to withCurrentOutput() are not allowed.")
}
with_promise_domain(
promises::with_promise_domain(
createVarPromiseDomain(private, "currentOutputName", name),
expr
)

View File

@@ -43,10 +43,7 @@ removeModal <- function(session = getDefaultReactiveDomain()) {
#' @param title An optional title for the dialog.
#' @param footer UI for footer. Use `NULL` for no footer.
#' @param size One of `"s"` for small, `"m"` (the default) for medium,
#' `"l"` for large, or `"xl"` for extra large. Note that `"xl"` only
#' works with Bootstrap 4 and above (to opt-in to Bootstrap 4+,
#' pass [bslib::bs_theme()] to the `theme` argument of a page container
#' like [fluidPage()]).
#' or `"l"` for large.
#' @param easyClose If `TRUE`, the modal dialog can be dismissed by
#' clicking outside the dialog box, or be pressing the Escape key. If
#' `FALSE` (the default), the modal dialog can't be dismissed in those

View File

@@ -1,65 +0,0 @@
# Very similar to srcrefFromShinyCall(),
# however, this works when the function does not have a srcref attr set
otel_srcref_attributes <- function(srcref, fn_name = NULL) {
if (is.function(srcref)) {
srcref <- getSrcRefs(srcref)[[1]][[1]]
}
if (is.null(srcref)) {
return(NULL)
}
stopifnot(inherits(srcref, "srcref"))
# Semantic conventions for code: https://opentelemetry.io/docs/specs/semconv/registry/attributes/code/
#
# Inspiration from https://github.com/r-lib/testthat/pull/2087/files#diff-92de3306849d93d6f7e76c5aaa1b0c037e2d716f72848f8a1c70536e0c8a1564R123-R124
filename <- attr(srcref, "srcfile")$filename
dropNulls(list(
"code.function.name" = fn_name,
# Location attrs
"code.file.path" = filename,
"code.line.number" = srcref[1],
"code.column.number" = srcref[2],
# Remove these deprecated location names once Logfire supports the preferred names
# https://github.com/pydantic/logfire/issues/1559
"code.filepath" = filename,
"code.lineno" = srcref[1],
"code.column" = srcref[2]
))
}
#' Get the srcref for the call at the specified stack level
#'
#' If you need to go farther back in the `sys.call()` stack, supply a larger
#' negative number to `which_offset`. The default of 0 gets the immediate
#' caller. `-1` would get the caller's caller, and so on.
#' @param which_offset The stack level to get the call from. Defaults to -1 (the
#' immediate caller).
#' @return An srcref object, or NULL if none is found.
#' @noRd
get_call_srcref <- function(which_offset = 0) {
# Go back one call to account for this function itself
call <- sys.call(which_offset - 1)
srcref <- attr(call, "srcref", exact = TRUE)
srcref
}
append_otel_srcref_attrs <- function(attrs, call_srcref, fn_name) {
if (is.null(call_srcref)) {
return(attrs)
}
srcref_attrs <- otel_srcref_attributes(call_srcref, fn_name)
if (is.null(srcref_attrs)) {
return(attrs)
}
attrs[names(srcref_attrs)] <- srcref_attrs
attrs
}

View File

@@ -1,55 +0,0 @@
otel_collect_choices <- c(
"none",
"session",
"reactive_update",
"reactivity",
"all"
)
# Check if the collect level is sufficient
otel_collect_is_enabled <- function(
impl_level,
# Listen to option and fall back to the env var
opt_collect_level = getOption("shiny.otel.collect", Sys.getenv("SHINY_OTEL_COLLECT", "all"))
) {
opt_collect_level <- as_otel_collect(opt_collect_level)
which(opt_collect_level == otel_collect_choices) >=
which(impl_level == otel_collect_choices)
}
# Check if tracing is enabled and if the collect level is sufficient
has_otel_collect <- function(collect) {
# Only check pkg author input iff loaded with pkgload
if (IS_SHINY_LOCAL_PKG) {
stopifnot(length(collect) == 1, any(collect == otel_collect_choices))
}
otel_is_tracing_enabled() && otel_collect_is_enabled(collect)
}
# Run expr with otel collection disabled
with_no_otel_collect <- function(expr) {
withOtelCollect("none", expr)
}
## -- Helpers -----------------------------------------------------
# shiny.otel.collect can be:
# "none"; To do nothing / fully opt-out
# "session" for session/start events
# "reactive_update" (includes "session" features) and reactive_update spans
# "reactivity" (includes "reactive_update" features) and spans for all reactive things
# "all" - Anything that Shiny can do. (Currently equivalent to the "reactivity" level)
as_otel_collect <- function(collect = "all") {
if (!is.character(collect)) {
stop("`collect` must be a character vector.")
}
# Match to collect enum
collect <- match.arg(collect, otel_collect_choices, several.ok = FALSE)
return(collect)
}

View File

@@ -1,194 +0,0 @@
# # Approach
# Use flags on the reactive object to indicate whether to record OpenTelemetry spans.
#
# Cadence:
# * `$.isRecordingOtel` - Whether to record OpenTelemetry spans for this reactive object
# * `$.otelLabel` - The label to use for the OpenTelemetry span
# * `$.otelAttrs` - Additional attributes to add to the OpenTelemetry span
#' Add OpenTelemetry for reactivity to an object
#'
#' @description
#'
#' `enable_otel_*()` methods add OpenTelemetry flags for [reactive()] expressions
#' and `render*` functions (like [renderText()], [renderTable()], ...).
#'
#' Wrapper to creating an active reactive OpenTelemetry span that closes when
#' the reactive expression is done computing. Typically this is when the
#' reactive expression finishes (synchronous) or when the returned promise is
#' done computing (asynchronous).
#' @section Async with OpenTelemetry:
#'
#' With a reactive expression, the key and/or value expression can be
#' _asynchronous_. In other words, they can be promises --- not regular R
#' promises, but rather objects provided by the
#' \href{https://rstudio.github.io/promises/}{\pkg{promises}} package, which
#' are similar to promises in JavaScript. (See [promises::promise()] for more
#' information.) You can also use [mirai::mirai()] or [future::future()]
#' objects to run code in a separate process or even on a remote machine.
#'
#' When reactive expressions are being calculated in parallel (by having
#' another reactive promise compute in the main process), the currently active
#' OpenTelemetry span will be dynamically swapped out according to the
#' currently active reactive expression. This means that as long as a promise
#' was `then()`ed or `catch()`ed with an active OpenTelemetry span, the span
#' will be correctly propagated to the next step (and subsequently other
#' steps) in the promise chain.
#'
#' While the common case is for a reactive expression to be created
#' synchronously, troubles arise when the reactive expression is created
#' asynchronously. The span **must** be created before the reactive expression
#' is executed, it **must** be active for the duration of the expression, and
#' it **must** not be closed until the reactive expression is done executing.
#' This is not easily achieved with a single function call, so we provide a
#' way to create a reactive expression that is bound to an OpenTelemetry
#' span.
#'
#' @section Span management and performance:
#'
#' Dev note - Barret 2025-10:
#' Typically, an OpenTelemetry span (`otel_span`) will inherit from the parent
#' span. This works well and we can think of the hierarchy as a tree. With
#' `options("shiny.otel.collect" = <value>)`, we are able to control with a sliding
#' dial how much of the tree we are interested in: "none", "session",
#' "reactive_update", "reactivity", and finally "all".
#'
#' Leveraging this hierarchy, we can avoid creating spans that are not needed.
#' The act of making a noop span takes on the order of 10microsec. Handling of
#' the opspan is also in the 10s of microsecond range. We should avoid this when
#' we **know** that we're not interested in the span. Therefore, manually
#' handling spans should be considered for Shiny.
#'
#' * Q:
#' * But what about app author who want the current span? Is there any
#' guarantee that the current span is expected `reactive()` span?
#' * A:
#' * No. The current span is whatever the current span is. If the app author
#' wants a specific span, they should create it themselves.
#' * Proof:
#' ```r
#' noop <- otel::get_active_span()
#' noop$get_context()$get_span_id()
#' #> [1] "0000000000000000"
#' ignore <- otelsdk::with_otel_record({
#' a <- otel::start_local_active_span("a")
#' a$get_context()$get_span_id() |> str()
#' otel::with_active_span(noop, {
#' otel::get_active_span()$get_context()$get_span_id() |> str()
#' })
#' })
#' #> chr "2645e95715841e75"
#' #> chr "2645e95715841e75"
#' # ## It is reasonable to expect the second id to be `0000000000000000`, but it's not.
#' ```
#' Therefore, the app author has no guarantee that the current span is the
#' span they're expecting. If the app author wants a specific span, they should
#' create it themselves and let natural inheritance take over.
#'
#' Given this, I will imagine that app authors will set
#' `options("shiny.otel.collect" = "reactive_update")` as their default behavior.
#' Enough to know things are happening, but not overwhelming from **everything**
#' that is reactive.
#'
#' To _light up_ a specific area, users can call `withr::with_options(list("shiny.otel.collect" = "all"), { ... })`.
#'
#' @param x The object to add caching to.
#' @param ... Future parameter expansion.
#' @noRd
NULL
enable_otel_reactive_val <- function(x) {
impl <- attr(x, ".impl", exact = TRUE)
# Set flag for otel logging when setting the value
impl$.isRecordingOtel <- TRUE
class(x) <- c("reactiveVal.otel", class(x))
x
}
enable_otel_reactive_values <- function(x) {
impl <- .subset2(x, "impl")
# Set flag for otel logging when setting values
impl$.isRecordingOtel <- TRUE
class(x) <- c("reactivevalues.otel", class(x))
x
}
enable_otel_reactive_expr <- function(x) {
domain <- reactive_get_domain(x)
impl <- attr(x, "observable", exact = TRUE)
impl$.isRecordingOtel <- TRUE
# Covers both reactive and reactive.event
impl$.otelLabel <- otel_span_label_reactive(x, domain = impl$.domain)
class(x) <- c("reactiveExpr.otel", class(x))
x
}
enable_otel_observe <- function(x) {
x$.isRecordingOtel <- TRUE
x$.otelLabel <- otel_span_label_observer(x, domain = x$.domain)
class(x) <- c("Observer.otel", class(x))
invisible(x)
}
enable_otel_shiny_render_function <- function(x) {
valueFunc <- force(x)
otel_span_label <- NULL
otel_span_attrs <- NULL
renderFunc <- function(...) {
# Dynamically determine the span label given the current reactive domain
if (is.null(otel_span_label)) {
domain <- getDefaultReactiveDomain()
otel_span_label <<-
otel_span_label_render_function(x, domain = domain)
otel_span_attrs <<- c(
attr(x, "otelAttrs"),
otel_session_id_attrs(domain)
)
}
with_otel_span(
otel_span_label,
{
hybrid_then(
valueFunc(...),
on_failure = set_otel_exception_status_and_throw,
# Must save the error object
tee = FALSE
)
},
attributes = otel_span_attrs
)
}
renderFunc <- addAttributes(renderFunc, renderFunctionAttributes(valueFunc))
class(renderFunc) <- c("shiny.render.function.otel", class(valueFunc))
renderFunc
}
# ## If we ever expose a S3 function, I'd like to add this method.
# bindOtel.function <- function(x, ...) {
# cli::cli_abort(paste0(
# "Don't know how to add OpenTelemetry recording to a plain function. ",
# "If this is a {.code render*()} function for Shiny, it may need to be updated. ",
# "Please see {.help shiny::bindOtel} for more information."
# ))
# }

View File

@@ -1,56 +0,0 @@
has_seen_otel_exception <- function(cnd) {
!is.null(cnd$.shiny_otel_exception)
}
mark_otel_exception_as_seen <- function(cnd) {
cnd$.shiny_otel_exception <- TRUE
cnd
}
set_otel_exception_status_and_throw <- function(cnd) {
cnd <- set_otel_exception_status(cnd)
# Rethrow the (possibly updated) error
signalCondition(cnd)
}
set_otel_exception_status <- function(cnd) {
if (inherits(cnd, "shiny.custom.error")) {
# No-op
} else if (inherits(cnd, "shiny.output.cancel")) {
# No-op
} else if (inherits(cnd, "shiny.output.progress")) {
# No-op
} else if (cnd_inherits(cnd, "shiny.silent.error")) {
# No-op
} else {
# Only when an unknown error occurs do we set the span status to error
span <- otel::get_active_span()
# Only record the exception once at the original point of failure,
# not every reactive expression that it passes through
if (!has_seen_otel_exception(cnd)) {
span$record_exception(
# Record a sanitized error if sanitization is enabled
get_otel_error_obj(cnd)
)
cnd <- mark_otel_exception_as_seen(cnd)
}
# Record the error status on the span for any context touching this error
span$set_status("error")
}
cnd
}
get_otel_error_obj <- function(e) {
# Do not expose errors to otel if sanitization is enabled
if (getOption("shiny.otel.sanitize.errors", TRUE)) {
sanitized_error()
} else {
e
}
}

View File

@@ -1,198 +0,0 @@
# observe mymod:<anonymous>
# observe <anonymous>
# observe mylabel
# -- Reactives --------------------------------------------------------------
#' OpenTelemetry Label Generation Functions
#'
#' Functions for generating formatted labels for OpenTelemetry tracing spans
#' in Shiny applications. These functions handle module namespacing and
#' cache/event modifiers for different Shiny reactive constructs.
#'
#' @param x The object to generate a label for (reactive, observer, etc.)
#' @param label Character string label for reactive values
#' @param key Character string key for reactiveValues operations
#' @param ... Additional arguments (unused)
#' @param domain Shiny domain object containing namespace information
#'
#' @return Character string formatted for OpenTelemetry span labels
#' @name otel_label
#' @noRd
NULL
otel_span_label_reactive <- function(x, ..., domain) {
fn_name <- otel_label_with_modifiers(
x,
"reactive",
cache_class = "reactive.cache",
event_class = "reactive.event"
)
label <- attr(x, "observable", exact = TRUE)[[".label"]]
otel_span_label <- otel_label_upgrade(label, domain = domain)
sprintf("%s %s", fn_name, otel_span_label)
}
otel_span_label_render_function <- function(x, ..., domain) {
fn_name <- otel_label_with_modifiers(
x,
"output",
cache_class = "shiny.render.function.cache",
event_class = "shiny.render.function.event"
)
label <- getCurrentOutputInfo(session = domain)$name %||% "<unknown>"
otel_span_label <- otel_label_upgrade(label, domain = domain)
sprintf("%s %s", fn_name, otel_span_label)
}
otel_span_label_observer <- function(x, ..., domain) {
fn_name <- otel_label_with_modifiers(
x,
"observe",
cache_class = NULL, # Do not match a cache class here
event_class = "Observer.event"
)
otel_span_label <- otel_label_upgrade(x$.label, domain = domain)
sprintf("%s %s", fn_name, otel_span_label)
}
# -- Set reactive value(s) ----------------------------------------------------
otel_log_label_set_reactive_val <- function(label, ..., domain) {
sprintf(
"Set reactiveVal %s",
otel_label_upgrade(label, domain = domain)
)
}
otel_log_label_set_reactive_values <- function(label, key, ..., domain) {
sprintf(
"Set reactiveValues %s$%s",
otel_label_upgrade(label, domain = domain),
key
)
}
# -- ExtendedTask -------------------------------------------------------------
otel_span_label_extended_task <- function(label, suffix = NULL, ..., domain) {
sprintf(
"ExtendedTask %s",
otel_label_upgrade(label, domain = domain)
)
}
otel_log_label_extended_task_add_to_queue <- function(label, ..., domain) {
sprintf(
"ExtendedTask %s add to queue",
otel_label_upgrade(label, domain = domain)
)
}
# -- Debounce / Throttle -------------------------------------------------------
otel_label_debounce <- function(label, ..., domain) {
sprintf(
"debounce %s",
otel_label_upgrade(label, domain = domain)
)
}
otel_label_throttle <- function(label, ..., domain) {
sprintf(
"throttle %s",
otel_label_upgrade(label, domain = domain)
)
}
# ---- Reactive Poll / File Reader -----------------------------------------------
otel_label_reactive_poll <- function(label, ..., domain) {
sprintf(
"reactivePoll %s",
otel_label_upgrade(label, domain = domain)
)
}
otel_label_reactive_file_reader <- function(label, ..., domain) {
sprintf(
"reactiveFileReader %s",
otel_label_upgrade(label, domain = domain)
)
}
# -- Helpers --------------------------------------------------------------
#' Modify function name based on object class modifiers
#'
#' @param x Object to check class of
#' @param fn_name Base function name
#' @param cache_class Optional class name that indicates cache operation
#' @param event_class Optional class name that indicates event operation
#'
#' @return Modified function name with "cache" or "event" suffix if applicable
#' @noRd
otel_label_with_modifiers <- function(
x,
fn_name,
cache_class = NULL,
event_class = NULL
) {
for (x_class in rev(class(x))) {
if (!is.null(cache_class) && x_class == cache_class) {
fn_name <- sprintf("%s cache", fn_name)
} else if (!is.null(event_class) && x_class == event_class) {
fn_name <- sprintf("%s event", fn_name)
}
}
fn_name
}
#' Upgrade and format OpenTelemetry labels with module namespacing
#'
#' Processes labels for OpenTelemetry tracing, replacing default verbose labels
#' with cleaner alternatives and prepending module namespaces when available.
#'
#' @param label Character string label to upgrade
#' @param ... Additional arguments (unused)
#' @param domain Shiny domain object containing namespace information
#'
#' @return Modified label string with module prefix if applicable
#' @noRd
#'
#' @details
#' Module prefix examples:
#' - "" -> ""
#' - "my-nested-mod-" -> "my-nested-mod"
otel_label_upgrade <- function(label, ..., domain) {
# By default, `observe()` sets the label to `observe(CODE)`
# This label is too big and inconsistent.
# Replace it with `<anonymous>`
# (Similar with `eventReactive()` and `observeEvent()`)
if (is_default_label(label) && grepl("(", label, fixed = TRUE)) {
label <- "<anonymous>"
# label <- sprintf("<anonymous> - %s", label)
}
if (is.null(domain)) {
return(label)
}
namespace <- domain$ns("")
if (!nzchar(namespace)) {
return(label)
}
# Remove trailing module separator
mod_ns <- sub(sprintf("%s$", ns.sep), "", namespace)
# Prepend the module name to the label
# Ex: `"mymod:x"`
sprintf("%s:%s", mod_ns, label)
}

View File

@@ -1,114 +0,0 @@
# * `session$userData[["_otel_span_reactive_update"]]` - The active reactive update span (or `NULL`)
#' Start a `reactive_update` OpenTelemetry span and store it
#'
#' Used when a reactive expression is updated
#' Will only start the span iff the otel tracing is enabled
#' @param ... Ignored
#' @param domain The reactive domain to associate with the span
#' @return Invisibly returns.
#' @seealso `otel_span_reactive_update_teardown()`
#' @noRd
otel_span_reactive_update_init <- function(..., domain) {
if (!has_otel_collect("reactive_update")) return()
# Ensure cleanup is registered only once per session
if (is.null(domain$userData[["_otel_has_reactive_cleanup"]])) {
domain$userData[["_otel_has_reactive_cleanup"]] <- TRUE
# Clean up any dangling reactive spans on an unplanned exit
domain$onSessionEnded(function() {
otel_span_reactive_update_teardown(domain = domain)
})
}
# Safety check
if (is_otel_span(domain$userData[["_otel_span_reactive_update"]])) {
stop("Reactive update span already exists")
}
domain$userData[["_otel_span_reactive_update"]] <-
start_otel_span(
"reactive_update",
...,
attributes = otel_session_id_attrs(domain)
)
invisible()
}
#' End a `reactive_update` OpenTelemetry span and remove it from the session
#' @param ... Ignored
#' @param domain The reactive domain to associate with the span
#' @return Invisibly returns.
#' @seealso `otel_span_reactive_update_init()`
#' @noRd
otel_span_reactive_update_teardown <- function(..., domain) {
ospan <- domain$userData[["_otel_span_reactive_update"]]
if (is_otel_span(ospan)) {
otel::end_span(ospan)
domain$userData[["_otel_span_reactive_update"]] <- NULL
}
invisible()
}
#' Run expr within a `reactive_update` OpenTelemetry span
#'
#' Used to wrap the execution of a reactive expression. Will only
#' require/activate the span iff the otel tracing is enabled
#' @param expr The expression to executed within the span
#' @param ... Ignored
#' @param domain The reactive domain to associate with the span
#' @noRd
with_otel_span_reactive_update <- function(expr, ..., domain) {
ospan <- domain$userData[["_otel_span_reactive_update"]]
if (!is_otel_span(ospan)) {
return(force(expr))
}
# Given the reactive update span is started before and ended when exec count
# is 0, we only need to wrap the expr in the span context
otel::with_active_span(ospan, {force(expr)})
}
#' Run expr within `reactive_update` otel span if not already active
#'
#' If the reactive update otel span is not already active, run the expression
#' within the reactive update otel span context. This ensures that nested calls
#' to reactive expressions do not attempt to re-enter the same span.
#'
#' This method is used within Context `run()` and running an Output's observer
#' implementation
#' @param expr The expression to executed within the span
#' @param ... Ignored
#' @param domain The reactive domain to associate with the span
#' @noRd
maybe_with_otel_span_reactive_update <- function(expr, ..., domain) {
if (is.null(domain$userData[["_otel_reactive_update_is_active"]])) {
domain$userData[["_otel_reactive_update_is_active"]] <- TRUE
# When the expression is done promising, clear the active flag
hybrid_then(
{
with_otel_span_reactive_update(domain = domain, expr)
},
on_success = function(value) {
domain$userData[["_otel_reactive_update_is_active"]] <- NULL
},
on_failure = function(e) {
domain$userData[["_otel_reactive_update_is_active"]] <- NULL
},
# Return the value before the callbacks
tee = TRUE
)
} else {
expr
}
}

View File

@@ -1,96 +0,0 @@
# Semantic conventions for session: https://opentelemetry.io/docs/specs/semconv/general/session/
#' Create and use session span and events
#'
#' If otel is disabled, the session span and events will not be created,
#' however the expression will still be evaluated.
#'
#' Span: `session_start`, `session_end`
#' @param expr Expression to evaluate within the session span
#' @param ... Ignored
#' @param domain The reactive domain
#' @noRd
otel_span_session_start <- function(expr, ..., domain) {
if (!has_otel_collect("session")) {
return(force(expr))
}
# Wrap the server initialization
with_otel_span(
"session_start",
expr,
attributes = otel::as_attributes(c(
otel_session_id_attrs(domain),
otel_session_attrs(domain)
))
)
}
otel_span_session_end <- function(expr, ..., domain) {
if (!has_otel_collect("session")) {
return(force(expr))
}
id_attrs <- otel_session_id_attrs(domain)
with_otel_span(
"session_end",
expr,
attributes = id_attrs
)
}
# -- Helpers -------------------------------
# Occurs when the websocket connection is established
otel_session_attrs <- function(domain) {
# TODO: Future: Posit Connect integration
# > we are still trying to identify all of the information we want to track/expose
#
# * `POSIT_PRODUCT` (Fallback to RSTUDIO_PRODUCT) for host environment
# * `CONNECT_SERVER` envvar to get the `session.address`.
# * `CONNECT_CONTENT_GUID` for the consistent app distinguisher
# * Maybe `CONNECT_CONTENT_JOB_KEY`?
# * Maybe `user.id` to be their user name: https://opentelemetry.io/docs/specs/semconv/registry/attributes/user/
attrs <- list(
server.path =
sub(
"/websocket/$", "/",
domain[["request"]][["PATH_INFO"]] %||% ""
),
server.address = domain[["request"]][["HTTP_HOST"]] %||% "",
server.origin = domain[["request"]][["HTTP_ORIGIN"]] %||% "",
## Currently, Shiny does not expose QUERY_STRING when connecting the websocket
# so we do not provide it here.
# QUERY_STRING = domain[["request"]][["QUERY_STRING"]] %||% "",
server.port = domain[["request"]][["SERVER_PORT"]] %||% NA_integer_
)
# Safely convert SERVER_PORT to integer
# If conversion fails, leave as-is (string or empty)
# This avoids warnings/errors if SERVER_PORT is not a valid integer
server_port <- suppressWarnings(as.integer(attrs$server.port))
if (!is.na(server_port)) {
attrs$server.port <- server_port
}
attrs
}
otel_session_id_attrs <- function(domain) {
token <- domain$token
if (is.null(token)) {
return(list())
}
list(
# Convention for client-side with session.start and session.end events
# https://opentelemetry.io/docs/specs/semconv/general/session/
#
# Since we are the server, we'll add them as an attribute to _every_ span
# within the session as we don't know exactly when they will be called.
# Given it's only a single attribute, the cost should be minimal, but it ties every reactive calculation together.
session.id = token
)
}

View File

@@ -1,127 +0,0 @@
# Used by otel to identify the tracer and logger for this package
# https://github.com/r-lib/otel/blob/afc31bc1f4bd177870d44b051ada1d9e4e685346/R/tracer-name.R#L33-L49
# DO NOT CHANGE THIS VALUE without understanding the implications for existing telemetry data!
otel_tracer_name <- "co.posit.r-package.shiny"
init_otel <- function() {
.globals$otel_tracer <- otel::get_tracer()
.globals$otel_is_tracing_enabled <- otel::is_tracing_enabled(.globals$otel_tracer)
.globals$otel_logger <- otel::get_logger()
# .globals$otel_is_logging_enabled <- otel::is_logging_enabled()
}
on_load({init_otel()})
#' Run expr within a Shiny OpenTelemetry recording context
#'
#' Reset the OpenTelemetry tracer and logger for Shiny.
#' Used for testing purposes only.
#' @param expr Expression to evaluate within the recording context
#' @return The result of evaluating `otelsdk::with_otel_record(expr)` with freshly enabled Shiny otel tracer and logger
#' @noRd
with_shiny_otel_record <- function(expr) {
# Only use within internal testthat tests
stopifnot(testthat__is_testing())
withr::defer({ init_otel() })
otelsdk::with_otel_record({
init_otel()
force(expr)
})
}
#' Check if OpenTelemetry tracing is enabled
#'
#' @param tracer The OpenTelemetry tracer to check (default: Shiny otel tracer)
#' @return `TRUE` if tracing is enabled, `FALSE` otherwise
#' @noRd
otel_is_tracing_enabled <- function() {
.globals[["otel_is_tracing_enabled"]]
}
#' Shiny OpenTelemetry logger
#'
#' Used for logging OpenTelemetry events via `otel_log()`
#' @return An OpenTelemetry logger
#' @noRd
shiny_otel_logger <- function() {
.globals[["otel_logger"]]
}
#' Shiny OpenTelemetry tracer
#'
#' Used for creating OpenTelemetry spans via `with_otel_span()` and
#' `start_otel_span()`
#'
#' Inspired by httr2:::get_tracer().
#' @return An OpenTelemetry tracer
#' @noRd
shiny_otel_tracer <- function() {
.globals[["otel_tracer"]]
}
#' Create and use a Shiny OpenTelemetry span
#'
#' If otel is disabled, the span will not be created,
#' however the expression will still be evaluated.
#' @param name Span name
#' @param expr Expression to evaluate within the span
#' @param ... Ignored
#' @param attributes Optional span attributes
#' @return The result of evaluating `expr`
#' @noRd
with_otel_span <- function(name, expr, ..., attributes = NULL) {
promises::with_otel_span(name, expr, ..., attributes = attributes, tracer = shiny_otel_tracer())
}
#' Start a Shiny OpenTelemetry span
#'
#' @param name Span name
#' @param ... Additional arguments passed to `otel::start_span()`
#' @return An OpenTelemetry span
#' @noRd
start_otel_span <- function(name, ...) {
otel::start_span(name, ..., tracer = shiny_otel_tracer())
}
# # TODO: Set attributes on the current active span
# # 5. Set attributes on the current active span
# set_otel_span_attrs(status = 200L)
# -- Helpers --------------------------------------------------------------
is_otel_span <- function(x) {
inherits(x, "otel_span")
}
testthat__is_testing <- function() {
# testthat::is_testing()
identical(Sys.getenv("TESTTHAT"), "true")
}
#' Log a message using the Shiny OpenTelemetry logger
#'
#' @param msg The log message
#' @param ... Additional attributes to add to the log record
#' @param severity The log severity level (default: "info")
#' @param logger The OpenTelemetry logger to use (default: Shiny otel logger)
#' @return Invisibly returns.
#' @noRd
otel_log <- function(
msg,
...,
severity = "info",
logger = shiny_otel_logger()
) {
otel::log(msg, ..., severity = severity, logger = logger)
}

View File

@@ -1,125 +0,0 @@
#' Temporarily set OpenTelemetry (OTel) collection level
#'
#' @description
#' Control Shiny's OTel collection level for particular reactive expression(s).
#'
#' `withOtelCollect()` sets the OpenTelemetry collection level for
#' the duration of evaluating `expr`. `localOtelCollect()` sets the collection
#' level for the remainder of the current function scope.
#'
#' @details
#' Note that `"session"` and `"reactive_update"` levels are not permitted as
#' these are runtime-specific levels that should only be set permanently via
#' `options(shiny.otel.collect = ...)` or the `SHINY_OTEL_COLLECT` environment
#' variable, not temporarily during reactive expression creation.
#'
#' @section Best practice:
#'
#' Best practice is to set the collection level for code that *creates* reactive
#' expressions, not code that *runs* them. For instance:
#'
#' ```r
#' # Disable telemetry for a reactive expression
#' withOtelCollect("none", {
#' my_reactive <- reactive({ ... })
#' })
#'
#' # Disable telemetry for a render function
#' withOtelCollect("none", {
#' output$my_plot <- renderPlot({ ... })
#' })
#'
#' #' # Disable telemetry for an observer
#' withOtelCollect("none", {
#' observe({ ... }))
#' })
#'
#' # Disable telemetry for an entire module
#' withOtelCollect("none", {
#' my_result <- my_module("my_id")
#' })
#' # Use `my_result` as normal here
#' ```
#'
#' NOTE: It's not recommended to pipe existing reactive objects into
#' `withOtelCollect()` since they won't inherit their intended OTel settings,
#' leading to confusion.
#'
#' @param collect Character string specifying the OpenTelemetry collection level.
#' Must be one of the following:
#'
#' * `"none"` - No telemetry data collected
#' * `"reactivity"` - Collect reactive execution spans (includes session and
#' reactive update events)
#' * `"all"` - All available telemetry (currently equivalent to `"reactivity"`)
#' @param expr Expression to evaluate with the specified collection level
#' (for `withOtelCollect()`).
#' @param envir Environment where the collection level should be set
#' (for `localOtelCollect()`). Defaults to the parent frame.
#'
#' @return
#' * `withOtelCollect()` returns the value of `expr`.
#' * `localOtelCollect()` is called for its side effect and returns the previous
#' `collect` value invisibly.
#'
#' @seealso See the `shiny.otel.collect` option within [`shinyOptions`]. Setting
#' this value will globally control OpenTelemetry collection levels.
#'
#' @examples
#' \dontrun{
#' # Temporarily disable telemetry collection
#' withOtelCollect("none", {
#' # Code here won't generate telemetry
#' reactive({ input$x + 1 })
#' })
#'
#' # Collect reactivity telemetry but not other events
#' withOtelCollect("reactivity", {
#' # Reactive execution will be traced
#' observe({ print(input$x) })
#' })
#'
#' # Use local variant in a function
#' my_function <- function() {
#' localOtelCollect("none")
#' # Rest of function executes without telemetry
#' reactive({ input$y * 2 })
#' }
#' }
#'
#' @rdname withOtelCollect
#' @export
withOtelCollect <- function(collect, expr) {
collect <- as_otel_collect_with(collect)
withr::with_options(
list(shiny.otel.collect = collect),
expr
)
}
#' @rdname withOtelCollect
#' @export
localOtelCollect <- function(collect, envir = parent.frame()) {
collect <- as_otel_collect_with(collect)
old <- withr::local_options(
list(shiny.otel.collect = collect),
.local_envir = envir
)
invisible(old)
}
# Helper function to validate collect levels for with/local functions
# Only allows "none", "reactivity", and "all" - not "session" or "reactive_update"
as_otel_collect_with <- function(collect) {
if (!is.character(collect)) {
stop("`collect` must be a character vector.")
}
allowed_levels <- c("none", "reactivity", "all")
collect <- match.arg(collect, allowed_levels, several.ok = FALSE)
return(collect)
}

View File

@@ -16,60 +16,6 @@ processId <- local({
}
})
ctx_otel_info_obj <- function(
isRecordingOtel = FALSE,
otelLabel = "<unknown>",
otelAttrs = list()
) {
structure(
list(
isRecordingOtel = isRecordingOtel,
otelLabel = otelLabel,
otelAttrs = otelAttrs
),
class = "ctx_otel_info"
)
}
with_otel_span_context <- function(otel_info, expr, domain) {
if (!otel_is_tracing_enabled()) {
return(force(expr))
}
isRecordingOtel <- .subset2(otel_info, "isRecordingOtel")
otelLabel <- .subset2(otel_info, "otelLabel")
otelAttrs <- .subset2(otel_info, "otelAttrs")
# Always set the reactive update span as active
# This ensures that any spans created within the reactive context
# are at least children of the reactive update span
maybe_with_otel_span_reactive_update(domain = domain, {
if (isRecordingOtel) {
with_otel_span(
otelLabel,
{
# Works with both sync and async expressions
# Needed for both observer and reactive contexts
hybrid_then(
expr,
on_failure = set_otel_exception_status_and_throw,
# Must upgrade the error object
tee = FALSE
)
},
# expr,
attributes = otelAttrs
)
} else {
force(expr)
}
})
}
#' @include graph.R
Context <- R6Class(
'Context',
@@ -87,14 +33,11 @@ Context <- R6Class(
.pid = NULL,
.weak = NULL,
.otel_info = NULL,
initialize = function(
domain, label='', type='other', prevId='',
reactId = rLog$noReactId,
id = .getReactiveEnvironment()$nextId(), # For dummy context
weak = FALSE,
otel_info = ctx_otel_info_obj()
weak = FALSE
) {
id <<- id
.label <<- label
@@ -104,27 +47,16 @@ Context <- R6Class(
.reactType <<- type
.weak <<- weak
rLog$createContext(id, label, type, prevId, domain)
if (!is.null(otel_info)) {
if (IS_SHINY_LOCAL_PKG) {
stopifnot(inherits(otel_info, "ctx_otel_info"))
}
.otel_info <<- otel_info
}
},
run = function(func) {
"Run the provided function under this context."
# Use `promises::` as it shows up in the stack trace
promises::with_promise_domain(reactivePromiseDomain(), {
withReactiveDomain(.domain, {
with_otel_span_context(.otel_info, domain = .domain, {
captureStackTraces({
env <- .getReactiveEnvironment()
rLog$enter(.reactId, id, .reactType, .domain)
on.exit(rLog$exit(.reactId, id, .reactType, .domain), add = TRUE)
env$runWith(self, func)
})
})
env <- .getReactiveEnvironment()
rLog$enter(.reactId, id, .reactType, .domain)
on.exit(rLog$exit(.reactId, id, .reactType, .domain), add = TRUE)
env$runWith(self, func)
})
})
},
@@ -287,31 +219,27 @@ getDummyContext <- function() {
wrapForContext <- function(func, ctx) {
force(func)
force(ctx) # may be NULL (in the case of maskReactiveContext())
force(ctx)
function(...) {
.getReactiveEnvironment()$runWith(ctx, function() {
func(...)
ctx$run(function() {
captureStackTraces(
func(...)
)
})
}
}
reactivePromiseDomain <- function() {
new_promise_domain(
promises::new_promise_domain(
wrapOnFulfilled = function(onFulfilled) {
force(onFulfilled)
# ctx will be NULL if we're in a maskReactiveContext()
ctx <- if (hasCurrentContext()) getCurrentContext() else NULL
ctx <- getCurrentContext()
wrapForContext(onFulfilled, ctx)
},
wrapOnRejected = function(onRejected) {
force(onRejected)
# ctx will be NULL if we're in a maskReactiveContext()
ctx <- if (hasCurrentContext()) getCurrentContext() else NULL
ctx <- getCurrentContext()
wrapForContext(onRejected, ctx)
}
)

View File

@@ -45,8 +45,6 @@ createMockDomain <- function() {
callbacks <- Callbacks$new()
ended <- FALSE
domain <- new.env(parent = emptyenv())
domain$ns <- function(id) id
domain$token <- "mock-domain"
domain$onEnded <- function(callback) {
return(callbacks$register(callback))
}
@@ -97,11 +95,7 @@ getDefaultReactiveDomain <- function() {
#' @rdname domains
#' @export
withReactiveDomain <- function(domain, expr) {
# Use `promises::` as it shows up in the stack trace
promises::with_promise_domain(
createVarPromiseDomain(.globals, "domain", domain),
expr
)
promises::with_promise_domain(createVarPromiseDomain(.globals, "domain", domain), expr)
}
#

View File

@@ -79,26 +79,19 @@ ReactiveVal <- R6Class(
dependents = NULL
),
public = list(
.isRecordingOtel = FALSE, # Needs to be set by Shiny
.otelLabel = NULL, # Needs to be set by Shiny
.otelAttrs = NULL, # Needs to be set by Shiny
initialize = function(value, label = NULL) {
reactId <- nextGlobalReactId()
private$reactId <- reactId
private$value <- value
private$label <- label
private$dependents <- Dependents$new(reactId = private$reactId)
domain <- getDefaultReactiveDomain()
rLog$define(private$reactId, value, private$label, type = "reactiveVal", domain)
.otelLabel <<- otel_log_label_set_reactive_val(private$label, domain = domain)
rLog$define(private$reactId, value, private$label, type = "reactiveVal", getDefaultReactiveDomain())
},
get = function() {
private$dependents$register()
if (private$frozen)
reactiveStop()
reactiveStop()
private$value
},
@@ -106,16 +99,7 @@ ReactiveVal <- R6Class(
if (identical(private$value, value)) {
return(invisible(FALSE))
}
domain <- getDefaultReactiveDomain()
if ((!is.null(domain)) && .isRecordingOtel) {
otel_log(
.otelLabel,
severity = "info",
attributes = c(private$.otelAttrs, otel_session_id_attrs(domain))
)
}
rLog$valueChange(private$reactId, value, domain)
rLog$valueChange(private$reactId, value, getDefaultReactiveDomain())
private$value <- value
private$dependents$invalidate()
invisible(TRUE)
@@ -221,20 +205,13 @@ ReactiveVal <- R6Class(
#'
#' @export
reactiveVal <- function(value = NULL, label = NULL) {
call_srcref <- get_call_srcref()
if (missing(label)) {
label <- rassignSrcrefToLabel(
call_srcref,
defaultLabel = paste0("reactiveVal", createUniqueId(4))
)
call <- sys.call()
label <- rvalSrcrefToLabel(attr(call, "srcref", exact = TRUE))
}
rv <- ReactiveVal$new(value, label)
if (!is.null(call_srcref)) {
rv$.otelAttrs <- otel_srcref_attributes(call_srcref, fn_name = "reactiveVal")
}
ret <- structure(
structure(
function(x) {
if (missing(x)) {
rv$get()
@@ -247,12 +224,6 @@ reactiveVal <- function(value = NULL, label = NULL) {
label = label,
.impl = rv
)
if (has_otel_collect("reactivity")) {
ret <- enable_otel_reactive_val(ret)
}
ret
}
#' @rdname freezeReactiveValue
@@ -291,11 +262,8 @@ format.reactiveVal <- function(x, ...) {
# assigned to (e.g. for `a <- reactiveVal()`, the result should be "a"). This
# is a fragile, error-prone operation, so we default to a random label if
# necessary.
rassignSrcrefToLabel <- function(
srcref,
defaultLabel,
fnName = "([a-zA-Z0-9_.]+)"
) {
rvalSrcrefToLabel <- function(srcref,
defaultLabel = paste0("reactiveVal", createUniqueId(4))) {
if (is.null(srcref))
return(defaultLabel)
@@ -319,11 +287,7 @@ rassignSrcrefToLabel <- function(
firstLine <- substring(lines[srcref[1]], srcref[2] - 1)
m <- regexec(
# Require the first assignment within the line
paste0("^\\s*([^[:space:]]+)\\s*(<<-|<-|=)\\s*", fnName, "\\b"),
firstLine
)
m <- regexec("\\s*([^[:space:]]+)\\s*(<-|=)\\s*reactiveVal\\b", firstLine)
if (m[[1]][1] == -1) {
return(defaultLabel)
}
@@ -362,12 +326,6 @@ ReactiveValues <- R6Class(
.dedupe = logical(0),
# Key, asList(), or names() have been retrieved
.hasRetrieved = list(),
# All names, in insertion order. The names are also stored in the .values
# object, but it does not preserve order.
.nameOrder = character(0),
.isRecordingOtel = FALSE, # Needs to be set by Shiny
.otelAttrs = NULL, # Needs to be set by Shiny
initialize = function(
@@ -445,26 +403,6 @@ ReactiveValues <- R6Class(
return(invisible())
}
if ((!is.null(domain)) && .isRecordingOtel) {
if (
# Any reactiveValues (other than input or clientData) are fair game
!(.label == "input" || .label == "clientData") ||
# Do not include updates to input or clientData unless _some_ reactivity has occured
!is.null(domain$userData[["_otel_has_reactive_cleanup"]])
) {
otel_log(
otel_log_label_set_reactive_values(.label, key, domain = domain),
severity = "info",
attributes = c(.otelAttrs, otel_session_id_attrs(domain))
)
}
}
# If it's new, append key to the name order
if (!key_exists) {
.nameOrder[length(.nameOrder) + 1] <<- key
}
# set the value for better logging
.values$set(key, value)
@@ -506,13 +444,14 @@ ReactiveValues <- R6Class(
},
names = function() {
nameValues <- .values$keys()
if (!isTRUE(.hasRetrieved$names)) {
domain <- getDefaultReactiveDomain()
rLog$defineNames(.reactId, .nameOrder, .label, domain)
rLog$defineNames(.reactId, nameValues, .label, domain)
.hasRetrieved$names <<- TRUE
}
.namesDeps$register()
return(.nameOrder)
return(nameValues)
},
# Get a metadata value. Does not trigger reactivity.
@@ -560,7 +499,7 @@ ReactiveValues <- R6Class(
},
toList = function(all.names=FALSE) {
listValue <- .values$mget(.nameOrder)
listValue <- .values$values()
if (!all.names) {
listValue <- listValue[!grepl("^\\.", base::names(listValue))]
}
@@ -633,28 +572,10 @@ reactiveValues <- function(...) {
if ((length(args) > 0) && (is.null(names(args)) || any(names(args) == "")))
rlang::abort("All arguments passed to reactiveValues() must be named.")
values <- .createReactiveValues(ReactiveValues$new(), withOtel = FALSE)
values <- .createReactiveValues(ReactiveValues$new())
# Use .subset2() instead of [[, to avoid method dispatch
impl <- .subset2(values, 'impl')
call_srcref <- get_call_srcref()
if (!is.null(call_srcref)) {
impl$.label <- rassignSrcrefToLabel(
call_srcref,
# Pass through the random default label created in ReactiveValues$new()
defaultLabel = impl$.label
)
impl$.otelAttrs <- otel_srcref_attributes(call_srcref, fn_name = "reactiveValues")
}
impl$mset(args)
# Add otel collection after `$mset()` so that we don't log the initial values
# Add otel collection after `.label` so that any logging uses the correct label
values <- maybeAddReactiveValuesOtel(values)
.subset2(values, 'impl')$mset(args)
values
}
@@ -669,11 +590,10 @@ checkName <- function(x) {
# @param values A ReactiveValues object
# @param readonly Should this object be read-only?
# @param ns A namespace function (either `identity` or `NS(namespace)`)
# @param withOtel Should otel collection be attempted?
.createReactiveValues <- function(values = NULL, readonly = FALSE,
ns = identity, withOtel = TRUE) {
ns = identity) {
ret <- structure(
structure(
list(
impl = values,
readonly = readonly,
@@ -681,20 +601,6 @@ checkName <- function(x) {
),
class='reactivevalues'
)
if (withOtel) {
ret <- maybeAddReactiveValuesOtel(ret)
}
ret
}
maybeAddReactiveValuesOtel <- function(x) {
if (!has_otel_collect("reactivity")) {
return(x)
}
enable_otel_reactive_values(x)
}
#' @export
@@ -918,10 +824,6 @@ Observable <- R6Class(
.mostRecentCtxId = character(0),
.ctx = 'Context',
.isRecordingOtel = FALSE, # Needs to be set by Shiny
.otelLabel = NULL, # Needs to be set by Shiny
.otelAttrs = NULL, # Needs to be set by Shiny
initialize = function(func, label = deparse(substitute(func)),
domain = getDefaultReactiveDomain(),
..stacktraceon = TRUE) {
@@ -976,19 +878,9 @@ Observable <- R6Class(
simpleExprToFunction(fn_body(.origFunc), "reactive")
},
.updateValue = function() {
ctx <- Context$new(
.domain,
.label,
type = 'observable',
prevId = .mostRecentCtxId,
reactId = .reactId,
weak = TRUE,
otel_info = ctx_otel_info_obj(
isRecordingOtel = .isRecordingOtel,
otelLabel = .otelLabel,
otelAttrs = c(.otelAttrs, otel_session_id_attrs(.domain))
)
)
ctx <- Context$new(.domain, .label, type = 'observable',
prevId = .mostRecentCtxId, reactId = .reactId,
weak = TRUE)
.mostRecentCtxId <<- ctx$id
# A Dependency object will have a weak reference to the context, which
@@ -1021,15 +913,6 @@ Observable <- R6Class(
},
error = function(cond) {
if (.isRecordingOtel) {
# `cond` is too early in the stack to be updated by `ctx`'s
# `with_otel_span_context()` where it calls
# `set_otel_exception_status_and_throw()` on eval error.
# So we mark it as seen here.
# When the error is re-thrown later, it won't be a _new_ error
cond <- mark_otel_exception_as_seen(cond)
}
# If an error occurs, we want to propagate the error, but we also
# want to save a copy of it, so future callers of this reactive will
# get the same error (i.e. the error is cached).
@@ -1061,10 +944,7 @@ 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 [`rlang::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.
#' @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
@@ -1127,24 +1007,12 @@ reactive <- function(
label <- exprToLabel(userExpr, "reactive", label)
o <- Observable$new(func, label, domain, ..stacktraceon = ..stacktraceon)
call_srcref <- get_call_srcref()
if (!is.null(call_srcref)) {
o$.otelAttrs <- otel_srcref_attributes(call_srcref, fn_name = "reactive")
}
ret <- structure(
structure(
o$getValue,
observable = o,
cacheHint = list(userExpr = zap_srcref(userExpr)),
class = c("reactiveExpr", "reactive", "function")
)
if (has_otel_collect("reactivity")) {
ret <- enable_otel_reactive_expr(ret)
}
ret
}
# Given the srcref to a reactive expression, attempts to figure out what the
@@ -1152,7 +1020,7 @@ reactive <- function(
# scans the line of code that started the reactive block and looks for something
# that looks like assignment. If we fail, fall back to a default value (likely
# the block of code in the body of the reactive).
rexprSrcrefToLabel <- function(srcref, defaultLabel, fnName) {
rexprSrcrefToLabel <- function(srcref, defaultLabel) {
if (is.null(srcref))
return(defaultLabel)
@@ -1175,8 +1043,7 @@ rexprSrcrefToLabel <- function(srcref, defaultLabel, fnName) {
firstLine <- substring(lines[srcref[1]], 1, srcref[2] - 1)
# Require the assignment to be parsed from the start
m <- regexec(paste0("^(.*)(<<-|<-|=)\\s*", fnName, "\\s*\\($"), firstLine)
m <- regexec("(.*)(<-|=)\\s*reactive\\s*\\($", firstLine)
if (m[[1]][1] == -1) {
return(defaultLabel)
}
@@ -1250,10 +1117,6 @@ Observer <- R6Class(
.prevId = character(0),
.ctx = NULL,
.isRecordingOtel = FALSE, # Needs to be set by Shiny
.otelLabel = NULL, # Needs to be set by Shiny
.otelAttrs = NULL, # Needs to be set by Shiny
initialize = function(observerFunc, label, suspended = FALSE, priority = 0,
domain = getDefaultReactiveDomain(),
autoDestroy = TRUE, ..stacktraceon = TRUE) {
@@ -1288,18 +1151,7 @@ Observer <- R6Class(
.createContext()$invalidate()
},
.createContext = function() {
ctx <- Context$new(
.domain,
.label,
type = 'observer',
prevId = .prevId,
reactId = .reactId,
otel_info = ctx_otel_info_obj(
isRecordingOtel = .isRecordingOtel,
otelLabel = .otelLabel,
otelAttrs = c(.otelAttrs, otel_session_id_attrs(.domain))
)
)
ctx <- Context$new(.domain, .label, type='observer', prevId=.prevId, reactId = .reactId)
.prevId <<- ctx$id
if (!is.null(.ctx)) {
@@ -1357,7 +1209,7 @@ Observer <- R6Class(
printError(e)
if (!is.null(.domain)) {
.domain$unhandledError(e, close = TRUE)
.domain$unhandledError(e)
}
},
finally = .domain$decrementBusyCount
@@ -1568,14 +1420,7 @@ observe <- function(
check_dots_empty()
func <- installExprFunction(x, "func", env, quoted)
call_srcref <- get_call_srcref()
if (is.null(label)) {
label <- rassignSrcrefToLabel(
call_srcref,
defaultLabel = funcToLabel(func, "observe", label)
)
}
label <- funcToLabel(func, "observe", label)
o <- Observer$new(
func,
@@ -1586,14 +1431,6 @@ observe <- function(
autoDestroy = autoDestroy,
..stacktraceon = ..stacktraceon
)
if (!is.null(call_srcref)) {
o$.otelAttrs <- otel_srcref_attributes(call_srcref, fn_name = "observe")
}
if (has_otel_collect("reactivity")) {
o <- enable_otel_observe(o)
}
invisible(o)
}
@@ -1981,64 +1818,34 @@ coerceToFunc <- function(x) {
#' }
#' @export
reactivePoll <- function(intervalMillis, session, checkFunc, valueFunc) {
reactive_poll_impl(
fnName = "reactivePoll",
intervalMillis = intervalMillis,
session = session,
checkFunc = checkFunc,
valueFunc = valueFunc
)
}
reactive_poll_impl <- function(
fnName,
intervalMillis,
session,
checkFunc,
valueFunc
) {
intervalMillis <- coerceToFunc(intervalMillis)
fnName <- match.arg(fnName, c("reactivePoll", "reactiveFileReader"), several.ok = FALSE)
call_srcref <- get_call_srcref(-1)
label <- rassignSrcrefToLabel(
call_srcref,
defaultLabel = "<anonymous>",
fnName = fnName
)
rv <- reactiveValues(cookie = isolate(checkFunc()))
re_finalized <- FALSE
env <- environment()
with_no_otel_collect({
cookie <- reactiveVal(
isolate(checkFunc()),
label = sprintf("%s %s cookie", fnName, label)
)
o <- observe({
# When no one holds a reference to the reactive returned from
# reactivePoll, destroy and remove the observer so that it doesn't keep
# firing and hold onto resources.
if (re_finalized) {
o$destroy()
rm(o, envir = env)
return()
}
o <- observe({
# When no one holds a reference to the reactive returned from
# reactivePoll, destroy and remove the observer so that it doesn't keep
# firing and hold onto resources.
if (re_finalized) {
o$destroy()
rm(o, envir = env)
return()
}
cookie(checkFunc())
invalidateLater(intervalMillis(), session)
}, label = sprintf("%s %s cleanup", fnName, label))
rv$cookie <- checkFunc()
invalidateLater(intervalMillis(), session)
})
re <- reactive(label = sprintf("%s %s", fnName, label), {
# Take a dependency on the cookie, so that when it changes, this
# reactive expression is invalidated.
cookie()
# TODO: what to use for a label?
re <- reactive({
rv$cookie
valueFunc()
})
}, label = NULL)
reg.finalizer(attr(re, "observable"), function(e) {
re_finalized <<- TRUE
@@ -2048,16 +1855,6 @@ reactive_poll_impl <- function(
# reference to `re` and thus prevent it from getting GC'd.
on.exit(rm(re))
local({
impl <- attr(re, "observable", exact = TRUE)
impl$.otelLabel <-
if (fnName == "reactivePoll")
otel_label_reactive_poll(label, domain = impl$.domain)
else if (fnName == "reactiveFileReader")
otel_label_reactive_file_reader(label, domain = impl$.domain)
impl$.otelAttrs <- append_otel_srcref_attrs(impl$.otelAttrs, call_srcref, fn_name = fnName)
})
return(re)
}
@@ -2121,16 +1918,14 @@ reactiveFileReader <- function(intervalMillis, session, filePath, readFunc, ...)
filePath <- coerceToFunc(filePath)
extraArgs <- list2(...)
reactive_poll_impl(
fnName = "reactiveFileReader",
intervalMillis = intervalMillis,
session = session,
checkFunc = function() {
reactivePoll(
intervalMillis, session,
function() {
path <- filePath()
info <- file.info(path)
return(paste(path, info$mtime, info$size))
},
valueFunc = function() {
function() {
do.call(readFunc, c(filePath(), extraArgs))
}
)
@@ -2212,8 +2007,6 @@ isolate <- function(expr) {
} else {
reactId <- rLog$noReactId
}
# Do not track otel spans for `isolate()`
ctx <- Context$new(getDefaultReactiveDomain(), '[isolate]', type='isolate', reactId = reactId)
on.exit(ctx$invalidate())
# Matching ..stacktraceon../..stacktraceoff.. pair
@@ -2387,8 +2180,8 @@ maskReactiveContext <- function(expr) {
#' @param autoDestroy If `TRUE` (the default), the observer will be
#' automatically destroyed when its domain (if any) ends.
#' @param ignoreNULL Whether the action should be triggered (or value
#' calculated, in the case of `eventReactive`) when the input event expression
#' is `NULL`. See Details.
#' calculated, in the case of `eventReactive`) when the input is
#' `NULL`. See Details.
#' @param ignoreInit If `TRUE`, then, when this `observeEvent` is
#' first created/initialized, ignore the `handlerExpr` (the second
#' argument), whether it is otherwise supposed to run or not. The default is
@@ -2492,41 +2285,26 @@ observeEvent <- function(eventExpr, handlerExpr,
eventQ <- exprToQuo(eventExpr, event.env, event.quoted)
handlerQ <- exprToQuo(handlerExpr, handler.env, handler.quoted)
call_srcref <- get_call_srcref()
if (is.null(label)) {
label <- rassignSrcrefToLabel(
call_srcref,
defaultLabel = quoToLabel(eventQ, "observeEvent", label)
)
}
label <- quoToLabel(eventQ, "observeEvent", label)
with_no_otel_collect({
handler <- inject(observe(
!!handlerQ,
label = label,
suspended = suspended,
priority = priority,
domain = domain,
autoDestroy = TRUE,
..stacktraceon = TRUE
))
handler <- inject(observe(
!!handlerQ,
label = label,
suspended = suspended,
priority = priority,
domain = domain,
autoDestroy = TRUE,
..stacktraceon = FALSE # TODO: Does this go in the bindEvent?
))
o <- inject(bindEvent(
ignoreNULL = ignoreNULL,
ignoreInit = ignoreInit,
once = once,
label = label,
!!eventQ,
x = handler
))
})
if (!is.null(call_srcref)) {
o$.otelAttrs <- otel_srcref_attributes(call_srcref, fn_name = "observeEvent")
}
if (has_otel_collect("reactivity")) {
o <- enable_otel_observe(o)
}
o <- inject(bindEvent(
ignoreNULL = ignoreNULL,
ignoreInit = ignoreInit,
once = once,
label = label,
!!eventQ,
x = handler
))
invisible(o)
}
@@ -2545,40 +2323,15 @@ eventReactive <- function(eventExpr, valueExpr,
eventQ <- exprToQuo(eventExpr, event.env, event.quoted)
valueQ <- exprToQuo(valueExpr, value.env, value.quoted)
func <- installExprFunction(eventExpr, "func", event.env, event.quoted, wrappedWithLabel = FALSE)
# Attach a label and a reference to the original user source for debugging
userEventExpr <- fn_body(func)
label <- quoToLabel(eventQ, "eventReactive", label)
call_srcref <- get_call_srcref()
if (is.null(label)) {
label <- rassignSrcrefToLabel(
call_srcref,
defaultLabel = exprToLabel(userEventExpr, "eventReactive", label)
)
}
with_no_otel_collect({
value_r <- inject(reactive(!!valueQ, domain = domain, label = label))
r <- inject(bindEvent(
ignoreNULL = ignoreNULL,
ignoreInit = ignoreInit,
label = label,
!!eventQ,
x = value_r
))
})
if (!is.null(call_srcref)) {
impl <- attr(r, "observable", exact = TRUE)
impl$.otelAttrs <- otel_srcref_attributes(call_srcref, fn_name = "eventReactive")
}
if (has_otel_collect("reactivity")) {
r <- enable_otel_reactive_expr(r)
}
return(r)
invisible(inject(bindEvent(
ignoreNULL = ignoreNULL,
ignoreInit = ignoreInit,
label = label,
!!eventQ,
x = reactive(!!valueQ, domain = domain, label = label)
)))
}
isNullEvent <- function(value) {
@@ -2636,7 +2389,7 @@ isNullEvent <- function(value) {
#' reactive recently (within the time window) invalidated. New `r`
#' invalidations do not reset the time window. This means that if invalidations
#' continually come from `r` within the time window, the throttled reactive
#' will invalidate regularly, at a rate equal to or slower than the time
#' will invalidate regularly, at a rate equal to or slower than than the time
#' window.
#'
#' `ooo-oo-oo---- => o--o--o--o---`
@@ -2693,103 +2446,71 @@ isNullEvent <- function(value) {
#'
#' @export
debounce <- function(r, millis, priority = 100, domain = getDefaultReactiveDomain()) {
# Do not bind OpenTelemetry spans for debounce reactivity internals,
# except for the eventReactive that is returned.
# TODO: make a nice label for the observer(s)
force(r)
force(millis)
call_srcref <- get_call_srcref()
label <- rassignSrcrefToLabel(
call_srcref,
defaultLabel = "<anonymous>"
)
if (!is.function(millis)) {
origMillis <- millis
millis <- function() origMillis
}
with_no_otel_collect({
trigger <- reactiveVal(NULL, label = sprintf("debounce %s trigger", label))
# the deadline for the timer to fire; NULL if not scheduled
when <- reactiveVal(NULL, label = sprintf("debounce %s when", label))
# Responsible for tracking when r() changes.
firstRun <- TRUE
observe(
label = sprintf("debounce %s tracker", label),
domain = domain,
priority = priority,
{
if (firstRun) {
# During the first run we don't want to set `when`, as this will kick
# off the timer. We only want to do that when we see `r()` change.
firstRun <<- FALSE
# Ensure r() is called only after setting firstRun to FALSE since r()
# may throw an error
try(r(), silent = TRUE)
return()
}
# This ensures r() is still tracked after firstRun
try(r(), silent = TRUE)
# The value (or possibly millis) changed. Start or reset the timer.
when(
getDomainTimeMs(domain) + millis()
)
}
)
# This observer is the timer. It rests until `when` elapses, then touches
# `trigger`.
observe(
label = sprintf("debounce %s timer", label),
domain = domain,
priority = priority,
{
if (is.null(when()))
return()
now <- getDomainTimeMs(domain)
if (now >= when()) {
# Mod by 999999999 to get predictable overflow behavior
trigger(
isolate(trigger() %||% 0) %% 999999999 + 1
)
when(NULL)
} else {
invalidateLater(when() - now)
}
}
)
})
# This is the actual reactive that is returned to the user. It returns the
# value of r(), but only invalidates/updates when `trigger` is touched.
er <- eventReactive(
{trigger()}, {r()},
label = sprintf("debounce %s result", label), ignoreNULL = FALSE, domain = domain
v <- reactiveValues(
trigger = NULL,
when = NULL # the deadline for the timer to fire; NULL if not scheduled
)
# Update the otel label
local({
er_impl <- attr(er, "observable", exact = TRUE)
er_impl$.otelLabel <- otel_label_debounce(label, domain = domain)
er_impl$.otelAttrs <- append_otel_srcref_attrs(er_impl$.otelAttrs, call_srcref, fn_name = "debounce")
})
# Responsible for tracking when r() changes.
firstRun <- TRUE
observe({
if (firstRun) {
# During the first run we don't want to set v$when, as this will kick off
# the timer. We only want to do that when we see r() change.
firstRun <<- FALSE
with_no_otel_collect({
# Force the value of er to be immediately cached upon creation. It's very hard
# to explain why this observer is needed, but if you want to understand, try
# commenting it out and studying the unit test failure that results.
primer <- observe({
primer$destroy()
try(er(), silent = TRUE)
}, label = sprintf("debounce %s primer", label), domain = domain, priority = priority)
})
# Ensure r() is called only after setting firstRun to FALSE since r()
# may throw an error
try(r(), silent = TRUE)
return()
}
# This ensures r() is still tracked after firstRun
try(r(), silent = TRUE)
# The value (or possibly millis) changed. Start or reset the timer.
v$when <- getDomainTimeMs(domain) + millis()
}, label = "debounce tracker", domain = domain, priority = priority)
# This observer is the timer. It rests until v$when elapses, then touches
# v$trigger.
observe({
if (is.null(v$when))
return()
now <- getDomainTimeMs(domain)
if (now >= v$when) {
# Mod by 999999999 to get predictable overflow behavior
v$trigger <- isolate(v$trigger %||% 0) %% 999999999 + 1
v$when <- NULL
} else {
invalidateLater(v$when - now)
}
}, label = "debounce timer", domain = domain, priority = priority)
# This is the actual reactive that is returned to the user. It returns the
# value of r(), but only invalidates/updates when v$trigger is touched.
er <- eventReactive(v$trigger, {
r()
}, label = "debounce result", ignoreNULL = FALSE, domain = domain)
# Force the value of er to be immediately cached upon creation. It's very hard
# to explain why this observer is needed, but if you want to understand, try
# commenting it out and studying the unit test failure that results.
primer <- observe({
primer$destroy()
try(er(), silent = TRUE)
}, label = "debounce primer", domain = domain, priority = priority)
er
}
@@ -2797,88 +2518,69 @@ debounce <- function(r, millis, priority = 100, domain = getDefaultReactiveDomai
#' @rdname debounce
#' @export
throttle <- function(r, millis, priority = 100, domain = getDefaultReactiveDomain()) {
# Do not bind OpenTelemetry spans for throttle reactivity internals,
# except for the eventReactive that is returned.
# TODO: make a nice label for the observer(s)
force(r)
force(millis)
call_srcref <- get_call_srcref()
label <- rassignSrcrefToLabel(
call_srcref,
defaultLabel = "<anonymous>"
)
if (!is.function(millis)) {
origMillis <- millis
millis <- function() origMillis
}
with_no_otel_collect({
trigger <- reactiveVal(0, label = sprintf("throttle %s trigger", label))
# Last time we fired; NULL if never
lastTriggeredAt <- reactiveVal(NULL, label = sprintf("throttle %s last triggered at", label))
# If TRUE, trigger again when timer elapses
pending <- reactiveVal(FALSE, label = sprintf("throttle %s pending", label))
})
v <- reactiveValues(
trigger = 0,
lastTriggeredAt = NULL, # Last time we fired; NULL if never
pending = FALSE # If TRUE, trigger again when timer elapses
)
blackoutMillisLeft <- function() {
if (is.null(lastTriggeredAt())) {
if (is.null(v$lastTriggeredAt)) {
0
} else {
max(0, lastTriggeredAt() + millis() - getDomainTimeMs(domain))
max(0, v$lastTriggeredAt + millis() - getDomainTimeMs(domain))
}
}
update_trigger <- function() {
lastTriggeredAt(getDomainTimeMs(domain))
trigger <- function() {
v$lastTriggeredAt <- getDomainTimeMs(domain)
# Mod by 999999999 to get predictable overflow behavior
trigger(isolate(trigger()) %% 999999999 + 1)
pending(FALSE)
v$trigger <- isolate(v$trigger) %% 999999999 + 1
v$pending <- FALSE
}
with_no_otel_collect({
# Responsible for tracking when f() changes.
observeEvent(try(r(), silent = TRUE), {
if (pending()) {
# In a blackout period and someone already scheduled; do nothing
} else if (blackoutMillisLeft() > 0) {
# In a blackout period but this is the first change in that period; set
# pending so that a trigger will be scheduled at the end of the period
pending(TRUE)
} else {
# Not in a blackout period. Trigger, which will start a new blackout
# period.
update_trigger()
}
}, label = sprintf("throttle %s tracker", label), ignoreNULL = FALSE, priority = priority, domain = domain)
# Responsible for tracking when f() changes.
observeEvent(try(r(), silent = TRUE), {
if (v$pending) {
# In a blackout period and someone already scheduled; do nothing
} else if (blackoutMillisLeft() > 0) {
# In a blackout period but this is the first change in that period; set
# v$pending so that a trigger will be scheduled at the end of the period
v$pending <- TRUE
} else {
# Not in a blackout period. Trigger, which will start a new blackout
# period.
trigger()
}
}, label = "throttle tracker", ignoreNULL = FALSE, priority = priority, domain = domain)
observe({
if (!pending()) {
return()
}
observe({
if (!v$pending) {
return()
}
timeout <- blackoutMillisLeft()
if (timeout > 0) {
invalidateLater(timeout)
} else {
update_trigger()
}
}, label = sprintf("throttle %s trigger", label), priority = priority, domain = domain)
})
timeout <- blackoutMillisLeft()
if (timeout > 0) {
invalidateLater(timeout)
} else {
trigger()
}
}, priority = priority, domain = domain)
# This is the actual reactive that is returned to the user. It returns the
# value of r(), but only invalidates/updates when trigger is touched.
er <- eventReactive({trigger()}, {
# value of r(), but only invalidates/updates when v$trigger is touched.
eventReactive(v$trigger, {
r()
}, label = sprintf("throttle %s result", label), ignoreNULL = FALSE, domain = domain)
# Update the otel label
local({
er_impl <- attr(er, "observable", exact = TRUE)
er_impl$.otelLabel <- otel_label_throttle(label, domain = domain)
er_impl$.otelAttrs <- append_otel_srcref_attrs(er_impl$.otelAttrs, call_srcref, fn_name = "throttle")
})
er
}, label = "throttle result", ignoreNULL = FALSE, domain = domain)
}

View File

@@ -194,8 +194,8 @@ renderPlot <- function(expr, width = 'auto', height = 'auto', res = 72, ...,
}
resizeSavedPlot <- function(name, session, result, width, height, alt, pixelratio, res, ...) {
if (isTRUE(result$img$width == width && result$img$height == height &&
result$pixelratio == pixelratio && result$res == res)) {
if (result$img$width == width && result$img$height == height &&
result$pixelratio == pixelratio && result$res == res) {
return(result)
}
@@ -253,7 +253,7 @@ drawPlot <- function(name, session, func, width, height, alt, pixelratio, res, .
hybrid_chain(
hybrid_chain(
with_promise_domain(domain, {
promises::with_promise_domain(domain, {
hybrid_chain(
func(),
function(value) {
@@ -266,8 +266,6 @@ drawPlot <- function(name, session, func, width, height, alt, pixelratio, res, .
# addition to ggplot, and there's a print method for that class, that we
# won't override that method. https://github.com/rstudio/shiny/issues/841
print.ggplot <- custom_print.ggplot
# For compatibility with ggplot2 >v4.0.0
`print.ggplot2::ggplot` <- custom_print.ggplot
# Use capture.output to squelch printing to the actual console; we
# are only interested in plot output

View File

@@ -84,22 +84,13 @@
#' runApp(app)
#' }
#' @export
runApp <- function(
appDir=getwd(),
port=getOption('shiny.port'),
launch.browser = getOption('shiny.launch.browser', interactive()),
host=getOption('shiny.host', '127.0.0.1'),
workerId="", quiet=FALSE,
display.mode=c("auto", "normal", "showcase"),
test.mode=getOption('shiny.testmode', FALSE)
) {
# * Wrap **all** execution of the app inside the otel promise domain
# * While this could be done at a lower level, it allows for _anything_ within
# shiny's control to allow for the opportunity to have otel active spans be
# reactivated upon promise domain restoration
promises::local_otel_promise_domain()
runApp <- function(appDir=getwd(),
port=getOption('shiny.port'),
launch.browser = getOption('shiny.launch.browser', interactive()),
host=getOption('shiny.host', '127.0.0.1'),
workerId="", quiet=FALSE,
display.mode=c("auto", "normal", "showcase"),
test.mode=getOption('shiny.testmode', FALSE)) {
on.exit({
handlerManager$clear()
}, add = TRUE)
@@ -454,20 +445,8 @@ stopApp <- function(returnValue = invisible()) {
#' @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.
#' @param display.mode The mode in which to display the example. Defaults to
#' `"auto"`, which uses the value of `DisplayMode` in the example's
#' `DESCRIPTION` file. Set to `"showcase"` to show the app code and
#' description with the running app, or `"normal"` to see the example without
#' `showcase`, but may be set to `normal` to see the example without
#' code or commentary.
#' @param package The package in which to find the example (defaults to
#' `"shiny"`).
#'
#' To provide examples in your package, store examples in the
#' `inst/examples-shiny` directory of your package. Each example should be
#' in its own subdirectory and should be runnable when [runApp()] is called
#' on the subdirectory. Example apps can include a `DESCRIPTION` file and a
#' `README.md` file to provide metadata and commentary about the example. See
#' the article on [Display Modes](https://shiny.posit.co/r/articles/build/display-modes/)
#' on the Shiny website for more information.
#' @inheritParams runApp
#'
#' @examples
@@ -483,46 +462,32 @@ stopApp <- function(returnValue = invisible()) {
#' system.file("examples", package="shiny")
#' }
#' @export
runExample <- function(
example = NA,
port = getOption("shiny.port"),
launch.browser = getOption("shiny.launch.browser", interactive()),
host = getOption("shiny.host", "127.0.0.1"),
display.mode = c("auto", "normal", "showcase"),
package = "shiny"
) {
if (!identical(package, "shiny") && !is_installed(package)) {
rlang::check_installed(package)
}
use_legacy_shiny_examples <-
identical(package, "shiny") &&
isTRUE(getOption('shiny.legacy.examples', FALSE))
examplesDir <- system_file(
if (use_legacy_shiny_examples) "examples" else "examples-shiny",
package = package
)
runExample <- function(example=NA,
port=getOption("shiny.port"),
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')
dir <- resolve(examplesDir, example)
if (is.null(dir)) {
valid_examples <- sprintf(
'Valid examples in {%s}: "%s"',
package,
paste(list.files(examplesDir), collapse = '", "')
)
if (is.na(example)) {
message(valid_examples)
return(invisible())
errFun <- message
errMsg <- ''
}
else {
errFun <- stop
errMsg <- paste('Example', example, 'does not exist. ')
}
stop("Example '", example, "' does not exist. ", valid_examples)
errFun(errMsg,
'Valid examples are "',
paste(list.files(examplesDir), collapse='", "'),
'"')
}
else {
runApp(dir, port = port, host = host, launch.browser = launch.browser,
display.mode = display.mode)
}
runApp(dir, port = port, host = host, launch.browser = launch.browser,
display.mode = display.mode)
}
#' Run a gadget

View File

@@ -1,9 +1,5 @@
# Create a Map object for input handlers and register the defaults.
# This is assigned in .onLoad time.
inputHandlers <- NULL
on_load({
inputHandlers <- Map$new()
})
# Create a map for input handlers and register the defaults.
inputHandlers <- Map$new()
#' Register an Input Handler
#'
@@ -129,117 +125,115 @@ applyInputHandlers <- function(inputs, shinysession = getDefaultReactiveDomain()
inputs
}
on_load({
# Takes a list-of-lists and returns a matrix. The lists
# must all be the same length. NULL is replaced by NA.
registerInputHandler("shiny.matrix", function(data, ...) {
if (length(data) == 0)
return(matrix(nrow=0, ncol=0))
m <- matrix(unlist(lapply(data, function(x) {
sapply(x, function(y) {
ifelse(is.null(y), NA, y)
})
})), nrow = length(data[[1]]), ncol = length(data))
return(m)
})
# Takes a list-of-lists and returns a matrix. The lists
# must all be the same length. NULL is replaced by NA.
registerInputHandler("shiny.matrix", function(data, ...) {
if (length(data) == 0)
return(matrix(nrow=0, ncol=0))
registerInputHandler("shiny.number", function(val, ...){
ifelse(is.null(val), NA, val)
})
registerInputHandler("shiny.password", function(val, shinysession, name) {
# Mark passwords as not serializable
setSerializer(name, serializerUnserializable)
val
})
registerInputHandler("shiny.date", function(val, ...){
# First replace NULLs with NA, then convert to Date vector
datelist <- ifelse(lapply(val, is.null), NA, val)
res <- NULL
tryCatch({
res <- as.Date(unlist(datelist))
},
error = function(e) {
# It's possible for client to send a string like "99999-01-01", which
# as.Date can't handle.
warning(e$message)
res <<- as.Date(rep(NA, length(datelist)))
}
)
res
})
registerInputHandler("shiny.datetime", function(val, ...){
# First replace NULLs with NA, then convert to POSIXct vector
times <- lapply(val, function(x) {
if (is.null(x)) NA
else x
m <- matrix(unlist(lapply(data, function(x) {
sapply(x, function(y) {
ifelse(is.null(y), NA, y)
})
as.POSIXct(unlist(times), origin = "1970-01-01", tz = "UTC")
})
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))
val
})
registerInputHandler("shiny.file", function(val, shinysession, name) {
# This function is only used when restoring a Shiny fileInput. When a file is
# uploaded the usual way, it takes a different code path and won't hit this
# function.
if (is.null(val))
return(NULL)
# The data will be a named list of lists; convert to a data frame.
val <- as.data.frame(lapply(val, unlist), stringsAsFactors = FALSE)
# `val$datapath` should be a filename without a path, for security reasons.
if (basename(val$datapath) != val$datapath) {
stop("Invalid '/' found in file input path.")
}
# Prepend the persistent dir
oldfile <- file.path(getCurrentRestoreContext()$dir, val$datapath)
# Copy the original file to a new temp dir, so that a restored session can't
# modify the original.
newdir <- file.path(tempdir(), createUniqueId(12))
dir.create(newdir)
val$datapath <- file.path(newdir, val$datapath)
file.copy(oldfile, val$datapath)
# Need to mark this input value with the correct serializer. When a file is
# uploaded the usual way (instead of being restored), this occurs in
# session$`@uploadEnd`.
setSerializer(name, serializerFileInput)
snapshotPreprocessInput(name, snapshotPreprocessorFileInput)
val
})
# to be used with !!!answer
registerInputHandler("shiny.symbolList", function(val, ...) {
if (is.null(val)) {
list()
} else {
lapply(val, as.symbol)
}
})
# to be used with !!answer
registerInputHandler("shiny.symbol", function(val, ...) {
if (is.null(val) || identical(val, "")) {
NULL
} else {
as.symbol(val)
}
})
})), nrow = length(data[[1]]), ncol = length(data))
return(m)
})
registerInputHandler("shiny.number", function(val, ...){
ifelse(is.null(val), NA, val)
})
registerInputHandler("shiny.password", function(val, shinysession, name) {
# Mark passwords as not serializable
setSerializer(name, serializerUnserializable)
val
})
registerInputHandler("shiny.date", function(val, ...){
# First replace NULLs with NA, then convert to Date vector
datelist <- ifelse(lapply(val, is.null), NA, val)
res <- NULL
tryCatch({
res <- as.Date(unlist(datelist))
},
error = function(e) {
# It's possible for client to send a string like "99999-01-01", which
# as.Date can't handle.
warning(e$message)
res <<- as.Date(rep(NA, length(datelist)))
}
)
res
})
registerInputHandler("shiny.datetime", function(val, ...){
# First replace NULLs with NA, then convert to POSIXct vector
times <- lapply(val, function(x) {
if (is.null(x)) NA
else x
})
as.POSIXct(unlist(times), origin = "1970-01-01", tz = "UTC")
})
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))
val
})
registerInputHandler("shiny.file", function(val, shinysession, name) {
# This function is only used when restoring a Shiny fileInput. When a file is
# uploaded the usual way, it takes a different code path and won't hit this
# function.
if (is.null(val))
return(NULL)
# The data will be a named list of lists; convert to a data frame.
val <- as.data.frame(lapply(val, unlist), stringsAsFactors = FALSE)
# `val$datapath` should be a filename without a path, for security reasons.
if (basename(val$datapath) != val$datapath) {
stop("Invalid '/' found in file input path.")
}
# Prepend the persistent dir
oldfile <- file.path(getCurrentRestoreContext()$dir, val$datapath)
# Copy the original file to a new temp dir, so that a restored session can't
# modify the original.
newdir <- file.path(tempdir(), createUniqueId(12))
dir.create(newdir)
val$datapath <- file.path(newdir, val$datapath)
file.copy(oldfile, val$datapath)
# Need to mark this input value with the correct serializer. When a file is
# uploaded the usual way (instead of being restored), this occurs in
# session$`@uploadEnd`.
setSerializer(name, serializerFileInput)
snapshotPreprocessInput(name, snapshotPreprocessorFileInput)
val
})
# to be used with !!!answer
registerInputHandler("shiny.symbolList", function(val, ...) {
if (is.null(val)) {
list()
} else {
lapply(val, as.symbol)
}
})
# to be used with !!answer
registerInputHandler("shiny.symbol", function(val, ...) {
if (is.null(val) || identical(val, "")) {
NULL
} else {
as.symbol(val)
}
})

View File

@@ -1,12 +1,7 @@
#' @include server-input-handlers.R
appsByToken <- NULL
appsNeedingFlush <- NULL
on_load({
appsByToken <- Map$new()
appsNeedingFlush <- Map$new()
})
appsByToken <- Map$new()
appsNeedingFlush <- Map$new()
# Provide a character representation of the WS that can be used
# as a key in a Map.
@@ -34,7 +29,7 @@ registerClient <- function(client) {
#' Define Server Functionality
#'
#' @description `r lifecycle::badge("superseded")`
#' @description \lifecycle{superseded}
#'
#' @description Defines the server-side logic of the Shiny application. This generally
#' involves creating functions that map user inputs to various kinds of output.
@@ -127,10 +122,7 @@ decodeMessage <- function(data) {
return(mainMessage)
}
autoReloadCallbacks <- NULL
on_load({
autoReloadCallbacks <- Callbacks$new()
})
autoReloadCallbacks <- Callbacks$new()
createAppHandlers <- function(httpHandlers, serverFuncSource) {
appvars <- new.env()
@@ -274,20 +266,15 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
args <- argsForServerFunc(serverFunc, shinysession)
withReactiveDomain(shinysession, {
otel_span_session_start(domain = shinysession, {
do.call(
# No corresponding ..stacktraceoff; the server func is pure
# user code
wrapFunctionLabel(appvars$server, "server",
..stacktraceon = TRUE
),
args
)
})
do.call(
# No corresponding ..stacktraceoff; the server func is pure
# user code
wrapFunctionLabel(appvars$server, "server",
..stacktraceon = TRUE
),
args
)
})
})
},
update = {

View File

@@ -65,20 +65,16 @@ getShinyOption <- function(name, default = NULL) {
#' changes are detected, all connected Shiny sessions are reloaded. This
#' allows for fast feedback loops when tweaking Shiny UI.
#'
#' Monitoring for changes is no longer expensive, thanks to the \pkg{watcher}
#' package, but this feature is still intended only for development.
#' Since monitoring for changes is expensive (we simply poll for last
#' modified times), this feature is intended only for development.
#'
#' You can customize the file patterns Shiny will monitor by setting the
#' shiny.autoreload.pattern option. For example, to monitor only `ui.R`:
#' `options(shiny.autoreload.pattern = glob2rx("ui.R"))`.
#' shiny.autoreload.pattern option. For example, to monitor only ui.R:
#' `options(shiny.autoreload.pattern = glob2rx("ui.R"))`
#'
#' As mentioned above, Shiny no longer polls watched files for changes.
#' Instead, using \pkg{watcher}, Shiny is notified of file changes as they
#' occur. These changes are batched together within a customizable latency
#' period. You can adjust this period by setting
#' `options(shiny.autoreload.interval = 2000)` (in milliseconds). This value
#' converted to seconds and passed to the `latency` argument of
#' [watcher::watcher()]. The default latency is 250ms.}
#' The default polling interval is 500 milliseconds. You can change this
#' by setting e.g. `options(shiny.autoreload.interval = 2000)` (every
#' two seconds).}
#' \item{shiny.deprecation.messages (defaults to `TRUE`)}{This controls whether messages for
#' deprecated functions in Shiny will be printed. See
#' [shinyDeprecated()] for more information.}
@@ -94,9 +90,8 @@ getShinyOption <- function(name, default = NULL) {
#' \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.}
#' \item{shiny.json.digits (defaults to `I(16)`)}{Max number of digits to use when converting
#' numbers to JSON format to send to the client web browser. Use [I()] to specify significant digits.
#' Use `NA` for max precision.}
#' \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"`)}{
@@ -117,7 +112,7 @@ getShinyOption <- function(name, default = NULL) {
#' production.}
#' \item{shiny.sanitize.errors (defaults to `FALSE`)}{If `TRUE`, then normal errors (i.e.
#' errors not wrapped in `safeError`) won't show up in the app; a simple
#' generic error message is printed instead (the error and stack trace printed
#' generic error message is printed instead (the error and strack trace printed
#' to the console remain unchanged). If you want to sanitize errors in general, but you DO want a
#' particular error `e` to get displayed to the user, then set this option
#' to `TRUE` and use `stop(safeError(e))` for errors you want the
@@ -155,36 +150,6 @@ getShinyOption <- function(name, default = NULL) {
# ' \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')
### start shiny.client_devmode is primarily for niche, internal shinylive usage
# ' \item{shiny.client_devmode (defaults to `FALSE`)}{If `TRUE`, enables client-
# ' side devmode features. Currently the primary feature is the client-side
# ' error console.}
### end shiny.client_devmode
#' \item{shiny.otel.collect (defaults to `Sys.getenv("SHINY_OTEL_COLLECT",
#' "all")`)}{Determines how Shiny will interact with OpenTelemetry.
#'
#' Supported values:
#' * `"none"` - No Shiny OpenTelemetry tracing.
#' * `"session"` - Adds session start/end spans.
#' * `"reactive_update"` - Spans for any synchronous/asynchronous reactive
#' update. (Includes `"session"` features).
#' * `"reactivity"` - Spans for all reactive expressions and logs for setting
#' reactive vals and values. (Includes `"reactive_update"` features). This
#' option must be set when creating any reactive objects that should record
#' OpenTelemetry spans / logs. See [`withOtelCollect()`] and
#' [`localOtelCollect()`] for ways to set this option locally when creating
#' your reactive expressions.
#' * `"all"` - All Shiny OpenTelemetry tracing. Currently equivalent to
#' `"reactivity"`.
#'
#' This option is useful for debugging and profiling while in production. This
#' option will only be useful if the `otelsdk` package is installed and
#' `otel::is_tracing_enabled()` returns `TRUE`. Please have any OpenTelemetry
#' environment variables set before loading any relevant R packages.
#'
#' To set this option locally within a specific part of your Shiny
#' application, see [`withOtelCollect()`] and [`localOtelCollect()`].}
#' \item{shiny.otel.sanitize.errors (defaults to `TRUE`)}{If `TRUE`, fatal and unhandled errors will be sanitized before being sent to the OpenTelemetry backend. The default value of `TRUE` is set to avoid potentially sending sensitive information to the OpenTelemetry backend. If you want the full error message and stack trace to be sent to the OpenTelemetry backend, set this option to `FALSE` or use `safeError(e)`.}
#' }
#'
#'

View File

@@ -1,15 +1,15 @@
# 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
#' %...!% %...>%
#' as.promise is.promising is.promise
#' promise_resolve promise_reject
#' hybrid_then
#' with_promise_domain new_promise_domain
#' 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
@@ -18,13 +18,13 @@
#' 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
## usethis namespace: end
NULL
# It's necessary to Depend on methods so Rscript doesn't fail. It's necessary
@@ -34,11 +34,3 @@ NULL
# since we call require(shiny) as part of loading the app.
#' @import methods
NULL
# For usethis::use_release_issue()
release_bullets <- function() {
c(
"Update static imports: `staticimports::import()`"
)
}

224
R/shiny.R
View File

@@ -16,7 +16,8 @@ NULL
#'
#' @name shiny-package
#' @aliases shiny
"_PACKAGE"
#' @docType package
NULL
createUniqueId <- function(bytes, prefix = "", suffix = "") {
withPrivateSeed({
@@ -32,12 +33,8 @@ createUniqueId <- function(bytes, prefix = "", suffix = "") {
}
toJSON <- function(x, ..., dataframe = "columns", null = "null", na = "null",
auto_unbox = TRUE,
# Shiny has had a legacy value of 16 significant digits
# We can use `I(16)` mixed with the default behavior in jsonlite's `use_signif=`
# https://github.com/jeroen/jsonlite/commit/728efa9
digits = getOption("shiny.json.digits", I(16)), use_signif = is(digits, "AsIs"),
force = TRUE, POSIXt = "ISO8601", UTC = TRUE,
auto_unbox = TRUE, digits = getOption("shiny.json.digits", 16),
use_signif = TRUE, force = TRUE, POSIXt = "ISO8601", UTC = TRUE,
rownames = FALSE, keep_vec_names = TRUE, strict_atomic = TRUE) {
if (strict_atomic) {
@@ -214,7 +211,7 @@ workerId <- local({
#' Sends a custom message to the web page. `type` must be a
#' single-element character vector giving the type of message, while
#' `message` can be any jsonlite-encodable value. Custom messages
#' have no meaning to Shiny itself; they are used solely to convey information
#' have no meaning to Shiny itself; they are used soley to convey information
#' to custom JavaScript logic in the browser. You can do this by adding
#' JavaScript code to the browser that calls
#' \code{Shiny.addCustomMessageHandler(type, function(message){...})}
@@ -362,7 +359,6 @@ ShinySession <- R6Class(
flushCallbacks = 'Callbacks',
flushedCallbacks = 'Callbacks',
inputReceivedCallbacks = 'Callbacks',
unhandledErrorCallbacks = 'Callbacks',
bookmarkCallbacks = 'Callbacks',
bookmarkedCallbacks = 'Callbacks',
restoreCallbacks = 'Callbacks',
@@ -428,7 +424,7 @@ ShinySession <- R6Class(
stop("Nested calls to withCurrentOutput() are not allowed.")
}
with_promise_domain(
promises::with_promise_domain(
createVarPromiseDomain(private, "currentOutputName", name),
expr
)
@@ -724,7 +720,6 @@ ShinySession <- R6Class(
private$flushCallbacks <- Callbacks$new()
private$flushedCallbacks <- Callbacks$new()
private$inputReceivedCallbacks <- Callbacks$new()
private$unhandledErrorCallbacks <- Callbacks$new()
private$.input <- ReactiveValues$new(dedupe = FALSE, label = "input")
private$.clientData <- ReactiveValues$new(dedupe = TRUE, label = "clientData")
private$timingRecorder <- ShinyServerTimingRecorder$new()
@@ -1045,34 +1040,8 @@ ShinySession <- R6Class(
new data from the client."
return(private$inputReceivedCallbacks$register(callback))
},
onUnhandledError = function(callback) {
"Registers the callback to be invoked when an unhandled error occurs."
return(private$unhandledErrorCallbacks$register(callback))
},
unhandledError = function(e, close = TRUE) {
"Call the global and session unhandled error handlers and then close the
session if the error is fatal."
if (close) {
class(e) <- c("shiny.error.fatal", class(e))
}
# For fatal errors, always log.
# For non-fatal errors, only log if we haven't seen this error before.
if (close || !has_seen_otel_exception(e)) {
otel_log(
if (close) "Fatal error" else "Unhandled error",
severity = if (close) "fatal" else "error",
attributes = otel::as_attributes(list(
session.id = self$token,
error = get_otel_error_obj(e)
))
)
}
private$unhandledErrorCallbacks$invoke(e, onError = printError)
.globals$onUnhandledErrorCallbacks$invoke(e, onError = printError)
if (close) self$close()
unhandledError = function(e) {
self$close()
},
close = function() {
if (!self$closed) {
@@ -1086,9 +1055,7 @@ ShinySession <- R6Class(
}
# ..stacktraceon matches with the top-level ..stacktraceoff..
withReactiveDomain(self, {
otel_span_session_end(domain = self, {
private$closedCallbacks$invoke(onError = printError, ..stacktraceon = TRUE)
})
private$closedCallbacks$invoke(onError = printError, ..stacktraceon = TRUE)
})
},
isClosed = function() {
@@ -1157,8 +1124,7 @@ ShinySession <- R6Class(
attr(label, "srcref") <- srcref
attr(label, "srcfile") <- srcfile
# Do not bind this `observe()` call
obs <- with_no_otel_collect(observe(..stacktraceon = FALSE, {
obs <- observe(..stacktraceon = FALSE, {
private$sendMessage(recalculating = list(
name = name, status = 'recalculating'
@@ -1170,9 +1136,7 @@ ShinySession <- R6Class(
hybrid_chain(
{
private$withCurrentOutput(name, {
maybe_with_otel_span_reactive_update({
shinyCallingHandlers(func())
}, domain = self)
shinyCallingHandlers(func())
})
},
catch = function(cond) {
@@ -1181,8 +1145,6 @@ ShinySession <- R6Class(
structure(list(), class = "try-error", condition = cond)
} else if (inherits(cond, "shiny.output.cancel")) {
structure(list(), class = "cancel-output")
} else if (inherits(cond, "shiny.output.progress")) {
structure(list(), class = "progress-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.
@@ -1197,9 +1159,10 @@ ShinySession <- R6Class(
} else {
if (isTRUE(getOption("show.error.messages"))) printError(cond)
if (getOption("shiny.sanitize.errors", FALSE)) {
cond <- sanitized_error()
cond <- simpleError(paste("An error has occurred. Check your",
"logs or contact the app author for",
"clarification."))
}
self$unhandledError(cond, close = FALSE)
invisible(structure(list(), class = "try-error", condition = cond))
}
}
@@ -1210,33 +1173,6 @@ ShinySession <- R6Class(
# client knows that progress is over.
self$requestFlush()
if (inherits(value, "progress-output")) {
# This is the case where an output needs to compute for longer
# than this reactive flush. We put the output into progress mode
# (i.e. adding .recalculating) with a special flag that means
# the progress indication should not be cleared until this
# specific output receives a new value or error.
self$showProgress(name, persistent=TRUE)
# It's conceivable that this output already ran successfully
# within this reactive flush, in which case we could either show
# the new output while simultaneously making it .recalculating;
# or we squelch the new output and make whatever output is in
# the client .recalculating. I (jcheng) decided on the latter as
# it seems more in keeping with what we do with these kinds of
# intermediate output values/errors in general, i.e. ignore them
# and wait until we have a final answer. (Also kind of feels
# like a bug in the app code if you routinely have outputs that
# are executing successfully, only to be invalidated again
# within the same reactive flush--use priority to fix that.)
private$invalidatedOutputErrors$remove(name)
private$invalidatedOutputValues$remove(name)
# It's important that we return so that the existing output in
# the client remains untouched.
return()
}
private$sendMessage(recalculating = list(
name = name, status = 'recalculated'
))
@@ -1261,7 +1197,7 @@ ShinySession <- R6Class(
private$invalidatedOutputValues$set(name, value)
}
)
}, suspended=private$shouldSuspend(name), label=label))
}, suspended=private$shouldSuspend(name), label=label)
# If any output attributes were added to the render function attach
# them to observer.
@@ -1369,29 +1305,23 @@ ShinySession <- R6Class(
private$startCycle()
}
},
showProgress = function(id, persistent=FALSE) {
showProgress = function(id) {
'Send a message to the client that recalculation of the output identified
by \\code{id} is in progress. There is currently no mechanism for
explicitly turning off progress for an output component; instead, all
progress is implicitly turned off when flushOutput is next called.
You can use persistent=TRUE if the progress for this output component
should stay on beyond the flushOutput (or any subsequent flushOutputs); in
that case, progress is only turned off (and the persistent flag cleared)
when the output component receives a value or error, or, if
showProgress(id, persistent=FALSE) is called and a subsequent flushOutput
occurs.'
progress is implicitly turned off when flushOutput is next called.'
# If app is already closed, be sure not to show progress, otherwise we
# will get an error because of the closed websocket
if (self$closed)
return()
if (!id %in% private$progressKeys) {
private$progressKeys <- c(private$progressKeys, id)
}
if (id %in% private$progressKeys)
return()
self$sendProgress('binding', list(id = id, persistent = persistent))
private$progressKeys <- c(private$progressKeys, id)
self$sendProgress('binding', list(id = id))
},
sendProgress = function(type, message) {
private$sendMessage(
@@ -2039,8 +1969,8 @@ ShinySession <- R6Class(
ext <- paste(".", ext, sep = "")
tmpdata <- tempfile(fileext = ext)
return(Context$new(getDefaultReactiveDomain(), '[download]')$run(function() {
with_promise_domain(reactivePromiseDomain(), {
captureStackTraces({
promises::with_promise_domain(reactivePromiseDomain(), {
promises::with_promise_domain(createStackTracePromiseDomain(), {
self$incrementBusyCount()
hybrid_chain(
# ..stacktraceon matches with the top-level ..stacktraceoff..
@@ -2211,8 +2141,6 @@ ShinySession <- R6Class(
if (private$busyCount == 0L) {
rLog$asyncStart(domain = self)
private$sendMessage(busy = "busy")
otel_span_reactive_update_init(domain = self)
}
private$busyCount <- private$busyCount + 1L
},
@@ -2234,8 +2162,6 @@ ShinySession <- R6Class(
private$startCycle()
}
})
otel_span_reactive_update_teardown(domain = self)
}
}
)
@@ -2405,89 +2331,23 @@ getCurrentOutputInfo <- function(session = getDefaultReactiveDomain()) {
#' Add callbacks for Shiny session events
#'
#' @description
#' These functions are for registering callbacks on Shiny session events.
#' `onFlush` registers a function that will be called before Shiny flushes the
#' reactive system. `onFlushed` registers a function that will be called after
#' Shiny flushes the reactive system. `onUnhandledError` registers a function to
#' be called when an unhandled error occurs before the session is closed.
#' `onSessionEnded` registers a function to be called after the client has
#' disconnected.
#' `onFlush` registers a function that will be called before Shiny flushes
#' the reactive system. `onFlushed` registers a function that will be
#' called after Shiny flushes the reactive system. `onSessionEnded`
#' registers a function to be called after the client has disconnected.
#'
#' These functions should be called within the application's server function.
#'
#' All of these functions return a function which can be called with no
#' arguments to cancel the registration.
#'
#' @section Unhandled Errors:
#' Unhandled errors are errors that aren't otherwise handled by Shiny or by the
#' application logic. In other words, they are errors that will either cause the
#' application to crash or will result in "Error" output in the UI.
#'
#' You can use `onUnhandledError()` to register a function that will be called
#' when an unhandled error occurs. This function will be called with the error
#' object as its first argument. If the error is fatal and will result in the
#' session closing, the error condition will have the `shiny.error.fatal` class.
#'
#' Note that the `onUnhandledError()` callbacks cannot be used to prevent the
#' app from closing or to modify the error condition. Instead, they are intended
#' to give you an opportunity to log the error or perform other cleanup
#' operations.
#'
#' @param fun A callback function.
#' @param once Should the function be run once, and then cleared, or should it
#' re-run each time the event occurs. (Only for `onFlush` and
#' `onFlushed`.)
#' @param session A shiny session object.
#'
#' @examplesIf interactive()
#' library(shiny)
#'
#' ui <- fixedPage(
#' markdown(c(
#' "Set the number to 8 or higher to cause an error",
#' "in the `renderText()` output."
#' )),
#' sliderInput("number", "Number", 0, 10, 4),
#' textOutput("text"),
#' hr(),
#' markdown(c(
#' "Click the button below to crash the app with an unhandled error",
#' "in an `observe()` block."
#' )),
#' actionButton("crash", "Crash the app!")
#' )
#'
#' log_event <- function(level, ...) {
#' ts <- strftime(Sys.time(), " [%F %T] ")
#' message(level, ts, ...)
#' }
#'
#' server <- function(input, output, session) {
#' log_event("INFO", "Session started")
#'
#' onUnhandledError(function(err) {
#' # log the unhandled error
#' level <- if (inherits(err, "shiny.error.fatal")) "FATAL" else "ERROR"
#' log_event(level, conditionMessage(err))
#' })
#'
#' onStop(function() {
#' log_event("INFO", "Session ended")
#' })
#'
#' observeEvent(input$crash, stop("Oops, an unhandled error happened!"))
#'
#' output$text <- renderText({
#' if (input$number > 7) {
#' stop("that's too high!")
#' }
#' sprintf("You picked number %d.", input$number)
#' })
#' }
#'
#' shinyApp(ui, server)
#'
#' @export
onFlush <- function(fun, once = TRUE, session = getDefaultReactiveDomain()) {
session$onFlush(fun, once = once)
@@ -2508,27 +2368,6 @@ onSessionEnded <- function(fun, session = getDefaultReactiveDomain()) {
session$onSessionEnded(fun)
}
.globals$onUnhandledErrorCallbacks <- NULL
on_load({
.globals$onUnhandledErrorCallbacks <- Callbacks$new()
})
#' @rdname onFlush
#' @export
onUnhandledError <- function(fun, session = getDefaultReactiveDomain()) {
if (!is.function(fun) || length(formals(fun)) == 0) {
rlang::abort(
"The unhandled error callback must be a function that takes an error object as its first argument."
)
}
if (is.null(session)) {
.globals$onUnhandledErrorCallbacks$register(fun)
} else {
session$onUnhandledError(fun)
}
}
flushPendingSessions <- function() {
lapply(appsNeedingFlush$values(), function(shinysession) {
@@ -2743,10 +2582,3 @@ validate_session_object <- function(session, label = as.character(sys.call(sys.p
)
}
}
sanitized_error <- function() {
simpleError(paste("An error has occurred. Check your",
"logs or contact the app author for",
"clarification."))
}

View File

@@ -162,29 +162,11 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
sharedEnv <- globalenv()
}
# To enable hot-reloading of support files, this function is called
# whenever the UI or Server func source is updated. To avoid loading
# support files 2x, we follow the last cache update trigger timestamp.
autoload_r_support_if_needed <- local({
autoload_last_loaded <- -1
function() {
if (!isTRUE(getOption("shiny.autoload.r", TRUE))) return()
last_cache_trigger <- cachedAutoReloadLastChanged$get()
if (identical(autoload_last_loaded, last_cache_trigger)) return()
loadSupport(appDir, renv = sharedEnv, globalrenv = globalenv())
autoload_last_loaded <<- last_cache_trigger
}
})
# uiHandlerSource is a function that returns an HTTP handler for serving up
# ui.R as a webpage. The "cachedFuncWithFile" call makes sure that the closure
# we're creating here only gets executed when ui.R's contents change.
uiHandlerSource <- cachedFuncWithFile(appDir, "ui.R", case.sensitive = FALSE,
function(uiR) {
autoload_r_support_if_needed()
if (file.exists(uiR)) {
# If ui.R contains a call to shinyUI (which sets .globals$ui), use that.
# If not, then take the last expression that's returned from ui.R.
@@ -215,7 +197,6 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
serverSource <- cachedFuncWithFile(appDir, "server.R", case.sensitive = FALSE,
function(serverR) {
autoload_r_support_if_needed()
# If server.R contains a call to shinyServer (which sets .globals$server),
# use that. If not, then take the last expression that's returned from
# server.R.
@@ -251,9 +232,10 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
onStart <- function() {
oldwd <<- getwd()
setwd(appDir)
# TODO: we should support hot reloading on global.R and R/*.R changes.
if (getOption("shiny.autoload.r", TRUE)) {
autoload_r_support_if_needed()
} else {
loadSupport(appDir, renv=sharedEnv, globalrenv=globalenv())
} else {
if (file.exists(file.path.ci(appDir, "global.R")))
sourceUTF8(file.path.ci(appDir, "global.R"))
}
@@ -308,77 +290,33 @@ initAutoReloadMonitor <- function(dir) {
return(function(){})
}
filePattern <- getOption(
"shiny.autoreload.pattern",
".*\\.(r|html?|js|css|png|jpe?g|gif)$"
)
filePattern <- getOption("shiny.autoreload.pattern",
".*\\.(r|html?|js|css|png|jpe?g|gif)$")
if (is_installed("watcher")) {
check_for_update <- function(paths) {
paths <- grep(
filePattern,
paths,
ignore.case = TRUE,
value = TRUE
)
if (length(paths) == 0) {
return()
}
cachedAutoReloadLastChanged$set()
lastValue <- NULL
observeLabel <- paste0("File Auto-Reload - '", basename(dir), "'")
obs <- observe(label = observeLabel, {
files <- sort_c(
list.files(dir, pattern = filePattern, recursive = TRUE, ignore.case = TRUE)
)
times <- file.info(files)$mtime
names(times) <- files
if (is.null(lastValue)) {
# First run
lastValue <<- times
} else if (!identical(lastValue, times)) {
# We've changed!
lastValue <<- times
autoReloadCallbacks$invoke()
}
# [garrick, 2025-02-20] Shiny <= v1.10.0 used `invalidateLater()` with an
# autoreload.interval in ms. {watcher} instead uses a latency parameter in
# seconds, which serves a similar purpose and that I'm keeping for backcompat.
latency <- getOption("shiny.autoreload.interval", 250) / 1000
watcher <- watcher::watcher(dir, check_for_update, latency = latency)
watcher$start()
onStop(watcher$stop)
} else {
# Fall back to legacy observer behavior
if (!is_false(getOption("shiny.autoreload.legacy_warning", TRUE))) {
cli::cli_warn(
c(
"Using legacy autoreload file watching. Please install {.pkg watcher} for a more performant autoreload file watcher.",
"i" = "Set {.run options(shiny.autoreload.legacy_warning = FALSE)} to suppress this warning."
),
.frequency = "regularly",
.frequency_id = "shiny.autoreload.legacy_warning"
)
}
lastValue <- NULL
observeLabel <- paste0("File Auto-Reload - '", basename(dir), "'")
watcher <- observe(label = observeLabel, {
files <- sort_c(
list.files(dir, pattern = filePattern, recursive = TRUE, ignore.case = TRUE)
)
times <- file.info(files)$mtime
names(times) <- files
if (is.null(lastValue)) {
# First run
lastValue <<- times
} else if (!identical(lastValue, times)) {
# We've changed!
lastValue <<- times
cachedAutoReloadLastChanged$set()
autoReloadCallbacks$invoke()
}
invalidateLater(getOption("shiny.autoreload.interval", 500))
})
onStop(watcher$destroy)
watcher$destroy
}
invalidateLater(getOption("shiny.autoreload.interval", 500))
})
invisible(watcher)
onStop(obs$destroy)
obs$destroy
}
#' Load an app's supporting R files
@@ -413,6 +351,17 @@ loadSupport <- function(appDir=NULL, renv=new.env(parent=globalenv()), globalren
appDir <- findEnclosingApp(".")
}
descFile <- file.path.ci(appDir, "DESCRIPTION")
if (file.exists(file.path.ci(appDir, "NAMESPACE")) ||
(file.exists(descFile) &&
identical(as.character(read.dcf(descFile, fields = "Type")), "Package")))
{
warning(
"Loading R/ subdirectory for Shiny application, but this directory appears ",
"to contain an R package. Sourcing files in R/ may cause unexpected behavior."
)
}
if (!is.null(globalrenv)){
# Evaluate global.R, if it exists.
globalPath <- file.path.ci(appDir, "global.R")
@@ -427,12 +376,10 @@ loadSupport <- function(appDir=NULL, renv=new.env(parent=globalenv()), globalren
helpersDir <- file.path(appDir, "R")
disabled <- list.files(helpersDir, pattern="^_disable_autoload\\.r$", recursive=FALSE, ignore.case=TRUE)
if (length(disabled) > 0) {
if (length(disabled) > 0){
return(invisible(renv))
}
warn_if_app_dir_is_package(appDir)
helpers <- list.files(helpersDir, pattern="\\.[rR]$", recursive=FALSE, full.names=TRUE)
# Ensure files in R/ are sorted according to the 'C' locale before sourcing.
# This convention is based on the default for packages. For details, see:
@@ -447,27 +394,6 @@ loadSupport <- function(appDir=NULL, renv=new.env(parent=globalenv()), globalren
invisible(renv)
}
warn_if_app_dir_is_package <- function(appDir) {
has_namespace <- file.exists(file.path.ci(appDir, "NAMESPACE"))
has_desc_pkg <- FALSE
if (!has_namespace) {
descFile <- file.path.ci(appDir, "DESCRIPTION")
has_desc_pkg <-
file.exists(descFile) &&
identical(as.character(read.dcf(descFile, fields = "Type")), "Package")
}
if (has_namespace || has_desc_pkg) {
warning(
"Loading R/ subdirectory for Shiny application, but this directory appears ",
"to contain an R package. Sourcing files in R/ may cause unexpected behavior. ",
"See `?loadSupport` for more details."
)
}
}
# This reads in an app dir for a single-file application (e.g. app.R), and
# returns a shiny.appobj.
# appDir must be a normalized (absolute) path, not a relative one
@@ -483,6 +409,8 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
wasDir <- setwd(appDir)
on.exit(setwd(wasDir))
# TODO: we should support hot reloading on R/*.R changes.
# In an upcoming version of shiny, this option will go away.
if (getOption("shiny.autoload.r", TRUE)) {
# Create a child env which contains all the helpers and will be the shared parent
# of the ui.R and server.R load.

View File

@@ -29,7 +29,6 @@ withMathJax <- function(...) {
}
renderPage <- function(ui, showcase=0, testMode=FALSE) {
lang <- getLang(ui)
# If the ui is a NOT complete document (created by htmlTemplate()), then do some
# preprocessing and make sure it's a complete document.
@@ -38,13 +37,17 @@ renderPage <- function(ui, showcase=0, testMode=FALSE) {
ui <- showcaseUI(ui)
# Wrap ui in body tag if it doesn't already have a single top-level body tag.
if (!(inherits(ui, "shiny.tag") && ui$name == "body"))
ui <- tags$body(ui)
ui <- if (inherits(ui, "shiny.tag") && ui$name == "body") {
tagAppendAttributes(ui, !!!getBodyAttrs(ui))
} else {
tags$body(ui, !!!getBodyAttrs(ui))
}
# Put the body into the default template
ui <- htmlTemplate(
system_file("template", "default.html", package = "shiny"),
lang = lang,
html_open = HTML(sub("</html>$", "", tags$html(!!!getHtmlAttrs(ui)))),
body = ui,
# this template is a complete HTML document
document_ = TRUE
@@ -69,21 +72,6 @@ renderPage <- function(ui, showcase=0, testMode=FALSE) {
)
}
if (in_devmode() || in_client_devmode()) {
# If we're in dev mode, add a simple script to the head that injects a
# global variable for the client to use to detect dev mode.
shiny_deps[[length(shiny_deps) + 1]] <-
htmlDependency(
"shiny-devmode",
get_package_version("shiny"),
src = "www/shared",
package = "shiny",
head="<script>window.__SHINY_DEV_MODE__ = true;</script>",
all_files = FALSE
)
}
html <- renderDocument(ui, shiny_deps, processDep = createWebDependency)
enc2utf8(paste(collapse = "\n", html))
}
@@ -114,7 +102,6 @@ jqueryDependency <- function() {
shinyDependencies <- function() {
list(
bslib::bs_dependency_defer(shinyDependencyCSS),
busyIndicatorDependency(),
htmlDependency(
name = "shiny-javascript",
version = get_package_version("shiny"),
@@ -135,14 +122,6 @@ shinyDependencies <- function() {
)
}
shinyDependencySass <- function(bs_version) {
bootstrap_scss <- paste0("shiny.bootstrap", bs_version, ".scss")
scss_home <- system_file("www/shared/shiny_scss", package = "shiny")
scss_files <- file.path(scss_home, c(bootstrap_scss, "shiny.scss"))
lapply(scss_files, sass::sass_file)
}
shinyDependencyCSS <- function(theme) {
version <- get_package_version("shiny")
@@ -157,10 +136,12 @@ shinyDependencyCSS <- function(theme) {
))
}
bs_version <- bslib::theme_version(theme)
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)
bslib::bs_dependency(
input = shinyDependencySass(bs_version),
input = scss_files,
theme = theme,
name = "shiny-sass",
version = version,
@@ -170,7 +151,7 @@ shinyDependencyCSS <- function(theme) {
#' Create a Shiny UI handler
#'
#' @description `r lifecycle::badge("superseded")`
#' @description \lifecycle{superseded}
#'
#' @description 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
@@ -178,7 +159,7 @@ shinyDependencyCSS <- function(theme) {
#' This function is kept for backwards compatibility with older applications. It
#' returns the value that is passed to it.
#'
#' @param ui A user interface definition
#' @param ui A user interace definition
#' @return The user interface definition, without modifications or side effects.
#' @keywords internal
#' @export

View File

@@ -134,14 +134,7 @@ markRenderFunction <- function(
else renderFunc(...)
}
otelAttrs <-
otel_srcref_attributes(
attr(renderFunc, "wrappedFunc", exact = TRUE),
# Can't retrieve the render function used at this point, so just use NULL
fn_name = NULL
)
ret <- structure(
structure(
wrappedRenderFunc,
class = c("shiny.render.function", "function"),
outputFunc = uiFunc,
@@ -149,15 +142,8 @@ markRenderFunction <- function(
hasExecuted = hasExecuted,
cacheHint = cacheHint,
cacheWriteHook = cacheWriteHook,
cacheReadHook = cacheReadHook,
otelAttrs = otelAttrs
cacheReadHook = cacheReadHook
)
if (has_otel_collect("reactivity")) {
ret <- enable_otel_shiny_render_function(ret)
}
ret
}
#' @export
@@ -285,7 +271,9 @@ createRenderFunction <- function(
# Hoist func's wrappedFunc attribute into renderFunc, so that when we pass
# renderFunc on to markRenderFunction, it is able to find the original user
# function.
attr(renderFunc, "wrappedFunc") <- attr(func, "wrappedFunc", exact = TRUE)
if (identical(cacheHint, "auto")) {
attr(renderFunc, "wrappedFunc") <- attr(func, "wrappedFunc", exact = TRUE)
}
markRenderFunction(outputFunc, renderFunc, outputArgs, cacheHint,
cacheWriteHook, cacheReadHook)
@@ -333,7 +321,7 @@ as.tags.shiny.render.function <- function(x, ..., inline = FALSE) {
# Get relevant attributes from a render function object.
renderFunctionAttributes <- function(x) {
attrs <- c("outputFunc", "outputArgs", "hasExecuted", "cacheHint", "otelAttrs")
attrs <- c("outputFunc", "outputArgs", "hasExecuted", "cacheHint")
names(attrs) <- attrs
lapply(attrs, function(name) attr(x, name, exact = TRUE))
}
@@ -395,10 +383,8 @@ markOutputAttrs <- function(renderFunc, snapshotExclude = NULL,
#' The corresponding HTML output tag should be `div` or `img` and have
#' the CSS class name `shiny-image-output`.
#'
#' @seealso
#' * For more details on how the images are generated, and how to control
#' @seealso For more details on how the images are generated, and how to control
#' the output, see [plotPNG()].
#' * Use [outputOptions()] to set general output options for an image output.
#'
#' @param expr An expression that returns a list.
#' @inheritParams renderUI
@@ -612,7 +598,6 @@ isTemp <- function(path, tempDir = tempdir(), mustExist) {
#' used in an interactive RMarkdown document.
#'
#' @example res/text-example.R
#' @seealso [outputOptions()]
#' @export
renderPrint <- function(expr, env = parent.frame(), quoted = FALSE,
width = getOption('width'), outputArgs=list())
@@ -628,7 +613,7 @@ renderPrint <- function(expr, env = parent.frame(), quoted = FALSE,
domain <- createRenderPrintPromiseDomain(width)
hybrid_chain(
{
with_promise_domain(domain, func())
promises::with_promise_domain(domain, func())
},
function(value) {
res <- withVisible(value)
@@ -657,7 +642,7 @@ renderPrint <- function(expr, env = parent.frame(), quoted = FALSE,
createRenderPrintPromiseDomain <- function(width) {
f <- file()
new_promise_domain(
promises::new_promise_domain(
wrapOnFulfilled = function(onFulfilled) {
force(onFulfilled)
function(...) {
@@ -734,7 +719,7 @@ renderText <- function(expr, env = parent.frame(), quoted = FALSE,
#' call to [uiOutput()] when `renderUI` is used in an
#' interactive R Markdown document.
#'
#' @seealso [uiOutput()], [outputOptions()]
#' @seealso [uiOutput()]
#' @export
#' @examples
#' ## Only run examples in interactive R sessions
@@ -793,8 +778,8 @@ renderUI <- function(expr, env = parent.frame(), quoted = FALSE,
#' 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
#' 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.
#' @param outputArgs A list of arguments to be passed through to the implicit
#' call to [downloadButton()] when `downloadHandler` is used
@@ -824,13 +809,6 @@ renderUI <- function(expr, env = parent.frame(), quoted = FALSE,
#'
#' shinyApp(ui, server)
#' }
#'
#' @seealso
#' * The download handler, like other outputs, is suspended (disabled) by
#' default for download buttons and links that are hidden. Use
#' [outputOptions()] to control this behavior, e.g. to set
#' `suspendWhenHidden = FALSE` if the download is initiated by
#' programmatically clicking on the download button using JavaScript.
#' @export
downloadHandler <- function(filename, content, contentType=NULL, outputArgs=list()) {
renderFunc <- function(shinysession, name, ...) {
@@ -844,12 +822,20 @@ downloadHandler <- function(filename, content, contentType=NULL, outputArgs=list
#' Table output with the JavaScript DataTables library
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#' `r lifecycle::badge("superseded")` Please use
#' \href{https://rstudio.github.io/DT/shiny.html}{\code{DT::renderDataTable()}}.
#' (Shiny 0.11.1)
#'
#' This function is deprecated, use
#' [DT::renderDT()](https://rstudio.github.io/DT/shiny.html) instead. It
#' provides a superset of functionality, better performance, and better user
#' experience.
#' 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>.
#'
#' @param expr An expression that returns a data frame or a matrix.
#' @inheritParams renderTable
@@ -901,60 +887,18 @@ downloadHandler <- function(filename, content, contentType=NULL, outputArgs=list
#' }
#' )
#' }
#' @keywords internal
renderDataTable <- function(expr, options = NULL, searchDelay = 500,
callback = 'function(oTable) {}', escape = TRUE,
env = parent.frame(), quoted = FALSE,
outputArgs = list()) {
outputArgs=list())
{
legacy <- useLegacyDataTable(
from = "shiny::renderDataTable()",
to = "DT::renderDT()"
)
if (!quoted) {
expr <- substitute(expr)
quoted <- TRUE
}
if (legacy) {
legacyRenderDataTable(
expr, env = env, quoted = quoted,
options = options,
searchDelay = searchDelay,
callback = callback,
escape = escape,
outputArgs = outputArgs
)
} else {
if (!missing(searchDelay)) {
warning("Ignoring renderDataTable()'s searchDelay value (since DT::renderDT() has no equivalent).")
}
force(options)
force(callback)
force(escape)
force(outputArgs)
DT::renderDataTable(
expr, env = env, quoted = quoted,
options = if (is.null(options)) list() else options,
# Turn function into a statement
callback = DT::JS(paste0("(", callback, ")(table)")),
escape = escape,
outputArgs = outputArgs
if (in_devmode()) {
shinyDeprecated(
"0.11.1", "shiny::renderDataTable()", "DT::renderDataTable()",
details = "See <https://rstudio.github.io/DT/shiny.html> for more information"
)
}
}
legacyRenderDataTable <- function(expr, options = NULL, searchDelay = 500,
callback = 'function(oTable) {}', escape = TRUE,
env = parent.frame(), quoted = FALSE,
outputArgs=list()) {
func <- installExprFunction(expr, "func", env, quoted, label = "renderDataTable")

View File

@@ -33,6 +33,13 @@ 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",
@@ -54,11 +61,10 @@ showcaseHead <- function() {
mdfile <- file.path.ci(getwd(), 'Readme.md')
html <- tagList(
if (file.exists(mdfile)) {
md_content <- paste(readUTF8(mdfile), collapse="\n")
md_html <- commonmark::markdown_html(md_content, extensions = TRUE)
tags$template(id="showcase-markdown-content", HTML(md_html))
} else ""
if (file.exists(mdfile))
tags$script(type="text/markdown", id="showcase-markdown-content",
paste(readUTF8(mdfile), collapse="\n"))
else ""
)
return(attachDependencies(html, deps))

View File

@@ -42,20 +42,36 @@ get_package_version <- function(pkg) {
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)
}
if (!is.character(version) && !inherits(version, "numeric_version")) {
# Avoid https://bugs.r-project.org/show_bug.cgi?id=18548
alert <- if (identical(Sys.getenv("TESTTHAT"), "true")) stop else warning
alert("`version` must be a character string or a `package_version` or `numeric_version` object.")
register_upgrade_message <- function(pkg, version, error = FALSE) {
version <- numeric_version(sprintf("%0.9g", version))
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)
}
installed && isTRUE(get_package_version(pkg) >= version)
# 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
@@ -174,9 +190,11 @@ system_file <- function(..., package = "base") {
normalizePath(files, winslash = "/")
}
# A wrapper for `system.file()`, which caches the package path because
# `system.file()` can be slow. If a package is not installed, the result won't
# be cached.
# 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()
@@ -188,9 +206,7 @@ system_file_cached <- local({
not_cached <- is.na(match(package, names(pkg_dir_cache)))
if (not_cached) {
pkg_dir <- system.file(package = package)
if (nzchar(pkg_dir)) {
pkg_dir_cache[[package]] <<- pkg_dir
}
pkg_dir_cache[[package]] <<- pkg_dir
} else {
pkg_dir <- pkg_dir_cache[[package]]
}

View File

@@ -158,7 +158,8 @@ print.shiny_runtests <- function(x, ..., reporter = "summary") {
if (any(x$pass)) {
cli::cat_bullet("Success", bullet = "tick", bullet_col = "green")
# TODO in future... use clisymbols::symbol$tick and crayon green
cat("* Success\n")
mapply(
x$file,
x$pass,
@@ -170,8 +171,9 @@ print.shiny_runtests <- function(x, ..., reporter = "summary") {
}
)
}
if (!all(x$pass)) {
cli::cat_bullet("Failure", bullet = "cross", bullet_col = "red")
if (any(!x$pass)) {
# TODO in future... use clisymbols::symbol$cross and crayon red
cat("* Failure\n")
mapply(
x$file,
x$pass,

View File

@@ -37,11 +37,7 @@
updateTextInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL, placeholder = NULL) {
validate_session_object(session)
message <- dropNulls(list(
label = if (!is.null(label)) processDeps(label, session),
value = value,
placeholder = placeholder
))
message <- dropNulls(list(label=label, value=value, placeholder=placeholder))
session$sendInputMessage(inputId, message)
}
@@ -115,10 +111,7 @@ updateTextAreaInput <- updateTextInput
updateCheckboxInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL) {
validate_session_object(session)
message <- dropNulls(list(
label = if (!is.null(label)) processDeps(label, session),
value = value
))
message <- dropNulls(list(label=label, value=value))
session$sendInputMessage(inputId, message)
}
@@ -126,8 +119,6 @@ updateCheckboxInput <- function(session = getDefaultReactiveDomain(), inputId, l
#' Change the label or icon of an action button on the client
#'
#' @template update-input
#' @param disabled If `TRUE`, the button will not be clickable; if `FALSE`, it
#' will be.
#' @inheritParams actionButton
#'
#' @seealso [actionButton()]
@@ -157,13 +148,13 @@ updateCheckboxInput <- function(session = getDefaultReactiveDomain(), inputId, l
#' label = "New label",
#' icon = icon("calendar"))
#'
#' # Leaves goButton2's label unchanged and
#' # Leaves goButton2's label unchaged and
#' # removes its icon
#' updateActionButton(session, "goButton2",
#' icon = character(0))
#'
#' # Leaves goButton3's icon, if it exists,
#' # unchanged and changes its label
#' # unchaged and changes its label
#' updateActionButton(session, "goButton3",
#' label = "New label 3")
#'
@@ -178,21 +169,16 @@ updateCheckboxInput <- function(session = getDefaultReactiveDomain(), inputId, l
#' }
#' @rdname updateActionButton
#' @export
updateActionButton <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, icon = NULL, disabled = NULL) {
updateActionButton <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, icon = NULL) {
validate_session_object(session)
message <- dropNulls(list(
label = if (!is.null(label)) processDeps(label, session),
icon = if (!is.null(icon)) processDeps(validateIcon(icon), session),
disabled = disabled
))
if (!is.null(icon)) icon <- as.character(validateIcon(icon))
message <- dropNulls(list(label=label, icon=icon))
session$sendInputMessage(inputId, message)
}
#' @rdname updateActionButton
#' @export
updateActionLink <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, icon = NULL) {
updateActionButton(session, inputId=inputId, label=label, icon=icon)
}
updateActionLink <- updateActionButton
#' Change the value of a date input on the client
@@ -235,12 +221,7 @@ updateDateInput <- function(session = getDefaultReactiveDomain(), inputId, label
min <- dateYMD(min, "min")
max <- dateYMD(max, "max")
message <- dropNulls(list(
label = if (!is.null(label)) processDeps(label, session),
value = value,
min = min,
max = max
))
message <- dropNulls(list(label=label, value=value, min=min, max=max))
session$sendInputMessage(inputId, message)
}
@@ -290,7 +271,7 @@ updateDateRangeInput <- function(session = getDefaultReactiveDomain(), inputId,
max <- dateYMD(max, "max")
message <- dropNulls(list(
label = if (!is.null(label)) processDeps(label, session),
label = label,
value = dropNulls(list(start = start, end = end)),
min = min,
max = max
@@ -389,16 +370,13 @@ updateNavlistPanel <- updateTabsetPanel
#' }
#' @export
updateNumericInput <- function(session = getDefaultReactiveDomain(), inputId, label = NULL, value = NULL,
min = NULL, max = NULL, step = NULL) {
min = NULL, max = NULL, step = NULL) {
validate_session_object(session)
message <- dropNulls(list(
label = if (!is.null(label)) processDeps(label, session),
value = formatNoSci(value),
min = formatNoSci(min),
max = formatNoSci(max),
step = formatNoSci(step)
label = label, value = formatNoSci(value),
min = formatNoSci(min), max = formatNoSci(max), step = formatNoSci(step)
))
session$sendInputMessage(inputId, message)
}
@@ -445,23 +423,6 @@ updateSliderInput <- function(session = getDefaultReactiveDomain(), inputId, lab
{
validate_session_object(session)
if (!is.null(value)) {
if (!is.null(min) && !is.null(max)) {
# Validate value/min/max together if all three are provided
tryCatch(
validate_slider_value(min, max, value, "updateSliderInput"),
error = function(err) warning(conditionMessage(err), call. = FALSE)
)
} else if (length(value) < 1 || length(value) > 2 || any(is.na(value))) {
# Otherwise ensure basic assumptions about value are met
warning(
"In updateSliderInput(): value must be a single value or a length-2 ",
"vector and cannot contain NA values.",
call. = FALSE
)
}
}
# 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)
@@ -478,7 +439,7 @@ updateSliderInput <- function(session = getDefaultReactiveDomain(), inputId, lab
}
message <- dropNulls(list(
label = if (!is.null(label)) processDeps(label, session),
label = label,
value = formatNoSci(value),
min = formatNoSci(min),
max = formatNoSci(max),
@@ -509,11 +470,7 @@ updateInputOptions <- function(session, inputId, label = NULL, choices = NULL,
))
}
message <- dropNulls(list(
label = if (!is.null(label)) processDeps(label, session),
options = options,
value = selected
))
message <- dropNulls(list(label = label, options = options, value = selected))
session$sendInputMessage(inputId, message)
}
@@ -666,11 +623,7 @@ updateSelectInput <- function(session = getDefaultReactiveDomain(), inputId, lab
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)
message <- dropNulls(list(
label = if (!is.null(label)) processDeps(label, session),
options = options,
value = selected
))
message <- dropNulls(list(label = label, options = options, value = selected))
session$sendInputMessage(inputId, message)
}

View File

@@ -53,8 +53,8 @@ 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 [`rlang::enquo0()`] to not unquote
#' the object too early. See [`rlang::enquo0()`] for more details.
#' 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(
@@ -208,10 +208,8 @@ exprToLabel <- function(expr, function_name, label = NULL) {
if (is.null(label)) {
label <- rexprSrcrefToLabel(
srcref[[1]],
simpleExprToFunction(expr, function_name),
function_name
simpleExprToFunction(expr, function_name)
)
label <- as_default_label(label)
}
if (length(srcref) >= 2) attr(label, "srcref") <- srcref[[2]]
attr(label, "srcfile") <- srcFileOfRef(srcref[[1]])
@@ -231,12 +229,10 @@ funcToLabelBody <- function(func) {
funcToLabel <- function(func, functionLabel, label = NULL) {
if (!is.null(label)) return(label)
as_default_label(
sprintf(
'%s(%s)',
functionLabel,
funcToLabelBody(func)
)
sprintf(
'%s(%s)',
functionLabel,
funcToLabelBody(func)
)
}
quoToLabelBody <- function(q) {
@@ -245,19 +241,9 @@ quoToLabelBody <- function(q) {
quoToLabel <- function(q, functionLabel, label = NULL) {
if (!is.null(label)) return(label)
as_default_label(
sprintf(
'%s(%s)',
functionLabel,
quoToLabelBody(q)
)
sprintf(
'%s(%s)',
functionLabel,
quoToLabelBody(q)
)
}
as_default_label <- function(x) {
class(x) <- c("default_label", class(x))
x
}
is_default_label <- function(x) {
inherits(x, "default_label")
}

View File

@@ -1,21 +0,0 @@
# Check if `x` is a tag(), tagList(), or HTML()
# @param strict If `FALSE`, also consider a normal list() of 'tags' to be a tag list.
isTagLike <- function(x, strict = FALSE) {
isTag(x) || isTagList(x, strict = strict) || isTRUE(attr(x, "html"))
}
isTag <- function(x) {
inherits(x, "shiny.tag")
}
isTagList <- function(x, strict = TRUE) {
if (strict) {
return(inherits(x, "shiny.tag.list"))
}
if (!is.list(x)) {
return(FALSE)
}
all(vapply(x, isTagLike, logical(1)))
}

View File

@@ -4,7 +4,7 @@ NULL
# @staticimports pkg:staticimports
# is_installed get_package_version system_file
# s3_register
# s3_register register_upgrade_message
# any_named any_unnamed
#' Make a random number generator repeatable
@@ -493,6 +493,7 @@ shinyCallingHandlers <- function(expr) {
)
}
#' Register a function with the debugger (if one is active).
#'
#' Call this function after exprToFunction to give any active debugger a hook
@@ -770,45 +771,22 @@ formatNoSci <- function(x) {
format(x, scientific = FALSE, digits = 15)
}
# A simple getter/setting to track the last time the auto-reload process
# updated. This value is used by `cachedFuncWithFile()` when auto-reload is
# enabled to reload app/ui/server files when watched supporting files change.
cachedAutoReloadLastChanged <- local({
last_update <- 0
list(
set = function() {
last_update <<- as.integer(Sys.time())
invisible(last_update)
},
get = function() {
last_update
}
)
})
# Returns a function that calls the given func and caches the result for
# subsequent calls, unless the given file's mtime changes.
cachedFuncWithFile <- function(dir, file, func, case.sensitive = FALSE) {
dir <- normalizePath(dir, mustWork = TRUE)
dir <- normalizePath(dir, mustWork=TRUE)
mtime <- NA
value <- NULL
last_mtime_file <- NA
last_autoreload <- 0
function(...) {
fname <- if (case.sensitive) {
fname <- if (case.sensitive)
file.path(dir, file)
} else {
else
file.path.ci(dir, file)
}
now <- file.info(fname)$mtime
autoreload <- last_autoreload < cachedAutoReloadLastChanged$get()
if (autoreload || !identical(last_mtime_file, now)) {
if (!identical(mtime, now)) {
value <<- func(fname, ...)
last_mtime_file <<- now
last_autoreload <<- cachedAutoReloadLastChanged$get()
mtime <<- now
}
value
}
@@ -1115,7 +1093,7 @@ need <- function(expr, message = paste(label, "must be provided"), label) {
#'
#' 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
#' chain now. There is no advantage to this, except perhaps ease of readability
#' chain now. There is no advantange to this, except perhaps ease of readibility
#' if you have a complicated condition to check for (or perhaps if you'd like to
#' divide your condition into nested `if` statements).
#'
@@ -1137,10 +1115,7 @@ need <- function(expr, message = paste(label, "must be provided"), label) {
#' @param ... Values to check for truthiness.
#' @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. If `"progress"`, do the same as `TRUE`,
#' but also keep the output in recalculating state; this is intended for cases
#' when an in-progress calculation will not be completed in this reactive
#' flush cycle, but is still expected to provide a result in the future.
#' whatever state it happens to be in.
#' @return The first value that was passed in.
#' @export
#' @examples
@@ -1172,8 +1147,6 @@ req <- function(..., cancelOutput = FALSE) {
if (!isTruthy(item)) {
if (isTRUE(cancelOutput)) {
cancelOutput()
} else if (identical(cancelOutput, "progress")) {
reactiveStop(class = "shiny.output.progress")
} else {
reactiveStop(class = "validation")
}
@@ -1267,12 +1240,14 @@ dotloop <- function(fun_, ...) {
#' @param x An expression whose truthiness value we want to determine
#' @export
isTruthy <- function(x) {
if (is.null(x))
return(FALSE)
if (inherits(x, 'try-error'))
return(FALSE)
if (!is.atomic(x))
return(TRUE)
if (is.null(x))
return(FALSE)
if (length(x) == 0)
return(FALSE)
if (all(is.na(x)))
@@ -1433,11 +1408,7 @@ URLencode <- function(value, reserved = FALSE) {
dateYMD <- function(date = NULL, argName = "value") {
if (!length(date)) return(NULL)
tryCatch({
if (inherits(date, "POSIXt")) {
res <- format(date, "%Y-%m-%d")
} else {
res <- format(as.Date(date), "%Y-%m-%d")
}
res <- format(as.Date(date), "%Y-%m-%d")
if (any(is.na(res))) stop()
date <- res
},
@@ -1460,12 +1431,6 @@ wrapFunctionLabel <- function(func, name, ..stacktraceon = FALSE, dots = TRUE) {
if (name == "name" || name == "func" || name == "relabelWrapper") {
stop("Invalid name for wrapFunctionLabel: ", name)
}
if (nchar(name, "bytes") > 10000) {
# Max variable length in R is 10000 bytes. Truncate to a shorter number of
# chars because some characters could be multi-byte.
name <- substr(name, 1, 5000)
}
assign(name, func, environment())
registerDebugHook(name, environment(), name)
@@ -1529,7 +1494,7 @@ promise_chain <- function(promise, ..., catch = NULL, finally = NULL,
}
if (!is.null(domain)) {
with_promise_domain(domain, do(), replace = replace)
promises::with_promise_domain(domain, do(), replace = replace)
} else {
do()
}
@@ -1546,7 +1511,7 @@ hybrid_chain <- function(expr, ..., catch = NULL, finally = NULL,
{
captureStackTraces({
result <- withVisible(force(expr))
if (is.promising(result$value)) {
if (promises::is.promising(result$value)) {
# Purposefully NOT including domain (nor replace), as we're already in
# the domain at this point
p <- promise_chain(valueWithVisible(result), ..., catch = catch, finally = finally)
@@ -1580,7 +1545,7 @@ hybrid_chain <- function(expr, ..., catch = NULL, finally = NULL,
}
if (!is.null(domain)) {
with_promise_domain(domain, do(), replace = replace)
promises::with_promise_domain(domain, do(), replace = replace)
} else {
do()
}
@@ -1598,7 +1563,7 @@ createVarPromiseDomain <- function(env, name, value) {
force(name)
force(value)
new_promise_domain(
promises::new_promise_domain(
wrapOnFulfilled = function(onFulfilled) {
function(...) {
orig <- env[[name]]

View File

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

View File

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

View File

@@ -1,2 +1,2 @@
# Generated by tools/updatejQueryUI.R; do not edit by hand
version_jqueryui <- "1.14.1"
version_jqueryui <- "1.13.2"

View File

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

View File

@@ -1,14 +0,0 @@
@posit/shiny
============
This npm package contains TypeScript type definitions for Shiny's client-side JavaScript libraries.
It does not include the Shiny framework itself, though that may change in the future.
[Shiny](https://github.com/rstudio/shiny) is a web application framework for both R and Python, developed by Posit PBC.
## Installation
```bash
npm install @posit/shiny
```

View File

@@ -3,7 +3,7 @@
<!-- 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)
[![RStudio community](https://img.shields.io/badge/community-shiny-blue?style=social&logo=rstudio&logoColor=75AADB)](https://forum.posit.co/new-topic?category=shiny&tags=shiny)
[![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 -->
@@ -16,7 +16,7 @@ Easily build rich and productive interactive web apps in R &mdash; no HTML/CSS/J
* 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://posit.co/blog/shiny-1-1-0/), [caching](https://talks.cpsievert.me/20201117), [load testing](https://rstudio.github.io/shinyloadtest/), and more.
* 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.
@@ -45,13 +45,9 @@ For more examples and inspiration, check out the [Shiny User Gallery](https://sh
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.
## Join the conversation
If you want to chat about Shiny, meet other developers, or help us decide what to work on next, [join us on Discord](https://discord.com/invite/yMGCamUMnS).
## Getting Help
To ask a question about Shiny, please use the [RStudio Community website](https://forum.posit.co/new-topic?category=shiny&tags=shiny).
To ask a question about Shiny, please use the [RStudio Community website](https://community.rstudio.com/new-topic?category=shiny&tags=shiny).
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.
@@ -61,8 +57,8 @@ We welcome contributions to the **shiny** package. Please see our [CONTRIBUTING.
## License
The shiny package as a whole is licensed under the MIT License. See the [LICENSE](LICENSE) file for more details.
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.3, then that version is supported, as well as 4.2, 4.1, 4.0, 3.6.
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.

15
babel.config.json Normal file
View File

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

View File

@@ -1,129 +0,0 @@
## Comments
#### 2025-12-08
Test has been removed from CRAN checks.
Also added a couple bug fixes as found by users.
Please let me know if you need any further changes.
Thank you,
Carson
#### 2025-12-04
Error:
```
Check Details
Version: 1.12.0
Check: tests
Result: ERROR
Running testthat.R [100s/394s]
Running the tests in tests/testthat.R failed.
Complete output:
> library(testthat)
> library(shiny)
>
> test_check("shiny")
Saving _problems/test-timer-35.R
[ FAIL 1 | WARN 0 | SKIP 22 | PASS 1981 ]
══ Skipped tests (22) ══════════════════════════════════════════════════════════
• File system is not case-sensitive (1): 'test-app.R:36:5'
• I'm not sure of a great way to test this without timers. (1):
'test-test-server.R:216:3'
• Not testing in CI (1): 'test-devmode.R:17:3'
• On CRAN (18): 'test-actionButton.R:59:1', 'test-busy-indication.R:1:1',
'test-busy-indication.R:15:1', 'test-busy-indication.R:50:1',
'test-otel-error.R:1:1', 'test-otel-mock.R:1:1', 'test-pkgdown.R:3:3',
'test-reactivity.r:146:1', 'test-reactivity.r:1240:5',
'test-reactivity.r:1240:5', 'test-stacks-deep.R:93:1',
'test-stacks-deep.R:141:1', 'test-stacks.R:140:3', 'test-tabPanel.R:46:1',
'test-tabPanel.R:66:1', 'test-tabPanel.R:73:1', 'test-tabPanel.R:83:1',
'test-utils.R:177:3'
• {shinytest2} is not installed (1): 'test-test-shinyAppTemplate.R:2:1'
══ Failed tests ════════════════════════════════════════════════════════════════
── Failure ('test-timer.R:35:3'): Unscheduling works ───────────────────────────
Expected `timerCallbacks$.times` to be identical to `origTimes`.
Differences:
`attr(actual, 'row.names')` is an integer vector ()
`attr(expected, 'row.names')` is a character vector ()
[ FAIL 1 | WARN 0 | SKIP 22 | PASS 1981 ]
Error:
! Test failures.
Execution halted
```
#### 2025-12-03
```
Dear maintainer,
Please see the problems shown on
<https://cran.r-project.org/web/checks/check_results_shiny.html>.
Please correct before 2025-12-17 to safely retain your package on CRAN.
The CRAN Team
```
## `R CMD check` results:
0 errors | 0 warning | 1 note
```
─ checking CRAN incoming feasibility ... [7s/70s] NOTE (1m 9.5s)
Maintainer: Carson Sievert <carson@posit.co>
Days since last update: 5
```
## revdepcheck results
We checked 1383 reverse dependencies (1376 from CRAN + 7 from Bioconductor), comparing R CMD check results across CRAN and dev versions of this package.
* We saw 0 new problems
* We failed to check 31 packages
Issues with CRAN packages are summarised below.
### Failed to check
* AssumpSure
* boinet
* brms
* cheem
* ctsem
* detourr
* FAfA
* fio
* fitteR
* FossilSimShiny
* GDINA
* ggsem
* grandR
* hbsaems
* langevitour
* lavaan.shiny
* lcsm
* linkspotter
* loon.shiny
* MOsemiind
* MVN
* pandemonium
* polarisR
* RCTrep
* rstanarm
* semdrw
* shotGroups
* sphereML
* spinifex
* SurprisalAnalysis
* TestAnaAPP

View File

@@ -1,108 +0,0 @@
import typescriptEslint from "@typescript-eslint/eslint-plugin";
import prettier from "eslint-plugin-prettier";
import unicorn from "eslint-plugin-unicorn";
import globals from "globals";
import tsParser from "@typescript-eslint/parser";
import path from "node:path";
import { fileURLToPath } from "node:url";
import js from "@eslint/js";
import { FlatCompat } from "@eslint/eslintrc";
const __filename = fileURLToPath(import.meta.url);
const __dirname = path.dirname(__filename);
const compat = new FlatCompat({
baseDirectory: __dirname,
recommendedConfig: js.configs.recommended,
allConfig: js.configs.all
});
export default [{
ignores: ["**/*.d.ts"],
}, ...compat.extends(
"eslint:recommended",
"plugin:@typescript-eslint/recommended",
"plugin:prettier/recommended",
), {
plugins: {
"@typescript-eslint": typescriptEslint,
prettier,
unicorn,
},
languageOptions: {
globals: {
...globals.browser,
Atomics: "readonly",
SharedArrayBuffer: "readonly",
},
parser: tsParser,
ecmaVersion: 2021,
sourceType: "module",
parserOptions: {
project: ["./tsconfig.json"],
},
},
rules: {
"@typescript-eslint/explicit-function-return-type": "off",
"@typescript-eslint/no-explicit-any": "off",
"@typescript-eslint/explicit-module-boundary-types": "error",
"default-case": ["error"],
"linebreak-style": ["error", "unix"],
quotes: ["error", "double", "avoid-escape"],
semi: ["error", "always"],
"dot-location": ["error", "property"],
camelcase: ["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/consistent-type-imports": "error",
"@typescript-eslint/no-floating-promises": "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,
},
}],
},
}];

View File

@@ -1,2 +0,0 @@
# Load application support files into testing environment
shinytest2::load_app_env()

View File

@@ -5,7 +5,7 @@ test_that("Initial snapshot values are consistent", {
app$expect_values()
}){{
if (isTRUE(module)) {
shiny::HTML('
HTML('
test_that("Module values are consistent", {

View File

@@ -1,154 +0,0 @@
<mxfile host="app.diagrams.net" modified="2024-05-07T22:40:15.581Z" agent="Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/124.0.0.0 Safari/537.36" etag="Zsitjb4PT-sW3A63SWd7" version="24.3.1" type="device">
<diagram name="Page-1" id="zz6aoPEyabkTD7ESu8ts">
<mxGraphModel dx="595" dy="889" grid="1" gridSize="10" guides="1" tooltips="1" connect="1" arrows="1" fold="1" page="1" pageScale="1" pageWidth="850" pageHeight="1100" math="0" shadow="0">
<root>
<mxCell id="0" />
<mxCell id="1" parent="0" />
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-1" value="Initial" style="ellipse;whiteSpace=wrap;html=1;fillColor=#dae8fc;strokeColor=#6c8ebf;" parent="1" vertex="1">
<mxGeometry x="120" y="270" width="80" height="40" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-2" value="Running" style="ellipse;whiteSpace=wrap;html=1;fillColor=#dae8fc;strokeColor=#6c8ebf;" parent="1" vertex="1">
<mxGeometry x="270" y="270" width="80" height="40" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-3" value="" style="endArrow=classic;html=1;rounded=0;exitX=1;exitY=0.5;exitDx=0;exitDy=0;entryX=0;entryY=0.5;entryDx=0;entryDy=0;" parent="1" source="DS1AFzV_2DL1v2c9v1jZ-1" target="DS1AFzV_2DL1v2c9v1jZ-2" edge="1">
<mxGeometry width="50" height="50" relative="1" as="geometry">
<mxPoint x="260" y="480" as="sourcePoint" />
<mxPoint x="310" y="270" as="targetPoint" />
</mxGeometry>
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-4" value="Recalculating" style="text;html=1;align=center;verticalAlign=middle;whiteSpace=wrap;rounded=0;" parent="1" vertex="1">
<mxGeometry x="210" y="250" width="60" height="30" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-6" value="" style="endArrow=classic;html=1;rounded=0;exitX=0.5;exitY=1;exitDx=0;exitDy=0;" parent="1" source="DS1AFzV_2DL1v2c9v1jZ-2" edge="1">
<mxGeometry width="50" height="50" relative="1" as="geometry">
<mxPoint x="320" y="220" as="sourcePoint" />
<mxPoint x="310" y="350" as="targetPoint" />
</mxGeometry>
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-7" value="Idle" style="ellipse;whiteSpace=wrap;html=1;fillColor=#dae8fc;strokeColor=#6c8ebf;" parent="1" vertex="1">
<mxGeometry x="270" y="350" width="80" height="40" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-8" value="Recalculated" style="text;html=1;align=center;verticalAlign=middle;whiteSpace=wrap;rounded=0;" parent="1" vertex="1">
<mxGeometry x="330" y="310" width="60" height="30" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-9" value="" style="endArrow=classic;html=1;rounded=0;exitX=0.5;exitY=1;exitDx=0;exitDy=0;entryX=0.5;entryY=0;entryDx=0;entryDy=0;" parent="1" source="DS1AFzV_2DL1v2c9v1jZ-7" target="DS1AFzV_2DL1v2c9v1jZ-10" edge="1">
<mxGeometry width="50" height="50" relative="1" as="geometry">
<mxPoint x="320" y="320" as="sourcePoint" />
<mxPoint x="310" y="440" as="targetPoint" />
<Array as="points">
<mxPoint x="320" y="410" />
</Array>
</mxGeometry>
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-10" value="Value" style="ellipse;whiteSpace=wrap;html=1;" parent="1" vertex="1">
<mxGeometry x="280" y="440" width="80" height="40" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-11" value="Error" style="ellipse;whiteSpace=wrap;html=1;" parent="1" vertex="1">
<mxGeometry x="370" y="440" width="80" height="40" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-12" value="Persistent" style="ellipse;whiteSpace=wrap;html=1;fillColor=#dae8fc;strokeColor=#6c8ebf;" parent="1" vertex="1">
<mxGeometry x="90" y="440" width="80" height="40" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-13" value="Cancel" style="ellipse;whiteSpace=wrap;html=1;" parent="1" vertex="1">
<mxGeometry x="180" y="440" width="80" height="40" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-14" value="&lt;span style=&quot;text-align: start; font-size: 10pt; font-family: Arial;&quot; data-sheets-userformat=&quot;{&amp;quot;2&amp;quot;:513,&amp;quot;3&amp;quot;:{&amp;quot;1&amp;quot;:0},&amp;quot;12&amp;quot;:0}&quot; data-sheets-value=&quot;{&amp;quot;1&amp;quot;:2,&amp;quot;2&amp;quot;:&amp;quot;{progress: {type: \&amp;quot;binding\&amp;quot;, message: {persistent: true}}}&amp;quot;}&quot; data-sheets-root=&quot;1&quot;&gt;{progress: {type: &quot;binding&quot;, message: {persistent: true}}}&lt;/span&gt;" style="text;html=1;align=center;verticalAlign=middle;whiteSpace=wrap;rounded=0;" parent="1" vertex="1">
<mxGeometry x="45" y="340" width="170" height="30" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-15" value="" style="endArrow=classic;html=1;rounded=0;exitX=0.5;exitY=1;exitDx=0;exitDy=0;" parent="1" source="DS1AFzV_2DL1v2c9v1jZ-10" edge="1">
<mxGeometry width="50" height="50" relative="1" as="geometry">
<mxPoint x="320" y="400" as="sourcePoint" />
<mxPoint x="310" y="550" as="targetPoint" />
<Array as="points">
<mxPoint x="320" y="520" />
</Array>
</mxGeometry>
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-16" value="" style="endArrow=classic;html=1;rounded=0;exitX=0.5;exitY=1;exitDx=0;exitDy=0;" parent="1" source="DS1AFzV_2DL1v2c9v1jZ-11" edge="1">
<mxGeometry width="50" height="50" relative="1" as="geometry">
<mxPoint x="320" y="490" as="sourcePoint" />
<mxPoint x="320" y="550" as="targetPoint" />
</mxGeometry>
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-17" value="" style="endArrow=classic;html=1;rounded=0;exitX=0.5;exitY=1;exitDx=0;exitDy=0;entryX=0;entryY=0.5;entryDx=0;entryDy=0;" parent="1" source="DS1AFzV_2DL1v2c9v1jZ-12" target="DS1AFzV_2DL1v2c9v1jZ-18" edge="1">
<mxGeometry width="50" height="50" relative="1" as="geometry">
<mxPoint x="330" y="500" as="sourcePoint" />
<mxPoint x="290" y="540" as="targetPoint" />
<Array as="points" />
</mxGeometry>
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-18" value="Invalidated" style="ellipse;whiteSpace=wrap;html=1;fillColor=#dae8fc;strokeColor=#6c8ebf;" parent="1" vertex="1">
<mxGeometry x="260" y="550" width="80" height="40" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-20" value="" style="curved=1;endArrow=classic;html=1;rounded=0;exitX=0.5;exitY=1;exitDx=0;exitDy=0;entryX=1;entryY=0.5;entryDx=0;entryDy=0;" parent="1" source="DS1AFzV_2DL1v2c9v1jZ-18" target="DS1AFzV_2DL1v2c9v1jZ-2" edge="1">
<mxGeometry width="50" height="50" relative="1" as="geometry">
<mxPoint x="260" y="480" as="sourcePoint" />
<mxPoint x="310" y="430" as="targetPoint" />
<Array as="points">
<mxPoint x="420" y="610" />
<mxPoint x="550" y="470" />
<mxPoint x="440" y="320" />
</Array>
</mxGeometry>
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-23" value="Recalculating" style="text;html=1;align=center;verticalAlign=middle;whiteSpace=wrap;rounded=0;" parent="1" vertex="1">
<mxGeometry x="450" y="340" width="60" height="30" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-24" value="" style="endArrow=classic;html=1;rounded=0;exitX=0;exitY=1;exitDx=0;exitDy=0;entryX=0.5;entryY=0;entryDx=0;entryDy=0;" parent="1" source="DS1AFzV_2DL1v2c9v1jZ-2" target="DS1AFzV_2DL1v2c9v1jZ-12" edge="1">
<mxGeometry width="50" height="50" relative="1" as="geometry">
<mxPoint x="320" y="400" as="sourcePoint" />
<mxPoint x="320" y="450" as="targetPoint" />
</mxGeometry>
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-25" value="" style="endArrow=classic;html=1;rounded=0;exitX=1;exitY=1;exitDx=0;exitDy=0;entryX=0.395;entryY=-0.025;entryDx=0;entryDy=0;entryPerimeter=0;" parent="1" source="DS1AFzV_2DL1v2c9v1jZ-7" target="DS1AFzV_2DL1v2c9v1jZ-11" edge="1">
<mxGeometry width="50" height="50" relative="1" as="geometry">
<mxPoint x="330" y="410" as="sourcePoint" />
<mxPoint x="330" y="460" as="targetPoint" />
<Array as="points">
<mxPoint x="380" y="410" />
</Array>
</mxGeometry>
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-26" value="" style="endArrow=classic;html=1;rounded=0;exitX=0;exitY=1;exitDx=0;exitDy=0;entryX=1;entryY=0;entryDx=0;entryDy=0;" parent="1" source="DS1AFzV_2DL1v2c9v1jZ-7" target="DS1AFzV_2DL1v2c9v1jZ-13" edge="1">
<mxGeometry width="50" height="50" relative="1" as="geometry">
<mxPoint x="340" y="420" as="sourcePoint" />
<mxPoint x="340" y="470" as="targetPoint" />
</mxGeometry>
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-27" value="Value" style="text;html=1;align=center;verticalAlign=middle;whiteSpace=wrap;rounded=0;" parent="1" vertex="1">
<mxGeometry x="270" y="400" width="60" height="30" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-28" value="Error" style="text;html=1;align=center;verticalAlign=middle;whiteSpace=wrap;rounded=0;" parent="1" vertex="1">
<mxGeometry x="330" y="400" width="60" height="30" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-29" value="No message" style="text;html=1;align=center;verticalAlign=middle;whiteSpace=wrap;rounded=0;" parent="1" vertex="1">
<mxGeometry x="200" y="400" width="60" height="30" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-30" value="" style="endArrow=classic;html=1;rounded=0;exitX=0.5;exitY=1;exitDx=0;exitDy=0;entryX=0;entryY=0;entryDx=0;entryDy=0;" parent="1" source="DS1AFzV_2DL1v2c9v1jZ-13" target="DS1AFzV_2DL1v2c9v1jZ-18" edge="1">
<mxGeometry width="50" height="50" relative="1" as="geometry">
<mxPoint x="230" y="490" as="sourcePoint" />
<mxPoint x="300" y="558" as="targetPoint" />
<Array as="points">
<mxPoint x="240" y="520" />
</Array>
</mxGeometry>
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-31" value="&lt;span style=&quot;font-family: Arial; font-size: 13px; text-align: left; white-space: pre-wrap; background-color: rgb(255, 255, 255);&quot;&gt;{progress: {type: &quot;binding&quot;}}&lt;/span&gt;" style="text;html=1;align=center;verticalAlign=middle;resizable=0;points=[];autosize=1;strokeColor=none;fillColor=none;" parent="1" vertex="1">
<mxGeometry x="190" y="490" width="180" height="30" as="geometry" />
</mxCell>
<mxCell id="DS1AFzV_2DL1v2c9v1jZ-35" value="&lt;h1 style=&quot;margin-top: 0px;&quot;&gt;Shiny output progress states&lt;/h1&gt;&lt;p&gt;This diagram depicts a state machine of output binding progress state. Each node represents a possible state and each edge represents a server-&amp;gt;client message that moves outputs from one state to another. &lt;b&gt;If a node is highlighted in blue&lt;/b&gt;, then the output should be showing a busy state when visible (i.e., &lt;font face=&quot;Courier New&quot;&gt;binding.showProgress(true)&lt;/font&gt;)&lt;/p&gt;" style="text;html=1;whiteSpace=wrap;overflow=hidden;rounded=0;" parent="1" vertex="1">
<mxGeometry x="85" y="120" width="465" height="120" as="geometry" />
</mxCell>
<mxCell id="J9lKobNiy15ndT9nfcn--1" value="" style="curved=1;endArrow=classic;html=1;rounded=0;exitX=1;exitY=0;exitDx=0;exitDy=0;entryX=1;entryY=0;entryDx=0;entryDy=0;" edge="1" parent="1" source="DS1AFzV_2DL1v2c9v1jZ-7" target="DS1AFzV_2DL1v2c9v1jZ-18">
<mxGeometry width="50" height="50" relative="1" as="geometry">
<mxPoint x="280" y="480" as="sourcePoint" />
<mxPoint x="220" y="510" as="targetPoint" />
<Array as="points">
<mxPoint x="610" y="420" />
</Array>
</mxGeometry>
</mxCell>
</root>
</mxGraphModel>
</diagram>
</mxfile>

File diff suppressed because one or more lines are too long

Before

Width:  |  Height:  |  Size: 312 KiB

View File

@@ -1,6 +0,0 @@
Title: Hello Shiny!
Author: RStudio, Inc.
AuthorUrl: http://www.rstudio.com/
License: MIT
Tags: getting-started
Type: Shiny

View File

@@ -1,3 +0,0 @@
This small Shiny application demonstrates Shiny's automatic UI updates.
Move the *Number of bins* slider and notice how the `renderPlot` expression is automatically re-evaluated when its dependant, `input$bins`, changes, causing a histogram with a new number of bins to be rendered.

View File

@@ -1,54 +0,0 @@
library(shiny)
library(bslib)
# Define UI for app that draws a histogram ----
ui <- page_sidebar(
# App title ----
title = "Hello Shiny!",
# Sidebar panel for inputs ----
sidebar = sidebar(
# Input: Slider for the number of bins ----
sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30
)
),
# Output: Histogram ----
plotOutput(outputId = "distPlot")
)
# Define server logic required to draw a histogram ----
server <- function(input, output) {
# Histogram of the Old Faithful Geyser Data ----
# with requested number of bins
# This expression that generates a histogram is wrapped in a call
# to renderPlot to indicate that:
#
# 1. It is "reactive" and therefore should be automatically
# re-executed when inputs (input$bins) change
# 2. Its output type is a plot
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(
x,
breaks = bins,
col = "#75AADB",
border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)

View File

@@ -1,6 +0,0 @@
Title: Shiny Text
Author: RStudio, Inc.
AuthorUrl: http://www.rstudio.com/
License: MIT
Tags: getting-started
Type: Shiny

View File

@@ -1 +0,0 @@
This example demonstrates output of raw text from R using the `renderPrint` function in `server` and the `verbatimTextOutput` function in `ui`. In this case, a textual summary of the data is shown using R's built-in `summary` function.

View File

@@ -1,61 +0,0 @@
library(shiny)
library(bslib)
# Define UI for dataset viewer app ----
ui <- page_sidebar(
# App title ----
title = "Shiny Text",
# Sidebar panel for inputs ----
sidebar = sidebar(
# Input: Selector for choosing dataset ----
selectInput(
inputId = "dataset",
label = "Choose a dataset:",
choices = c("rock", "pressure", "cars")
),
# Input: Numeric entry for number of obs to view ----
numericInput(
inputId = "obs",
label = "Number of observations to view:",
value = 10
)
),
# Output: Verbatim text for data summary ----
verbatimTextOutput("summary"),
# Output: HTML table with requested number of observations ----
tableOutput("view")
)
# Define server logic to summarize and view selected dataset ----
server <- function(input, output) {
# Return the requested dataset ----
datasetInput <- reactive({
switch(
input$dataset,
"rock" = rock,
"pressure" = pressure,
"cars" = cars
)
})
# Generate a summary of the dataset ----
output$summary <- renderPrint({
dataset <- datasetInput()
summary(dataset)
})
# Show the first "n" observations ----
output$view <- renderTable({
head(datasetInput(), n = input$obs)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)

View File

@@ -1,6 +0,0 @@
Title: Reactivity
Author: RStudio, Inc.
AuthorUrl: http://www.rstudio.com/
License: MIT
Tags: getting-started
Type: Shiny

View File

@@ -1,5 +0,0 @@
This example demonstrates a core feature of Shiny: **reactivity**. In the `server` function, a reactive called `datasetInput` is declared.
Notice that the reactive expression depends on the input expression `input$dataset`, and that it's used by two output expressions: `output$summary` and `output$view`. Try changing the dataset (using *Choose a dataset*) while looking at the reactive and then at the outputs; you will see first the reactive and then its dependencies flash.
Notice also that the reactive expression doesn't just update whenever anything changes--only the inputs it depends on will trigger an update. Change the "Caption" field and notice how only the `output$caption` expression is re-evaluated; the reactive and its dependents are left alone.

Some files were not shown because too many files have changed in this diff Show More