1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
#' Dark mode input control
#'
#' @description
#' 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 to reactively read 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.
#'
#' @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 (!is.null(id)) {
mode <- shiny::restoreInput(id, default = mode)
}
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" = " "
),
...
)
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.
#' @param session A Shiny session object (the default should almost always be
#' used).
#' @export
toggle_dark_mode <- function(
mode = NULL,
...,
session = get_current_session()
) {
rlang::check_dots_empty(
error = function(err) rlang::warn(rlang::cnd_message(err))
)
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)
}
|
