Added id's to menuItems and menuSubItems

R/boxes.R

@@ -11,13 +11,14 @@
 #' @param color A color for the box. Valid colors are listed in
 #'   \link{validColors}.
 #' @param href An optional URL to link to.
+#' @param id An optional id for the element
 #'
 #' @family boxes
 #' @seealso \code{\link{box}} for usage examples.
 #'
 #' @export
 valueBox <- function(value, subtitle, icon = NULL, color = "aqua", width = 4,
-  href = NULL)
+  href = NULL, id = NULL)
 {
   validateColor(color)
   if (!is.null(icon)) tagAssert(icon, type = "i")
@@ -34,6 +35,7 @@ valueBox <- function(value, subtitle, icon = NULL, color = "aqua", width = 4,
     boxContent <- a(href = href, boxContent)
 
   div(class = if (!is.null(width)) paste0("col-sm-", width),
+      id = id,
     boxContent
   )
 }
@@ -58,14 +60,15 @@ valueBox <- function(value, subtitle, icon = NULL, color = "aqua", width = 4,
 #'   content; the icon will use the same color with a slightly darkened
 #'   background.
 #' @param href An optional URL to link to.
+#' @param id An optional id for the element
 #'
 #' @family boxes
 #' @seealso \code{\link{box}} for usage examples.
 #'
 #' @export
 infoBox <- function(title, value = NULL, subtitle = NULL,
   icon = shiny::icon("bar-chart"), color = "aqua", width = 4, href = NULL,
-  fill = FALSE) {
+  fill = FALSE, id = NULL) {
 
   validateColor(color)
   tagAssert(icon, type = "i")
@@ -91,6 +94,7 @@ infoBox <- function(title, value = NULL, subtitle = NULL,
     boxContent <- a(href = href, boxContent)
 
   div(class = if (!is.null(width)) paste0("col-sm-", width),
+      id = id,
     boxContent
   )
 }
@@ -119,6 +123,7 @@ infoBox <- function(title, value = NULL, subtitle = NULL,
 #'   the user to collapse the box.
 #' @param collapsed If TRUE, start collapsed. This must be used with
 #'   \code{collapsible=TRUE}.
+#' @param id An optional id for the element
 #' @param ... Contents of the box.
 #'
 #' @family boxes
@@ -250,7 +255,7 @@ infoBox <- function(title, value = NULL, subtitle = NULL,
 #' @export
 box <- function(..., title = NULL, footer = NULL, status = NULL,
                 solidHeader = FALSE, background = NULL, width = 6,
-                height = NULL, collapsible = FALSE, collapsed = FALSE) {
+                height = NULL, collapsible = FALSE, collapsed = FALSE, id = NULL) {
 
   boxClass <- "box"
   if (solidHeader || !is.null(background)) {
@@ -301,6 +306,7 @@ box <- function(..., title = NULL, footer = NULL, status = NULL,
   }
 
   div(class = if (!is.null(width)) paste0("col-sm-", width),
+      id = id,
     div(class = boxClass,
       style = if (!is.null(style)) style,
       headerTag,

R/dashboardSidebar.R

@@ -364,7 +364,7 @@ sidebarMenu <- function(..., id = NULL, .list = NULL) {
 #' @rdname sidebarMenu
 #' @export
 menuItem <- function(text, ..., icon = NULL, badgeLabel = NULL, badgeColor = "green",
-                     tabName = NULL, href = NULL, newtab = TRUE, selected = NULL,
+                     tabName = NULL, href = NULL, newtab = TRUE, selected = NULL, id = NULL,
                      expandedName = as.character(gsub("[[:space:]]", "", text)),
                      startExpanded = FALSE) {
   subItems <- list(...)
@@ -407,7 +407,7 @@ menuItem <- function(text, ..., icon = NULL, badgeLabel = NULL, badgeColor = "gr
   # If no subitems, return a pretty simple tag object
   if (length(subItems) == 0) {
     return(
-      tags$li(
+      tags$li(id = id,
         a(href = href,
           `data-toggle` = if (isTabItem) "tab",
           `data-value` = if (!is.null(tabName)) tabName,
@@ -433,7 +433,7 @@ menuItem <- function(text, ..., icon = NULL, badgeLabel = NULL, badgeColor = "gr
   # this menuItem's `expandedName``
   isExpanded <- nzchar(dataExpanded) && (dataExpanded == expandedName)
 
-  tags$li(class = "treeview",
+  tags$li(class = "treeview", id = id,
     a(href = href,
       icon,
       span(text),
@@ -453,7 +453,7 @@ menuItem <- function(text, ..., icon = NULL, badgeLabel = NULL, badgeColor = "gr
 #' @rdname sidebarMenu
 #' @export
 menuSubItem <- function(text, tabName = NULL, href = NULL, newtab = TRUE,
-  icon = shiny::icon("angle-double-right"), selected = NULL)
+  icon = shiny::icon("angle-double-right"), selected = NULL, id = NULL)
 {
 
   if (!is.null(href) && !is.null(tabName)) {
@@ -476,7 +476,7 @@ menuSubItem <- function(text, tabName = NULL, href = NULL, newtab = TRUE,
   }
 
 
-  tags$li(
+  tags$li( id = id,
     a(href = href,
       `data-toggle` = if (isTabItem) "tab",
       `data-value` = if (!is.null(tabName)) tabName,

tests-manual/dashboardSidebar.R

@@ -16,20 +16,23 @@ sidebar <- dashboardSidebar(
     menuItem(
       "Dashboard",
       tabName = "dashboard",
-      icon = icon("dashboard")
+      icon = icon("dashboard"),
+      id = "dashboardmenuitem"
     ),
     menuItem(
       "Widgets",
       icon = icon("th"),
       tabName = "widgets",
       badgeLabel = "new",
-      badgeColor = "green"
+      badgeColor = "green",
+      id = "widgetsmenuitem"
     ),
     menuItem(
       "Charts",
       icon = icon("bar-chart-o"),
-      menuSubItem("Sub-item 1", tabName = "subitem1"),
-      menuSubItem("Sub-item 2", tabName = "subitem2")
+      menuSubItem("Sub-item 1", tabName = "subitem1", id = "subitem1menuitem"),
+      menuSubItem("Sub-item 2", tabName = "subitem2", id = "subitem2menuitem"),
+      id = "chartsmenuitem"
     )
   )
 )

tests-manual/renderMenu.R

@@ -12,7 +12,7 @@ ui <- dashboardPage(
 server <- function(input, output) {
   output$menu <- renderMenu({
     sidebarMenu(
-      menuItem("Menu item", icon = icon("calendar"))
+      menuItem("Menu item", icon = icon("calendar"), id = "aaa")
     )
   })
 }