闪亮的仪表板 header 修改下拉菜单

Question

如果在带有消息或通知项的 header 中包含下拉菜单，它会在点击时自动显示句子 "You have 1 messages"。如何只显示消息而不显示句子 "You have 1 messages"?

下面要重现的示例：

    ui <- dashboardPage(
  dashboardHeader(dropdownMenu(type = "messages",
                               messageItem(
                                 from = "Sales Dept",
                                 message = "Sales are steady this month."
                               ))),
  dashboardSidebar(),
  dashboardBody()
)

server <- function(input, output) { }

shinyApp(ui, server)

Answer 1

dropdownMenu 函数中的句子似乎是硬编码的：

function (..., type = c("messages", "notifications", "tasks"), 
          badgeStatus = "primary", icon = NULL, .list = NULL) 
{
    type <- match.arg(type)
    if (!is.null(badgeStatus)) validateStatus(badgeStatus)
    items <- c(list(...), .list)
    lapply(items, tagAssert, type = "li")
    dropdownClass <- paste0("dropdown ", type, "-menu")
    if (is.null(icon)) {
        icon <- switch(type, messages = shiny::icon("envelope"), 
        notifications = shiny::icon("warning"), tasks = shiny::icon("tasks"))
    }
    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", 
            icon, 
            badge
        ), 
        tags$ul(
            class = "dropdown-menu", 
            tags$li(
                class = "header", 
                paste("You have", numItems, type)
            ), 
            tags$li(
                tags$ul(class = "menu", items)
            )
        )
    )
}

我们看到这个句子是用paste("You have", numItems, type)造的。改变它的一种方法是编写一个新函数，该函数采用一个带有您想要的句子的新参数：

customSentence <- function(numItems, type) {
  paste("This is a custom message")
}

# Function to call in place of dropdownMenu
dropdownMenuCustom <-     function (..., type = c("messages", "notifications", "tasks"), 
                                    badgeStatus = "primary", icon = NULL, .list = NULL, customSentence = customSentence) 
{
  type <- match.arg(type)
  if (!is.null(badgeStatus)) shinydashboard:::validateStatus(badgeStatus)
  items <- c(list(...), .list)
  lapply(items, shinydashboard:::tagAssert, type = "li")
  dropdownClass <- paste0("dropdown ", type, "-menu")
  if (is.null(icon)) {
    icon <- switch(type, messages = shiny::icon("envelope"), 
                   notifications = shiny::icon("warning"), tasks = shiny::icon("tasks"))
  }
  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", 
      icon, 
      badge
    ), 
    tags$ul(
      class = "dropdown-menu", 
      tags$li(
        class = "header", 
        customSentence(numItems, type)
      ), 
      tags$li(
        tags$ul(class = "menu", items)
      )
    )
  )
}

一个最小的例子：

ui <- dashboardPage(
  dashboardHeader(dropdownMenuCustom(type = "messages",
                                     customSentence = customSentence,
                               messageItem(
                                 from = "Sales Dept",
                                 message = "Sales are steady this month."
                               ))),
  dashboardSidebar(),
  dashboardBody()
)

server <- function(input, output) { }

shinyApp(ui, server)

闪亮的仪表板 header 修改下拉菜单

Shiny dashboard header modify dropdown

r

shiny

shinydashboard