Add input bindings for toolbar buttons and select components

[elnelson575]

Fixes #1266

Objectives:

Create input for single select and action button, including update functions.

Todo: Create an issue to deal with validation as specified below
Decision Log:

• Update tooltip will remain a separate function call, not a part of update_toolbar_*()

• Resolved. Question: Right now, if the options are changed using update_toolbar_input_select(), there is not a selected choice set by default unless it is also specified using the selected argument. This is consistent with the standard input_select()s behavior. An alternative would be to automatically select the new choices' first value on update, clearing any selection already made.

• If current choice is not in choices, clear it and select the first in the new choice list

• Implemented a small mocking function for testing the errors with blank labels

Additional test and failure cases:

Select Input:

• If a user attempts to update a label to "" they will get a fatal warning

Input Action Button:

• If a user attempts to update a label to "" they will get a non-fatal warning

Examples and recordings:

Action Button Test App

Screen.Recording.2026-01-05.at.1.01.47.PM.mov

library(shiny)
library(bslib)

ui <- page_fluid(
  h2("Toolbar Button Update Example"),
  p("This example demonstrates updating toolbar buttons dynamically."),

  card(
    card_header(
      "Media Player",
      toolbar(
        align = "right",
        toolbar_input_button(
          "play",
          label = "Play",
          icon = icon("play"),
          show_label = FALSE
        ),
        toolbar_input_button(
          "stop",
          label = "Stop",
          icon = icon("stop"),
          show_label = FALSE,
          disabled = TRUE
        ),
        toolbar_divider(),
        toolbar_input_button(
          "volume",
          label = "Volume: High",
          icon = icon("volume-high"),
          show_label = FALSE
        )
      )
    ),
    card_body(
      h4("Player Status"),
      verbatimTextOutput("status"),
      hr(),
      h4("Button Click Counts"),
      verbatimTextOutput("clicks"),
      actionButton("dummy", "Dummy")
    )
  ),

  card(
    card_header(
      "Another Example: Task Status",
      toolbar(
        align = "right",
        toolbar_input_button(
          "hide_label",
          label = "Boo!",
          icon = icon("exclamation-triangle"),
          show_label = FALSE
        )
      )
    ),
    card_body(
      toolbar(
        align = "left",
        toolbar_input_button(
          "task",
          label = "Do a Task",
          icon = icon("play-circle"),
          show_label = TRUE
        )
      ),
      verbatimTextOutput("task_status")
    )
  )
)

server <- function(input, output, session) {
  # Track player state
  playing <- reactiveVal(FALSE)
  volume_level <- reactiveVal(3) # 1=mute, 2=low, 3=high

  # Handle play button
  observeEvent(input$play, {
    will_be_playing <- !playing()
    update_toolbar_input_button(
      "play",
      label = if (will_be_playing) "Pause" else "Play",
      icon = icon(if (will_be_playing) "pause" else "play"),
      session = session
    )
    update_tooltip(
      "play_tooltip",
      if (will_be_playing) "Pause playback" else "Start playback",
      session = session
    )
    update_toolbar_input_button(
      "stop",
      disabled = !will_be_playing,
      session = session
    )
    playing(will_be_playing)
  })

  # Handle stop button
  observeEvent(input$stop, {
    playing(FALSE)
    update_toolbar_input_button(
      "play",
      label = "Play",
      icon = icon("play"),
      session = session
    )
    update_tooltip(
      "play_tooltip",
      "Start playback",
      session = session
    )
    update_toolbar_input_button(
      "stop",
      disabled = TRUE,
      session = session
    )
  })

  # Handle volume button - cycle through mute, low, high
  observeEvent(input$volume, {
    current <- volume_level()
    new_level <- if (current == 3) 1 else current + 1
    volume_level(new_level)

    vol_info <- switch(
      new_level,
      list(icon = "volume-xmark", label = "Volume: Mute"),
      list(icon = "volume-low", label = "Volume: Low"),
      list(icon = "volume-high", label = "Volume: High")
    )

    update_toolbar_input_button(
      "volume",
      label = vol_info$label,
      icon = icon(vol_info$icon)
    )
    update_tooltip("volume_tooltip", vol_info$label)
  })

  # Show/hide label button
  observeEvent(input$hide_label, {
    update_toolbar_input_button(
      "hide_label",
      show_label = TRUE,
    )
  })

  # Handle task button
  observeEvent(input$task, {
    # Update to show task is complete
    update_toolbar_input_button(
      "task",
      label = "Task Complete!",
      icon = icon("check-circle"),
      session = session
    )

    # Reset to original after 2 seconds
    later::later(
      function() {
        update_toolbar_input_button(
          "task",
          label = "Do a Task",
          icon = icon("play-circle"),
          session = session
        )
      },
      delay = 2
    )
  })

  # Display status
  output$status <- renderPrint({
    cat("Player State:", if (playing()) "Playing" else "Stopped", "\n")
    vol_text <- switch(
      volume_level(),
      "Muted",
      "Low",
      "High"
    )
    cat("Volume Level:", vol_text, "\n")
  })

  output$clicks <- renderPrint({
    cat("Play button clicks:", input$play, "\n")
    cat("Stop button clicks:", input$stop, "\n")
    cat("Volume button clicks:", input$volume, "\n")
    cat("Regular button clicks:", input$dummy, "\n")
  })

  output$task_status <- renderPrint({
    cat("Task completed", input$task, "time(s)\n")
  })
}

