Add input bindings for toolbar buttons and select components

[elnelson575]

Fixes #1266

Objectives:

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

Decision Log:

• Update tooltip will remain a separate function call, not a part of update_toolbar_*()
• 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.
• Question: I see that show/hide_toast() has mock sessions to do testing on updates. My instinct was not to do this, because there's not much to the update logic beyond passing the right stuff using more or less the same functions. Agree/disagree?

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]

Can you elaborate a bit about what conflicts arise? (Here in this thread first)

[elnelson575]

Looking back at my notes, it looks like this is because we're wrapping this select element (with the label and icon) and we want to update those as well as the select element within it. We want any update message to go through the toolbar-specific select bindings, not the select binding, which won't know what to do with some of the params we have.
This way, we only register the wrapped select with the toolbar select bindings and avoid having the select double-claimed, if that makes sense?

[elnelson575]

From discussion: Revert back to the code at bdda4da

should register correctly with data-shiny-no-bind-input added to the select tag, but verify

[gadenbuie]

I think you could remove all of the comments in this function

[gadenbuie]

Just for consistency

Suggested change

	warning(
	rlang::warn(

[gadenbuie]

A small re-ordering; I think this form scans a little better.

Suggested change

	# 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
	}
	icon <- validateIcon(icon)
	icon_processed <- if (!is.null(icon)) processDeps(icon, session)
	label_processed <- if (!is.null(label)) processDeps(label, session)

[gadenbuie]

Suggested change

	# 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
	toolbar_input_button_input_handler <- function(value, shinysession, name) {
	# Treat like a standard action button for event handlers and input validation

[gadenbuie]

I wonder if we could import the input button binding directly to avoid having to define some of the basic methods?

[gadenbuie]

We always include the label and icon containers, right? Just checking that if (labelEl) and similar are about satisfying the type checkers

[gadenbuie]

I think you can remove all the internal comments in this class as well

[gadenbuie]

This is somewhat of a more recent style adjustment, but I like using expect_snapshot() with error = TRUE for these messages. That way, the error message is captured in the snapshot, and the expectation fails if no error is thrown, even on CRAN.

Suggested change

	expect_error(
	update_toolbar_input_select(
	"test_id",
	label = ""
	),
	"`label` must be a non-empty string"
	)
	expect_snapshot(error = TRUE, {
	update_toolbar_input_select("test_id", label = "")
	})

On the other hand, this approach introduces the problem that if label = "" made it past the validation, we'd get a different error about missing an active Shiny session. That could be fixed by mocking session, but I'm not sure it's worth it. Up to you!

It would be nice to have the update function on one line in these tests though to make it easier to scan

Suggested change

	expect_error(
	update_toolbar_input_select(
	"test_id",
	label = ""
	),
	"`label` must be a non-empty string"
	)
	expect_error(
	update_toolbar_input_select("test_id", label = ""),
	"`label` must be a non-empty string"
	)

[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 🤔