Add input bindings for toolbar buttons and select components

R/onLoad.R

@@ -32,5 +32,10 @@ setup_input_handlers <- function() {
     input_task_button_input_handler,
     force = TRUE
   )
+  shiny::registerInputHandler(
+    "bslib.toolbar.button",
+    toolbar_input_button_input_handler,
+    force = TRUE
+  )
   TRUE
 }

R/toolbar.R

@@ -153,12 +153,119 @@ toolbar_input_button <- function(
   if (!is.null(tooltip)) {
     # Default placement is "bottom" for the toolbar case because otherwise the
     # tooltip ends up covering the neighboring buttons in the header/footer.
-    button <- tooltip(button, tooltip, placement = "bottom")
+    button <- tooltip(
+      button,
+      tooltip,
+      id = sprintf("%s_tooltip", id),
+      placement = "bottom"
+    )
   }
 
   button
 }
 
+#' Update toolbar button input
+#'
+#' @description
+#' Change the value or appearance of a toolbar button input on the client.
+#'
+#' @rdname toolbar_input_button
+#' @inheritParams toolbar_input_button
+#' @param session The `session` object passed to function given to `shinyServer`.
+#'   Default is `getDefaultReactiveDomain()`.
+#'
+#' @details
+#' This update function works similarly to [shiny::updateActionButton()], but
+#' is specifically designed for [toolbar_input_button()]. It allows you to
+#' update the button's label, icon, and disabled state from the server.
+#'
+#' Note that you cannot change `show_label`, `tooltip`, or `border` parameters
+#' after the button has been created, as these affect the button's structure
+#' and ARIA attributes.
+#'
+#' @examplesIf interactive()
+#' library(shiny)
+#' library(bslib)
+#'
+#' ui <- page_fluid(
+#'   toolbar(
+#'     align = "right",
+#'     toolbar_input_button("btn", label = "Click me", icon = icon("play"))
+#'   ),
+#'   verbatimTextOutput("count")
+#' )
+#'
+#' server <- function(input, output, session) {
+#'   output$count <- renderPrint({
+#'     input$btn
+#'   })
+#'
+#'   observeEvent(input$btn, {
+#'     if (input$btn == 1) {
+#'       update_toolbar_input_button(
+#'         "btn",
+#'         label = "Clicked!",
+#'         icon = icon("check")
+#'       )
+#'     }
+#'   })
+#' }
+#'
+#' shinyApp(ui, server)
+#'
+#' @seealso [toolbar_input_button()], [shiny::updateActionButton()]
+#' @export
+update_toolbar_input_button <- function(
+  id,
+  label = NULL,
+  show_label = NULL,
+  icon = NULL,
+  disabled = NULL,
+  session = get_current_session()
+) {
+  # Validate that label has text for accessibility
+  label_text <- paste(unlist(find_characters(label)), collapse = " ")
+  # Verifies the label contains non-empty text
+  if (!nzchar(trimws(label_text))) {
+    warning(
+      "Consider providing a non-empty string label for accessibility."
+    )
+  }
+
+  # Process label - wrap it in the same structure as toolbar_input_button()
+  # The label content will be updated within the existing .bslib-toolbar-label span
+  label_processed <- if (!is.null(label)) {
+    processDeps(label, session)
+  } else {
+    NULL
+  }
+
+  # Process icon - wrap it in the same structure as toolbar_input_button()
+  # The icon content will be updated within the existing .bslib-toolbar-icon span
+  icon_processed <- if (!is.null(icon)) {
+    processDeps(validateIcon(icon), session)
+  } else {
+    NULL
+  }
+
+  message <- dropNulls(list(
+    label = label_processed,
+    showLabel = show_label,
+    icon = icon_processed,
+    disabled = disabled
+  ))
+
+  session$sendInputMessage(id, message)
+}
+
+# Input handler for toolbar_input_button
+toolbar_input_button_input_handler <- function(value, shinysession, name) {
+  # Match shinyActionButtonValue class so it behaves
+  # like a standard action button for event handlers and input validation
+  class(value) <- c("shinyActionButtonValue", class(value))
+  value
+}
+
 #' Toolbar Input Select
 #'
 #' @description
