(Re)-Introducing card(), value_box(), and layout_column_wrap() (#454)

* Port fill logic to htmltools; better organization of Sass code; require BS5 universally for modern components * Updates/fixes * `devtools::document()` (GitHub Actions) * Update to use bindFillRole() * Vignette updates Co-authored-by: cpsievert <[email protected]>
rstudio · Oct 25, 2022 · 035e5f2 · 035e5f2
1 parent 0906a9f
commit 035e5f2
Show file tree

Hide file tree

Showing 17 changed files with 126 additions and 162 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -20,7 +20,7 @@ Description: Simplifies custom 'CSS' styling of both 'shiny' and 'rmarkdown' via
 Depends: R (>= 2.10)
 Imports:
     grDevices,
-    htmltools (>= 0.5.2),
+    htmltools (>= 0.5.3.9001),
     jsonlite,
     sass (>= 0.4.0),
     jquerylib (>= 0.1.3),
@@ -108,8 +108,6 @@ Config/Needs/deploy:
     rsconnect
 Remotes:
     rstudio/bsicons,
+    rstudio/htmltools,
     rstudio/shiny,
-    ramnathv/htmlwidgets,
-    rstudio/DT,
-    rstudio/leaflet,
-    ropensci/plotly
+    ramnathv/htmlwidgets
diff --git a/R/bs-dependencies.R b/R/bs-dependencies.R
@@ -66,12 +66,7 @@ bs_theme_dependencies <- function(
   version <- theme_version(theme)
 
   if (isTRUE(version >= 5)) {
-    shiny_version <- "1.6.0.9001"
-    msg <- sprintf("`bs_theme(version = 5)` is designed to work with shiny %s or higher", shiny_version)
-    if (isNamespaceLoaded("shiny") && !is_installed("shiny", shiny_version)) warning(msg, call. = FALSE)
-    setHook(packageEvent("shiny", "onLoad"), function(...) {
-      if (!is_installed("shiny", shiny_version)) warning(msg, call. = FALSE)
-    })
+    register_runtime_package_check("`bs_theme(version = 5)`", "shiny", "1.7.0")
   }
 
   if (is.character(cache)) {

diff --git a/R/bs-theme.R b/R/bs-theme.R
@@ -270,16 +270,11 @@ bootstrap_bundle <- function(version) {
       # Additions to BS5 that are always included (i.e., not a part of compatibility)
       sass_layer(rules = pandoc_tables),
       bs3compat = bs3compat_bundle(),
-      # card() CSS (can be removed)
-      vfill = sass_layer(
-        rules = sass_file(system_file("components/vfill.scss", package = "bslib"))
-      ),
-      card = sass_layer(
-        rules = sass_file(system_file("components/card.scss", package = "bslib"))
-      ),
-      value_box = sass_layer(
-        rules = sass_file(system_file("components/value-box.scss", package = "bslib"))
-      )
+      !!!rule_bundles(c(
+        system_file("components", "card.scss", package = "bslib"),
+        system_file("components", "value_box.scss", package = "bslib"),
+        system_file("components", "layout_column_wrap.scss", package = "bslib")
+      ))
     ),
     four = sass_bundle(
       sass_layer(

diff --git a/R/card.R b/R/card.R
@@ -60,16 +60,17 @@ card <- function(..., full_screen = FALSE, height = NULL, class = NULL, wrapper
 
   tag <- div(
     class = "card",
-    class = vfill_classes,
-    class = class,
     style = css(height = validateCssUnit(height)),
     !!!attribs,
     !!!children,
     if (full_screen) full_screen_toggle()
   )
 
+  tag <- bindFillRole(tag, container = TRUE, item = TRUE)
+  tag <- tagAppendAttributes(tag, class = class)
+
   as_fragment(
-    tag_require(tag, version = 4, caller = "card()")
+    tag_require(tag, version = 5, caller = "card()")
   )
 }
 
@@ -137,6 +138,9 @@ card_body <- function(..., height = NULL, class = NULL) {
 #' @export
 card_body_fill <- function(..., gap = NULL, max_height = NULL, max_height_full_screen = max_height, min_height = NULL, class = NULL) {
 
+  register_runtime_package_check("`card_body_fill()`", "shiny", "1.7.2.9001")
+  register_runtime_package_check("`card_body_fill()`", "htmlwidgets", "1.5.4.9001")
+
   card_body_(
     fill = TRUE,
     class = class,
@@ -161,18 +165,20 @@ card_title <- function(..., container = htmltools::h5) {
 
 card_body_ <- function(..., fill = TRUE, height = NULL, class = NULL, container = htmltools::div) {
 
-  res <- container(
+  tag <- container(
     class = "card-body",
-    class = if (fill) vfill_classes,
-    class = class,
     style = css(
       height = validateCssUnit(height),
       flex = if (fill) "1 1 auto" else "0 0 auto"
     ),
     ...
   )
 
-  as.card_item(res)
+  tag <- bindFillRole(tag, container = fill, item = fill)
+
+  tag <- tagAppendAttributes(tag, class = class)
+
+  as.card_item(tag)
 }
 
 
@@ -217,8 +223,6 @@ card_image <- function(
   image <- tags$img(
     src = src,
     class = "img-fluid",
-    class = "vfill-item",
-    class = class,
     class = switch(
       match.arg(border_radius),
       all = "card-img",
@@ -233,12 +237,11 @@ card_image <- function(
     ...
   )
 
+  image <- bindFillRole(image, item = TRUE)
+  image <- tagAppendAttributes(image, class = class)
+
   if (!is.null(href)) {
-    image <- tags$a(
-      href = href,
-      class = vfill_classes,
-      image
-    )
+    image <- bindFillRole(tags$a(href = href, image), container = TRUE, item = TRUE)
   }
 
   if (is.function(container)) {

diff --git a/R/files.R b/R/files.R
@@ -46,6 +46,7 @@ bootswatch_sass_file <- function(theme, file, version = version_default()) {
 # Given a vector of sass_file()s, create a list of sass_bundles(),
 # so each rule may be removed layer (by it's files basename)
 rule_bundles <- function(files) {
+  files <- lapply(files, as_sass_file)
   paths <- vapply(files, get_sass_file_path, character(1))
   nms <- tools::file_path_sans_ext(basename(paths))
   Map(
@@ -62,3 +63,7 @@ get_sass_file_path <- function(x) {
 
   stop("Couldn't find file path")
 }
+
+as_sass_file <- function(x) {
+  if (inherits(x, "sass_file")) x else sass_file(x)
+}
diff --git a/R/layout.R b/R/layout.R
@@ -71,45 +71,38 @@ layout_column_wrap <- function(
   }
 
   # Wrap grid items in flex containers for essentially two reasons:
-  #   1. Allow .vfill-item children (e.g. plotOutput("id", height = NULL))
+  #   1. Allow fill item children (e.g. plotOutput("id", fill = TRUE))
   #      to fill the grid row.
   #   2. Allow for fill=FALSE, which useful for allowing contents to
   #      shrink but not grow (i.e., default flex behavior).
   children <- lapply(children, function(x) {
-    div(
-      class = "vfill-container",
-      div(
-        class = "vfill-container",
-        class = if (fill) "vfill-item",
-        x
-      )
+    bindFillRole(
+      container = TRUE,
+      div(bindFillRole(div(x), container = TRUE, item = fill))
     )
   })
 
   tag <- div(
-    class = "bslib-grid-layout",
-    class = "vfill-item",
-    class = class,
+    class = "bslib-column-wrap",
     style = css(
       grid_template_columns = colspec,
       grid_auto_rows = if (heights_equal == "all") "1fr",
       # Always provide the `height:auto` default so that the CSS variable
       # doesn't get inherited in a scenario like layout_column_wrap(height=200, ..., layout_column_wrap(...))
-      "--bslib-grid-layout-height" = validateCssUnit(height %||% "auto"),
-      "--bslib-grid-layout-height-mobile" = validateCssUnit(height_mobile %||% "auto"),
+      "--bslib-column-wrap-height" = validateCssUnit(height %||% "auto"),
+      "--bslib-column-wrap-height-mobile" = validateCssUnit(height_mobile %||% "auto"),
       gap = validateCssUnit(gap)
     ),
     !!!attribs,
     children
   )
 
+  tag <- bindFillRole(tag, item = TRUE)
+  tag <- tagAppendAttributes(tag, class = class)
   tag <- as.card_item(tag)
 
   as_fragment(
-    tag_require(tag, version = 4, caller = "layout_column_wrap()")
+    tag_require(tag, version = 5, caller = "layout_column_wrap()")
   )
 }
 
-
-
-vfill_classes <- c("vfill-container", "vfill-item")
diff --git a/R/navs.R b/R/navs.R
@@ -84,8 +84,8 @@ collect_nav_items <- function(..., wrapper) {
 
 navs_card_body <- function(tabs) {
 
-  tabs <- tagAppendAttributes(tabs, class = vfill_classes, .cssSelector = ".tab-content")
-  tabs <- tagAppendAttributes(tabs, class = vfill_classes, .cssSelector = ".tab-content > *")
+  tabs <- bindFillRole(tabs, .cssSelector = ".tab-content", container = TRUE, item = TRUE)
+  tabs <- bindFillRole(tabs, .cssSelector = ".tab-content > *", container = TRUE, item = TRUE)
 
   content <- tagQuery(tabs)$find(".tab-content")$selectedTags()
 

diff --git a/R/utils.R b/R/utils.R
@@ -47,6 +47,24 @@ is_shiny_runtime <- function() {
   isTRUE(grepl("^shiny", knitr::opts_knit$get("rmarkdown.runtime")))
 }
 
+register_runtime_package_check <- function(feature, pkg, version) {
+  msg <- sprintf(
+    "%s is designed to work with %s %s or higher",
+    feature, pkg, version
+  )
+
+  if (isNamespaceLoaded(pkg) && !is_installed(pkg, version)) {
+    warning(msg, call. = FALSE)
+  }
+
+  setHook(
+    packageEvent(pkg, "onLoad"),
+    function(...) {
+      if (!is_installed(pkg, version)) warning(msg, call. = FALSE)
+    }
+  )
+}
+
 add_class <- function(x, y) {
   class(x) <- unique(c(y, oldClass(x)))
   x

diff --git a/R/value-box.R b/R/value-box.R
@@ -54,13 +54,8 @@ value_box <- function(title, value, ..., showcase = NULL, showcase_layout = show
     value  <- tags$span(value, class = "h2 mb-2")
   }
 
-  contents <- div(
-    class = "value-box-area",
-    class = vfill_classes,
-    title,
-    value,
-    !!!children
-  )
+  contents <- div(class = "value-box-area", title, value, !!!children)
+  contents <- bindFillRole(contents, container = TRUE, item = TRUE)
 
   if (!is.null(showcase)) {
     contents <- showcase_layout(showcase, contents)
@@ -116,7 +111,6 @@ showcase_layout_ <- function(width, max_height, max_height_full_screen, top_righ
 
     showcase_container <- div(
       class = "value-box-showcase",
-      class = vfill_classes,
       class = if (top_right) "showcase-top-right",
       style = css(
         "--bslib-value-box-max-height" = max_height,
@@ -125,6 +119,8 @@ showcase_layout_ <- function(width, max_height, max_height_full_screen, top_righ
       showcase
     )
 
+    showcase_container <- bindFillRole(showcase_container, container = TRUE, item = TRUE)
+
     if (!top_right) {
       contents <- tagAppendAttributes(contents, class = "border-start")
     }

diff --git a/inst/components/card.scss b/inst/components/card.scss
@@ -1,20 +1,3 @@
-.bslib-grid-layout {
-  display: grid !important;
-  gap: $spacer;
-  height: var(--bslib-grid-layout-height);
-  // This undoes the margin-bottom added below
-  .card {
-    margin-bottom: 0;
-  }
-}
-
-@include media-breakpoint-down(sm) {
-  .bslib-grid-layout {
-    grid-template-columns: 1fr !important;
-    height: var(--bslib-grid-layout-height-mobile);
-  }
-}
-
 .card {
   margin-bottom: $spacer;
 
@@ -59,19 +42,40 @@
   .card-footer {
     margin-top: auto;
   }
-}
 
-// For navs_tab_card(title = ...)
-.bslib-card-title {
-  display: flex;
-  flex-wrap: wrap;
-  justify-content: space-between;
-  align-items: center;
-  .nav {
-    margin-left: auto;
+  // For navs_tab_card(title = ...)
+  .bslib-card-title {
+    display: flex;
+    flex-wrap: wrap;
+    justify-content: space-between;
+    align-items: center;
+    .nav {
+      margin-left: auto;
+    }
+  }
+
+  .tab-content {
+    // Workaround for pkgdown's CSS to make tab-pane all a consistent height
+    // https://github.com/r-lib/pkgdown/blob/956f07/inst/BS5/assets/pkgdown.scss#L342-L355
+    > .tab-pane.html-fill-container {
+      display: none;
+    }
+
+    // Take precedence over Bootstrap's `display:block` rule
+    > .active.html-fill-container {
+      display: flex;
+    }
+
+    // Another workaround for pkgdown adding extra padding we didn't ask for
+    // https://github.com/r-lib/pkgdown/blob/956f07/inst/BS5/assets/pkgdown.scss#L335-L337
+    &.html-fill-container {
+      padding: 0;
+    }
   }
 }
 
+
+
 /*************************************************
 * Full screen card logic
 *************************************************/

diff --git a/inst/components/layout_column_wrap.scss b/inst/components/layout_column_wrap.scss
@@ -0,0 +1,17 @@
+.bslib-column-wrap {
+  display: grid !important;
+  gap: $spacer;
+  height: var(--bslib-column-wrap-height);
+  // Vanilla Bootstrap doesn't have a margin-bottom, but bslib's
+  // does (as long as it appears outside of a grid)
+  .card {
+    margin-bottom: 0;
+  }
+}
+
+@include media-breakpoint-down(sm) {
+  .bslib-column-wrap {
+    grid-template-columns: 1fr !important;
+    height: var(--bslib-column-wrap-height-mobile);
+  }
+}
diff --git a/inst/components/value-box.scss → inst/components/value_box.scss b/inst/components/value-box.scss → inst/components/value_box.scss
diff --git a/inst/components/vfill.scss b/inst/components/vfill.scss