From 702ca541e83b3e1331283159441c083a385d8ca9 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Tue, 1 Nov 2022 14:41:22 -0400 Subject: [PATCH 1/7] Implement `tagQuery()$matches(fn)` --- R/tag_query.R | 31 ++++++++++++++++++++++++++++--- man/tagQuery.Rd | 6 +++++- 2 files changed, 33 insertions(+), 4 deletions(-) diff --git a/R/tag_query.R b/R/tag_query.R index 1af54402..b202997e 100644 --- a/R/tag_query.R +++ b/R/tag_query.R @@ -631,14 +631,21 @@ tagQuery_ <- function( tagQueryFindClosest(selected_, cssSelector) ) }, - #' ### Custom filter + #' ### Filter #' + #' * `$matches(fn)`: For each for the selected tags, return `TRUE` if + #' `fn(el)` returns `TRUE`. In addition to an R function with two + #' arguments (the selected tag `x` and the index `i`), `fn` may also + #' be a valid CSS selector. + matches = function(fn) { + tagQueryMatches(selected_, fn) + }, #' * `$filter(fn)`: Filter the selected tags to those for which `fn(x, #' i)` returns `TRUE`. In addition to an R function with two arguments #' (the selected tag `x` and the index `i`), `fn` may also be a valid #' CSS selector. filter = function(fn) { - newSelected <- tagQueryFindFilter(selected_, fn) + newSelected <- tagQueryFilter(selected_, fn) rebuild_() newTagQuery(newSelected) }, @@ -953,6 +960,11 @@ walkIRev <- function(.x, .f, ...) { NULL } +# Actually return the iterated results +MapI <- function(.x, .f, ..., USE.NAMES = FALSE) { + Map(.x, seq_along(.x), f = .f, ..., USE.NAMES = USE.NAMES) +} + # Return function that will verify elements before performing `func(els, fn)` selectedWalkGen <- function(func) { @@ -986,6 +998,7 @@ tagQueryWalk <- selectedWalkGen(walk) # selectedWalkRev <- selectedWalkGen(walkRev) selectedWalkI <- selectedWalkGen(walkI) selectedWalkIRev <- selectedWalkGen(walkIRev) +selectedMapI <- selectedWalkGen(MapI) tagQueryLapply <- selectedWalkGen(lapply) @@ -1388,7 +1401,19 @@ tagQueryFindSiblings <- function(els, cssSelector = NULL) { # Filter the selected elements using a function # The answer of `fn(el, i)` should work in an `if` block -tagQueryFindFilter <- function(els, fn) { +tagQueryMatches <- function(els, fn) { + if (is.character(fn)) { + selector <- cssSelectorToSelector(fn) + fn <- function(el, i) { + elMatchesSelector(el, selector) + } + } + validateFnCanIterate(fn) + unlist(selectedMapI(els, fn)) +} +# Filter the selected elements using a function +# The answer of `fn(el, i)` should work in an `if` block +tagQueryFilter <- function(els, fn) { if (is.character(fn)) { selector <- cssSelectorToSelector(fn) fn <- function(el, i) { diff --git a/man/tagQuery.Rd b/man/tagQuery.Rd index 2480baf3..80917204 100644 --- a/man/tagQuery.Rd +++ b/man/tagQuery.Rd @@ -83,8 +83,12 @@ ancestor tag (including itself) satisfying a \code{cssSelector}. If } } -\subsection{Custom filter}{ +\subsection{Filter}{ \itemize{ +\item \verb{$matches(fn)}: For each for the selected tags, return \code{TRUE} if +\code{fn(el)} returns \code{TRUE}. In addition to an R function with two +arguments (the selected tag \code{x} and the index \code{i}), \code{fn} may also +be a valid CSS selector. \item \verb{$filter(fn)}: Filter the selected tags to those for which \code{fn(x, i)} returns \code{TRUE}. In addition to an R function with two arguments (the selected tag \code{x} and the index \code{i}), \code{fn} may also be a valid CSS selector. From 1cf7c8b6bd93399815b53ec7eb2bc9a3e776b612 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Tue, 1 Nov 2022 14:41:36 -0400 Subject: [PATCH 2/7] Test `tagQuery()$matches()` --- tests/testthat/test-tag-query.R | 44 ++++++++++++++++++++++++++++++++- 1 file changed, 43 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-tag-query.R b/tests/testthat/test-tag-query.R index d0f482ed..3979b4ce 100644 --- a/tests/testthat/test-tag-query.R +++ b/tests/testthat/test-tag-query.R @@ -183,8 +183,50 @@ test_that("tagQuery()$find()", { expect_equal_tags(x$selectedTags(), tagListPrintAsList(p("text2"))) }) +test_that("tagQuery()$matches()", { + x <- tagQuery( + div( + span(1, class = "first"), + span(2, class = "second"), + span(3, class = "third"), + span(4, class = "fourth"), + span(5, class = "fifth") + ) + ) + + x <- x$find("span") + expect_length(x$selectedTags(), 5) + + expect_equal(x$matches("span"), rep(TRUE, 5)) + expect_equal(x$matches(".second"), c(FALSE, TRUE, FALSE, FALSE, FALSE)) + expect_equal(x$matches(function(el, i) { + grepl("second", tagGetAttribute(el, "class")) + }), c(FALSE, TRUE, FALSE, FALSE, FALSE)) + + expect_error(x$matches("span div"), "using a simple CSS selector") + + # Make sure selected tags were not altered + expect_length(x$selectedTags(), 5) + + # Vignette example + (html <- tagList(div(), span())) + tagQ <- tagQuery(html) + expect_equal(tagQ$matches("span"), c(FALSE, TRUE)) + expect_equal( + tagQ$matches(function(el, i) { + el$name == "span" + }), + c(FALSE, TRUE) + ) + +}) + test_that("tagQuery()$filter()", { - x <- tagQuery(div(span(1), span(2), span(3), span(4), span(5))) + x <- tagQuery(div(span(1), span(2, class = "second"), span(3), span(4), span(5))) + + y <- x$find("span") + y <- y$filter(".second") + expect_equal_tags(y$selectedTags(), tagListPrintAsList(span(2, class = "second"))) x <- x$find("span") expect_length(x$selectedTags(), 5) From 7a58a2f13a8c6ffad931634aa792d2c770e88742 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Tue, 1 Nov 2022 14:41:52 -0400 Subject: [PATCH 3/7] Add note on `tagQuery()$matches()` in tagQuery vignette --- vignettes/tagQuery.Rmd | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/vignettes/tagQuery.Rmd b/vignettes/tagQuery.Rmd index 94d463d5..5fb01dff 100644 --- a/vignettes/tagQuery.Rmd +++ b/vignettes/tagQuery.Rmd @@ -120,6 +120,15 @@ tagQ$ selectedTags() ``` +To test your selected tags against a CSS selector, you can use `$matches()` with a CSS selector string: + +```{r} +(html <- tagList(div(), span())) +tagQ <- tagQuery(html) +tagQ$matches("span") +tagQ$matches(function(el, i) { el$name == "span" }) +``` + ### Reset To reset the set of selected tags to the root tag, use `$resetSelected()`: From 2e0b6ba67df616c981dc1e4dd1934ef80acc0415 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Tue, 1 Nov 2022 14:49:09 -0400 Subject: [PATCH 4/7] If the returned value is not `isTRUE()`, then return `FALSE` --- R/tag_query.R | 4 ++-- tests/testthat/test-tag-query.R | 8 ++++++++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/R/tag_query.R b/R/tag_query.R index b202997e..56c36cce 100644 --- a/R/tag_query.R +++ b/R/tag_query.R @@ -1409,7 +1409,7 @@ tagQueryMatches <- function(els, fn) { } } validateFnCanIterate(fn) - unlist(selectedMapI(els, fn)) + vapply(selectedMapI(els, fn), isTRUE, logical(1)) } # Filter the selected elements using a function # The answer of `fn(el, i)` should work in an `if` block @@ -1424,7 +1424,7 @@ tagQueryFilter <- function(els, fn) { filterStack <- envirStackUnique() selectedWalkI(els, function(el, i) { - if (fn(el, i)) { + if (isTRUE(fn(el, i))) { filterStack$push(el) } }) diff --git a/tests/testthat/test-tag-query.R b/tests/testthat/test-tag-query.R index 3979b4ce..a84fc8bf 100644 --- a/tests/testthat/test-tag-query.R +++ b/tests/testthat/test-tag-query.R @@ -219,6 +219,14 @@ test_that("tagQuery()$matches()", { c(FALSE, TRUE) ) + # If the value is not `TRUE`, then it is `FALSE` + expect_equal( + tagQ$matches(function(el, i) { + c(TRUE, TRUE) + }), + c(FALSE, FALSE) + ) + }) test_that("tagQuery()$filter()", { From d5701accaf9308623d92ba26e0e165d5afb182ea Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Tue, 1 Nov 2022 14:52:10 -0400 Subject: [PATCH 5/7] Add news entry --- NEWS.md | 2 ++ R/tag_query.R | 2 +- man/tagQuery.Rd | 2 +- 3 files changed, 4 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index 71dc970c..5f8f7b17 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,8 @@ * 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) +* Added new `tagQuery()` method `$matches(fn)`. For each of the selected `tagQuery()` tags, return `TRUE` if `fn(el)` returns `TRUE`. In addition to an R function with two arguments (the selected tag `x` and the index `i`), `fn` may also be a valid CSS selector. (#351) + ## Bug fixes * Closed #331: `copyDependencyToDir()` creates `outputDir` recursively, which happens in Quarto or when `lib_dir` points to a nested directory. (@gadenbuie, #332) diff --git a/R/tag_query.R b/R/tag_query.R index 56c36cce..e01fe24e 100644 --- a/R/tag_query.R +++ b/R/tag_query.R @@ -633,7 +633,7 @@ tagQuery_ <- function( }, #' ### Filter #' - #' * `$matches(fn)`: For each for the selected tags, return `TRUE` if + #' * `$matches(fn)`: For each of the selected tags, return `TRUE` if #' `fn(el)` returns `TRUE`. In addition to an R function with two #' arguments (the selected tag `x` and the index `i`), `fn` may also #' be a valid CSS selector. diff --git a/man/tagQuery.Rd b/man/tagQuery.Rd index 80917204..3dc1b2dd 100644 --- a/man/tagQuery.Rd +++ b/man/tagQuery.Rd @@ -85,7 +85,7 @@ ancestor tag (including itself) satisfying a \code{cssSelector}. If \subsection{Filter}{ \itemize{ -\item \verb{$matches(fn)}: For each for the selected tags, return \code{TRUE} if +\item \verb{$matches(fn)}: For each of the selected tags, return \code{TRUE} if \code{fn(el)} returns \code{TRUE}. In addition to an R function with two arguments (the selected tag \code{x} and the index \code{i}), \code{fn} may also be a valid CSS selector. From 895d34bacb1c8284f6f7457e2539db37f121912e Mon Sep 17 00:00:00 2001 From: Carson Date: Wed, 5 Apr 2023 15:34:35 -0500 Subject: [PATCH 6/7] Put NEWS item in the right spot --- NEWS.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index aba2527c..28017c27 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,8 @@ # htmltools 0.5.5.9000 +## New Features +* Added new `tagQuery()` method `$matches(fn)`. For each of the selected `tagQuery()` tags, return `TRUE` if `fn(el)` returns `TRUE`. In addition to an R function with two arguments (the selected tag `x` and the index `i`), `fn` may also be a valid CSS selector. (#351) # htmltools 0.5.5 @@ -16,8 +18,6 @@ * Added a new `bindFillRole()` function for modifying `tag()` object(s) into tags that are allowed to grow and shrink when their parent is opinionated about their height. See `help(bindFillRole, "htmltools")` 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) -* Added new `tagQuery()` method `$matches(fn)`. For each of the selected `tagQuery()` tags, return `TRUE` if `fn(el)` returns `TRUE`. In addition to an R function with two arguments (the selected tag `x` and the index `i`), `fn` may also be a valid CSS selector. (#351) - ## Bug fixes * Closed #331: `copyDependencyToDir()` creates `outputDir` recursively, which happens in Quarto or when `lib_dir` points to a nested directory. (@gadenbuie, #332) From b7b1d5c19a854ea082c2419d695f09a111d73404 Mon Sep 17 00:00:00 2001 From: Barret Schloerke Date: Thu, 20 Apr 2023 09:12:41 -0400 Subject: [PATCH 7/7] Use separate subsection for `$matches()` --- R/tag_query.R | 22 ++++++++++++---------- man/tagQuery.Rd | 14 ++++++++++---- 2 files changed, 22 insertions(+), 14 deletions(-) diff --git a/R/tag_query.R b/R/tag_query.R index c572c4e4..3856de8d 100644 --- a/R/tag_query.R +++ b/R/tag_query.R @@ -631,24 +631,26 @@ tagQuery_ <- function( tagQueryFindClosest(selected_, cssSelector) ) }, - #' ### Filter + #' ### Custom filter #' - #' * `$matches(fn)`: For each of the selected tags, return `TRUE` if - #' `fn(el)` returns `TRUE`. In addition to an R function with two + #' * `$filter(fn)`: Filter the selected tags to those for which + #' `fn(x, i)` returns `TRUE`. In addition to an R function with two #' arguments (the selected tag `x` and the index `i`), `fn` may also #' be a valid CSS selector. - matches = function(fn) { - tagQueryMatches(selected_, fn) - }, - #' * `$filter(fn)`: Filter the selected tags to those for which `fn(x, - #' i)` returns `TRUE`. In addition to an R function with two arguments - #' (the selected tag `x` and the index `i`), `fn` may also be a valid - #' CSS selector. filter = function(fn) { newSelected <- tagQueryFilter(selected_, fn) rebuild_() newTagQuery(newSelected) }, + #' ### Matching + #' + #' * `$matches(fn)`: For each of the selected tags, return `TRUE` if + #' `fn(el)` returns `TRUE`. In addition to an R function with two + #' arguments (the selected tag `x` and the index `i`), `fn` may also + #' be a valid CSS selector. + matches = function(fn) { + tagQueryMatches(selected_, fn) + }, #' ### Length #' #' * `$length()`: Number of tags that have been selected. diff --git a/man/tagQuery.Rd b/man/tagQuery.Rd index 3dc1b2dd..64463f53 100644 --- a/man/tagQuery.Rd +++ b/man/tagQuery.Rd @@ -83,15 +83,21 @@ ancestor tag (including itself) satisfying a \code{cssSelector}. If } } -\subsection{Filter}{ +\subsection{Custom filter}{ +\itemize{ +\item \verb{$filter(fn)}: Filter the selected tags to those for which +\code{fn(x, i)} returns \code{TRUE}. In addition to an R function with two +arguments (the selected tag \code{x} and the index \code{i}), \code{fn} may also +be a valid CSS selector. +} +} + +\subsection{Matching}{ \itemize{ \item \verb{$matches(fn)}: For each of the selected tags, return \code{TRUE} if \code{fn(el)} returns \code{TRUE}. In addition to an R function with two arguments (the selected tag \code{x} and the index \code{i}), \code{fn} may also be a valid CSS selector. -\item \verb{$filter(fn)}: Filter the selected tags to those for which \code{fn(x, i)} returns \code{TRUE}. In addition to an R function with two arguments -(the selected tag \code{x} and the index \code{i}), \code{fn} may also be a valid -CSS selector. } }