@@ -243,6 +243,13 @@ sidebarSearchForm <- function(textId, buttonId, label = "Search...",
243243# ' @param selected If \code{TRUE}, this \code{menuItem} or \code{menuSubItem}
244244# ' will start selected. If no item have \code{selected=TRUE}, then the first
245245# ' \code{menuItem} will start selected.
246+ # ' @param expandedName A unique name given to each \code{menuItem} that serves
247+ # ' to indicate which one (if any) is currently expanded. (This is only applicable
248+ # ' to \code{menuItem}s that have children and it is mostly only useful for
249+ # ' bookmarking state.)
250+ # ' @param startExpanded Should this \code{menuItem} be expanded on app startup?
251+ # ' (This is only applicable to \code{menuItem}s that have children, and only
252+ # ' one of these can be expanded at any given time).
246253# ' @param ... For menu items, this may consist of \code{\link{menuSubItem}}s.
247254# ' @param .list An optional list containing items to put in the menu Same as the
248255# ' \code{...} arguments, but in list format. This can be useful when working
@@ -270,7 +277,9 @@ sidebarMenu <- function(..., id = NULL, .list = NULL) {
270277 # Given a menuItem and a logical value for `selected`, set the
271278 # data-start-selected attribute to the appropriate value (1 or 0).
272279 selectItem <- function (item , selected ) {
273- if (length(item $ children ) == 0 ) {
280+
281+ # in the cases that the children of menuItems are NOT menuSubItems
282+ if (is.atomic(item ) || length(item $ children ) == 0 ) {
274283 return (item )
275284 }
276285
@@ -281,6 +290,7 @@ sidebarMenu <- function(..., id = NULL, .list = NULL) {
281290 # data-start-selected="1". The []<- assignment is to preserve
282291 # attributes.
283292 item $ children [] <- lapply(item $ children , function (child ) {
293+
284294 # Find the appropriate <a> child
285295 if (tagMatches(child , name = " a" , `data-toggle` = " tab" )) {
286296 child $ attribs [[" data-start-selected" ]] <- value
@@ -335,18 +345,25 @@ sidebarMenu <- function(..., id = NULL, .list = NULL) {
335345 item
336346 })
337347 }
348+ # This is a 0 height div, whose only purpose is to hold the tabName of the currently
349+ # selected menuItem in its `data-value` attribute. This is the DOM element that is
350+ # bound to tabItemInputBinding in the JS side.
351+ items [[length(items ) + 1 ]] <- div(id = id ,
352+ class = " sidebarMenuSelectedTabItem" , `data-value` = selectedTabName %OR % " null" )
338353 }
339354
340355 # Use do.call so that we don't add an extra list layer to the children of the
341356 # ul tag. This makes it a little easier to traverse the tree to search for
342357 # selected items to restore.
343- do.call(tags $ ul , c(id = id , class = " sidebar-menu" , items ))
358+ do.call(tags $ ul , c(class = " sidebar-menu" , items ))
344359}
345360
346361# ' @rdname sidebarMenu
347362# ' @export
348363menuItem <- function (text , ... , icon = NULL , badgeLabel = NULL , badgeColor = " green" ,
349- tabName = NULL , href = NULL , newtab = TRUE , selected = NULL ) {
364+ tabName = NULL , href = NULL , newtab = TRUE , selected = NULL ,
365+ expandedName = as.character(gsub(" [[:space:]]" , " " , text )),
366+ startExpanded = FALSE ) {
350367 subItems <- list (... )
351368
352369 if (! is.null(icon )) tagAssert(icon , type = " i" )
@@ -401,6 +418,18 @@ menuItem <- function(text, ..., icon = NULL, badgeLabel = NULL, badgeColor = "gr
401418 )
402419 }
403420
421+ # If we're restoring a bookmarked app, this holds the value of what menuItem (if any)
422+ # was expanded (this has be to stored separately from the selected menuItem, since
423+ # these actually independent in AdminLTE). If no menuItem was expanded, `dataExpanded`
424+ # is NULL. However, we want to this input to get passed on (and not dropped), so we
425+ # do `%OR% ""` to assure this.
426+ default <- if (startExpanded ) expandedName else " "
427+ dataExpanded <- shiny :: restoreInput(id = " sidebarItemExpanded" , default ) %OR % " "
428+
429+ # If `dataExpanded` is not the empty string, we need to check that it is eqaul to the
430+ # this menuItem's `expandedName``
431+ isExpanded <- nzchar(dataExpanded ) && (dataExpanded == expandedName )
432+
404433 tags $ li(class = " treeview" ,
405434 a(href = href ,
406435 icon ,
@@ -410,7 +439,11 @@ menuItem <- function(text, ..., icon = NULL, badgeLabel = NULL, badgeColor = "gr
410439 # Use do.call so that we don't add an extra list layer to the children of the
411440 # ul tag. This makes it a little easier to traverse the tree to search for
412441 # selected items to restore.
413- do.call(tags $ ul , c(class = " treeview-menu" , subItems ))
442+ do.call(tags $ ul , c(
443+ class = paste0(" treeview-menu" , if (isExpanded ) " menu-open" else " " ),
444+ style = paste0(" display: " , if (isExpanded ) " block;" else " none;" ),
445+ `data-expanded` = expandedName ,
446+ subItems ))
414447 )
415448}
416449
0 commit comments