shinydashboard header dropdown添加组链接

时间:2017-04-09 03:42:29

标签: html css r shiny shinydashboard

我想在标题面板的下拉菜单中放置多个链接,但现在我只能通过标签$ li创建平面水平布局,而我想要一个垂直分组下拉菜单。

最小可重复代码如下所示,我的意思是我想将linkA和linkB放在grouplinkAB下,用户可以在新窗口中打开其中一个。可以使用dropdownMenu(类型='通知',...)来实现,但是我不知道将组名称放在哪里" grouplinkAB",哪个点击链接时无法打开新窗口,我也必须隐藏文字"你有2个通知",所以我想用标签$ li和标签$ ul实现它,但我很少关于HTML的知识,任何帮助将不胜感激。

library(shinydashboard)
library(shiny)

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

1 个答案:

答案 0 :(得分:2)

好的,我在一年前看到过类似的请求,但看起来并不那么深刻。这次我试图让你的代码工作,然后我不能查看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://stackoverflow.com/"),
                                     menuitemHack(text='linkB',href="http://stackoverflow.com/")
                        ),
                        dropdownMenu(type='notifications',
                                   notificationItem(text='linkA',href="http://stackoverflow.com/"),
                                   notificationItem(text='linkB',href="http://stackoverflow.com/")
                        )
        ),
        dashboardSidebar(),
        dashboardBody()
      )
    ), 
    server = function(input, output){}
  ), launch.browser = TRUE
)

结果如下:

enter image description here

注意:

  • 它需要一个图标,你可以选择任何fontAwesome或Glyphicons,如果你想什么都没有,那里可能有一个空白。
  • 我想如果ShinyDashboard结构发生很大变化会破坏,所以请记住这一点。
  • 也许下一个版本也支持这个选项,它只是几行额外的代码。