JS changes are now captured in main.ts

DESCRIPTION

@@ -170,6 +170,7 @@ Collate:
     'mock-session.R'
     'modal.R'
     'modules.R'
+    'navtreePanel.R'
     'notifications.R'
     'priorityqueue.R'
     'progress.R'

NAMESPACE

@@ -175,6 +175,7 @@ export(moduleServer)
 export(navbarMenu)
 export(navbarPage)
 export(navlistPanel)
+export(navtreePanel)
 export(nearPoints)
 export(need)
 export(ns.sep)

R/navtreePanel.R

@@ -0,0 +1,159 @@
+#' @export
+navtreePanel <- function(..., id = NULL,
+                          selected = NULL,
+                          fluid = TRUE,
+                         # Also allow for string to determine padding in a flex layout?
+                          widths = c(3, 9)) {
+  # TODO: how to incorporate this into a sidebar layout?
+
+  if (!is.null(id))
+    selected <- restoreInput(id = id, default = selected)
+
+  tabset <- buildTreePanel(..., ulClass = "nav nav-navtree", id = id, selected = selected)
+
+  row <- if (fluid) fluidRow else fixedRow
+
+  navList <- attachDependencies(
+    tabset$navList,
+    bslib::bs_dependency_defer(navtreeCssDependency)
+  )
+
+  row(
+    column(widths[[1]], navList),
+    column(widths[[2]], tabset$content)
+  )
+}
+
+
+# Algorithm inspired by buildTabset() but we need different HTML/CSS,
+# and menus are rendered as collapse toggles instead of Bootstrap dropdowns
+buildTreePanel <- function(..., ulClass, id = NULL, selected = NULL, foundSelected = FALSE, depth = 0) {
+
+  tabs <- list2(...)
+  res <- findAndMarkSelectedTab(tabs, selected, foundSelected)
+  tabs <- res$tabs
+  foundSelected <- res$foundSelected
+
+  # add input class if we have an id
+  if (!is.null(id)) ulClass <- paste(ulClass, "shiny-tab-input")
+
+  if (anyNamed(tabs)) {
+    nms <- names(tabs)
+    nms <- nms[nzchar(nms)]
+    stop("Tabs should all be unnamed arguments, but some are named: ",
+         paste(nms, collapse = ", "))
+  }
+
+  tabsetId <- p_randomInt(1000, 10000)
+  tabs <- lapply(
+    seq_len(length(tabs)), buildTreeItem,
+    tabsetId = tabsetId,
+    foundSelected = foundSelected,
+    tabs = tabs, depth = depth
+  )
+
+  list(
+    navList = tags$ul(
+      class = ulClass, id = id,
+      `data-tabsetid` = tabsetId,
+      !!!lapply(tabs, "[[", "liTag")
+    ),
+    content = div(
+      class = "tab-content",
+      `data-tabsetid` = tabsetId,
+      !!!lapply(tabs, "[[", "divTag")
+    )
+  )
+}
+
+buildTreeItem <- function(index, tabsetId, foundSelected, tabs = NULL, divTag = NULL, depth = 0) {
+  divTag <- divTag %||% tabs[[index]]
+
+  subMenuPadding <- if (depth > 0) css(padding_left = paste0(depth * 1.25, "rem"))
+
+  if (isNavbarMenu(divTag)) {
+    icon <- getIcon(iconClass = divTag$iconClass)
+    if (!is.null(icon)) {
+      warning("Configurable icons are not yet supported in navtreePanel().")
+    }
+    tabset <- buildTreePanel(
+      !!!divTag$tabs, ulClass = "nav nav-navtree",
+      foundSelected = foundSelected, depth = depth + 1
+    )
+    # Sort of like .dropdown in the tabsetPanel() case,
+    # but utilizes collapsing (which is recursive) instead of dropdown
+    active <- containsSelectedTab(divTag$tabs)
+    menuId <- paste0("collapse-", p_randomInt(1000, 10000))
+    liTag <- tags$li(
+      tags$a(
+        class = if (!active) "collapsed",
+        "data-toggle" = "collapse",
+        "data-value" = divTag$menuName,
+        "data-target" = paste0("#", menuId),
+        role = "button",
+        style = subMenuPadding,
+        getIcon(iconClass = divTag$iconClass),
+        divTag$title
+      ),
+      div(
+        class = "collapse",
+        class = if (active) "show in",
+        id = menuId,
+        tabset$navList
+      )
+    )
+    return(list(liTag = liTag, divTag = tabset$content$children))
+  }
+
+  if (isTabPanel(divTag)) {
+    # Borrow from the usual nav logic so we get the right
+    # li.active vs li > a.active (BS4) markup
+    navItem <- buildNavItem(divTag, tabsetId, index)
+    liTag <- navItem$liTag
+    return(
+      list(
+        divTag = navItem$divTag,
+        liTag = tagFunction(function() {
+          # Incoming liTag should be a tagFunction()
+          liTag <- if (inherits(liTag, "shiny.tag.function")) liTag() else liTag
+
+          # Add padding for sub menu anchors
+          liTag$children[[1]] <- tagAppendAttributes(
+            liTag$children[[1]], style = subMenuPadding
+          )
+
+          liTag
+        })
+      )
+    )
+  }
+
+  abort("navtreePanel() items must be tabPanel()s and/or tabPanelMenu()s")
+}
+
+
+navtreeCssDependency <- function(theme) {
+  name <- "navtreePanel"
+  version <- packageVersion("shiny")
+  if (!is_bs_theme(theme)) {
+    # TODO: Should we allow navtreePanel() to be statically rendered?
+    # Can/should we move away from href="shared/*"?
+    htmlDependency(
+      name = name, version = version,
+      src = c(href = "shared/navtree", file = "www/shared/navtree"),
+      package = "shiny",
+      stylesheet = "navtree.css",
+      script = "navtree.js"
+    )
+  } else {
+    navtree <- system.file(package = "shiny", "www/shared/navtree")
+    bslib::bs_dependency(
+      sass::sass_file(file.path(navtree, "navtree.scss")),
+      theme = theme,
+      name = name,
+      version = version,
+      cache_key_extra = version,
+      .dep_args = list(script = file.path(navtree, "navtree.js"))
+    )
+  }
+}

