feat: Add dark-mode toggle switch

DESCRIPTION

@@ -119,6 +119,7 @@ Collate:
     'files.R'
     'fill.R'
     'imports.R'
+    'input-dark-mode.R'
     'input-switch.R'
     'layout.R'
     'nav-items.R'

NAMESPACE

@@ -73,6 +73,7 @@ export(font_collection)
 export(font_face)
 export(font_google)
 export(font_link)
+export(input_dark_mode)
 export(input_switch)
 export(is.card_item)
 export(is_bs_theme)
@@ -128,6 +129,7 @@ export(sidebar)
 export(sidebar_toggle)
 export(theme_bootswatch)
 export(theme_version)
+export(toggle_dark_mode)
 export(toggle_popover)
 export(toggle_sidebar)
 export(toggle_switch)

R/input-dark-mode.R

@@ -0,0 +1,84 @@
+#' Dark mode input control
+#'
+#' Creates a button that toggles between dark and light modes, specifically for
+#' toggling between light and dark [Bootstrap color
+#' modes](https://getbootstrap.com/docs/5.3/customize/color-modes/) -- a new
+#' feature added in [Bootstrap
+#' 5.3](https://getbootstrap.com/docs/5.3/migration/#color-modes).
+#'
+#' @param ... Additional attributes to be passed to the input control UI, such
+#'   as `class`, `style`, etc.
+#'
+#'   In `toggle_dark_mode()`, the `...` are included for future extensibility
+#'   and are currently ignored.
+#' @param id An optional input id, required if you'd like to be able to
+#'   reactively read programmatically toggle the current color mode.
+#' @param mode The initial mode of the dark mode switch. By default or when set
+#'   to `NULL`, the user's system settings for preferred color scheme will be
+#'   used. Otherwise, set to `"light"` or `"dark"` to force a particular initial
+#'   mode.
+#' @inheritParams tooltip
+#'
+#' @return Returns a UI element for a dark mode switch input control. The server
+#'   value received for the input corresponding to `id` will be a string value
+#'   with the current color mode (`"light"` or `"dark"`).
+#'
+#' @describeIn input_dark_mode Create a dark mode switch input control
+#' @family input controls
+#' @export
+input_dark_mode <- function(..., id = NULL, mode = NULL) {
+  if (!is.null(mode)) {
+    mode <- rlang::arg_match(mode, c("light", "dark"))
+  }
+
+  if (any(!nzchar(rlang::names2(rlang::list2(...))))) {
+    abort("All arguments in `...` must be named.")
+  }
+
+  res <- web_component(
+    "bslib-input-dark-mode",
+    id = id,
+    attribute = "data-bs-theme",
+    mode = mode,
+    style = css(
+      "--text-1" = "var(--bs-emphasis-color)",
+      "--text-2" = "var(--bs-tertiary-color)",
+      # The vertical correction used in the dark mode component isn't quite
+      # right on Bootstrap pages. This next line overrides it and removes the
+      # vertical correction. But users can still set the CSS property manually
+      # in their a `style` argument passed in via `...` if they want.
+      "--vertical-correction" = " "
+    ),
+    ...,
+    component_dependency_js("bslibShiny")
+  )
+
+  res <- tag_require(res, version = 5, caller = "input_dark_mode()")
+  as_fragment(res)
+}
+
+#' @describeIn input_dark_mode Programmatically toggle or set the current light
+#'   or dark color mode.
+#' @export
+toggle_dark_mode <- function(mode = NULL, ..., session = get_current_session()) {
+  if (!is.null(mode)) {
+    mode <- tryCatch(
+      rlang::arg_match(mode, c("light", "dark")),
+      error = function(err) {
+        rlang::warn(rlang::cnd_message(err))
+        mode
+      }
+    )
+  }
+
+  data <- dropNulls(list(method = "toggle", value = mode))
+
+  # We're using sendCustomMessage() here because dark mode is set globally and
+  # `id` is not required for `toggle_dark_mode()`. `$sendInputMessage()` would
+  # require us to know the `id` of at least one input control.
+  callback <- function() {
+    session$sendCustomMessage("bslib.toggle-dark-mode", data)
+  }
+
+  session$onFlush(callback, once = TRUE)
+}

R/input-switch.R

@@ -77,17 +77,6 @@ toggle_switch <- function(id, value = NULL, session = get_current_session()) {
   session$onFlush(callback, once = TRUE)
 }
 
-# Keep this internal for now until we agree on the UX
-input_dark_mode_switch <- function(id, label, ..., width = "auto") {
-  res <- input_switch(id, label, ..., width = width)
-  # TODO: .navbar should probably do this for .shiny-input-container
-  res <- tagAppendAttributes(res, style = "margin-bottom: 0;")
-  tagAppendAttributes(
-    res, .cssSelector = "input",
-    onclick = "document.documentElement.setAttribute('data-bs-theme', this.checked ? 'dark' : 'light'); $(window).resize();"
-  )
-}
-
 input_checkbox <- function(id, label, class = "bslib-input-checkbox", value = FALSE, width = NULL, inline = FALSE) {
   div(
     class = "form-group shiny-input-container",

_pkgdown.yml

@@ -131,6 +131,7 @@ reference:
     UI controls for capturing user input
   contents:
     - input_switch
+    - input_dark_mode
 - title: Accordions
   description: |
     Create collapsible sections of content