閃亮的儀表板標題修改下拉框

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)