inst/www/shared/navtree/navtree.css

@@ -0,0 +1,50 @@
+.nav-navtree {
+  display: block !important;
+}
+
+.nav-navtree li.active, .nav-navtree li > a.active, .nav-navtree li a:focus {
+  font-weight: 600;
+  background-color: rgba(0, 123, 255, 0.3) !important;
+  color: rgba(33, 37, 41, 0.85);
+}
+
+.nav-navtree li:not(.active) > a:not(.active):hover {
+  background-color: rgba(33, 37, 41, 0.1);
+}
+
+.nav-navtree li a {
+  display: inline-flex !important;
+  align-items: center !important;
+  width: 100% !important;
+  padding: .1875rem .5rem;
+  border: 1px solid #dee2e6 !important;
+  color: rgba(33, 37, 41, 0.65) !important;
+  text-decoration: none !important;
+}
+
+.nav-navtree li a i {
+  padding-right: 1.25rem !important;
+}
+
+.nav-navtree li a[data-toggle="collapse"]::before {
+  width: 1.25em;
+  line-height: 0;
+  content: url("data:image/svg+xml,%3csvg xmlns='http://www.w3.org/2000/svg' width='16' height='16' viewBox='0 0 16 16'%3e%3cpath fill='none' stroke='rgba%2833, 37, 41, 0.5%29' stroke-linecap='round' stroke-linejoin='round' stroke-width='2' d='M5 14l6-6-6-6'/%3e%3c/svg%3e");
+  transition: transform 0.35s ease;
+  transform-origin: .5em 50%;
+  padding-right: 1rem;
+}
+
+@media (prefers-reduced-motion: reduce) {
+  .nav-navtree li a[data-toggle="collapse"]::before {
+    transition: none;
+  }
+}
+
+.nav-navtree li a[data-toggle="collapse"]:not(.collapsed) {
+  color: rgba(33, 37, 41, 0.85);
+}
+
+.nav-navtree li a[data-toggle="collapse"]:not(.collapsed)::before {
+  transform: rotate(90deg);
+}

inst/www/shared/navtree/navtree.js

@@ -0,0 +1,11 @@
+// nav-navtree is built on a combination of Bootstrap's tab &
+// collapse components, but the tab component isn't smart enough to
+// know about the deactive when are activated. Note that this logic also
+// exists in input_binding_tabinput.js and is repeated here in case this
+// component wants to be statically rendered
+$(document).on("shown.bs.tab", ".nav-navtree", function(e) {
+  var tgt = $(e.target);
+  var nav =  tgt.parents(".nav-navtree");
+  nav.find("li").not(tgt).removeClass("active"); // BS3
+  nav.find("li > a").not(tgt).removeClass("active"); // BS4
+});

inst/www/shared/navtree/navtree.scss

