Add input_check_buttons() and input_radio_buttons()

Author: cpsievert

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'

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)

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"
+  )
+}

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);