r - How to dynamically remove all nav_panel from a tabsetPanel? - Stack Overflow

Is it possible to access the names of the nav_panel() objects contained in a navigation container? In the example below, I want to dynamically remove all the panels, and can do this if I know the names (see the line panel_names<-c("a", "b", "c")). However, in a larger app, these panels are generated dynamically, and I may not know the names of the panels.

library(shiny)
library(bslib)
library(purrr)

ui <- fluidPage(
  
  actionButton("remove", "Remove all nav panels"),
  tabsetPanel(
    id="panel_set",
    nav_panel("a", "frame a"),
    nav_panel("b", "frame b"),
    nav_panel("c", "frame c")
  )
)

server <- function(input, output) {
  observe({
    panel_names = c("a", "b", "c") # How can I replace this line?
    walk(panel_names, \(pn) nav_remove("panel_set", target=pn))
  }) |> bindEvent(input$remove)
}

# Run the application 
shinyApp(ui = ui, server = server)

How can I replace the line panel_names<-c("a", "b", "c")?

Is it possible to access the names of the nav_panel() objects contained in a navigation container? In the example below, I want to dynamically remove all the panels, and can do this if I know the names (see the line panel_names<-c("a", "b", "c")). However, in a larger app, these panels are generated dynamically, and I may not know the names of the panels.

library(shiny)
library(bslib)
library(purrr)

ui <- fluidPage(
  
  actionButton("remove", "Remove all nav panels"),
  tabsetPanel(
    id="panel_set",
    nav_panel("a", "frame a"),
    nav_panel("b", "frame b"),
    nav_panel("c", "frame c")
  )
)

server <- function(input, output) {
  observe({
    panel_names = c("a", "b", "c") # How can I replace this line?
    walk(panel_names, \(pn) nav_remove("panel_set", target=pn))
  }) |> bindEvent(input$remove)
}

# Run the application 
shinyApp(ui = ui, server = server)

How can I replace the line panel_names<-c("a", "b", "c")?

• r
• shiny
• bslib

Share Improve this question Follow edited Feb 10 at 5:36 Jan 10.2k66 gold badges2121 silver badges3333 bronze badges asked Jan 30 at 19:56 langtanglangtang 25k11 gold badge1414 silver badges3030 bronze badges

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 4

htmltools solution

You can use htmltools::tagQuery():

library(shiny)
library(bslib)
library(purrr)

ui <- page_fluid(
  actionButton("remove", "Remove all nav panels"),
  tabsetPanel(
    id="panel_set",
    nav_panel("a", "frame a"),
    nav_panel("b", "frame b"),
    nav_panel("c", "frame c")
  )
)

server <- function(input, output, session) {
  
  observeEvent(input$remove, {
    panel_names <- sapply(
      htmltools::tagQuery(ui)$find("#panel_set")$find("a")$selectedTags(), 
      function(x){ tagGetAttribute(x, "data-value") }
    )
    walk(panel_names, \(pn) nav_remove("panel_set", target=pn))
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Javascript solution

You can use a custom message handler which gets activated when the button is clicked. It collects the names in Javascript and sends them back as a list to Shiny.

library(shiny)
library(bslib)
library(purrr)

ui <- page_fluid(
  tags$head(
    tags$script("
      Shiny.addCustomMessageHandler('get_nav_panel_names', function(panel) {
        var names = $('#' + panel).find('a').map(function() {
          return $(this).attr('data-value');
        }).toArray();
        Shiny.setInputValue(panel + '_names', {names});
      });
    ")
  ),
  actionButton("remove", "Remove all nav panels"),
  tabsetPanel(
    id="panel_set",
    nav_panel("a", "frame a"),
    nav_panel("b", "frame b"),
    nav_panel("c", "frame c")
  )
)

server <- function(input, output, session) {
  
  observeEvent(input$remove, {
    session$sendCustomMessage("get_nav_panel_names", "panel_set")
    
    req(input$panel_set_names)
    panel_names <- unlist(unname(input$panel_set_names))
    walk(panel_names, \(pn) nav_remove("panel_set", target=pn))
  }, ignoreNULL = FALSE)
}

# Run the application 
shinyApp(ui = ui, server = server)

Unrelated here, but please note that I replaced Shiny's fluidPage with bslib's page_fluid.