Alter dropdown menu in shiny

[vinayprakash808]

In the below application, is there a way to remove number 3 (Basically, can we remove number displaying there)? Only message box needs to be displayed there

library(shiny)

ui <- dashboardPage(
  dashboardHeader(dropdownMenu(type = "messages",
                               messageItem(
                                 from = "Sales Dept",
                                 message = "Sales are steady this month."
                               ),
                               messageItem(
                                 from = "New User",
                                 message = "How do I register?",
                                 icon = icon("question"),
                                 time = "13:45"
                               ),
                               messageItem(
                                 from = "Support",
                                 message = "The new server is ready.",
                                 icon = icon("life-ring"),
                                 time = "2014-12-01"
                               )
  )),
  dashboardSidebar(),
  dashboardBody()
)

server <- function(input, output, session) {
  
}

shinyApp(ui, server)

[nirgrahamuk]

Here is one way, get the code for dropdownmenu from shinydashboard (i used getanywhere(dropdownMenu)), edit this not to create the badge/number count and store as your own function that you use instead. However you also have to prefix shinydashboard function calls in this definition with shinydashboard::: so that they are found in that namespace.

library(shiny)
library(shinydashboard)


customDropDownMenu <-
  function (..., type = c("messages", "notifications", 
                          "tasks"), badgeStatus = "primary", icon = NULL, 
            headerText = NULL, .list = NULL) 
  {
    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)
    # }
    if (is.null(headerText)) {
      headerText <- paste("You have", numItems, type)
    }
    tags$li(class = dropdownClass, a(href = "#", class = "dropdown-toggle", 
                                     `data-toggle` = "dropdown", icon, badge), 
            tags$ul(class = "dropdown-menu", tags$li(class = "header", 
                                                     headerText), tags$li(tags$ul(class = "menu", 
                                                                                  items))))
  }

ui <- dashboardPage(
  dashboardHeader(customDropDownMenu(type = "messages",headerText="",
                               messageItem(
                                 from = "Sales Dept",
                                 message = "Sales are steady this month."
                               ),
                               messageItem(
                                 from = "New User",
                                 message = "How do I register?",
                                 icon = icon("question"),
                                 time = "13:45"
                               ),
                               messageItem(
                                 from = "Support",
                                 message = "The new server is ready.",
                                 icon = icon("life-ring"),
                                 time = "2014-12-01"
                               )
  )),
  dashboardSidebar(),
  dashboardBody()
)

server <- function(input, output, session) {
}

shinyApp(ui, server)