Custom Shiny navlist with collapsible menus - buttons stuck on active

Hi, I'm building a custom navigation sidebar with collapsible menus. The end product should be similar to what can be achieved with Shiny's navlistPanel(), but the links to the various tab panels would collapse below the menu's title when clicking on it.

Here a small example of the output (the code is below):

In the example, there are two collapsible items (menus) already collapsed, each containing two buttons linking to different tab panels.

The Issue: When navigating tabs across menus (only in this case), the last clicked tab button in a menu remains stuck on active, hence when clicking again on that button it will not switch to the corresponding tab panel.

Examples: (Checking the button classes in the browser inspector)

  1. Working transitions:
  • Click on tab button 1, tab button 1 becomes active and tab panel 1 appears on the right side of the page.
  • Then click on tab button 2, button 1 deactivates while button 2 activates and tab panel 2 appears on the right.
  • Similarly if I navigate back from 2 to 1, or within item 2, from 3 to 4 and vice versa.
  1. Not working transitions:
  • Click on tab button 1 which activates and tab panel 1 appears on the right.
  • Then click on tab button 3, button 3 activates and tab panel 3 appears, however tab button 1 does not deactivate.
  • Clicking back on tab button 1 will not activate the button (since already stuck on active) while tab panel 3 will remain on the right.

Here a reproducible example:

library(shiny)

# helper functions
gen_nav_item <- function(id, title, ...) {
  button_tag <- tags$button(
    class = "btn",
    `data-bs-toggle` = "collapse",
    `data-bs-target` = paste0("#", id),
    title
  )
  
  content_tag <- tags$div(
    class = "collapse",
    id = id,
    tags$ul(
      class = "nav flex-column",
      ...
    )
  )
  
  tags$li(button_tag, content_tag) 
}

gen_tab_button <- function(tab_id, title) {
  tags$li(
    tags$button(
      class = "btn nav-link",
      `data-bs-toggle` = "tab",
      `data-bs-target` = paste0("#", tab_id),
      title)
    )
}

gen_tab_panel <- function(id, ...) {
  tags$div(
    class = "tab-pane",
    id = id,
    ...
  )
}

# html elements
tab_1 <- gen_tab_panel("tab-1", h1("This is Tab 1"))
tab_2 <- gen_tab_panel("tab-2", h1("This is Tab 2"))
tab_3 <- gen_tab_panel("tab-3", h1("This is Tab 3"))
tab_4 <- gen_tab_panel("tab-4", h1("This is Tab 4"))

button_tab_1 <- gen_tab_button("tab-1", "Tab 1")
button_tab_2 <- gen_tab_button("tab-2", "Tab 2")
button_tab_3 <- gen_tab_button("tab-3", "Tab 3")
button_tab_4 <- gen_tab_button("tab-4", "Tab 4")

item_1 <- gen_nav_item("item-1", "Item 1", button_tab_1, button_tab_2)
item_2 <- gen_nav_item("item-2", "Item 2", button_tab_3, button_tab_4)

# app code
ui <- fluidPage(
  theme = bslib::bs_theme(version = 5),
  fluidRow(
    column(
      width = 4,
      tags$ul(
        item_1,
        item_2,
      )
    ),
    column(
      width = 8,
      tags$div(
        class = "tab-content",
        tab_1,
        tab_2,
        tab_3,
        tab_4
      )
    )
  )
)
server <- function(input, output, session) {}
shinyApp(ui, server)

Does anybody have any idea? Do you think it is an issue related to Shiny? or maybe JavaScript?

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.