Блестящий раскрывающийся список изменения заголовка панели инструментов

Похоже, что предложение жестко запрограммировано в функции 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)