@@ -0,0 +1,66 @@
+// Inspired by BS5's sidebar nav
+// https://github.com/twbs/bootstrap/blob/548be2e/site/assets/scss/_sidebar.scss#L7
+// As well as
+// https://chniter.github.io/bstreeview/
+
+$body-color: $text-color !default; // BS3compat
+$link-decoration: none !default;
+$link-hover-decoration: underline !default;
+
+$sidebar-collapse-icon-color: rgba($body-color, 0.5) !default;
+$sidebar-collapse-icon: url("data:image/svg+xml,<svg xmlns='http://www.w3.org/2000/svg' width='16' height='16' viewBox='0 0 16 16'><path fill='none' stroke='#{$sidebar-collapse-icon-color}' stroke-linecap='round' stroke-linejoin='round' stroke-width='2' d='M5 14l6-6-6-6'/></svg>") !default;
+
+// TODO: make this more configurable from the R side?
+$navtree-anchor-color: rgba($body-color, .65) !default;
+$navtree-active-bg: rgba($component-active-bg, .3) !default;
+$navtree-active-color: rgba($body-color, .85) !default;
+
+.nav-navtree {
+  // Override collapse behaviors
+  display: block !important;
+
+  li {
+    // Handle both li.active (BS3) and li > a.active (BS4)
+    &.active, > a.active, a:focus {
+      font-weight: 600;
+      background-color: $navtree-active-bg !important;
+      color: $navtree-active-color;
+    }
+    &:not(.active) > a:not(.active):hover {
+      background-color: rgba($body-color, .1);
+    }
+
+    a {
+      display: inline-flex !important; // Needed for centering/transforming the collapse icon
+      align-items: center !important;
+      width: 100% !important;
+      padding: .1875rem .5rem;
+      border: $border-width solid $border-color !important;
+      color: $navtree-anchor-color !important;
+      text-decoration: none !important;
+      i {
+        padding-right: 1.25rem !important;
+      }
+      // Add chevron if there's a submenu
+      &[data-toggle="collapse"] {
+        &::before {
+          width: 1.25em;
+          line-height: 0; // Align in the middle
+          content: escape-svg($sidebar-collapse-icon);
+          @include transition(transform .35s ease);
+          transform-origin: .5em 50%;
+          padding-right: 1rem;
+        }
+
+        &:not(.collapsed) {
+          color: $navtree-active-color;
+          &::before {
+            transform: rotate(90deg);
+          }
+        }
+      }
+    } // a
+
+  } // li
+
+} // nav

inst/www/shared/shiny.js

@@ -3086,6 +3086,22 @@
             $tabContent[0].appendChild(el);
             Shiny.renderContent(el, el.innerHTML || el.textContent);
           });
+          if ($tabset.hasClass("nav-navtree") && $liTag.hasClass("dropdown")) {
+            var collapseId = "collapse-" + tabsetId + "-" + getTabIndex($tabset, tabsetId);
+            $tabset.find(".dropdown").each(function(i, el) {
+              var $el = import_jquery6.default(el).removeClass("dropdown nav-item");
+              $el.find(".dropdown-toggle").removeClass("dropdown-toggle nav-link").addClass(message.select ? "" : "collapsed").attr("data-toggle", "collapse").attr("data-target", "#" + collapseId);
+              var collapse = import_jquery6.default("<div>").addClass("collapse" + (message.select ? " show" : "")).attr("id", collapseId);
+              var menu = $el.find(".dropdown-menu").removeClass("dropdown-menu").addClass("nav nav-navtree").wrap(collapse);
+              var depth = $el.parents(".nav-navtree").length - 1;
+              if (depth > 0) {
+                $el.find("a").css("padding-left", depth + "rem");
+              }
+              if (menu.find("li").length === 0) {
+                menu.find("a").removeClass("dropdown-item").addClass("nav-link").wrap("<li class='nav-item'></li>");
+              }
+            });
+          }
           if (message.select) {
             $liTag.find("a").tab("show");
           }
@@ -6108,6 +6124,7 @@
             anchors.each(function() {
               if (self2._getTabName(import_jquery6.default(this)) === value) {
                 import_jquery6.default(this).tab("show");
+                import_jquery6.default(this).parents(".collapse").collapse("show");
                 success = true;
                 return false;
               }
@@ -6129,7 +6146,9 @@
           import_jquery6.default(el).trigger("change");
         },
         subscribe: function subscribe(el, callback) {
+          var deactivateOtherTabs = this._deactivateOtherTabs;
           import_jquery6.default(el).on("change shown.bootstrapTabInputBinding shown.bs.tab.bootstrapTabInputBinding", function(event) {
+            deactivateOtherTabs(event);
             callback();
           });
         },
@@ -6138,6 +6157,12 @@
         },
         _getTabName: function _getTabName(anchor) {
           return anchor.attr("data-value") || anchor.text();
+        },
+        _deactivateOtherTabs: function _deactivateOtherTabs(event) {
+          var tgt = import_jquery6.default(event.target);
+          var nav = tgt.parents(".nav-navtree");
+          nav.find("li").not(tgt).removeClass("active");
+          nav.find("li > a").not(tgt).removeClass("active");
         }
       });
       inputBindings.register(bootstrapTabInputBinding, "shiny.bootstrapTabInput");

