Add input_switch()

DESCRIPTION

@@ -73,6 +73,7 @@ Collate:
     'files.R'
     'fill.R'
     'imports.R'
+    'input-switch.R'
     'layout.R'
     'nav-items.R'
     'nav-update.R'

NAMESPACE

@@ -71,6 +71,7 @@ export(font_collection)
 export(font_face)
 export(font_google)
 export(font_link)
+export(input_switch)
 export(is.card_item)
 export(is_bs_theme)
 export(is_fill_carrier)
@@ -123,6 +124,7 @@ export(sidebar)
 export(sidebar_toggle)
 export(theme_bootswatch)
 export(theme_version)
+export(update_switch)
 export(value_box)
 export(version_default)
 export(versions)

NEWS.md

@@ -1,5 +1,9 @@
 # bslib 0.5.0.9000
 
+## New features
+
+* The new `input_switch()` function provides a [Bootstrap 5 switch input](https://getbootstrap.com/docs/5.2/forms/checks-radios/#switches) (an on-off toggle) for binary input values. (#483)
+
 ## Improvements
 
 * Closed quarto-dev/quarto-cli#6081: `{bslib}`'s components (e.g., `card()`, `sidebar()`, etc.) now work more sensibly in Quarto docs. (#664)

R/input-switch.R

@@ -0,0 +1,82 @@
+#' Switch input control
+#'
+#' Create an on-off style switch control for specifying logical values.
+#'
+#' @examplesIf interactive()
+#' library(shiny)
+#' library(bslib)
+#'
+#' ui <- page_fixed(
+#'   title = "Keyboard Settings",
+#'   h2("Keyboard Settings"),
+#'   input_switch("auto_capitalization", "Auto-Capitalization", TRUE),
+#'   input_switch("auto_correction", "Auto-Correction", TRUE),
+#'   input_switch("check_spelling", "Check Spelling", TRUE),
+#'   input_switch("smart_punctuation", "Smart Punctuation"),
+#'   h2("Preview"),
+#'   verbatimTextOutput("preview")
+#' )
+#'
+#' server <- function(input, output, session) {
+#'   output$preview <- renderPrint({
+#'     list(
+#'       auto_capitalization = input$auto_capitalization,
+#'       auto_correction = input$auto_correction,
+#'       check_spelling = input$check_spelling,
+#'       smart_punctuation = input$smart_punctuation
+#'     )
+#'   })
+#' }
+#'
+#' shinyApp(ui, server)
+#'
+#' @param id An input id.
+#' @param label A label for the switch.
+#' @param value Whether or not the switch should be checked by default.
+#' @param width Any valid [CSS unit][htmltools::validateCssUnit] (e.g.,
+#'   `width="200px"`).
+#'
+#' @return Returns a UI element for a switch input control. The server value
+#'   received for the input corresponding to `id` will be a logical
+#'   (`TRUE`/`FALSE`) value.
+#'
+#' @family input controls
+#' @export
+input_switch <- function(id, label, value = FALSE, width = NULL) {
+  tag <- input_checkbox(id, label, class = "form-check form-switch", value = value, width = width)
+  tag <- tag_require(tag, version = 5, caller = "input_switch()")
+  as_fragment(tag)
+}
+
+#' @rdname input_switch
+#' @inheritParams nav_insert
+#' @export
+update_switch <- function(id, label = NULL, value = NULL, session = get_current_session()) {
+  message <- dropNulls(list(label = label, value = value))
+  session$sendInputMessage(id, message)
+}
+
+input_checkbox <- function(id, label, class = "form-check", value = FALSE, width = NULL, inline = FALSE) {
+  div(
+    class = "form-group shiny-input-container",
+    class = if (inline) "shiny-input-container-inline",
+    style = css(width = width),
+    div(
+      class = class,
+      tags$input(
+        id = id,
+        class = "form-check-input",
+        type = "checkbox",
+        role = "switch",
+        checked = if (value) NA,
+      ),
+      tags$label(
+        # The span here is needed to adhere to shiny.js' checkbox binding logic
+        # https://github.com/rstudio/shiny/blob/c21ba0b/srcts/src/bindings/input/checkbox.ts#L42-L43
+        tags$span(label),
+        class = "form-check-label",
+        `for` = id
+      )
+    )
+  )
+}

_pkgdown.yml

@@ -111,6 +111,11 @@ reference:
     Highlight important findings
   contents:
     - value_box
+- title: Input controls
+  description: |
+    UI controls for capturing user input
+  contents:
+    - input_switch
 - title: Accordions
   description: |
     Create collapsible sections of content