Shiny dashboard header modify dropdown

问题

When including a dropdown in a header with message or notification items it automatically displays the sentence "You have 1 messages" upon click. How can I only show the message but not the sentence "You have 1 messages"?

example to reproduce below:

    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)

回答1:

It appears that sentence is hardcoded in the dropdownMenu function:

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

We see that the sentence is built with paste("You have", numItems, type). One way to change that is to write a new function which take a new parameter with the sentence you want:

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 a minimal example:

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)

来源：https://stackoverflow.com/questions/40851634/shiny-dashboard-header-modify-dropdown

标签

Shiny

shinydashboard