shinydashboard header 下拉添加组链接

Question

我想在 header 面板的下拉菜单中放置多个 link，但现在我只能通过 tags$li 创建一个平面水平布局，而我想要一个垂直分组下拉菜单。

一个最小的可重复代码如下，我的意思是我想把linkA和linkB放在组linkAB下，用户可以打开其中一个一个新的 window。代码中可以用dropdownMenu(type='notifications',...)来实现，但是我不知道"grouplinkAB"的组名放在哪里，也无法打开新的window点击link的时候，还要隐藏文字"You have 2 notifications"，所以想用tags$li和tags$ul来实现，但是对HTML，我们将不胜感激。

library(shinydashboard)
library(shiny)

runApp(
  shinyApp(
    ui = shinyUI(
      dashboardPage(
        dashboardHeader(title='Reporting Dashboard',
                        tags$li(class="dropdown",tags$a("grouplinkAB",href="http://whosebug.com/", target="_blank")),
                        tags$li(class="dropdown",tags$a("linkA",href="http://whosebug.com/", target="_blank")),
                        tags$li(class="dropdown",tags$a("linkB",href="http://whosebug.com/", target="_blank")),
                        dropdownMenu(type='notifications',
                                     notificationItem(text='linkA',href="http://whosebug.com/"),
                                     notificationItem(text='linkB',href="http://whosebug.com/")
                                     )
        ),
        dashboardSidebar(),
        dashboardBody()
      )
    ), 
    server = function(input, output){}
  ), launch.browser = TRUE
)

Answer 1

好的，大约一年前我看到了类似的请求，但没有深入了解。这次我试图让您的代码工作，但不能，然后我查看了 dropdownMenu 代码，发现它根本没有设置来处理这个问题，但可以很容易地进行修改。

虽然我选择不这样做，但我创建了一个新版本的 dropdownMenu 专门用于执行此操作。

代码如下：

library(shinydashboard)

dropdownHack <- function (...,badgeStatus = NULL, .list = NULL,menuname=NULL) 
{
  if (!is.null(badgeStatus)){
    shinydashboard:::validateStatus(badgeStatus)
  }
  items <- c(list(...), .list)
  lapply(items, shinydashboard:::tagAssert, type = "li")
  dropdownClass <- paste0("dropdown ", "text-menu")
  numItems <- length(items)
  if (is.null(badgeStatus)) {
    badge <- NULL
  }
  else {
    badge <- span(class = paste0("label label-", badgeStatus), numItems)
  }
  tags$li(class = dropdownClass, a( href="#", class="dropdown-toggle", 
                                    `data-toggle`="dropdown", menuname, badge),
          tags$ul(class = "dropdown-menu",  items  )
  )
}

menuitemHack <- function(text,href){
  notificationItem(text=text,href=href,icon=shiny::icon("rocket") )
}

runApp(
  shinyApp(
    ui = shinyUI(
      dashboardPage(
        dashboardHeader(title='Reporting Dashboard',
                        dropdownHack(menuname="GroupAB",
                                     menuitemHack(text='linkA',href="http://whosebug.com/"),
                                     menuitemHack(text='linkB',href="http://whosebug.com/")
                        ),
                        dropdownMenu(type='notifications',
                                   notificationItem(text='linkA',href="http://whosebug.com/"),
                                   notificationItem(text='linkB',href="http://whosebug.com/")
                        )
        ),
        dashboardSidebar(),
        dashboardBody()
      )
    ), 
    server = function(input, output){}
  ), launch.browser = TRUE
)

结果如下：

备注：

它需要一个图标，你可以 select 任何 fontAwesome 或 Glyphicons，如果你什么都不想的话，那里可能有一个空白的。
我想如果 ShinyDashboard 结构改变太多它会崩溃，所以记住这一点。
也许下个版本也会支持这个选项，只是多加几行代码而已。

shinydashboard header 下拉添加组链接

shinydashboard header dropdown add group links

html

css

r

shiny

shinydashboard