Introduce asFillContainer() and asFilItem() (#343)

* Introduce asFillContainer() and asFillItem()

* Code review

* `devtools::document()` (GitHub Actions)

* Add some basic unit tests

* Update news

Co-authored-by: cpsievert <[email protected]>

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: htmltools
 Type: Package
 Title: Tools for HTML
-Version: 0.5.3.9000
+Version: 0.5.3.9001
 Authors@R: c(
   person("Joe", "Cheng", role = "aut", email = "[email protected]"),
   person("Carson", "Sievert", role = c("aut", "cre"), email = "[email protected]", comment = c(ORCID = "0000-0002-4958-2844")),
@@ -20,7 +20,8 @@ Imports:
     grDevices,
     base64enc,
     rlang (>= 0.4.10),
-    fastmap (>= 1.1.0)
+    fastmap (>= 1.1.0),
+    ellipsis
 Suggests:
     markdown,
     testthat,
@@ -36,6 +37,7 @@ RoxygenNote: 7.2.1
 Encoding: UTF-8
 Collate:
     'colors.R'
+    'fill.R'
     'html_dependency.R'
     'html_escape.R'
     'html_print.R'

NAMESPACE

@@ -35,6 +35,8 @@ export("htmlDependencies<-")
 export(HTML)
 export(a)
 export(as.tags)
+export(asFillContainer)
+export(asFillItem)
 export(attachDependencies)
 export(br)
 export(browsable)

NEWS.md

@@ -1,10 +1,13 @@
 # htmltools 0.5.3.9000
 
+## New Features
+
+* Added new `asFillContainer()` and `asFillItem()` functions for modifying `tag()` object(s) into tags that are allowed to grow and shrink when their parent is opinionated about their height. See `help(asFillContainer)` for documentation and examples. Note the primary motivation for adding these functions is to power `{bslib}`'s new `card()` API (in particular, [responsive sizing](https://rstudio.github.io/bslib/articles/cards.html#responsive-sizing)) as well as the new `fill` arguments in `shiny::plotOutput()`, `shiny::imageOutput()`, `shiny::uiOutput()`, `htmlwidgets::sizingPolicy()`, and `htmlwidgets::shinyWidgetOutput()`. (#343)
+
 ## Bug fixes
 
 * Closed #331: `copyDependencyToDir()` creates `outputDir` recursively, which happens in Quarto or when `lib_dir` points to a nested directory. (@gadenbuie, #332)
 
-
 # htmltools 0.5.3
 
 ## Breaking changes

R/fill.R

@@ -0,0 +1,112 @@
+#' Allow tags to intelligently fill their container
+#'
+#' Create fill containers and items. If a fill item is a direct child of a fill
+#' container with a fixed height, then the item is allowed to grow and shrink to
+#' its container's size.
+#'
+#' @details `asFillContainer()` changes the CSS `display` property on the tag to
+#'   `flex`, which changes the way it does layout of it's direct children. Thus,
+#'   one should be careful not to mark a tag as a fill container when it needs
+#'   to rely on other `display` behavior.
+#'
+#' @param x a [tag()] object.
+#' @param ... currently unused.
+#' @param height,width Any valid [CSS unit][htmltools::validateCssUnit] (e.g.,
+#'   height="200px").
+#' @param asItem whether or not to also treat the container as an item. This is
+#'   useful if the tag wants to both be a direct child of a fill container and a
+#'   direct parent of a fill item.
+#' @param .cssSelector A character string containing a CSS selector for
+#'   targeting particular (inner) tag(s) of interest. For more details on what
+#'   selector(s) are supported, see [tagAppendAttributes()]
+#'
+#' @returns The original tag object (`x`) with additional attributes (and a
+#'   [htmlDependency()]).
+#'
+#' @export
+#' @examples
+#'
+#' tagz <- div(
+#'   id = "outer",
+#'   style = css(
+#'     height = "600px",
+#'     border = "3px red solid"
+#'   ),
+#'   div(
+#'     id = "inner",
+#'     style = css(
+#'       height = "400px",
+#'       border = "3px blue solid"
+#'     )
+#'   )
+#' )
+#'
+#' # Inner doesn't fill outer
+#' if (interactive()) browsable(tagz)
+#'
+#' tagz <- asFillContainer(tagz)
+#' tagz <- asFillItem(tagz, .cssSelector = "#inner")
+#'
+#' # Inner does fill outer
+#' if (interactive()) browsable(tagz)
+#'
+asFillContainer <- function(x, ..., height = NULL, width = NULL, asItem = FALSE, .cssSelector = NULL) {
+  if (!inherits(x, "shiny.tag")) {
+    return(throwFillWarning(x))
+  }
+
+  ellipsis::check_dots_empty()
+
+  x <- tagAppendAttributes(
+    x, class = "html-fill-container",
+    class = if (asItem) "html-fill-item",
+    style = css(
+      height = validateCssUnit(height),
+      width = validateCssUnit(width)
+    ),
+    .cssSelector = .cssSelector
+  )
+
+  attachDependencies(x, fillDependencies(), append = TRUE)
+}
+
+#' @export
+#' @rdname asFillContainer
+asFillItem <- function(x, ..., height = NULL, width = NULL, .cssSelector = NULL) {
+  if (!inherits(x, "shiny.tag")) {
+    return(throwFillWarning(x, "item"))
+  }
+
+  ellipsis::check_dots_empty()
+
+  tagAppendAttributes(
+    x, class = "html-fill-item",
+    style = css(
+      height = validateCssUnit(height),
+      width = validateCssUnit(width)
+    ),
+    .cssSelector = .cssSelector
+  )
+}
+
+fillDependencies <- function() {
+  htmlDependency(
+    name = "htmltools-fill",
+    version = get_package_version("htmltools"),
+    package = "htmltools",
+    src = "fill",
+    stylesheet = "fill.css"
+  )
+}
+
+throwFillWarning <- function(x, type = "container") {
+  rlang::warn(
+    paste0(
+      "Don't know how to treat an object of type '",
+      class(x)[1], "' as a fill ", type, ". ",
+      "Only a htmltools::tag() object may be treated as a fill ", type
+    ),
+    class = "htmltools_fill_input_type"
+  )
+  x
+}

inst/fill/fill.css

@@ -0,0 +1,12 @@
+.html-fill-container {
+  display: flex;
+  flex-direction: column;
+  overflow: auto;
+  width: 100%;
+}
+
+.html-fill-container > .html-fill-item {
+  flex: 1 1 auto;
+  overflow: auto;
+  width: 100%;
+}

pkgdown/_pkgdown.yml

@@ -97,6 +97,11 @@ reference:
   - '`capturePlot`'
   - '`defaultPngDevice`'
 
+- title: Fill containers
+  contents:
+  - '`asFillContainer`'
+  - '`asFillItem`'
+
 - title: Utilities
   contents:
   - '`css`'

tests/testthat/test-fill.R

@@ -0,0 +1,32 @@
+# Some basic test coverage of asFillContainer() and asFillItem().
+# Note that these expectations aren't as important as the e2e test coverage
+# we'll have via bslib::card(), shiny::plotOutput(), shiny::uiOutput()
+# (those will also be testing the client-side CSS)
+test_that("asFillContainer() and asFillItem()", {
+
+  container <- asFillContainer(div())
+  item <- asFillItem(div())
+  expect_equal(tagGetAttribute(container, "class"), "html-fill-container")
+  expect_equal(tagGetAttribute(item, "class"), "html-fill-item")
+
+  container <- asFillContainer(
+    div(span()), asItem = TRUE, .cssSelector = "span", height = 300
+  )
+  expect_equal(
+    tagGetAttribute(container$children[[1]], "class"),
+    "html-fill-container html-fill-item"
+  )
+  expect_equal(
+    tagGetAttribute(container$children[[1]], "style"),
+    "height:300px;"
+  )
+
+  expect_warning(
+    asFillContainer(tagList()),
+    "Don't know how to treat an object of type"
+  )
+  expect_warning(
+    asFillItem(tagList()),
+    "Don't know how to treat an object of type"
+  )
+})