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")
htmltools
solutionYou 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)
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
.