@@ -245,27 +352,31 @@ toolbar_input_select <- function(
   choicesWithNames <- asNamespace("shiny")[["choicesWithNames"]]
   choices <- choicesWithNames(choices)
 
+  # Use a unique ID for the select element to avoid conflicts with standard
+  # select binding. The wrapper will have the main ID that Shiny uses.
+  select_internal_id <- paste0(id, "-select")
+
   select_tag <- tags$select(
-    id = id,
-    class = "form-select form-select-sm",
-    selectOptions(choices, selected, inputId = id)
+    id = select_internal_id,
+    class = "form-select form-select-sm bslib-toolbar-select",
+    selectOptions(choices, selected, inputId = select_internal_id)
   )
 
   # Add optional icon before the select
   icon_elem <- span(
-    icon,
-    style = "pointer-events: none",
     class = "bslib-toolbar-icon",
     `aria-hidden` = "true",
+    style = "pointer-events: none",
     `role` = "none",
-    tabindex = "-1"
+    tabindex = "-1",
+    icon
   )
 
   label_elem <- tags$label(
     # shiny::selectInput() append `-label` to id for the label `for` attribute
     id = sprintf("%s-label", id),
     class = "control-label",
-    `for` = id,
+    `for` = select_internal_id,
     icon_elem,
     tags$span(
       class = "bslib-toolbar-label",
@@ -291,13 +402,135 @@ toolbar_input_select <- function(
   }
 
   div(
+    id = id,
     class = "bslib-toolbar-input-select shiny-input-container",
     !!!dots$attribs,
     label_elem,
     select_tag
   )
 }
 
+#' Update toolbar select input
+#'
+#' @description
+#' Change the value or appearance of a toolbar select input.
+#'
+#' @rdname toolbar_input_select
+#' @inheritParams toolbar_input_select
+#' @param selected The new selected value. If `NULL`, the selection is not changed.
+#' @param session The `session` object passed to function given to `shinyServer`.
+#'   Default is `getDefaultReactiveDomain()`.
+#'
+#' @details
+#' This update function works similarly to [shiny::updateSelectInput()], but
+#' is specifically designed for [toolbar_input_select()]. It allows you to
+#' update the select's label, icon, choices, selected value(s), and label
+#' visibility from the server.
+#'
+#' Note that you cannot change the `tooltip` parameter after the select has
+#' been created, as it affects the structure and ARIA attributes.
+#'
+#' @examplesIf interactive()
+#' library(shiny)
+#' library(bslib)
+#'
+#' ui <- page_fluid(
+#'   toolbar(
+#'     align = "right",
+#'     toolbar_input_select(
+#'       "select",
+#'       label = "Choose",
+#'       choices = c("A", "B", "C")
+#'     )
+#'   ),
+#'   verbatimTextOutput("value")
+#' )
+#'
+#' server <- function(input, output, session) {
+#'   output$value <- renderPrint({
+#'     input$select
+#'   })
+#'
+#'   observeEvent(input$select, {
+#'     if (input$select == "A") {
+#'       update_toolbar_input_select(
+#'         "select",
+#'         label = "Pick one",
+#'         choices = c("X", "Y", "Z"),
+#'         selected = "Y"
+#'       )
+#'     }
+#'   })
+#' }
+#'
+#' shinyApp(ui, server)
+#'
+#' @seealso [toolbar_input_select()], [shiny::updateSelectInput()]
+#' @export
+update_toolbar_input_select <- function(
+  id,
+  label = NULL,
+  show_label = NULL,
+  choices = NULL,
+  selected = NULL,
+  icon = NULL,
+  session = get_current_session()
+) {
+  # Label can be null if there is no update, but if it is supplied it must be
+  # valid
+  if (
+    !is.null(label) &&
+      (!is.character(label) || length(label) != 1 || !nzchar(trimws(label)))
+  ) {
+    rlang::abort("`label` must be a non-empty string.")
+  }
+  # Process label if supplied
+  label_processed <- if (!is.null(label)) {
+    processDeps(label, session)
+  } else {
+    NULL
+  }
+
+  # Process icon if supplied
+  icon_processed <- if (!is.null(icon)) {
+    processDeps(validateIcon(icon), session)
+  } else {
+    NULL
+  }
+
+  # Process choices - reuse the selectOptions helper
+  # Follow Shiny's pattern: choices and selected are handled separately
+  choices_processed <- if (!is.null(choices)) {
+    # Normalize choices using util function imported from Shiny
+    choicesWithNames <- asNamespace("shiny")[["choicesWithNames"]]
+    choices <- choicesWithNames(choices)
+
+    # Generate the options HTML (selected will be marked in the HTML if provided)
+    options_html <- selectOptions(choices, selected, inputId = id)
+
+    as.character(options_html)
+  } else {
+    NULL
+  }
+
+  # Convert selected to character if provided (following Shiny's pattern)
+  selected_processed <- if (!is.null(selected)) {
+    as.character(selected)
+  } else {
+    NULL
+  }
+
+  message <- dropNulls(list(
+    label = label_processed,
+    showLabel = show_label,
+    icon = icon_processed,
+    options = choices_processed,
+    value = selected_processed
+  ))
+
+  session$sendInputMessage(id, message)
+}
+
 # This function was copied from shiny's `input-select.R` with a small change
 selectOptions <- function(
   choices,

R/utils-shiny.R

@@ -42,6 +42,10 @@ processDeps <- function(...) {
   getFromNamespace("processDeps", "shiny")(...)
 }
 
+validateIcon <- function(...) {
+  getFromNamespace("validateIcon", "shiny")(...)
+}
+
 p_randomInt <- function(...) {
   getFromNamespace("p_randomInt", "shiny")(...)
 }

srcts/src/components/index.ts

@@ -5,6 +5,8 @@ import "./accordion";
 import "./card";
 import "./sidebar";
 import "./taskButton";
+import "./toolbarInputButton";
+import "./toolbarInputSelect";
 import "./submitTextArea";
 import "./toast";