Dynamically create sortable menuSubItems in shinydashboard

Question

I have a Shiny app using the shinydashboard package in which I\'m dynamically creating menuSubItems in the sidebarMenu of a dashboar

Answer 1

The sortable_js() function generates HTML, so it’ll need to be included in the UI. However, you also have to make sure it is included after the element that it applies to already exists; it won’t work otherwise. Here, we can accomplish that by adding it to the output of the renderMenu() call as an additional child of the menu item created with menuItem():

output$test <- renderMenu({
  menu <- menuItem("test_tabs", do.call(tagList, tabs_list))
  tagAppendChildren(menu, sortable_js("test_tabs"))
})

Now, the id that you give to sortable_js() has to be the CSS id of the element whose children you want to make sortable. In this case, that would be the ul element inside the menuItem(), which contains all of the sub-items. Unfortunately there is no way to directly set this id when creating the menu item, so we have to inject it after the fact. A quick inspection of the menuItem() source code reveals that the ul tag is the second child of the menu item tag:

output$test <- renderMenu({
  menu <- menuItem("test_tabs", do.call(tagList, tabs_list))
  menu$children[[2]] <- tagAppendAttributes(menu$children[[2]], id = "test_tabs")
  tagAppendChildren(menu, sortable_js("test_tabs"))
})

With these modifications, your example will be up and running:

library(shiny)
library(shinydashboard)
library(sortable)

# Define UI for shinydashboard
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    sidebarMenu(
      menuItem("tab_one", tabName = "test_body"),
      menuItemOutput("test")
    )
  ),
  dashboardBody(
    tabItem("test_body", actionButton("click_me", "Click Me"))
  )
)

# Define server logic to dynamically create menuSubItems
server <- function(input, output) {
  observeEvent(input$click_me, {
    tabs_list <- lapply(1:5, function(x) {
      menuSubItem(text = paste("tab", x))
    })

    output$test <- renderMenu({
      menu <- menuItem("test_tabs", do.call(tagList, tabs_list))
      menu$children[[2]] <- tagAppendAttributes(menu$children[[2]], id = "test_tabs")
      tagAppendChildren(menu, sortable_js("test_tabs"))
    })
  })
}

# Run the application
shinyApp(ui = ui, server = server)

^{Created on 2019-10-16 by the reprex package (v0.3.0)}