From 03f4e3854e00ed723b44eaa086bb0d26cdc63af8 Mon Sep 17 00:00:00 2001 From: Carson Date: Fri, 10 Feb 2023 14:34:47 -0600 Subject: [PATCH] Add input_check_buttons() and input_radio_buttons() --- DESCRIPTION | 1 + NAMESPACE | 4 + R/input-button-group.R | 134 ++++++++++++++++++++++++++++++ inst/components/toggle-buttons.js | 47 +++++++++++ man/input_check_buttons.Rd | 49 +++++++++++ 5 files changed, 235 insertions(+) create mode 100644 R/input-button-group.R create mode 100644 inst/components/toggle-buttons.js create mode 100644 man/input_check_buttons.Rd diff --git a/DESCRIPTION b/DESCRIPTION index c536d7246..33ff4c473 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -119,6 +119,7 @@ Collate: 'files.R' 'fill.R' 'imports.R' + 'input-button-group.R' 'input-dark-mode.R' 'input-switch.R' 'layout.R' diff --git a/NAMESPACE b/NAMESPACE index 3a9f6c9c7..070547179 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -73,7 +73,9 @@ export(font_collection) export(font_face) export(font_google) export(font_link) +export(input_check_buttons) export(input_dark_mode) +export(input_radio_buttons) export(input_switch) export(is.card_item) export(is_bs_theme) @@ -137,7 +139,9 @@ export(toggle_sidebar) export(toggle_switch) export(toggle_tooltip) export(tooltip) +export(update_check_buttons) export(update_popover) +export(update_radio_buttons) export(update_switch) export(update_tooltip) export(value_box) diff --git a/R/input-button-group.R b/R/input-button-group.R new file mode 100644 index 000000000..8a102e297 --- /dev/null +++ b/R/input-button-group.R @@ -0,0 +1,134 @@ +#' Create a button group of radio/check boxes +#' +#' Use `input_check_buttons()` if multiple choices may be selected at once; otherwise, use `input_radio_buttons()` +#' +#' @inheritParams input_check_search +#' @param size size of the button group +#' @param bg a theme color to use for the btn modifier class +#' @export +input_check_buttons <- function(id, choices, ..., selected = NULL, size = c("md", "sm", "lg"), bg = "primary") { + size <- match.arg(size) + tag <- div( + id = id, + class = "btn-group bslib-toggle-buttons", + class = if (size != "md") paste0("btn-group-", size), + role = "group", + ..., + !!!input_buttons_container( + type = "checkbox", id = id, choices = choices, selected = selected, + size = size, bg = bg + ), + toggle_dependency() + ) + tag <- tag_require(tag, version = 5, caller = "input_check_buttons()") + as_fragment(tag) +} + +#' @export +#' @rdname input_check_buttons +update_check_buttons <- function(id, choices = NULL, selected = NULL, session = get_current_session()) { + if (!is.null(choices)) { + choices <- processDeps( + input_buttons_container(type = "checkbox", id, choices, selected), + session + ) + } + message <- dropNulls(list( + choices = choices, + selected = as.list(selected) + )) + session$sendInputMessage(id, message) +} + +#' @export +#' @rdname input_check_buttons +input_radio_buttons <- function(id, choices, ..., selected = NULL, size = c("md", "sm", "lg"), bg = "primary") { + size <- match.arg(size) + tag <- div( + id = id, + class = "btn-group bslib-toggle-buttons", + class = if (size != "md") paste0("btn-group-", size), + role = "group", + ..., + !!!input_buttons_container( + type = "radio", id = id, choices = choices, selected = selected, + size = size, bg = bg + ), + toggle_dependency() + ) + tag <- tag_require(tag, version = 5, caller = "input_radio_buttons()") + as_fragment(tag) +} + +#' @export +#' @rdname input_check_buttons +update_radio_buttons <- function(id, choices = NULL, selected = NULL, session = get_current_session()) { + if (!is.null(choices)) { + choices <- processDeps( + input_buttons_container(type = "radio", id, choices, selected), + session + ) + } + message <- dropNulls(list( + choices = choices, + selected = as.list(selected) + )) + session$sendInputMessage(id, message) +} + + +input_buttons_container <- function(type = c("radio", "checkbox"), id, choices, selected, size = "md", bg = "primary") { + + if (is.null(names(choices)) && is.atomic(choices)) { + names(choices) <- choices + } + if (is.null(names(choices))) { + stop("names() must be provided on list() vectors provided to choices") + } + + vals <- rlang::names2(choices) + #if (!all(nzchar(vals))) { + # stop("Input values must be non-empty character strings") + #} + + is_checked <- vapply(vals, function(x) isTRUE(x %in% selected) || identical(I("all"), selected), logical(1)) + + if (!any(is_checked) && !identical(selected, I("none"))) { + is_checked[1] <- TRUE + } + + type <- match.arg(type) + if (type == "radio" && sum(is_checked) > 1) { + stop("input_radio_buttons() doesn't support more than one selected choice (do you want input_check_buttons() instead?)", call. = FALSE) + } + + inputs <- Map( + vals, choices, is_checked, paste0(id, "-", seq_along(is_checked)), + f = function(val, lbl, checked, this_id) { + list( + tags$input( + type = type, class = "btn-check", name = id, + id = this_id, autocomplete = "off", + `data-value` = val, + checked = if (checked) NA + ), + tags$label( + class = paste0("btn btn-outline-", bg), + `for` = this_id, lbl + ) + ) + } + ) + + inputs <- unlist(inputs, recursive = FALSE, use.names = FALSE) +} + +toggle_dependency <- function() { + htmltools::htmlDependency( + "bslib-toggle-buttons", + version = get_package_version("bslib"), + package = "bslib", + src = "components", + script = "toggle-buttons.js" + ) +} diff --git a/inst/components/toggle-buttons.js b/inst/components/toggle-buttons.js new file mode 100644 index 000000000..23455e052 --- /dev/null +++ b/inst/components/toggle-buttons.js @@ -0,0 +1,47 @@ +var toggleButtonsInputBinding = new Shiny.InputBinding(); +$.extend(toggleButtonsInputBinding, { + + find: function(scope) { + return $(scope).find(".btn-group.bslib-toggle-buttons"); + }, + + getValue: function(el) { + var inputs = $(el).find("input.btn-check"); + var vals = []; + inputs.each(function(i) { + if (this.checked) { + vals.push($(this).attr("data-value")); + } + }); + return vals.length > 0 ? vals : null; + }, + + subscribe: function(el, callback) { + $(el).on( + 'change.toggleButtonsInputBinding', + function(event) { callback(true); } + ); + }, + + unsubscribe: function(el) { + $(el).off(".toggleButtonsInputBinding"); + }, + + receiveMessage: function(el, data) { + if (data.hasOwnProperty("choices")) { + Shiny.renderContent(el, data.choices); + } else if (data.hasOwnProperty("selected")) { + const inputs = $(el).find("input"); + inputs.each(function(i) { + const val = $(this).attr("data-value"); + const checked = data.selected.indexOf(val) > -1; + this.checked = checked; + }); + } + + $(el).trigger("change.toggleButtonsInputBinding"); + } + +}); + +Shiny.inputBindings.register(toggleButtonsInputBinding); diff --git a/man/input_check_buttons.Rd b/man/input_check_buttons.Rd new file mode 100644 index 000000000..d3ba6c1ca --- /dev/null +++ b/man/input_check_buttons.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/input-button-group.R +\name{input_check_buttons} +\alias{input_check_buttons} +\alias{update_check_buttons} +\alias{input_radio_buttons} +\alias{update_radio_buttons} +\title{Create a button group of radio/check boxes} +\usage{ +input_check_buttons( + id, + choices, + ..., + selected = NULL, + size = c("md", "sm", "lg"), + bg = "primary" +) + +update_check_buttons( + id, + choices = NULL, + selected = NULL, + session = get_current_session() +) + +input_radio_buttons( + id, + choices, + ..., + selected = NULL, + size = c("md", "sm", "lg"), + bg = "primary" +) + +update_radio_buttons( + id, + choices = NULL, + selected = NULL, + session = get_current_session() +) +} +\arguments{ +\item{size}{size of the button group} + +\item{bg}{a theme color to use for the btn modifier class} +} +\description{ +Use \code{input_check_buttons()} if multiple choices may be selected at once; otherwise, use \code{input_radio_buttons()} +}