Show content for menuItem when menuSubItems exist in Shiny Dashboard

十年热恋 提交于 2019-11-30 23:49:32

Much credit goes to this question React to menuItem() tab selection . The only this that is a bit annoying is you have to click again on the Charts tab but I think thats fine

library(shiny)
library(shinydashboard)

convertMenuItem <- function(mi,tabName) {
  mi$children[[1]]$attribs['data-toggle']="tab"
  mi$children[[1]]$attribs['data-value'] = tabName
  if(length(mi$attribs$class)>0 && mi$attribs$class=="treeview"){
    mi$attribs$class=NULL
  }
  mi
}

header <- dashboardHeader()

sidebar <- dashboardSidebar(
  sidebarUserPanel("Pork Chop",
                   subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
                   # Image file should be in www/ subdir
                   image = "https://vignette.wikia.nocookie.net/fanfictiondisney/images/9/9e/Pumba_3.jpg/revision/latest?cb=20120708163413"
  ),
  sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
  sidebarMenu(
    # Setting id makes input$tabs give the tabName of currently-selected tab
    id = "tabs",
    menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new", badgeColor = "green"),
    convertMenuItem(menuItem("Charts", tabName = "charts",icon = icon("bar-chart-o"),selected=T,
             menuSubItem("Sub-item 1", tabName = "subitem1"),
             menuSubItem("Sub-item 2", tabName = "subitem2")),"charts")
  )
)

body <- dashboardBody(
  tabItems(
    tabItem("dashboard",div(p("Dashboard tab content"))),
    tabItem("widgets","Widgets tab content"),
    tabItem("charts","Charts Tab"),
    tabItem("subitem1","Sub-item 1 tab content"),
    tabItem("subitem2","Sub-item 2 tab content")
  )
)

shinyApp(
  ui = dashboardPage(header, sidebar, body),
  server = function(input, output) { }
)

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!