shinyApp(ui, server)

Select Test App

Screen.Recording.2026-01-05.at.1.19.54.PM.mov

library(shiny)
library(bslib)

ui <- page_fluid(
  h2("Toolbar Input Select Test App"),

  card(
    card_header(
      "Toolbar with Select Input",
      toolbar(
        align = "right",
        toolbar_input_select(
          "filter",
          label = "Filter",
          choices = c("All", "Active", "Inactive"),
          selected = "All",
          icon = icon("filter")
        ),
        toolbar_input_button(
          "refresh",
          label = "Refresh",
          icon = icon("arrows-rotate")
        )
      )
    ),
    card_body(
      h4("Current Selection"),
      verbatimTextOutput("selection"),
      hr(),
      h4("Update Controls"),
      fluidRow(
        column(
          6,
          textInput("new_label", "New Label", value = "Filter"),
          checkboxInput("show_label_check", "Show Label", value = FALSE),
          actionButton(
            "update_label",
            "Update Label & Visibility",
            class = "btn-primary"
          )
        ),
        column(
          6,
          selectInput(
            "new_icon",
            "New Icon",
            choices = c("filter", "search", "list", "table", "chart-bar"),
            selected = "filter"
          ),
          actionButton("update_icon", "Update Icon", class = "btn-primary")
        )
      ),
      hr(),
      fluidRow(
        column(
          6,
          radioButtons(
            "choice_set",
            "Choice Set",
            choices = c(
              "Status" = "status",
              "Priority" = "priority",
              "Category" = "category"
            ),
            selected = "status"
          ),
          actionButton(
            "update_choices",
            "Update Choices",
            class = "btn-primary"
          )
        ),
        column(
          6,
          h5("Choice Sets:"),
          tags$ul(
            tags$li(tags$strong("Status:"), " All, Active, Inactive"),
            tags$li(tags$strong("Priority:"), " Low, Medium, High, Critical"),
            tags$li(
              tags$strong("Category:"),
              " Feature, Bug, Enhancement, Documentation"
            )
          )
        )
      ),
      hr(),
      h4("Test All Updates Together (All new values)"),
      actionButton(
        "update_all",
        "Update Everything",
        class = "btn-success btn-lg"
      )
    )
  )
)

server <- function(input, output, session) {
  # Reactive value that updates whenever filter changes
  filter_info <- reactive({
    list(
      value = input$filter,
      timestamp = Sys.time()
    )
  })

  # Display current selection
  output$selection <- renderPrint({
    filter_info()
  })

  # Update label and show_label
  observeEvent(input$update_label, {
    update_toolbar_input_select(
      "filter",
      label = input$new_label,
      show_label = input$show_label_check
    )
    showNotification(
      sprintf(
        "Updated label to '%s' (visible: %s)",
        input$new_label,
        input$show_label_check
      ),
      type = "message"
    )
  })

  # Update icon
  observeEvent(input$update_icon, {
    update_toolbar_input_select(
      "filter",
      icon = icon(input$new_icon)
    )
    showNotification(
      sprintf("Updated icon to '%s'", input$new_icon),
      type = "message"
    )
  })

  # Update choices based on selected set
  observeEvent(input$update_choices, {
    new_choices <- switch(
      input$choice_set,
      "status" = c("All", "Active", "Inactive"),
      "priority" = c("Low", "Medium", "High", "Critical"),
      "category" = c("Feature", "Bug", "Enhancement", "Documentation")
    )

    update_toolbar_input_select(
      "filter",
      choices = new_choices,
      #selected = new_choices[1]
    )
    showNotification(
      sprintf("Updated choices to '%s' set", input$choice_set),
      type = "message"
    )
  })

  # Update everything at once
  observeEvent(input$update_all, {
    update_toolbar_input_select(
      "filter",
      label = "Chaos",
      show_label = TRUE,
      icon = icon("star"),
      choices = c("Option A", "Option B", "Option C", "Option D"),
      selected = "Option B"
    )
    showNotification(
      "Updated label, visibility, icon, choices, and selection!",
      type = "message",
      duration = 3
    )
  })

  # Demonstrate dynamic updates based on button clicks
  observeEvent(input$refresh, {
    current <- input$filter
    showNotification(
      sprintf("Refreshing with filter: %s", current),
      type = "message"
    )

    # Simulate a refresh action
    Sys.sleep(0.5)

    showNotification(
      "Refresh complete!",
      type = "message"
    )
  })
}

shinyApp(ui, server)

[gadenbuie]

Looking great! I have a handful of comments but they're all mostly pretty small 😄

[gadenbuie]

Given how we now handle label in toolbar_input_select(), I think we might want to bump this up to an error as well. I.e. require that label is provided for accessibility reasons, even if not shown.

Although now I'm remembering that the difference is that in the select input we could also enforce label being a scalar string, where here it could be tags that do meet accessibility requirements. Hmmm 🤔

[elnelson575]

Yeah, I think that had been why we warned instead of errored, since we didn't want to make a strict string requirement on people's labels in the buttons because they're more likely to actually use visible labels, vs. in the select, we're assuming the vast majority of people will use no visible label, which means the tooltip/accessible annotations are way more important.