Shinydashboard: keep sidebar-tab expanded while other tab is clicked / expanded

shinydashboard
#1

Hey everyone,

I've searched for a lot of time in a lot of places, but couldn't find any solution to this.

I want an app with shinydashboard design like the following:
A few menuItems with each a few menuSubItems. My problem is that if one menuItem is expanded, it'll collapse automatically once I expand another one.

I saw the startExpanded option, and if I set it to TRUE, all the menuItems are expanded, but as soon as you (accidentally) collapse a menuItem it's not possible to expand it again without the other tabs collapsing. Here is a reprex:

# reprex.R

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  
  dashboardHeader(title="dashheader"),
  
  dashboardSidebar(
    sidebarMenu(
      menuItem("MenuItemA", tabName="MIA",
        menuSubItem("MenuSubItemA_1", tabName="MSIA_1")),
      menuItem("MenuItemB", tabName="MIB",
        menuSubItem("MenuSubItemB_1", tabName="MSIB_1"))
    )
  ),
  
  dashboardBody()
)

server <- function(input, output){}

shinyApp(ui, server)

Is there something I've missed or is this option not existing yet? Thanks a lot!

Paul

#2

Thanks for the very nice minimal example!

That is the way that shinydashboard works. Shinydashboard uses AdminLTE, and AdminLTE behaves that way. See here for a demo:
https://adminlte.io/themes/AdminLTE/index2.html

The fact that you can use startExpanded=TRUE for both menus is just a quirk of the what is allowed in the initial HTML layout.

One hack you could do to prevent clicking from doing anything is to change the <a> tag from this:

<a href="#shiny-tab-MIA">

to this:

<a href="#shiny-tab-MIA" onclick="event.stopPropagation()">

This prevents the click event from triggering the JavaScript callback that collapses/uncollapses the menus.

To do it in R, you can write a function that modifies the menuItem's HTML. Here's your app modified to work this way:

library(shiny)
library(shinydashboard)

modify_stop_propagation <- function(x) {
  x$children[[1]]$attribs$onclick = "event.stopPropagation()"
  x
}

ui <- dashboardPage(
  
  dashboardHeader(title="dashheader"),
  
  dashboardSidebar(
    sidebarMenu(
      modify_stop_propagation(
        menuItem("MenuItemA", tabName="MIA", startExpanded = TRUE,
          menuSubItem("MenuSubItemA_1", tabName="MSIA_1"))
      ),
      modify_stop_propagation(
        menuItem("MenuItemB", tabName="MIB", startExpanded = TRUE,
          menuSubItem("MenuSubItemB_1", tabName="MSIB_1"))
      )
    )
  ),
  
  dashboardBody()
)

server <- function(input, output){}

shinyApp(ui, server)