Search code examples
rshinybslib

dynamically remove all nav panel from tabsetPanel


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


Solution

  • 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.