Shiny Dashboard Header ändern dropdown

Question

Wenn Sie eine Dropdown-Liste in eine Kopfzeile mit Nachrichten- oder Benachrichtigungselementen einfügen, wird beim Klicken automatisch der Satz "Sie haben 1 Nachrichten" angezeigt. Wie kann ich nur die Nachricht anzeigen, aber nicht den Satz "Sie haben 1 Nachrichten"?

Beispiel unten zu reproduzieren:

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

Es scheint, dass Satz in der dropdownMenu Funktion fest einprogrammiert ist:

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) 
      ) 
     ) 
    ) 
} 

Wir sehen, dass der Satz mit paste("You have", numItems, type) gebaut wird. Eine Möglichkeit, das zu ändern ist eine neue Funktion, die mit dem Satz, den Sie wollen einen neuen Parameter nehmen schreiben:

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) 
    ) 
    ) 
) 
} 

An ein minimales Beispiel:

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)