From 6ffed45693f9a160ec27d06de654df1d3b04dacc Mon Sep 17 00:00:00 2001 From: Carson Date: Tue, 25 Oct 2022 12:29:40 -0500 Subject: [PATCH 1/2] Remove asFillContainer()/asFillItem() in favor of bindFillRole() --- NAMESPACE | 3 +- R/fill.R | 117 +++++++++++--------- man/{asFillContainer.Rd => bindFillRole.Rd} | 43 ++++--- pkgdown/_pkgdown.yml | 5 +- tests/testthat/test-fill.R | 50 ++++++--- 5 files changed, 120 insertions(+), 98 deletions(-) rename man/{asFillContainer.Rd => bindFillRole.Rd} (54%) diff --git a/NAMESPACE b/NAMESPACE index a49a4db4..1ff7f08f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -35,9 +35,8 @@ export("htmlDependencies<-") export(HTML) export(a) export(as.tags) -export(asFillContainer) -export(asFillItem) export(attachDependencies) +export(bindFillRole) export(br) export(browsable) export(capturePlot) diff --git a/R/fill.R b/R/fill.R index 3c9e22bf..1e0c5584 100644 --- a/R/fill.R +++ b/R/fill.R @@ -4,21 +4,19 @@ #' 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 x a [tag()] object. Can also be a valid [tagQuery()] input if `.cssSelector` is specified. #' @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 item whether or not to treat `x` as a fill item. +#' @param container whether or not to treat `x` as a fill container. Note this +#' will 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 overwrite whether or not to override previous calls to +#' `bindFillRole()` (e.g., to remove the item/container role from a tag). #' @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()] +#' selector(s) are supported, see [tagAppendAttributes()]. #' #' @returns The original tag object (`x`) with additional attributes (and a #' [htmlDependency()]). @@ -44,51 +42,76 @@ #' # Inner doesn't fill outer #' if (interactive()) browsable(tagz) #' -#' tagz <- asFillContainer(tagz) -#' tagz <- asFillItem(tagz, .cssSelector = "#inner") +#' tagz <- bindFillRole(tagz, container = TRUE) +#' tagz <- bindFillRole(tagz, item = FALSE, .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)) - } +bindFillRole <- function(x, ..., item = FALSE, container = FALSE, overwrite = FALSE, .cssSelector = NULL) { ellipsis::check_dots_empty() + hasSelection <- FALSE + query <- NULL + if (!is.null(.cssSelector)) { + + try(silent = TRUE, { + query <- tagQuery(x)$find(.cssSelector) + hasSelection <- length(query$selectedTags()) > 0 + }) + + if (!hasSelection) { + rlang::warn( + paste0( + "`bindFillRole()` didn't find any tags matching the .cssSelector: '", .cssSelector, "'. ", + "Thus, it won't apply any fill roles." + ), + class = "htmltools_fill_role_selector" + ) + return(x) + } + } + + if (!(inherits(x, "shiny.tag") || hasSelection)) { + rlang::warn( + paste0( + "`bindFillRole()` only works on htmltools::tag() objects (e.g., div(), p(), etc.), ", + "not objects of type '", class(x)[1], "'. " + ), + class = "htmltools_fill_role_object" + ) + return(x) + } + x <- tagAppendAttributes( - x, class = "html-fill-container", - class = if (asItem) "html-fill-item", - style = css( - height = validateCssUnit(height), - width = validateCssUnit(width) - ), - .cssSelector = .cssSelector + x, .cssSelector = .cssSelector, + class = if (item) "html-fill-item", + class = if (container) "html-fill-container" ) - attachDependencies(x, fillDependencies(), append = TRUE) -} + if (container) { + x <- 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")) + if (!overwrite) { + return(x) } - ellipsis::check_dots_empty() + query <- query %||% tagQuery(x) - tagAppendAttributes( - x, class = "html-fill-item", - style = css( - height = validateCssUnit(height), - width = validateCssUnit(width) - ), - .cssSelector = .cssSelector - ) + # removeClass() removes all occurrences of a given class + if (!item) { + query <- query$removeClass("html-fill-item") + } + if (!container) { + query <- query$removeClass("html-fill-container") + } + + query$allTags() } + fillDependencies <- function() { htmlDependency( name = "htmltools-fill", @@ -98,15 +121,3 @@ fillDependencies <- function() { 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 -} diff --git a/man/asFillContainer.Rd b/man/bindFillRole.Rd similarity index 54% rename from man/asFillContainer.Rd rename to man/bindFillRole.Rd index 1b28f0ef..4c58924c 100644 --- a/man/asFillContainer.Rd +++ b/man/bindFillRole.Rd @@ -1,36 +1,37 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/fill.R -\name{asFillContainer} -\alias{asFillContainer} -\alias{asFillItem} +\name{bindFillRole} +\alias{bindFillRole} \title{Allow tags to intelligently fill their container} \usage{ -asFillContainer( +bindFillRole( x, ..., - height = NULL, - width = NULL, - asItem = FALSE, + item = FALSE, + container = FALSE, + overwrite = FALSE, .cssSelector = NULL ) - -asFillItem(x, ..., height = NULL, width = NULL, .cssSelector = NULL) } \arguments{ -\item{x}{a \code{\link[=tag]{tag()}} object.} +\item{x}{a \code{\link[=tag]{tag()}} object. Can also be a valid \code{\link[=tagQuery]{tagQuery()}} input if \code{.cssSelector} is specified.} \item{...}{currently unused.} -\item{height, width}{Any valid \link[=validateCssUnit]{CSS unit} (e.g., -height="200px").} +\item{item}{whether or not to treat \code{x} as a fill item.} + +\item{container}{whether or not to treat \code{x} as a fill container. Note this +will the CSS \code{display} property on the tag to \code{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 \code{display} +behavior.} -\item{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.} +\item{overwrite}{whether or not to override previous calls to +\code{bindFillRole()} (e.g., to remove the item/container role from a tag).} \item{.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 \code{\link[=tagAppendAttributes]{tagAppendAttributes()}}} +selector(s) are supported, see \code{\link[=tagAppendAttributes]{tagAppendAttributes()}}.} } \value{ The original tag object (\code{x}) with additional attributes (and a @@ -41,12 +42,6 @@ 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{ -\code{asFillContainer()} changes the CSS \code{display} property on the tag to -\code{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 \code{display} behavior. -} \examples{ tagz <- div( @@ -67,8 +62,8 @@ tagz <- div( # Inner doesn't fill outer if (interactive()) browsable(tagz) -tagz <- asFillContainer(tagz) -tagz <- asFillItem(tagz, .cssSelector = "#inner") +tagz <- bindFillRole(tagz, container = TRUE) +tagz <- bindFillRole(tagz, item = FALSE, .cssSelector = "#inner") # Inner does fill outer if (interactive()) browsable(tagz) diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 30b4a602..f0fc29ac 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -97,10 +97,9 @@ reference: - '`capturePlot`' - '`defaultPngDevice`' -- title: Fill containers +- title: Fill items and containers contents: - - '`asFillContainer`' - - '`asFillItem`' + - '`bindFillRole`' - title: Utilities contents: diff --git a/tests/testthat/test-fill.R b/tests/testthat/test-fill.R index 373ac311..a7ca94e3 100644 --- a/tests/testthat/test-fill.R +++ b/tests/testthat/test-fill.R @@ -4,29 +4,47 @@ # (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") + x <- bindFillRole(div(), container = TRUE) + expect_true( + doRenderTags(x) == "
" + ) + + x <- bindFillRole(div(), item = TRUE) + expect_true( + doRenderTags(x) == "
" + ) - container <- asFillContainer( - div(span()), asItem = TRUE, .cssSelector = "span", height = 300 + x <- bindFillRole( + div(span()), .cssSelector = "span", container = TRUE, item = TRUE ) - expect_equal( - tagGetAttribute(container$children[[1]], "class"), - "html-fill-container html-fill-item" + expect_true( + doRenderTags(x) == "
\n \n
" ) - expect_equal( - tagGetAttribute(container$children[[1]], "style"), - "height:300px;" + + x <- bindFillRole(x, .cssSelector = "span", container = FALSE, item = FALSE, overwrite = TRUE) + + expect_true( + doRenderTags(x) == "
\n \n
" + ) + + x <- bindFillRole( + tagList(div(span())), .cssSelector = "span", container = TRUE + ) + expect_true( + doRenderTags(x) == "
\n \n
" ) expect_warning( - asFillContainer(tagList()), - "Don't know how to treat an object of type" + bindFillRole(tagList()), + "htmltools::tag" ) expect_warning( - asFillItem(tagList()), - "Don't know how to treat an object of type" + bindFillRole(tagList()), + "htmltools::tag" + ) + + expect_warning( + bindFillRole(div(span()), .cssSelector = "foo"), + "cssSelector" ) }) From fe0a2db176ef2181eaec6e69ba38317a8abbf672 Mon Sep 17 00:00:00 2001 From: Carson Date: Tue, 25 Oct 2022 14:39:44 -0500 Subject: [PATCH 2/2] Add another test case; clean up docs --- R/fill.R | 7 ++++--- man/bindFillRole.Rd | 7 ++++--- tests/testthat/test-fill.R | 5 +++++ 3 files changed, 13 insertions(+), 6 deletions(-) diff --git a/R/fill.R b/R/fill.R index 1e0c5584..467fda9f 100644 --- a/R/fill.R +++ b/R/fill.R @@ -1,10 +1,11 @@ #' 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. +#' container, and that container has an opinionated height, then the item is +#' allowed to grow and shrink to its container's size. #' -#' @param x a [tag()] object. Can also be a valid [tagQuery()] input if `.cssSelector` is specified. +#' @param x a [tag()] object. Can also be a valid [tagQuery()] input if +#' `.cssSelector` is specified. #' @param ... currently unused. #' @param item whether or not to treat `x` as a fill item. #' @param container whether or not to treat `x` as a fill container. Note this diff --git a/man/bindFillRole.Rd b/man/bindFillRole.Rd index 4c58924c..67ba4a7b 100644 --- a/man/bindFillRole.Rd +++ b/man/bindFillRole.Rd @@ -14,7 +14,8 @@ bindFillRole( ) } \arguments{ -\item{x}{a \code{\link[=tag]{tag()}} object. Can also be a valid \code{\link[=tagQuery]{tagQuery()}} input if \code{.cssSelector} is specified.} +\item{x}{a \code{\link[=tag]{tag()}} object. Can also be a valid \code{\link[=tagQuery]{tagQuery()}} input if +\code{.cssSelector} is specified.} \item{...}{currently unused.} @@ -39,8 +40,8 @@ The original tag object (\code{x}) with additional attributes (and a } \description{ 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. +container, and that container has an opinionated height, then the item is +allowed to grow and shrink to its container's size. } \examples{ diff --git a/tests/testthat/test-fill.R b/tests/testthat/test-fill.R index a7ca94e3..fef0cdff 100644 --- a/tests/testthat/test-fill.R +++ b/tests/testthat/test-fill.R @@ -14,6 +14,11 @@ test_that("asFillContainer() and asFillItem()", { doRenderTags(x) == "
" ) + x <- bindFillRole(x, container = TRUE, overwrite = TRUE) + expect_true( + doRenderTags(x) == "
" + ) + x <- bindFillRole( div(span()), .cssSelector = "span", container = TRUE, item = TRUE )