diff --git a/DESCRIPTION b/DESCRIPTION index 333d85005..7e2acca70 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -86,6 +86,7 @@ Collate: 'shiny-devmode.R' 'sidebar.R' 'staticimports.R' + 'tooltip.R' 'utils-deps.R' 'utils-shiny.R' 'utils-tags.R' diff --git a/NAMESPACE b/NAMESPACE index 3799674a1..d787588bd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -124,7 +124,10 @@ export(sidebar) export(sidebar_toggle) export(theme_bootswatch) export(theme_version) +export(toggle_tooltip) +export(tooltip) export(update_switch) +export(update_tooltip) export(value_box) export(version_default) export(versions) diff --git a/R/card.R b/R/card.R index 2ee6fb194..1b94a896b 100644 --- a/R/card.R +++ b/R/card.R @@ -271,13 +271,13 @@ is.card_item <- function(x) { full_screen_toggle <- function() { - tags$span( - class = "bslib-full-screen-enter", - class = "badge rounded-pill bg-dark", - "data-bs-toggle" = "tooltip", - "data-bs-placement" = "bottom", - title = "Expand", - full_screen_toggle_icon() + tooltip( + tags$span( + class = "bslib-full-screen-enter", + class = "badge rounded-pill bg-dark", + full_screen_toggle_icon() + ), + "Expand" ) } diff --git a/R/layout.R b/R/layout.R index 00ab80ffa..5e14f3df2 100644 --- a/R/layout.R +++ b/R/layout.R @@ -55,9 +55,9 @@ layout_column_wrap <- function( heights_equal <- match.arg(heights_equal) - args <- list_split_named(rlang::list2(...)) - attribs <- args[["named"]] - children <- dropNulls(args[["unnamed"]]) + args <- separate_arguments(...) + attribs <- args$attribs + children <- args$children if (length(width) > 1) { stop("`width` of length greater than 1 is not currently supported.") @@ -189,9 +189,9 @@ layout_columns <- function( class = NULL, height = NULL ) { - args <- list_split_named(rlang::list2(...)) - attribs <- args[["named"]] - children <- dropNulls(args[["unnamed"]]) + args <- separate_arguments(...) + attribs <- args$attribs + children <- args$children n_kids <- length(children) # Resolve missing value(s) for col_widths, etc. diff --git a/R/sysdata.rda b/R/sysdata.rda index 679e5ba3c..027f090f6 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/R/tooltip.R b/R/tooltip.R new file mode 100644 index 000000000..2a375af50 --- /dev/null +++ b/R/tooltip.R @@ -0,0 +1,125 @@ +#' Add a tooltip to a UI element +#' +#' Display additional information when focusing (or hovering over) a UI element. +#' +#' @param trigger A UI element (i.e., [htmltools tag][htmltools::tags]) to serve +#' as the tooltips trigger. It's good practice for this element to be a +#' keyboard-focusable and interactive element (e.g., `actionButton()`, +#' `actionLink()`, etc) so that the tooltip is accessible to keyboard and +#' assistive technology users. +#' @param ... UI elements for the tooltip. Character strings are [automatically +#' escaped][htmlEscape()] unless marked as [HTML()]. +#' @param id A character string. Required to re-actively respond to the +#' visibility of the tooltip (via the `input[[id]]` value) and/or update the +#' visibility/contents of the tooltip. +#' @param placement The placement of the tooltip relative to its trigger. +#' @param options A list of additional [Bootstrap +#' options](https://getbootstrap.com/docs/5.3/components/tooltips/#options). +#' +#' @details If `trigger` yields multiple HTML elements (e.g., a `tagList()` or +#' complex `{htmlwidgets}` object), the last HTML element is used as the +#' trigger. If the `trigger` should contain all of those elements, wrap the +#' object in a [div()] or [span()]. +#' +#' @describeIn tooltip Add a tooltip to a UI element +#' @references +#' @export +#' @examplesIf interactive() +#' +#' tooltip( +#' shiny::actionButton("btn", "A button"), +#' "A message" +#' ) +#' +#' card( +#' card_header( +#' tooltip( +#' span("Card title ", bsicons::bs_icon("question-circle-fill")), +#' "Additional info", +#' placement = "right" +#' ) +#' ), +#' "Card body content..." +#' ) +tooltip <- function( + trigger, + ..., + id = NULL, + placement = c("auto", "top", "right", "bottom", "left"), + options = list() +) { + + args <- separate_arguments(...) + children <- args$children + attribs <- args$attribs + + if (length(children) == 0) { + abort("At least one value must be provided to `...`.") + } + + res <- web_component( + "bslib-tooltip", + id = id, + placement = rlang::arg_match(placement), + options = jsonlite::toJSON(options, auto_unbox = TRUE), + !!!attribs, + # Use display:none instead of