闪亮的仪表板标题修改下拉框

Question

当在包含消息或通知项的标题中包含下拉菜单时，它会在单击后自动显示句子“您有1条消息”。我如何才能显示消息，但不显示“您有1条消息”的句子？

例如下面重现：

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)