闪亮的仪表板标题修改下拉菜单 [英] Shiny dashboard header modify dropdown

问题描述

当在带有消息或通知项目的标题中包含下拉菜单时，它会在单击时自动显示句子"You Have%1 Messages"。我怎么能只显示消息而不显示句子"您有%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)

推荐答案

该句子似乎已硬编码在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)

这篇关于闪亮的仪表板标题修改下拉菜单的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！