从tabsetPanel中动态删除所有导航面板

htmltools 解决方案

您可以使用 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解决方案

您可以使用 custom message handler 当点击按钮时,该功能被激活。它收集Javascript中的名字,并将其作为列表发送回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)

此处无关,但请注意,我替换了Shiny的 fluidPage 使用bslib page_fluid .