diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
index b20f53be5..fa37f3a15 100644
--- a/.github/workflows/R-CMD-check.yaml
+++ b/.github/workflows/R-CMD-check.yaml
@@ -40,10 +40,6 @@ jobs:
- name: Install bslib from GitHub
shell: Rscript {0}
run: |
- # rsconnect 1.0 introduced an issue with deploying from CI
- # Once a proper fix is CRAN, we can go back install.packages
- if (!require('remotes')) install.packages('remotes')
- remotes::install_version("rsconnect", "0.8.29")
pak::pkg_install("rstudio/bslib", dependencies = TRUE, upgrade = TRUE)
# Workaround for this (probably spurious error):
@@ -58,7 +54,7 @@ jobs:
run: |
install.packages("cpp11")
- - name: Register account
+ - name: Register account(s)
shell: Rscript {0}
run: |
rsconnect::setAccountInfo(
@@ -66,10 +62,18 @@ jobs:
token = '${{ secrets.SHINYAPPS_TOKEN }}',
secret = '${{ secrets.SHINYAPPS_SECRET }}'
)
+ rsconnect::setAccountInfo(
+ name = 'bslib',
+ token = '${{ secrets.SHINYAPPS_BSLIB_TOKEN }}',
+ secret = '${{ secrets.SHINYAPPS_BSLIB_SECRET }}'
+ )
- name: Deploy
+ shell: bash
run: |
- Rscript 'inst/themer-demo/deploy.R'
- Rscript 'inst/examples/card/deploy.R'
- Rscript 'inst/examples/value_box/deploy.R'
- Rscript 'inst/examples/flights/deploy.R'
+ deployScripts=$(find inst -name "deploy.R" -type f)
+
+ for deployScript in $deployScripts; do
+ echo "Deploying $deployScript"
+ Rscript $deployScript
+ done
diff --git a/DESCRIPTION b/DESCRIPTION
index bdd560604..e56a27a01 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -57,6 +57,8 @@ Remotes:
rstudio/htmltools
Config/Needs/deploy:
BH,
+ colourpicker,
+ commonmark,
cpp11,
dplyr,
DT,
@@ -65,6 +67,7 @@ Config/Needs/deploy:
gt,
hexbin,
histoslider,
+ htmlwidgets,
lattice,
leaflet,
lubridate,
@@ -75,9 +78,12 @@ Config/Needs/deploy:
reshape2,
rprojroot,
rsconnect,
- scales
+ rstudio/shiny,
+ scales,
+ styler,
+ tibble
Config/Needs/routine: chromote, desc, renv
-Config/Needs/website:
+Config/Needs/website:
brio,
crosstalk,
dplyr,
diff --git a/NEWS.md b/NEWS.md
index f8e65a60c..28a4887e4 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -23,6 +23,8 @@
* The `showcase_layout` argument of `value_box()` now accepts one of three character values: `"left center"`, `"top right"`, `"bottom"`. (#758)
+* A new [Build a Box app](https://bslib.shinyapps.io/build-a-box/) is now available online or via bslib. See `?value_box()` for details. The app helps preview a set of value boxes while you configure and customize their appearance and provides you with code to copy and paste into your app. (#790)
+
* Added `input_dark_mode()`, a new input control that provides a toggle button that can be used to switch between the dark and light modes when using Bootstrap 5.3. By default, dark mode is applied automatically if the user's operating system is also in dark mode. App authors can toggle dark mode programmatically from the server using `toggle_dark_mode()`, and if you provide `input_dark_mode()` with an `id`, you can read the current color mode via the corresponding input value. (#787)
## Improvements
diff --git a/R/sysdata.rda b/R/sysdata.rda
index 5f69d4ab9..ed0482730 100644
Binary files a/R/sysdata.rda and b/R/sysdata.rda differ
diff --git a/R/value-box.R b/R/value-box.R
index f2fcd6c85..a31aa1097 100644
--- a/R/value-box.R
+++ b/R/value-box.R
@@ -5,6 +5,17 @@
#' `value` represents (for example, it could hold a [bsicons::bs_icon()], or
#' even a [shiny::plotOutput()]).
#'
+#' @section Build a Box App:
+#'
+#' Explore all of the `value_box()` options and layouts interactively with the
+#' [Build a Box app](https://bslib.shinyapps.io/build-a-box/), available
+#' online thanks to [shinyapps.io](https://www.shinyapps.io/). Or, you can
+#' run the app locally with:
+#'
+#' ```r
+#' shiny::runApp(system.file("examples", "build-a-box", package = "bslib"))
+#' ```
+#'
#' @section Themes:
#'
#' ```{r child="man/fragments/value-box-themes.Rmd"}
diff --git a/inst/examples/build-a-box/R/code_modal.R b/inst/examples/build-a-box/R/code_modal.R
new file mode 100644
index 000000000..801d858be
--- /dev/null
+++ b/inst/examples/build-a-box/R/code_modal.R
@@ -0,0 +1,34 @@
+code_modal <- function(code) {
+ if (rlang::is_call(code)) {
+ code <- rlang::expr_text(code)
+ }
+
+ if (requireNamespace("styler", quietly = TRUE)) {
+ code <- styler::style_text(code)
+ }
+
+ code <- paste(code, collapse = "\n")
+
+ showModal(
+ modalDialog(
+ HTML(sprintf(
+ '%s
',
+ code
+ )),
+ p(
+ id = "copy-clipboard-not-supported",
+ class = "text-muted d-none",
+ HTML("Press Ctrl/Cmd + C to copy the value box example code.")
+ ),
+ tags$button(
+ id = "copy-code-to-clipboard",
+ class = "btn btn-outline-primary",
+ onclick = "copyValueBoxCode()",
+ "Copy to clipboard"
+ ),
+ singleton(tags$script(src = "code-modal.js")),
+ footer = modalButton("Done"),
+ easyClose = TRUE
+ )
+ )
+}
diff --git a/inst/examples/build-a-box/R/colors.R b/inst/examples/build-a-box/R/colors.R
new file mode 100644
index 000000000..e1f3f3d17
--- /dev/null
+++ b/inst/examples/build-a-box/R/colors.R
@@ -0,0 +1,37 @@
+theme_colors <- list(
+ "primary",
+ "secondary",
+ "success",
+ "danger",
+ "warning",
+ "info",
+ "light",
+ "dark"
+)
+
+named_colors <- c(
+ "blue",
+ "indigo",
+ "purple",
+ "pink",
+ "red",
+ "orange",
+ "yellow",
+ "green",
+ "teal",
+ "cyan"
+)
+
+gc <- expand.grid(named_colors, named_colors)
+gc <- gc[gc$Var1 != gc$Var2,]
+gradient_classes <- sprintf("bg-gradient-%s-%s", gc$Var1, gc$Var2)
+
+
+all_themes <- c(
+ "Default" = "",
+ theme_colors,
+ named_colors,
+ paste0("text-", theme_colors),
+ paste0("text-", named_colors),
+ sort(gradient_classes)
+)
diff --git a/inst/examples/build-a-box/R/mod-global-controls.R b/inst/examples/build-a-box/R/mod-global-controls.R
new file mode 100644
index 000000000..7b2fc9d45
--- /dev/null
+++ b/inst/examples/build-a-box/R/mod-global-controls.R
@@ -0,0 +1,123 @@
+ui_global_controls <- function(id) {
+ ns <- shiny::NS(id)
+
+ tagList(
+ layout_columns(
+ class = "align-items-end",
+ selectizeInput(
+ ns("theme_style"),
+ "Theme style",
+ list(
+ "Default" = "default",
+ "All" = "all",
+ "Semantic Colors" = list(
+ "Semantic Background" = "semantic-bg",
+ "Semantic Text" = "semantic-fg"
+ ),
+ "Theme Colors" = list(
+ "Colored Background" = "colors-bg",
+ "Colored Text" = "colors-fg"
+ ),
+ "Vibrant" = list(
+ "Gradient Background" = "gradient"
+ )
+ )
+ ),
+ shuffleButton(ns("random_theme"), "Theme"),
+ shuffleButton(ns("random_stat"), "Stats")
+ ),
+ layout_columns(
+ class = "align-items-start",
+ div(
+ radioButtons(
+ ns("showcase_item"),
+ "Showcase Item",
+ choices = c("Plot", "Icon"),
+ inline = TRUE
+ ),
+ conditionalPanel(
+ "input.showcase_item == 'Plot'",
+ ns = ns,
+ p(
+ class = "text-muted",
+ "See",
+ tags$a(href = "https://rstudio.github.io/bslib/articles/value-boxes/index.html#expandable-sparklines", "Expandable Sparklines"),
+ "for example plot code."
+ )
+ ),
+ conditionalPanel(
+ "input.showcase_item == 'Icon'",
+ ns = ns,
+ shuffleButton(ns("random_icon"), "Icons")
+ )
+ ),
+ radioButtons(
+ ns("showcase_layout"),
+ "Showcase Layout",
+ choices = c("Left center", "Top right", "Bottom"),
+ inline = TRUE
+ )
+ )
+ )
+}
+
+server_global_controls <- function(input, output, sessions, one, two, three) {
+ observeEvent(c(input$random_theme, input$theme_style), {
+ new_values <- switch(
+ input$theme_style,
+ all = {
+ one$theme$shuffle()
+ two$theme$shuffle()
+ three$theme$shuffle()
+ NULL
+ },
+ default = {
+ one$theme$set("Default")
+ two$theme$set("Default")
+ three$theme$set("Default")
+ NULL
+ },
+ "semantic-bg" = sample(setdiff(theme_colors, c("light", "dark")), 3),
+ "semantic-fg" = paste0("text-", sample(setdiff(theme_colors, c("light", "dark")), 3)),
+ "colors-bg" = sample(named_colors, 3, replace = TRUE),
+ "colors-fg" = paste0("text-", sample(named_colors, 3, replace = TRUE)),
+ gradient = sample(gradient_classes, 3)
+ )
+
+ if (is.null(new_values)) return()
+
+ one$theme$set(new_values[[1]])
+ two$theme$set(new_values[[2]])
+ three$theme$set(new_values[[3]])
+ }, ignoreInit = TRUE)
+
+ observeEvent(input$random_stat, {
+ one$random_stat()
+ two$random_stat()
+ three$random_stat()
+ })
+
+ observeEvent(input$random_icon, {
+ one$showcase_icon$shuffle()
+ two$showcase_icon$shuffle()
+ three$showcase_icon$shuffle()
+ })
+
+ observeEvent(input$showcase_item, {
+ item <- tolower(input$showcase_item)
+ one$set_showcase_item(item)
+ two$set_showcase_item(item)
+ three$set_showcase_item(item)
+ }, ignoreInit = TRUE)
+
+ observeEvent(input$showcase_layout, {
+ layout <- tolower(input$showcase_layout)
+ one$set_showcase_layout(layout)
+ two$set_showcase_layout(layout)
+ three$set_showcase_layout(layout)
+ }, ignoreInit = TRUE)
+}
+
+module_global_controls <- function(id, one, two, three) {
+ callModule(server_global_controls, id, one = one, two = two, three = three)
+}
diff --git a/inst/examples/build-a-box/R/mod-selextra.R b/inst/examples/build-a-box/R/mod-selextra.R
new file mode 100644
index 000000000..5cc162f30
--- /dev/null
+++ b/inst/examples/build-a-box/R/mod-selextra.R
@@ -0,0 +1,113 @@
+
+label_with_extras <- function(label, ...) {
+ div(
+ class = "d-inline-block w-100",
+ span(label),
+ span(class = "float-right", ...),
+ singleton(tags$style(HTML(".shiny-input-container .control-label { width: 100%; }")))
+ )
+}
+
+ui_selextra <- function(id, label) {
+ ns <- shiny::NS(id)
+
+ selectizeInput(
+ inputId = ns("selected"),
+ choices = NULL,
+ label_with_extras(
+ label,
+ actionLink(
+ ns("shuffle"),
+ bsicons::bs_icon("shuffle", title = paste("Random", label))
+ ),
+ actionLink(
+ ns("prev"),
+ bsicons::bs_icon("caret-left-fill", title = paste("Previous", label))
+ ),
+ actionLink(
+ ns("next"),
+ bsicons::bs_icon("caret-right-fill", title = paste("Next", label))
+ )
+ )
+ )
+}
+
+server_selextra <- function(input, output, session, choices) {
+ ns <- session$ns
+
+ # These are server-side selectize inputs, so we update them on initialization
+ updateSelectizeInput(session, "selected", choices = choices, server = TRUE)
+
+ trigger_shuffle <- reactiveVal(0)
+ trigger_next <- reactiveVal(0)
+ trigger_prev <- reactiveVal(0)
+
+ observeEvent(
+ input$shuffle,
+ ignoreInit = TRUE,
+ trigger_shuffle(trigger_shuffle() + 1)
+ )
+
+ observeEvent(trigger_shuffle(), {
+ req(trigger_shuffle() > 0)
+
+ updateSelectizeInput(
+ session,
+ "selected",
+ selected = sample(unlist(choices), 1),
+ choices = choices,
+ server = TRUE
+ )
+ })
+
+ observeEvent(input[["next"]], move(1))
+ observeEvent(trigger_next(), move(1), ignoreInit = TRUE)
+
+ observeEvent(input[["prev"]], move(-1))
+ observeEvent(trigger_prev(), move(-1), ignoreInit = TRUE)
+
+ move <- reactiveVal(0)
+
+ observeEvent(move(), {
+ req(move() != 0)
+
+ current <- input$selected
+ choices_flat <- unlist(choices)
+
+ idx <- which(choices_flat == current) + move()
+ move(0)
+ req(idx)
+
+ if (idx > length(choices_flat)) idx <- 1
+ if (idx <= 0) idx <- length(choices_flat)
+
+ updateSelectizeInput(
+ session,
+ "selected",
+ selected = choices_flat[[idx]],
+ choices = choices,
+ server = TRUE
+ )
+ })
+
+ list(
+ "value" = reactive(input$selected %||% ""),
+ "shuffle" = function() trigger_shuffle(as.integer(Sys.time())),
+ "next" = function() trigger_next(as.integer(Sys.time())),
+ "prev" = function() trigger_prev(as.integer(Sys.time())),
+ "choices" = choices,
+ "set" = function(value) {
+ updateSelectizeInput(
+ session,
+ "selected",
+ selected = value,
+ choices = choices,
+ server = TRUE
+ )
+ }
+ )
+}
+
+module_selextra <- function(id, choices) {
+ callModule(server_selextra, id, choices = choices)
+}
diff --git a/inst/examples/build-a-box/R/mod-value-box-ui.R b/inst/examples/build-a-box/R/mod-value-box-ui.R
new file mode 100644
index 000000000..2aff857f7
--- /dev/null
+++ b/inst/examples/build-a-box/R/mod-value-box-ui.R
@@ -0,0 +1,255 @@
+`%||%` <- function(x, y) if (is.null(x)) y else x
+
+icon_list <- list(
+ "bsicons" = setNames(
+ paste0("bsicons::", bsicons:::icon_info$name),
+ bsicons:::icon_info$name
+ ),
+ "fontawesome" = setNames(
+ paste0("fontawesome::", fontawesome::fa_metadata()$icon_names),
+ fontawesome::fa_metadata()$icon_names
+ )
+)
+
+resolve_icon <- function(name) {
+ icon <- strsplit(name, "::", fixed = TRUE)[[1]]
+ icon_fn <- switch(
+ icon[1],
+ bsicons = {
+ ns <- "bsicons"
+ fn <- "bs_icon"
+ },
+ {
+ ns <- "fontawesome"
+ fn <- "fa_i"
+ }
+ )
+ rlang::call2(.ns = ns, fn, icon[2])
+}
+
+ui_value_box_options <- function(id) {
+ ns <- NS(id)
+
+ conditional_panel <- function(condition, ...) {
+ conditionalPanel(condition, ..., ns = ns)
+ }
+
+ init <- random_title_value()
+
+ list(
+ "title_value" = list(
+ textInput(ns("title"), "Title", init$title),
+ textInput(ns("value"), "Value", init$value),
+ tagAppendAttributes(
+ textAreaInput(ns("extra"), "Extra text (markdown allowed)", ""),
+ class = "input-text-code"
+ ),
+ actionButton(ns("random_stat"), "Random stat")
+ ),
+ "theme_opts" = list(
+ input_switch(ns("use_custom_colors"), "Use custom colors", FALSE),
+ conditional_panel(
+ "!input.use_custom_colors",
+ ui_selextra(ns("theme"), "Theme")
+ ),
+ conditional_panel(
+ "input.use_custom_colors",
+ colourpicker::colourInput(ns("foreground"), "Foreground", value = "#000000"),
+ colourpicker::colourInput(ns("background"), "Background", value = "#FFFFFF")
+ ),
+ input_switch(ns("full_screen"), "Allow full screen", value = FALSE),
+ input_switch(ns("fill"), "Fill vertical space", value = TRUE),
+ input_switch(ns("fixed_height"), "Fixed height", value = FALSE),
+ conditional_panel(
+ "input.fixed_height",
+ sliderInput(
+ inputId = ns("height"),
+ label = "Height",
+ min = 100,
+ max = 500,
+ value = 150,
+ post = "px",
+ step = 10
+ )
+ )
+ ),
+ showcase = list(
+ input_switch(ns("showcase"), "Include showcase", value = TRUE),
+ conditional_panel(
+ "input.showcase",
+ radioButtons(
+ ns("showcase_layout"),
+ "Showcase Layout",
+ c("left center", "top right", "bottom"),
+ inline = TRUE
+ ),
+ radioButtons(
+ ns("showcase_item"),
+ "Showcase Item",
+ c("icon", "plot"),
+ selected = "plot",
+ inline = TRUE
+ ),
+ conditional_panel(
+ "input.showcase_item == 'plot'",
+ selectInput(ns("showcase_plot_type"), "Plot Type", c("line", "bar", "box")),
+ radioButtons(ns("showcase_plot_color"), "Plot Color", c("auto", "black", "white"), inline = TRUE)
+ ),
+ conditional_panel(
+ "input.showcase_item == 'icon'",
+ ui_selextra(ns("showcase_icon"), "Icon")
+ )
+ )
+ )
+ )
+}
+
+ui_value_box_output <- function(id) {
+ uiOutput(NS(id)("value_box"), class = "shiny-report-theme", fill = TRUE)
+}
+
+server_value_box <- function(input, output, session, ...) {
+ ns <- session$ns
+
+ theme <- module_selextra("theme", all_themes)
+ showcase_icon <- module_selextra("showcase_icon", icon_list)
+
+ random_plot <- reactive({
+ req(isolate(input$showcase), input$showcase_plot_type, plot_color())
+ random_plotly_plot(input$showcase_plot_type, plot_color())
+ })
+
+ plot_color <- reactiveVal("#FFFFFF")
+
+ observe({
+ if (input$showcase_plot_color != "auto") {
+ plot_color(input$showcase_plot_color)
+ return()
+ }
+
+ if (input$use_custom_colors) {
+ plot_color(input$foreground)
+ return()
+ }
+
+ if (!is.null(input$value_box_fg_color)) {
+ fg <- input$value_box_fg_color
+ fg <- htmltools::parseCssColors(fg)
+ plot_color(fg)
+ } else {
+ plot_color("#808080")
+ }
+ })
+
+ observe({
+ req(input$showcase, input$showcase_item == "icon")
+ showcase_icon$shuffle()
+ })
+
+ # ┌─ {bslib} ──────────────────────┐
+ # │ │
+ # │ value_box() │
+ # │ │
+ # └────────────────────────────────┘
+
+ value_box_args_impl <- reactive({
+ req(input$title, input$value)
+
+ theme <-
+ if (input$use_custom_colors) {
+ rlang::call2(
+ "value_box_theme",
+ bg = input$background,
+ fg = input$foreground
+ )
+ } else {
+ if (nzchar(theme$value())) theme$value()
+ }
+
+ extra <-
+ if (nzchar(input$extra)) {
+ rlang::call2(.ns = "shiny", "markdown", input$extra)
+ }
+
+ showcase <-
+ if (input$showcase) {
+ req(showcase_icon$value())
+
+ switch(
+ input$showcase_item,
+ icon = resolve_icon(showcase_icon$value()),
+ plot = "Your Plot"
+ )
+ }
+
+ rlang::list2(
+ title = input$title,
+ value = input$value,
+ if (!is.null(extra)) extra else rlang::missing_arg(),
+ theme = theme,
+ showcase = showcase,
+ showcase_layout = input$showcase_layout,
+ full_screen = input$full_screen,
+ fill = input$fill,
+ height = if (input$fixed_height) input$height
+ )
+ })
+
+ value_box_args <- debounce(value_box_args_impl, 250)
+
+ value_box_call <- reactive({
+ req(input$title, input$value)
+
+ rlang::call2("value_box", !!!value_box_args())
+ })
+
+ output$value_box <- renderUI({
+ req(value_box_call())
+
+ call <- value_box_call()
+
+ is_showcase_plot <- isolate(input$showcase && input$showcase_item == "plot")
+
+ if (is_showcase_plot) {
+ call <- rlang::call_modify(call, showcase = random_plot())
+ }
+
+ rlang::eval_bare(call)
+ })
+
+ observeEvent(input$showcase_item, {
+ updateCheckboxInput(session, "full_screen", value = input$showcase_item == "plot")
+ })
+
+ observeEvent(input$random_stat, {
+ random <- random_title_value()
+ updateTextInput(session, "title", value = random$title)
+ updateTextInput(session, "value", value = random$value)
+ })
+
+ observeEvent(input$shuffle_showcase_icon, {
+ new <- sample(bsicons:::icon_info$name, 1)
+ updateSelectInput(session, "showcase_icon", selected = paste0("bsicons::", new))
+ })
+
+ list(
+ code = value_box_call,
+ theme = theme,
+ showcase_icon = showcase_icon,
+ random_stat = function() {
+ random <- random_title_value()
+ updateTextInput(session, "title", value = random$title)
+ updateTextInput(session, "value", value = random$value)
+ },
+ set_showcase_layout = function(layout) {
+ updateRadioButtons(session, "showcase_layout", selected = layout)
+ },
+ set_showcase_item = function(item) {
+ updateRadioButtons(session, "showcase_item", selected = item)
+ }
+ )
+}
+
+module_value_box <- function(id) {
+ moduleServer(id, server_value_box)
+}
diff --git a/inst/examples/build-a-box/R/random_plot.R b/inst/examples/build-a-box/R/random_plot.R
new file mode 100644
index 000000000..19246ec04
--- /dev/null
+++ b/inst/examples/build-a-box/R/random_plot.R
@@ -0,0 +1,81 @@
+
+generate_random_walk <- function(num_steps = 90) {
+ start_date <- as.POSIXct(as.integer(Sys.time()) * runif(1), origin = "1970-01-01")
+
+ increments <- rnorm(num_steps)
+ cumulative_sum <- cumsum(increments)
+ time_series <- c(0, cumulative_sum) + rnorm(1, 0, 50) + 25
+
+ dates <- seq(start_date, length.out = num_steps + 1, by = "day")
+
+ data.frame(date = dates, value = time_series)
+}
+
+as_plotly_sparkline <- function(plot, color = "white") {
+ plot |>
+ layout(
+ xaxis = list(visible = FALSE, showgrid = FALSE, title = ""),
+ yaxis = list(visible = FALSE, showgrid = FALSE, title = ""),
+ hovermode = "x",
+ margin = list(t = 0, r = 0, l = 0, b = 0),
+ font = list(color = color),
+ paper_bgcolor = "transparent",
+ plot_bgcolor = "transparent"
+ ) |>
+ config(displayModeBar = FALSE) |>
+ htmlwidgets::onRender(
+ "function(el) {
+ var ro = new ResizeObserver(function() {
+ var visible = el.offsetHeight > 200;
+ Plotly.relayout(el, {'xaxis.visible': visible});
+ });
+ ro.observe(el);
+ }"
+ )
+ }
+
+
+random_plotly_plot <- function(type = NULL, color = "white") {
+ if (is.null(type)) {
+ type <- sample(c("bar", "box", "line"), 1)
+ }
+
+ plot <- switch(
+ type,
+ bar = random_plotly_bar(color, 50),
+ box = random_plotly_box(color, 50),
+ line = random_plotly_line(color, 50),
+ stop("Not a valid random plot type: ", type)
+ )
+
+ as_plotly_sparkline(plot, color)
+}
+
+random_plotly_bar <- function(color, n = 50) {
+ plot_ly(
+ x = ~ runif(n),
+ type = "histogram",
+ histnorm = "probability",
+ nbinsx = 10,
+ color = I(color),
+ stroke = I(color),
+ alpha_stroke = 1,
+ alpha = 0.6
+ )
+}
+
+random_plotly_box <- function(color, n = 50) {
+ plot_ly(x = ~rnorm(n), type = "box", color = I(color))
+}
+
+random_plotly_line <- function(color, n) {
+ add_lines(
+ plot_ly(generate_random_walk(n)),
+ x = ~ date,
+ y = ~ value,
+ color = I(color),
+ fill = "tozeroy",
+ span = I(1),
+ alpha = 0.2
+ )
+}
diff --git a/inst/examples/build-a-box/R/random_values.R b/inst/examples/build-a-box/R/random_values.R
new file mode 100644
index 000000000..f314b38c0
--- /dev/null
+++ b/inst/examples/build-a-box/R/random_values.R
@@ -0,0 +1,76 @@
+random_values <- tibble::tribble(
+ ~title, ~value,
+ "Sales revenue", "$22,456.78",
+ "Customer satisfaction", "94.5%",
+ "Inventory turnover", "8/month",
+ "Number of employees", "75",
+ "Website traffic", "12,345 visits/day",
+ "Customer retention", "87%",
+ "Average transaction", "$56.73",
+ "Followers", "10,234",
+ "Open rate", "22.6%",
+ "Production efficiency", "92%",
+ "Project completion", "17 days",
+ "Employee turnover", "10%",
+ "Market share", "15.2%",
+ "ROI", "8.3%",
+ "Average response time", "3.2 seconds",
+ "Energy consumption", "345 kwh/month",
+ "Customer churn", "5%",
+ "Production defect rate", "0.6%",
+ "Engagement rate", "3.8%",
+ "Average wait", "4 minutes",
+ "Project budget variance", "$2,345.67",
+ "Employee productivity", "95%",
+ "Conversion rate", "2.5%",
+ "Website bounce rate", "42%",
+ "Revenue growth", "+15.2%",
+ "Customer loyalty", "4.5 out of 5",
+ "Product quality", "8.9/10",
+ "Social media followers", "50,000+",
+ "Market reach", "10.5 million",
+ "Employee satisfaction", "92.3%",
+ "Average order value", "$123.45",
+ "Website conversion rate", "3.6%",
+ "Customer support", "9.8/10",
+ "Productivity index", "120%",
+ "Customer lifetime value", "$5,000",
+ "Brand awareness", "85%",
+ "Time to market", "4 weeks",
+ "Return on investment", "18.5%",
+ "Net promoter score", "8.2 out of 10",
+ "Email click-through rate", "12.7%",
+ "Supply chain efficiency", "92%",
+ "Website loading time", "2.3 seconds",
+ "Cost per acquisition", "$25.60",
+ "Employee engagement", "83%",
+ "Innovation index", "9.5/10",
+ "Customer complaints resolved", "98.6%",
+ "Market share growth", "+2.3%",
+ "Production capacity utilization", "87%",
+ "Website traffic source diversity", "5 channels",
+ "Brand equity", "$1.2 billion",
+ "Code Coverage", "85%",
+ "Lines of Code", "46,157",
+ "Commits", "339",
+ "Review Turnaround", "2 days",
+ "Community Contributors", "34",
+ "Project Forks", "36",
+ "Open Issues", "87",
+ "Open Pull Requests", "12",
+ "Closed Issues", "19",
+ "AWS Cloud Spending", "$3,463",
+ "Diversity Index", "0.75",
+ "API Response Time", "150 ms",
+ "Daily Active Users", "8,507",
+ "Project Stars", "5,100",
+ "Package Downloads", "409,446",
+ "Average Response Time", "50 ms",
+ "Uptime", "99.97%",
+ "Developer Satisfaction", "4.8/5",
+ "Project Funding", "$2,805"
+)
+
+random_title_value <- function() {
+ as.list(random_values[sample(nrow(random_values), 1), ])
+}
diff --git a/inst/examples/build-a-box/R/shuffleButton.R b/inst/examples/build-a-box/R/shuffleButton.R
new file mode 100644
index 000000000..588f224f7
--- /dev/null
+++ b/inst/examples/build-a-box/R/shuffleButton.R
@@ -0,0 +1,20 @@
+iconButton <- function(
+ id,
+ label,
+ class = NULL,
+ icon = "shuffle",
+ icon_title = "Random",
+ ...
+) {
+ tags$button(
+ id = id,
+ class = "btn btn-default action-button",
+ class = class,
+ bsicons::bs_icon("shuffle", title = "Random"),
+ label
+ )
+}
+
+shuffleButton <- function(id, label, class = NULL) {
+ iconButton(id, label, class = c("shuffle-button", class))
+}
diff --git a/inst/examples/build-a-box/about-value-boxes.md b/inst/examples/build-a-box/about-value-boxes.md
new file mode 100644
index 000000000..3e3038218
--- /dev/null
+++ b/inst/examples/build-a-box/about-value-boxes.md
@@ -0,0 +1,13 @@
+Use `value_box()`
+from [bslib](https://rstudio.github.io/bslib/reference/value_box.html)
+to showcase values in your dashboards and apps!
+
+The **Build A Box** app is designed to help you quickly choose
+the right styles for your value boxes.
+
+When you're ready to start coding,
+click the
+
+**Code** icon
+to copy the code you need to get started
+in your own apps!
diff --git a/inst/examples/build-a-box/app.R b/inst/examples/build-a-box/app.R
new file mode 100644
index 000000000..3f34a3514
--- /dev/null
+++ b/inst/examples/build-a-box/app.R
@@ -0,0 +1,237 @@
+# Packages ---------------------------------------
+library(shiny)
+library(bslib)
+
+pkgs_extra <- c("plotly", "colourpicker")
+pkgs_yes <- vapply(pkgs_extra, rlang::is_installed, logical(1))
+if (any(!pkgs_yes)) {
+ rlang::abort(paste0(
+ "The `build-a-box` app requires additional packages: ",
+ paste(pkgs_extra[!pkgs_yes], collapse = ", ")
+ ))
+}
+
+library(plotly)
+
+# Settings ---------------------------------------
+ENABLE_THEMER <- identical(Sys.getenv("ENABLE_THEMER"), "true")
+
+# Functions ---------------------------------------
+layout_value_box_options <- function(ui_opts) {
+ layout_columns(
+ div(h4("Content", class = "border-bottom"), ui_opts$title_value),
+ div(h4("Theme", class = "border-bottom"), ui_opts$theme_opts),
+ div(h4("Showcase", class = "border-bottom"), ui_opts$showcase)
+ )
+}
+
+value_box_placeholder <- function(id) {
+ value_box(
+ id = id,
+ class = "placeholder-glow",
+ title = span(class = "placeholder col-7"),
+ value = span(class = "placeholder col-4"),
+ showcase = div(class = "placeholder bg-primary col-12", as_fill_item())
+ )
+}
+
+# Theme ---------------------------------------
+theme_build_a_box <- bs_add_rules(
+ bs_theme(preset = "shiny"),
+ sass::sass_file("www/build-a-box.scss")
+)
+
+# UI ---------------------------------------
+ui <- page_fixed(
+ title = "Build a Box | bslib",
+ theme = theme_build_a_box,
+
+ # Header ----
+ tags$header(
+ class = "mt-4 d-flex flex-row justify-content-between align-items-center",
+ h2("Build a Box"),
+ div(
+ class = "d-flex flex-row align-items-center gap-3",
+ popover(
+ bsicons::bs_icon(
+ "info-square-fill",
+ title = "About Value Boxes",
+ class = "icon-gradient"
+ ),
+ title = "About Value Boxes",
+ HTML(commonmark::markdown_html(readLines("about-value-boxes.md")))
+ ),
+ actionLink(
+ "show_code",
+ tooltip(icon("code"), "Show code"),
+ class = "nav-link text-blue",
+ style = css(width = "1em")
+ ),
+ input_dark_mode(
+ id = "color_mode",
+ style = css("--text-1" = "var(--bs-blue)")
+ )
+ )
+ ),
+
+ # Main ----
+ tags$main(
+ # Value Box Previews ----
+ div(
+ id = "preview",
+ class = "my-5",
+ layout_columns(
+ class = "value-box-previews",
+ div(
+ as_fill_carrier(),
+ value_box_placeholder("one-value_box_placeholder"),
+ ui_value_box_output("one")
+ ),
+ div(
+ as_fill_carrier(),
+ value_box_placeholder("two-value_box_placeholder"),
+ ui_value_box_output("two")
+ ),
+ div(
+ as_fill_carrier(),
+ value_box_placeholder("three-value_box_placeholder"),
+ ui_value_box_output("three")
+ )
+ )
+ ),
+
+ # Settings Panel ----
+ navset_card_pill(
+ id = "settings",
+ title = span(
+ "Value box settings",
+ popover(
+ bsicons::bs_icon("question-square-fill"),
+ class = "ms-1 d-inline-block text-orange",
+ title = "Getting started",
+ shiny::markdown("
+ The Build-a-Box app includes three value boxes. You can customize
+ all three at once from the **All** tab.
+
+ Pick an overall theme, choose whether you'd like to **showcase** a plot or icon, and decide which **showcase layout** works best for your data.
+
+ Then, click directly on a value box or switch to the
+ One,
+ Two, or
+ Three
+ tabs to customize its settings individually.
+ ")
+ )
+ ),
+ nav_panel(
+ "All",
+ value = "all",
+ ui_global_controls("all")
+ ),
+ nav_panel(
+ "One",
+ value = "one-value_box",
+ layout_value_box_options(
+ ui_value_box_options("one")
+ )
+ ),
+ nav_panel(
+ "Two",
+ value = "two-value_box",
+ layout_value_box_options(
+ ui_value_box_options("two")
+ )
+ ),
+ nav_panel(
+ "Three",
+ value = "three-value_box",
+ layout_value_box_options(
+ ui_value_box_options("three")
+ )
+ )
+ )
+ ),
+
+ # Footer ----
+ tags$footer(
+ class = "footer mt-auto py-3",
+ layout_columns(
+ class = "border-top pt-3 text-muted",
+ div(
+ class = "text-center text-sm-start",
+ "Made with",
+ a(href = "https://rstudio.github.io/bslib", "{bslib}"),
+ "and",
+ a(
+ href = "https://shiny.rstudio.com",
+ img(src = "shiny.png", width = "22px", alt = " "),
+ "Shiny"
+ )
+ ),
+ div(
+ class = "text-center text-sm-end",
+ HTML('Proudly supported by 
')
+ )
+ )
+ ),
+ # Extras ----
+ tags$script(src = "build-a-box.js")
+)
+
+# Server ---------------------------------------
+server <- function(input, output, session) {
+ enable_themer <- reactive({
+ query <- shiny::getQueryString()
+ query_has_themer <- "themer" %in% names(query)
+
+ if (!length(query) || !query_has_themer) return(ENABLE_THEMER)
+
+ query$themer %in% c(1, "true", "") || ENABLE_THEMER
+ })
+
+ observeEvent(enable_themer(), {
+ # TODO: This only runs on app startup right now
+ req(enable_themer())
+
+ insertUI(
+ selector = "body",
+ where = "beforeEnd",
+ ui = tags$script("window.watchForThemer()")
+ )
+ bs_themer()
+ })
+
+ one <- module_value_box("one")
+ two <- module_value_box("two")
+ three <- module_value_box("three")
+
+ module_global_controls("all", one, two, three)
+
+ observeEvent(input$clicked_value_box, {
+ nav_select("settings", input$clicked_value_box)
+ })
+
+ observeEvent(input$switch_to_one, nav_select("settings", "one-value_box"))
+ observeEvent(input$switch_to_two, nav_select("settings", "two-value_box"))
+ observeEvent(input$switch_to_three, nav_select("settings", "three-value_box"))
+
+ observeEvent(input$settings, {
+ session$sendCustomMessage("active-value-box", input$settings)
+ })
+
+ observeEvent(input$show_code, {
+ layout_value_boxes <-
+ paste0(
+ "layout_columns(\n ",
+ rlang::expr_text(one$code()), ",\n ",
+ rlang::expr_text(two$code()), ",\n ",
+ rlang::expr_text(three$code()), "\n",
+ ")"
+ )
+
+ code_modal(layout_value_boxes)
+ })
+}
+
+# BUILD A BOX -----------------------------------------
+shinyApp(ui, server)
diff --git a/inst/examples/build-a-box/deploy.R b/inst/examples/build-a-box/deploy.R
new file mode 100644
index 000000000..4915c3973
--- /dev/null
+++ b/inst/examples/build-a-box/deploy.R
@@ -0,0 +1,6 @@
+rsconnect::deployApp(
+ rprojroot::find_package_root_file("inst/examples/build-a-box"),
+ appName = "build-a-box",
+ account = "bslib",
+ forceUpdate = TRUE
+)
diff --git a/inst/examples/build-a-box/www/build-a-box.js b/inst/examples/build-a-box/www/build-a-box.js
new file mode 100644
index 000000000..ba0f6f391
--- /dev/null
+++ b/inst/examples/build-a-box/www/build-a-box.js
@@ -0,0 +1,86 @@
+/* globals Shiny,$ */
+
+document.getElementById("preview").addEventListener("click", function (ev) {
+ const vb = ev.target.closest(".bslib-value-box");
+ if (!vb) return;
+ Shiny.setInputValue("clicked_value_box", vb.parentElement.id);
+});
+
+Shiny.addCustomMessageHandler("active-value-box", function (id) {
+ document
+ .querySelectorAll(".active-preview")
+ .forEach((el) => el.classList.remove("active-preview"));
+
+ const vb = document.getElementById(id);
+ if (!vb) {
+ Shiny.setInputValue("clicked_value_box", "");
+ return;
+ }
+ vb.parentElement.classList.add("active-preview");
+});
+
+function reportValueBoxForegroundColor(id) {
+ const vb = document.getElementById(id).querySelector(".value-box-title");
+ if (!vb) {
+ console.warn(id, "no value box found");
+ return;
+ }
+
+ const styles = window.getComputedStyle(vb);
+ const fg = styles.getPropertyValue("color");
+ const inputId = id + "_fg_color";
+
+ Shiny.setInputValue(inputId, fg, { priority: "event" });
+}
+
+function showOrHideLoadingBox(id) {
+ const hasBox = document.getElementById(id).querySelector(".bslib-value-box");
+ document.getElementById(id + "_placeholder").style.display = hasBox
+ ? "none"
+ : "block";
+}
+
+["one", "two", "three"].forEach(function (id) {
+ id = `${id}-value_box`;
+ $(document).on("shiny:value", `#${id}`, () => {
+ showOrHideLoadingBox(id);
+ Shiny.shinyapp.taskQueue.enqueue(() => {
+ showOrHideLoadingBox(id);
+ reportValueBoxForegroundColor(id);
+ });
+ });
+});
+
+$(document).on("shiny:inputchanged", "#color_mode", function() {
+ ['one', 'two', 'three'].forEach(id => {
+ reportValueBoxForegroundColor(`${id}-value_box`);
+ });
+});
+
+// Watch for the themer to be added to the DOM
+window.watchForThemer = function () {
+ const hideThemer = () => {
+ const themer = document.getElementById("bsthemerContainer");
+ themer.style.top = null;
+ themer.style.bottom = "1rem";
+ window.bootstrap.Collapse.getOrCreateInstance(
+ themer.querySelector(".accordion")
+ );
+ };
+
+ const observer = new MutationObserver(function (mutationsList, observer) {
+ // Check if the target element has been added
+ for (let mutation of mutationsList) {
+ if (mutation.type === "childList" && mutation.addedNodes.length > 0) {
+ if (!document.getElementById("bsthemerContainer")) continue;
+
+ hideThemer();
+ observer.disconnect();
+ break;
+ }
+ }
+ });
+
+ // Start observing the changes in the parent element of the target element
+ observer.observe(document.body, { childList: true });
+};
diff --git a/inst/examples/build-a-box/www/build-a-box.scss b/inst/examples/build-a-box/www/build-a-box.scss
new file mode 100644
index 000000000..91da2a660
--- /dev/null
+++ b/inst/examples/build-a-box/www/build-a-box.scss
@@ -0,0 +1,84 @@
+.popover {
+ --bs-popover-max-width: 400px;
+}
+
+/* FIXME: Remove after rstudio/htmltools#401 */
+.html-fill-container > .html-fill-item {
+ overflow: visible !important;
+}
+
+.bslib-card .card-body {
+ overflow: visible !important;
+}
+
+.shiny-input-container:not(.shiny-input-container-inline) {
+ width: 100% !important;
+}
+
+.selectize-control {
+ margin-bottom: 0 !important;
+}
+
+.input-text-code textarea {
+ font-family: var(--bs-font-monospace);
+}
+
+.active-preview::before {
+ --active-border: 4px solid rgba(var(--bs-danger-rgb), 0.25);
+ content: '';
+ border-top: var(--active-border);
+ position: absolute;
+ top: -12px;
+ width: 100%;
+}
+
+#preview .bslib-grid > div {
+ position: relative;
+}
+
+.shuffle-button {
+ display: grid;
+ grid-template-columns: minmax(0, 2em) auto;
+ align-items: center;
+ justify-content: center;
+}
+
+.btn-group > .shuffle-button {
+ padding: 0;
+}
+
+.container {
+ display: flex;
+ flex-direction: column;
+ height: 100vh;
+
+ header, main {
+ flex-shrink: 0;
+ }
+}
+
+.bslib-gap-spacing > .shiny-html-output > .bslib-mb-spacing {
+ margin-bottom: 0;
+}
+
+.icon-gradient {
+ opacity: 0.8;
+ &:hover, &:focus { opacity: 1 }
+ fill: url('#bslib---icon-gradient') $blue !important;
+}
+
+@include media-breakpoint-down(sm) {
+ .value-box-previews {
+ margin-left: 0.5rem;
+ margin-right: 0.5rem;
+ }
+
+ .active-preview::before {
+ border-top: unset;
+ border-left: var(--active-border);
+ top: 0;
+ bottom: 0;
+ left: -0.75rem;
+ height: 100%;
+ }
+}
diff --git a/inst/examples/build-a-box/www/code-modal.js b/inst/examples/build-a-box/www/code-modal.js
new file mode 100644
index 000000000..bc4d543ca
--- /dev/null
+++ b/inst/examples/build-a-box/www/code-modal.js
@@ -0,0 +1,68 @@
+(function () {
+ function showValueBoxCodeHelp() {
+ document
+ .getElementById("copy-clipboard-not-supported")
+ .classList.remove("d-none");
+ }
+
+ function selectValueBoxCode() {
+ const codeElement = document.getElementById("value-box-code");
+
+ // Create a range and select all of the text within the element
+ const range = document.createRange();
+ range.selectNodeContents(codeElement);
+
+ // Create a selection and add the range to it
+ const selection = window.getSelection();
+ selection.removeAllRanges();
+ selection.addRange(range);
+ }
+
+ let copyButtonUpdateTimer = null;
+
+ function resetCopyButtonText() {
+ const btn = document.getElementById("copy-code-to-clipboard");
+ if (!btn) return;
+ btn.innerText = "Copy to clipboard";
+ }
+
+ window.copyValueBoxCode = function () {
+ const code = document.getElementById("value-box-code").innerText;
+ const btn = document.getElementById("copy-code-to-clipboard");
+
+ clearTimeout(copyButtonUpdateTimer);
+
+ navigator.clipboard
+ .writeText(code)
+ .then(() => {
+ btn.innerText = "Copied!";
+ copyButtonUpdateTimer = setTimeout(resetCopyButtonText, 2000);
+ })
+ .catch(() => {
+ btn.innerText = "Copy failed";
+ copyButtonUpdateTimer = setTimeout(resetCopyButtonText, 2000);
+
+ showValueBoxCodeHelp();
+ selectValueBoxCode();
+ });
+ };
+
+ document.addEventListener("show.bs.modal", function () {
+ if (!document.getElementById("value-box-code")) return;
+
+ navigator.permissions.query({ name: "clipboard-write" }).then((result) => {
+ const allowed = result.state == "granted" || result.state == "prompt";
+ if (!allowed) {
+ // clipboard isn't supported, hide the copy button
+ document
+ .getElementById("copy-code-to-clipboard")
+ .classList.add("d-none");
+
+ // fall back to manual copy/paste with a little help
+ showValueBoxCodeHelp();
+ selectValueBoxCode();
+ }
+ });
+ });
+})();
+
diff --git a/inst/examples/build-a-box/www/shiny.png b/inst/examples/build-a-box/www/shiny.png
new file mode 100644
index 000000000..d95def62f
Binary files /dev/null and b/inst/examples/build-a-box/www/shiny.png differ
diff --git a/man/value_box.Rd b/man/value_box.Rd
index 05ac2b5ff..a433152c4 100644
--- a/man/value_box.Rd
+++ b/man/value_box.Rd
@@ -116,6 +116,18 @@ An opinionated (\code{\link[=card]{card()}}-powered) box, designed for displayin
\code{value} represents (for example, it could hold a \code{\link[bsicons:bs_icon]{bsicons::bs_icon()}}, or
even a \code{\link[shiny:plotOutput]{shiny::plotOutput()}}).
}
+\section{Build a Box App}{
+
+
+Explore all of the \code{value_box()} options and layouts interactively with the
+\href{https://bslib.shinyapps.io/build-a-box/}{Build a Box app}, available
+online thanks to \href{https://www.shinyapps.io/}{shinyapps.io}. Or, you can
+run the app locally with:
+
+\if{html}{\out{}}\preformatted{shiny::runApp(system.file("examples", "build-a-box", package = "bslib"))
+}\if{html}{\out{
}}
+}
+
\section{Themes}{
diff --git a/tools/yarn_install.R b/tools/yarn_install.R
index 7f576440b..815438402 100644
--- a/tools/yarn_install.R
+++ b/tools/yarn_install.R
@@ -45,7 +45,7 @@ unlink("inst/lib/popper.js", recursive = TRUE)
scss_files <- dir("inst", pattern = "\\.scss$", recursive = TRUE, full.names = TRUE)
# These libs should already have prefixes in their source
# TODO: add test(s) that we aren't missing vendor prefixes
-scss_files <- scss_files[!grepl("^inst/(lib/bs3|bs3compat|themer|components|bslib-scss|builtin)", scss_files)]
+scss_files <- scss_files[!grepl("^inst/(lib/bs3|bs3compat|themer|components|bslib-scss|builtin|examples)", scss_files)]
scss_src <- lapply(scss_files, readLines)
diff --git a/vignettes/value-boxes/index.Rmd b/vignettes/value-boxes/index.Rmd
index 81ca3184f..44167d83c 100644
--- a/vignettes/value-boxes/index.Rmd
+++ b/vignettes/value-boxes/index.Rmd
@@ -24,6 +24,15 @@ library(shiny)
library(bsicons)
```
+::: {.callout .callout-note .mt-5}
+### Build a Box App
+
+Want to explore all of the `value_box()` options and layouts in an interactive app?
+Check out the [Build a Box App](https://bslib.shinyapps.io/build-a-box)!
+Use the app to quickly choose the right layout and theme for your value boxes,
+and then copy the code right into your own app.
+:::
+
## Hello `value_box()`