Merge pull request #199 from rstudio/barbara/changes

Updates

Author: bborgesr

.Rbuildignore

@@ -1,6 +1,7 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^tools$
+^srcjs$
 ^tests-manual$
 ^\.travis\.yml$
 ^appveyor\.yml$

DESCRIPTION

@@ -18,4 +18,4 @@ Imports:
     shiny (>= 0.12.1),
     htmltools (>= 0.2.6)
 BugReports: https://github.com/rstudio/shinydashboard
-RoxygenNote: 5.0.1
+RoxygenNote: 6.0.1

NEWS.md

@@ -1,8 +1,33 @@
-shinydashboard 0.5.3.9000
+shinydashboard 0.6
 =========================
 
+This release of shinydashboard was aimed at both fixing bugs and also bringing the package up to speed with users' requests and Shiny itself (especially fully bringing [bookmarkable state](https://shiny.rstudio.com/articles/bookmarking-state.html) to shinydashboard's sidebar). In addition to the changes listed below, we also added a [new "Behavior" section to the shinydashboard website](https://rstudio.github.io/shinydashboard/behavior.html) to explain this release's two biggest new features.
+
+
+## Full changelog
+
+### New features
+
+* Address [#179](https://github.com/rstudio/shinydashboard/issues/179) support for bookmarking the expanded/collapsed state of the whole sidebar. (commit [e71c93f](https://github.com/rstudio/shinydashboard/pull/199/commits/e71c93fa7a71f229e725efd4a7867e431cd57679))
+
+* Added Shiny input to keep track of which sidebar `menuItem` is expanded (if any), which makes bookmarking the exact state of the sidebar trivial. (commit [6901b90](https://github.com/rstudio/shinydashboard/pull/199/commits/6901b90b8c866b89d02514cfc01fdfab88175602))
+
+### Minor new features and improvements
+
 * Addressed [#165](https://github.com/rstudio/shinydashboard/issues/165): added a new optional argument, called `headerText` to the `dropdownMenu()` function. If provided by the user, this text (instead of the default) will be shown on the header of the menu (only visible when the menu is expanded). See `?dropdownMenu` for more details. [#207](https://github.com/rstudio/shinydashboard/pull/207)
 
+* Split JS files. (commit [ea91503](https://github.com/rstudio/shinydashboard/pull/199/commits/ea915038ae2126f48c15e3aac41782a22b16c506)). More updates to Gruntfile and structure. (commit [4e80616](https://github.com/rstudio/shinydashboard/pull/199/commits/4e80616c5b3aa0dc73022dc815288b5ba7c35be0))
+
+* Better shown/hidden mechanic for Shiny inputs inside collapsible `menuItem`s. (commit [6901b90](https://github.com/rstudio/shinydashboard/pull/199/commits/6901b90b8c866b89d02514cfc01fdfab88175602))
+
+* Added hack on adminLTE/app.js in order to make the `slideUp`/`slideDown` css transitions look reasonable when its content is initially empty (use case is for hidden Shiny outputs that are not rendered until the first time the `menuItem` is expanded and reveal them -- i.e. first time that `trigger("shown")` is called). (commit [25725a6](https://github.com/rstudio/shinydashboard/pull/199/commits/25725a67ce3dd841786dd82b0e46624c6a7d4722))
+
+* Added manual tests for bookmarking and the shown/hidden events that happen on the sidebar. (commit [9e3e55d](https://github.com/rstudio/shinydashboard/pull/199/commits/9e3e55de8cc63d4bdd179251cd53eeb845441d3d))
+
+### Bug fixes
+
+* Fixed [#71](https://github.com/rstudio/shinydashboard/issues/71) and [#87](https://github.com/rstudio/shinydashboard/issues/87): detect and enforce selected tab for dynamic sidebar menus by calling `ensureActivatedTab()` for these. (commit [9b88a79](https://github.com/rstudio/shinydashboard/pull/199/commits/9b88a790df058432165ca3b483b5bbfe1d267326))
+
 * Fixed [#127](https://github.com/rstudio/shinydashboard/issues/127) and [#177](https://github.com/rstudio/shinydashboard/issues/177): previously, if `dashboardSidebar()` was called with an explicit `width` parameter, mobile rendering would look weird (the sidebar wouldn't completely disappear when it was collapsed, and content in the dashboard body would be hidden under the still-visible sidebar). ([#204](https://github.com/rstudio/shinydashboard/pull/204))
 
 * Fixed [#79](https://github.com/rstudio/shinydashboard/issues/79): Re-enable slight css transition when the sidebar is expanded/collapsed. ([#205](https://github.com/rstudio/shinydashboard/pull/205)).
@@ -15,10 +40,14 @@ shinydashboard 0.5.3.9000
 
 * Fixed [#62](https://github.com/rstudio/shinydashboard/issues/62): make images resize when the sidebar collapses/expands. [#185](https://github.com/rstudio/shinydashboard/pull/185)
 
-* Addressed [#178](https://github.com/rstudio/shinydashboard/issues/178): switch from `npm` to `yarn`. Also upgraded all yarn packages to the `latest` tag (all major changes). [#184](https://github.com/rstudio/shinydashboard/pull/184)
-
 * Fixed [#176](https://github.com/rstudio/shinydashboard/issues/176) (making buttons look good on the sidebar) by giving Shiny action buttons and links some margin space. ([#182](https://github.com/rstudio/shinydashboard/pull/182))
 
+### Library updates
+
+* Update documentation to newest version of roxygen. (commit [#541d3c1](https://github.com/rstudio/shinydashboard/pull/199/commits/541d3c13467446c8e89b178d95b0984729559059))
+
+* Addressed [#178](https://github.com/rstudio/shinydashboard/issues/178): switch from `npm` to `yarn`. Also upgraded all yarn packages to the `latest` tag (all major changes). [#184](https://github.com/rstudio/shinydashboard/pull/184)
+
 * Updated to AdminLTE 2.3.11. ([#181](https://github.com/rstudio/shinydashboard/pull/181))
 
 shinydashboard 0.5.3

R/dashboardPage.R

@@ -57,9 +57,9 @@ dashboardPage <- function(header, sidebar, body, title = NULL,
     body
   )
 
-  # if the sidebar has the class "start-collapsed", it means that the user set
-  # the `collapsed` argument of `dashboardSidebar` to TRUE
-  collapsed <- "start-collapsed" %in% strsplit(sidebar$attribs$class, " ")[[1]]
+  # if the sidebar has the attribute `data-collapsed = "true"`, it means that
+  # the user set the `collapsed` argument of `dashboardSidebar` to TRUE
+  collapsed <- findAttribute(sidebar, "data-collapsed", "true")
 
   addDeps(
     tags$body(

R/dashboardSidebar.R

@@ -117,12 +117,20 @@ dashboardSidebar <- function(..., disable = FALSE, width = NULL, collapsed = FAL
     '))))
   }
 
+  # If we're restoring a bookmarked app, this holds the value of whether or not the
+  # sidebar was collapsed. If this is not the case, the default is whatever the user
+  # specified in the `collapsed` argument.
+  dataValue <- shiny::restoreInput(id = "sidebarCollapsed", default = collapsed)
+  if (disable) dataValue <- TRUE # this is a workaround to fix #209
+  dataValueString <- if (dataValue) "true" else "false"
+
   # The expanded/collapsed state of the sidebar is actually set by adding a
   # class to the body (not to the sidebar). However, it makes sense for the
   # `collapsed` argument to belong in this function. So this information is
-  # just passed through (also as a class) to the `dashboardPage()` function
-  tags$aside(class = paste("main-sidebar", if (collapsed) "start-collapsed"),
-    custom_css,
+  # just passed through (as the `data-collapsed` attribute) to the
+  # `dashboardPage()` function
+  tags$aside(
+    class = "main-sidebar", `data-collapsed` = dataValueString, custom_css,
     tags$section(
       class = "sidebar",
       `data-disable` = if (disable) 1 else NULL,
@@ -236,6 +244,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
@@ -263,7 +278,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)
         }
 
@@ -274,6 +291,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
@@ -328,18 +346,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")
@@ -394,6 +419,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,
@@ -403,7 +440,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))
   )
 }
 

R/deps.R

@@ -13,9 +13,11 @@ appendDependencies <- function(x, value) {
 addDeps <- function(x) {
   if (getOption("shiny.minified", TRUE)) {
     adminLTE_js <- "app.min.js"
+    shinydashboard_js <- "shinydashboard.min.js"
     adminLTE_css <- c("AdminLTE.min.css", "_all-skins.min.css")
   } else {
     adminLTE_js <- "app.js"
+    shinydashboard_js <- "shinydashboard.js"
     adminLTE_css <- c("AdminLTE.css", "_all-skins.css")
   }
 
@@ -28,7 +30,7 @@ addDeps <- function(x) {
     htmlDependency("shinydashboard",
       as.character(utils::packageVersion("shinydashboard")),
       c(file = system.file(package = "shinydashboard")),
-      script = "shinydashboard.js",
+      script = shinydashboard_js,
       stylesheet = "shinydashboard.css"
     )
   )

R/utils.R

@@ -198,3 +198,24 @@ tagMatches <- function(item, ..., id = NULL, name = NULL, class = NULL) {
 
   TRUE
 }
+
+# This function takes a DOM element/tag object and reccurs within it until
+# it finds a child which has an attribute called `attr` and with value `val`
+# (and returns TRUE). If it finds an element with an attribute called `attr`
+# whose value is NOT `val`, it returns FALSE. If it exhausts all children
+# and it doesn't find an element with an attribute called `attr`, it also
+# returns FALSE
+findAttribute <- function(x, attr, val) {
+  if (is.atomic(x)) return(FALSE) # exhausted this branch of the tree
+
+  if (!is.null(x$attribs[[attr]])) { # found attribute called `attr`
+    if (identical(x$attribs[[attr]], val)) return(TRUE)
+    else return(FALSE)
+  }
+
+  if (length(x$children) > 0) { # recursion
+    return(any(unlist(lapply(x$children, findAttribute, attr, val))))
+  }
+
+  return(FALSE) # found no attribute called `attr`
+}