srcts/src/main.ts

@@ -1407,6 +1407,50 @@ function main(): void {
         Shiny.renderContent(el, el.innerHTML || el.textContent);
       });
 
+      // If we're inserting a navbarMenu() into a navtreePanel() target, we need
+      // to transform buildTabset() output (i.e., a .dropdown component) to
+      // buildTreePanel() output (i.e., a .collapse component), because
+      // insertTab() et al. doesn't know about the relevant tabset container
+      if ($tabset.hasClass("nav-navtree") && $liTag.hasClass("dropdown")) {
+        let collapseId =
+          "collapse-" + tabsetId + "-" + getTabIndex($tabset, tabsetId);
+
+        $tabset.find(".dropdown").each(function (i, el) {
+          let $el = $(el).removeClass("dropdown nav-item");
+
+          $el
+            .find(".dropdown-toggle")
+            .removeClass("dropdown-toggle nav-link")
+            .addClass(message.select ? "" : "collapsed")
+            .attr("data-toggle", "collapse")
+            .attr("data-target", "#" + collapseId);
+
+          let collapse = $("<div>")
+            .addClass("collapse" + (message.select ? " show" : ""))
+            .attr("id", collapseId);
+
+          let menu = $el
+            .find(".dropdown-menu")
+            .removeClass("dropdown-menu")
+            .addClass("nav nav-navtree")
+            .wrap(collapse);
+
+          let depth = $el.parents(".nav-navtree").length - 1;
+
+          if (depth > 0) {
+            $el.find("a").css("padding-left", depth + "rem");
+          }
+
+          if (menu.find("li").length === 0) {
+            menu
+              .find("a")
+              .removeClass("dropdown-item")
+              .addClass("nav-link")
+              .wrap("<li class='nav-item'></li>");
+          }
+        });
+      }
+
       if (message.select) {
         $liTag.find("a").tab("show");
       }
@@ -5925,6 +5969,8 @@ function main(): void {
         anchors.each(function () {
           if (self._getTabName($(this)) === value) {
             $(this).tab("show");
+            // navtreePanel()'s navbarMenu() uses collapsing -- expand the menu when activated!
+            $(this).parents(".collapse").collapse("show");
             success = true;
             return false; // Break out of each()
           }
@@ -5945,9 +5991,12 @@ function main(): void {
       $(el).trigger("change");
     },
     subscribe: function (el, callback) {
+      let deactivateOtherTabs = this._deactivateOtherTabs;
+
       $(el).on(
         "change shown.bootstrapTabInputBinding shown.bs.tab.bootstrapTabInputBinding",
         function (event) {
+          deactivateOtherTabs(event);
           callback();
         }
       );
@@ -5958,6 +6007,17 @@ function main(): void {
     _getTabName: function (anchor) {
       return anchor.attr("data-value") || anchor.text();
     },
+    // nav-navtree is built on a combination of Bootstrap's tab &
+    // collapse components, but the tab component isn't smart enough to
+    // know about the deactive when are activated. Note that this logic is
+    // very similar to shinydashboard's deactivateOtherTabs() (in tab.js)
+    _deactivateOtherTabs: function (event) {
+      let tgt = $(event.target);
+      let nav = tgt.parents(".nav-navtree");
+
+      nav.find("li").not(tgt).removeClass("active"); // BS3
+      nav.find("li > a").not(tgt).removeClass("active"); // BS4
+    },
   });
   inputBindings.register(bootstrapTabInputBinding, "shiny.bootstrapTabInput");
 

tools/updateNavTreeList.R

@@ -0,0 +1,15 @@
+library(sass)
+home <- rprojroot::find_package_root_file("inst/www/shared/navtree")
+# TODO: write a unit test
+withr::with_dir(
+  home, {
+    sass_partial(
+      sass_file("navtree.scss"),
+      bslib::bs_theme(),
+      output = "navtree.css",
+      cache = FALSE,
+      write_attachments = FALSE
+    )
+  }
+)
+