-
Notifications
You must be signed in to change notification settings - Fork 1.9k
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
111 changed files
with
12,351 additions
and
10,520 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,7 +1,7 @@ | ||
| Package: shiny | ||
| Type: Package | ||
| Title: Web Application Framework for R | ||
| Version: 1.8.1.9000 | ||
| Version: 1.8.1.9001 | ||
| Authors@R: c( | ||
| person("Winston", "Chang", role = c("aut", "cre"), email = "[email protected]", comment = c(ORCID = "0000-0002-1576-2126")), | ||
| person("Joe", "Cheng", role = "aut", email = "[email protected]"), | ||
|
|
@@ -91,8 +91,8 @@ Imports: | |
| withr, | ||
| commonmark (>= 1.7), | ||
| glue (>= 1.3.2), | ||
| bslib (>= 0.3.0), | ||
| cachem, | ||
| bslib (>= 0.6.0), | ||
| cachem (>= 1.1.0), | ||
| lifecycle (>= 0.2.0) | ||
| Suggests: | ||
| datasets, | ||
|
|
@@ -128,6 +128,8 @@ Collate: | |
| 'map.R' | ||
| 'utils.R' | ||
| 'bootstrap.R' | ||
| 'busy-indicators-spinners.R' | ||
| 'busy-indicators.R' | ||
| 'cache-utils.R' | ||
| 'deprecated.R' | ||
| 'devmode.R' | ||
|
|
@@ -204,7 +206,7 @@ Collate: | |
| 'version_selectize.R' | ||
| 'version_strftime.R' | ||
| 'viewer.R' | ||
| RoxygenNote: 7.3.1 | ||
| RoxygenNote: 7.3.2 | ||
| Encoding: UTF-8 | ||
| Roxygen: list(markdown = TRUE) | ||
| RdMacros: lifecycle | ||
|
|
||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,4 @@ | ||
| # Generated by tools/updateSpinnerTypes.R: do not edit by hand | ||
| .busySpinnerTypes <- | ||
| c("ring", "ring2", "ring3", "bars", "bars2", "bars3", "pulse", | ||
| "pulse2", "pulse3", "dots", "dots2", "dots3") |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,249 @@ | ||
| #' 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. | ||
| #' | ||
| #' @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) { | ||
|
|
||
| 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) | ||
| } | ||
| }) | ||
|
|
||
| js <- HTML(paste(js, collapse = "\n")) | ||
|
|
||
| # 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. | ||
| tags$script(js) | ||
| } | ||
|
|
||
| #' Customize busy indicator options | ||
| #' | ||
| #' When busy indicators are enabled (see [useBusyIndicators()]), 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. This function allows | ||
| #' you to customize the appearance of those busy indicators. To apply the | ||
| #' customization, include the result of this function inside the app's UI. | ||
| #' | ||
| #' @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 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()] for enabling/disabling 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, | ||
| 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 | ||
| ), | ||
| 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) | ||
| } | ||
|
|
||
| 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" | ||
| ) | ||
| } |
Oops, something went wrong.