* Added Shiny input to keep track of which sidebar menuItem is expand…

…ed (if any), which makes bookmarking the exact state of the sidebar trivial.

* Better shown/hidden mechanic for Shiny inputs inside collapsible menuItems.

R/dashboardSidebar.R

@@ -243,6 +243,13 @@ sidebarSearchForm <- function(textId, buttonId, label = "Search...",
 #' @param selected If \code{TRUE}, this \code{menuItem} or \code{menuSubItem}
 #'   will start selected. If no item have \code{selected=TRUE}, then the first
 #'   \code{menuItem} will start selected.
+#' @param expandedName A unique name given to each \code{menuItem} that serves
+#'   to indicate which one (if any) is currently expanded. (This is only applicable
+#'   to \code{menuItem}s that have children and it is mostly only useful for
+#'   bookmarking state.)
+#' @param startExpanded Should this \code{menuItem} be expanded on app startup?
+#'   (This is only applicable to \code{menuItem}s that have children, and only
+#'   one of these can be expanded at any given time).
 #' @param ... For menu items, this may consist of \code{\link{menuSubItem}}s.
 #' @param .list An optional list containing items to put in the menu Same as the
 #'   \code{...} arguments, but in list format. This can be useful when working
@@ -270,7 +277,9 @@ sidebarMenu <- function(..., id = NULL, .list = NULL) {
       # Given a menuItem and a logical value for `selected`, set the
       # data-start-selected attribute to the appropriate value (1 or 0).
       selectItem <- function(item, selected) {
-        if (length(item$children) == 0) {
+
+        # in the cases that the children of menuItems are NOT menuSubItems
+        if (is.atomic(item) || length(item$children) == 0) {
           return(item)
         }
 
@@ -281,6 +290,7 @@ sidebarMenu <- function(..., id = NULL, .list = NULL) {
         # data-start-selected="1". The []<- assignment is to preserve
         # attributes.
         item$children[] <- lapply(item$children, function(child) {
+
           # Find the appropriate <a> child
           if (tagMatches(child, name = "a", `data-toggle` = "tab")) {
             child$attribs[["data-start-selected"]] <- value
@@ -335,18 +345,25 @@ sidebarMenu <- function(..., id = NULL, .list = NULL) {
         item
       })
     }
+    # This is a 0 height div, whose only purpose is to hold the tabName of the currently
+    # selected menuItem in its `data-value` attribute. This is the DOM element that is
+    # bound to tabItemInputBinding in the JS side.
+    items[[length(items) + 1]] <- div(id = id,
+      class = "sidebarMenuSelectedTabItem", `data-value` = selectedTabName %OR% "null")
   }
 
   # Use do.call so that we don't add an extra list layer to the children of the
   # ul tag. This makes it a little easier to traverse the tree to search for
   # selected items to restore.
-  do.call(tags$ul, c(id = id, class = "sidebar-menu", items))
+  do.call(tags$ul, c(class = "sidebar-menu", items))
 }
 
 #' @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,
+                     expandedName = as.character(gsub("[[:space:]]", "", text)),
+                     startExpanded = FALSE) {
   subItems <- list(...)
 
   if (!is.null(icon)) tagAssert(icon, type = "i")
@@ -401,6 +418,18 @@ menuItem <- function(text, ..., icon = NULL, badgeLabel = NULL, badgeColor = "gr
     )
   }
 
+  # If we're restoring a bookmarked app, this holds the value of what menuItem (if any)
+  # was expanded (this has be to stored separately from the selected menuItem, since
+  # these actually independent in AdminLTE). If no menuItem was expanded, `dataExpanded`
+  # is NULL. However, we want to this input to get passed on (and not dropped), so we
+  # do `%OR% ""` to assure this.
+  default <- if (startExpanded) expandedName else ""
+  dataExpanded <- shiny::restoreInput(id = "sidebarItemExpanded", default) %OR% ""
+
+  # If `dataExpanded` is not the empty string, we need to check that it is eqaul to the
+  # this menuItem's `expandedName``
+  isExpanded <- nzchar(dataExpanded) && (dataExpanded == expandedName)
+
   tags$li(class = "treeview",
     a(href = href,
       icon,
@@ -410,7 +439,11 @@ menuItem <- function(text, ..., icon = NULL, badgeLabel = NULL, badgeColor = "gr
     # Use do.call so that we don't add an extra list layer to the children of the
     # ul tag. This makes it a little easier to traverse the tree to search for
     # selected items to restore.
-    do.call(tags$ul, c(class = "treeview-menu", subItems))
+    do.call(tags$ul, c(
+      class = paste0("treeview-menu", if (isExpanded) " menu-open" else ""),
+      style = paste0("display: ",     if (isExpanded) "block;" else "none;"),
+      `data-expanded` = expandedName,
+      subItems))
   )
 }