diff --git a/DESCRIPTION b/DESCRIPTION index 19858546..9d0600ae 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: htmltools Type: Package Title: Tools for HTML -Version: 0.5.1.9002 +Version: 0.5.1.9003 Authors@R: c( person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"), person("Carson", "Sievert", role = c("aut", "cre"), email = "carson@rstudio.com", comment = c(ORCID = "0000-0002-4958-2844")), diff --git a/NAMESPACE b/NAMESPACE index 02e16ec9..f8d90f92 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,36 +1,36 @@ # Generated by roxygen2: do not edit by hand S3method(as.character,html) -S3method(as.character,htmltools.tag.env) -S3method(as.character,htmltools.tag.query) S3method(as.character,shiny.tag) +S3method(as.character,shiny.tag.env) S3method(as.character,shiny.tag.list) +S3method(as.character,shiny.tag.query) S3method(as.tags,character) S3method(as.tags,default) S3method(as.tags,html) S3method(as.tags,html_dependency) -S3method(as.tags,htmltools.tag.env) -S3method(as.tags,htmltools.tag.query) S3method(as.tags,list) S3method(as.tags,shiny.tag) +S3method(as.tags,shiny.tag.env) S3method(as.tags,shiny.tag.function) S3method(as.tags,shiny.tag.list) +S3method(as.tags,shiny.tag.query) S3method(format,html) S3method(format,htmltools.selector) S3method(format,htmltools.selector.list) -S3method(format,htmltools.tag.env) -S3method(format,htmltools.tag.query) S3method(format,shiny.tag) +S3method(format,shiny.tag.env) S3method(format,shiny.tag.list) +S3method(format,shiny.tag.query) S3method(print,html) S3method(print,html_dependency) S3method(print,htmltools.selector) S3method(print,htmltools.selector.list) -S3method(print,htmltools.tag.env) -S3method(print,htmltools.tag.query) S3method(print,shiny.tag) +S3method(print,shiny.tag.env) S3method(print,shiny.tag.list) -S3method(str,htmltools.tag.env) +S3method(print,shiny.tag.query) +S3method(str,shiny.tag.env) export("htmlDependencies<-") export(HTML) export(a) diff --git a/R/tag_query.R b/R/tag_query.R index a62ebe2e..b8a6236b 100644 --- a/R/tag_query.R +++ b/R/tag_query.R @@ -35,16 +35,16 @@ NULL ## Instead write them where they are needed since they are small. ## (Just like we don't wrap dplyr code) # tagAppendAttributesAt <- function(tag, cssSelector, ...) { -# tagQuery(tag)$find(cssSelector)$addAttrs(...)$root() +# tagQuery(tag)$find(cssSelector)$addAttrs(...)$allTags() # } # tagAddClassAt <- function(tag, cssSelector, class) { -# tagQuery(tag)$find(cssSelector)$addClass(class)$root() +# tagQuery(tag)$find(cssSelector)$addClass(class)$allTags() # } # tagMutateAt <- function(x, cssSelector, fn) { -# tagQuery(tag)$find(cssSelector)$each(fn)$root() +# tagQuery(tag)$find(cssSelector)$each(fn)$allTags() # } # tagFindAt <- function(x, css) { -# tagQuery(tag)$find(cssSelector)$selected() +# tagQuery(tag)$find(cssSelector)$selectedTags() # } @@ -257,7 +257,7 @@ asTagEnv_ <- function(x, parent = NULL) { if (isTagVal || isTagEnvVal) { if (!isTagEnvVal) { xList <- x - x <- safeListToEnv(xList, "htmltools.tag.env") + x <- safeListToEnv(xList, "shiny.tag.env") # add parent env and key x$parent <- parent x$envKey <- obj_address(x) @@ -288,7 +288,7 @@ asTagEnv_ <- function(x, parent = NULL) { } # This method MUST undo everything done in `asTagEnv(x)` -# Do not export to encourage direct use of `tagQuery()$selected()` +# Do not export to encourage direct use of `tagQuery()$selectedTags()` # Only allow for tag environments to be passed in. tagEnvToTags <- function(x) { if (!isTagEnv(x)) { @@ -302,7 +302,7 @@ tagEnvToTags_ <- function(x) { if (isTagEnv(x)) { xEl <- x # convert to list first to avoid altering the original env obj - x <- safeEnvToList(xEl, c("htmltools.tag.env")) + x <- safeEnvToList(xEl, c("shiny.tag.env")) # undo parent env and key x$parent <- NULL x$envKey <- NULL @@ -314,68 +314,68 @@ tagEnvToTags_ <- function(x) { isTagEnv <- function(x) { - inherits(x, "htmltools.tag.env") + inherits(x, "shiny.tag.env") } isTagQuery <- function(x) { - inherits(x, "htmltools.tag.query") + inherits(x, "shiny.tag.query") } assertNotTagEnvLike <- function(x, fnName) { if (isTagEnv(x)) { - stop("Tag environment objects (which inherit `htmltools.tag.env`) are not allowed to be processed in `", fnName, "()`") + stop("Tag environment objects (which inherit `shiny.tag.env`) are not allowed to be processed in `", fnName, "()`") } if (isTagQuery(x)) { - stop("`tagQuery()` structures (which inherit `htmltools.tag.query`) are not allowed to be processed in `", fnName, "()`") + stop("`tagQuery()` structures (which inherit `shiny.tag.query`) are not allowed to be processed in `", fnName, "()`") } invisible() } -shinyTagEnvStr <- "" +shinyTagEnvStr <- "" #' @export -as.tags.htmltools.tag.env <- function(x, ...) { +as.tags.shiny.tag.env <- function(x, ...) { stop("Method not allowed", call. = TRUE) # as.tags(tagEnvToTags(x), ...) } #' @export -print.htmltools.tag.env <- function(x, ...) { +print.shiny.tag.env <- function(x, ...) { cat(shinyTagEnvStr, "\n") print(tagEnvToTags(x), ...) } #' @export -format.htmltools.tag.env <- function(x, ...) { +format.shiny.tag.env <- function(x, ...) { format(tagEnvToTags(x), ...) } #' @export -as.character.htmltools.tag.env <- function(x, ...) { +as.character.shiny.tag.env <- function(x, ...) { as.character(tagEnvToTags(x), ...) } #' @export -str.htmltools.tag.env <- function(object, ...) { +str.shiny.tag.env <- function(object, ...) { cat(shinyTagEnvStr, "\n") str(tagEnvToTags(object), ...) } #' @export -as.tags.htmltools.tag.query <- function(x, ...) { +as.tags.shiny.tag.query <- function(x, ...) { stop("Method not allowed", call. = TRUE) } #' @export -print.htmltools.tag.query <- function(x, ...) { +print.shiny.tag.query <- function(x, ...) { x$print() } #' @export -format.htmltools.tag.query <- function(x, ...) { +format.shiny.tag.query <- function(x, ...) { stop( "`tagQuery()` objects can not be written directly as HTML tags.\n", - "Call either `$root()` or `$selected()` to extract the tags of interest." + "Call either `$allTags()` or `$selectedTags()` to extract the tags of interest." ) } #' @export -as.character.htmltools.tag.query <- function(x, ...) { +as.character.shiny.tag.query <- function(x, ...) { stop( "`tagQuery()` objects can not be written directly as HTML tags.\n", - "Call either `$root()` or `$selected()` to extract the tags of interest." + "Call either `$allTags()` or `$selectedTags()` to extract the tags of interest." ) } @@ -405,7 +405,7 @@ as.character.htmltools.tag.query <- function(x, ...) { #' tag elements. This could be accomplished using code similar to #' #' ```r tagQuery(ex_tags)$find("div .inner -#' span")$parent()$parent()$addClass("custom-class")$root() +#' span")$parent()$parent()$addClass("custom-class")$allTags() #' ``` #' #' This style of alteration is not easily achieved when using typical "pass by @@ -422,7 +422,7 @@ as.character.htmltools.tag.query <- function(x, ...) { #' environment using `$addClass()` and the result of the method call is ignored, #' the selected tag environments within the tag query object will still contain #' the class addition. The added class will exist when the tag query tag -#' environment are converted back to standard tags objects with `$selected()`. +#' environment are converted back to standard tags objects with `$selectedTags()`. #' #' Tag environments also contain an extra field, `.$parent`. The `.$parent` #' value contains their parent tag environment. The top level tags supplied to @@ -439,7 +439,7 @@ as.character.htmltools.tag.query <- function(x, ...) { #' A `tagQuery()` behaves simliar to an R6 object in that internal values are #' altered in place. (but a `tagQuery()` object is not implemented with `R6`). #' The `tagQuery()`'s methods will return itself as much as possible, unless the -#' method is directly asking for information, e.g. `$root()` or `$selected()`. +#' method is directly asking for information, e.g. `$allTags()` or `$selectedTags()`. #' #' Internally, two important pieces of information are maintained: the root #' elements and the selected elements. The root tag environment will always @@ -451,26 +451,26 @@ as.character.htmltools.tag.query <- function(x, ...) { #' unless declared otherwise. #' #' Tag query objects can be created from other tag query objects. Note, unless -#' there is an intermediate call to `$selected()`, the original and new tag query +#' there is an intermediate call to `$selectedTags()`, the original and new tag query #' objects will share the same tag environments. The new tag query object will #' have its selected elements reset. For example: #' #' ```r #' x <- tagQuery(div()) #' y <- tagQuery(x) -#' z <- tagQuery(x$root()) +#' z <- tagQuery(x$allTags()) #' #' # Add an example class #' y$addClass("example") #' #' # Show `x` and `y` both have the new class -#' x$selected() +#' x$selectedTags() #' #>
-#' y$selected() +#' y$selectedTags() #' #>
#' -#' # `z` is isolated from the changes in `x` and `y` due to the `$selected()` -#' z$selected() +#' # `z` is isolated from the changes in `x` and `y` due to the `$selectedTags()` +#' z$selectedTags() #' #>
#' ``` #' @@ -478,12 +478,10 @@ as.character.htmltools.tag.query <- function(x, ...) { #' @section Limitations: #' #' `tagQuery()`s can **not** be used directly within typical `tag` locations. -#' An error should be thrown. Instead, please call `$selected()` to retrieve the +#' An error should be thrown. Instead, please call `$selectedTags()` to retrieve the #' tag structures of the selected tag elements or root element respectively. #' -#' @param tags Any standard tag object or `tagList()`. If a `list()` or -#' `tagList()` is provided, a `tagList()` will be returned when calling -#' `$selected()`. +#' @param tags Any standard tag object or `tagList()`. #' @return A `tagQuery()` object. The `tag` supplied will be considered the #' `root` object. At the time of initialization, the `root` is also considered #' the single selected item. If any selections are made, the selected elements @@ -499,7 +497,7 @@ tagQuery <- function(tags) { # Make a new tag query object from the root element of `tags` # * Set the selected to `list(tags)` if (isTagEnv(tags)) { - return(tagQuery_(findRootTag(tags), list(tags))) + return(tagQuery_(findPseudoRootTag(tags), list(tags))) } # If `tags` is a list of tagEnvs... @@ -523,7 +521,7 @@ tagQuery <- function(tags) { } rootStack <- envirStackUnique() walk(tags, function(el) { - rootStack$push(findRootTag(el)) + rootStack$push(findPseudoRootTag(el)) }) roots <- rootStack$uniqueList() if (length(roots) != 1) { @@ -537,7 +535,7 @@ tagQuery <- function(tags) { # Convert standard tags to tag envs root <- asTagEnv( - wrapWithRootTag(tags) + wrapWithPseudoRootTag(tags) ) # Select the top level tags selected <- tagQueryFindResetSelected(root) @@ -554,22 +552,22 @@ tagQuery <- function(tags) { #' @aliases NULL #' @usage NULL tagQuery_ <- function( - root, + pseudoRoot, # Using a trailing `_` to avoid name collisions selected_ ) { - if (!isRootTag(root)) { - stop("`tagQuery_(root=)` must be a root tag environment") + if (!isPseudoRootTag(pseudoRoot)) { + stop("`tagQuery_(pseudoRoot=)` must be a pseudoRoot tag environment") } # Use `var_` names to avoid namespace collision # Make sure all elements are tag envs rebuild_ <- function() { - # safe to do as `root` will never be turned into a standard list - asTagEnv(root) + # safe to do as `pseudoRoot` will never be turned into a standard list + asTagEnv(pseudoRoot) } newTagQuery <- function(selected) { - tagQuery_(root, selected) + tagQuery_(pseudoRoot, selected) } setSelected <- function(selected) { @@ -584,7 +582,7 @@ tagQuery_ <- function( " that was not a tag environment" ) } - !isRootTag(el) + !isPseudoRootTag(el) }) selected } @@ -592,7 +590,7 @@ tagQuery_ <- function( self <- structure( - class = "htmltools.tag.query", + class = "shiny.tag.query", list( #' @details #' # CSS Selector @@ -666,7 +664,7 @@ tagQuery_ <- function( #' * `$closest(cssSelector = NULL)`: For each selected element, get the #' closest ancestor element (including itself) that matches the #' single-element CSS selector. If `cssSelector = NULL`, it is - #' equivalent to calling `$selected()`. A new `tagQuery()` object will be + #' equivalent to calling `$selectedTags()`. A new `tagQuery()` object will be #' created with the selected items set to the closest matching elements. closest = function(cssSelector = NULL) { newTagQuery( @@ -690,7 +688,7 @@ tagQuery_ <- function( #' created with the selected items set to the filtered selected #' elements. Remember, any alterations to the provided tag environments will persist #' in calling tag query object. If you need to make local changes, consider - #' using `tagQuery(el)$selected()` to use standard tag objects. + #' using `tagQuery(el)$selectedTags()` to use standard tag objects. filter = function(fn) { newSelected <- tagQueryFindFilter(selected_, fn) rebuild_() @@ -700,7 +698,7 @@ tagQuery_ <- function( #' selected items set to the top level tag objects. resetSelected = function() { newTagQuery( - tagQueryFindResetSelected(root) + tagQueryFindResetSelected(pseudoRoot) ) }, ## end Find @@ -830,7 +828,7 @@ tagQuery_ <- function( #' environments will be given first, followed by the index position. #' Remember, any alterations to the provided tag environments will persist #' in calling tag query object. If you need to make local changes, consider - #' using `tagQuery(el)$selected()` to use standard tag objects. + #' using `tagQuery(el)$selectedTags()` to use standard tag objects. each = function(fn) { tagQueryEach(selected_, fn) # MUST rebuild full tree as anything could have been done to the tag envs @@ -841,18 +839,17 @@ tagQuery_ <- function( #' ## Tag Query methods #' - #' * `$root()`: Converts the top level tag + #' * `$allTags()`: Converts the top level (root) tag #' elements (and their descendants) from tag environments to - #' standard [`tag`] objects. If there is more than one element being - #' returned, a [`tagList()`] will be used to hold all of the - #' tags. - root = function() { - tagQueryRootAsTags(root) + #' standard [`tag`] objects. All root tags will be returned in a + #' [`tagList()`]. + allTags = function() { + tagQueryTopLevelTags(pseudoRoot) }, - #' * `$selected()`: Converts the selected tag environments + #' * `$selectedTags()`: Converts the selected tag environments #' to standard [`tag`] objects. The selected tags will be returned in a #' [`tagList()`]. - selected = function() { + selectedTags = function() { tagQuerySelectedAsTags(selected_) }, #' * `$rebuild()`: Makes sure that all tags have been upgraded to tag @@ -865,10 +862,10 @@ tagQuery_ <- function( self }, #' * `$print()`: Internal print method. Called by - #' `print.htmltools.tag.query()` + #' `print.shiny.tag.query()` print = function() { # Allows `$print()` to know if there is a root el - tagQueryPrint(root, selected_) + tagQueryPrint(pseudoRoot, selected_) invisible(self) } ) @@ -910,12 +907,12 @@ validateFnCanIterate <- function(fn) { } } -isRootTag <- function(x) { +isPseudoRootTag <- function(x) { name <- x$name - isTag(x) && !is.null(name) && isTRUE(name == "tagQuery") + isTag(x) && !is.null(name) && isTRUE(name == "TagQueryPseudoRoot") } -findRootTag <- function(el) { +findPseudoRootTag <- function(el) { while (!is.null(el$parent)) { el <- el$parent } @@ -925,9 +922,9 @@ findRootTag <- function(el) { # Wrap the top level tags in the tagQuery() in a `tagQuery` tag object. # This allows for appending and prepending elements to the top level tags. # (Don't fight the structures... embrace them!) -wrapWithRootTag <- function(x) { +wrapWithPseudoRootTag <- function(x) { tagSetChildren( - tag("tagQuery", list()), + tag("TagQueryPseudoRoot", list()), x ) } @@ -940,7 +937,7 @@ tagQueryGetRoot <- function(root) { if (len == 1) { children[[1]] } else if (len > 1) { - do.call(tagList, children) + tagList(!!!children) } else { # no children? NULL @@ -949,7 +946,7 @@ tagQueryGetRoot <- function(root) { # Return a list of the manually selected elements tagQuerySelected <- function(selected) { - if (length(selected) == 1 && isRootTag(selected[[1]])) { + if (length(selected) == 1 && isPseudoRootTag(selected[[1]])) { list() } else { selected @@ -964,26 +961,39 @@ tagQuerySelected <- function(selected) { # selected[[position]] # } -# Return the top level tags as tags -tagQueryRootAsTags <- function(root) { - tagQueryGetRoot(tagEnvToTags(root)) +# Return the top level tags as a tagList or a single tag +tagQueryTopLevelTags <- function(pseudoRoot) { + children <- tagEnvToTags(pseudoRoot)$children + len <- length(children) + if (len == 1) { + # single top level tag + children[[1]] + } else { + # 0 or >1 top leve tags + tagList(!!!children) + } } +tagListPrintAsList <- function(...) { + x <- tagList(...) + attr(x, "print.as.list") <- TRUE + x +} tagQuerySelectedAsTags <- function(selected) { - # return as tagList - do.call(tagList, lapply(selected, tagEnvToTags)) + # return as a `tagList()` with a special attr that will cause it to print like a list + tagListPrintAsList(!!!lapply(selected, tagEnvToTags)) } -tagQueryPrint <- function(root, selected) { +tagQueryPrint <- function(pseudoRoot, selected) { cat("Root:\n") - print(tagQueryRootAsTags(root)) + print(tagQueryTopLevelTags(pseudoRoot)) cat("\nSelected:") if (length(selected) == 0) { cat(" (Empty)\n") } else { - if (length(selected) == 1 && isRootTag(selected[[1]])) { + if (identical(pseudoRoot$children, selected)) { cat(" (Root)\n") } else { cat("\n") @@ -1321,11 +1331,12 @@ tagQueryClassToggle <- function(els, class) { # Return a list of `root$children`. -tagQueryFindResetSelected <- function(root) { - if (!isTagEnv(root)) { - stop("`root` must be a tag environment") +# This may change if root ends up becoming a list of elements +tagQueryFindResetSelected <- function(pseudoRoot) { + if (!isTagEnv(pseudoRoot)) { + stop("`pseudoRoot` must be a tag environment") } - Filter(root$children, f = isTagEnv) + Filter(pseudoRoot$children, f = isTagEnv) } # Return a list of the unique set of parent elements tagQueryFindParent <- function(els, cssSelector = NULL) { @@ -1476,7 +1487,7 @@ cssSelectorToSelector <- function(cssSelector) { selectorList <- asSelectorList(cssSelector) if (length(selectorList) > 1) { stop( - "Can only match a single element selector. ", + "Can only match using a simple CSS selector. ", "Looking for descendant elements is not allowed." ) } diff --git a/R/tags.R b/R/tags.R index c8c9e5fd..2db37698 100644 --- a/R/tags.R +++ b/R/tags.R @@ -211,7 +211,15 @@ as.character.html <- function(x, ...) { } #' @export -print.shiny.tag.list <- print.shiny.tag +print.shiny.tag.list <- function(x, ...) { + if (isTRUE(attr(x, "print.as.list", exact = TRUE))) { + attr(x, "print.as.list") <- NULL + class(x) <- setdiff(class(x), "shiny.tag.list") + return(print(x)) + } + + print.shiny.tag(x, ...) +} #' @export format.shiny.tag.list <- format.shiny.tag @@ -1159,7 +1167,7 @@ as.tags.default <- function(x, ...) { # will get here. (tagLists will already have been handled by # as.tags.shiny.tag.list) if (is.list(x)) { - do.call(tagList, unclass(x)) + tagList(!!!unclass(x)) } else { tagList(as.character(x)) } @@ -1199,7 +1207,7 @@ as.tags.shiny.tag.function <- function(x, ...) { as.tags.list <- function(x, ...) { # Only non-classed lists will hit this method # (classed lists will reach the default method) - do.call(tagList, x) + tagList(!!!x) } #' @export diff --git a/man/tagQuery.Rd b/man/tagQuery.Rd index 4021c904..27598c51 100644 --- a/man/tagQuery.Rd +++ b/man/tagQuery.Rd @@ -7,9 +7,7 @@ tagQuery(tags) } \arguments{ -\item{tags}{Any standard tag object or \code{tagList()}. If a \code{list()} or -\code{tagList()} is provided, a \code{tagList()} will be returned when calling -\verb{$selected()}.} +\item{tags}{Any standard tag object or \code{tagList()}.} } \value{ A \code{tagQuery()} object. The \code{tag} supplied will be considered the @@ -37,7 +35,7 @@ For example, it is difficult to find a set of tags and alter the parent tag when working with standard \code{\link{tag}} objects. With \code{tagQuery()}, it is possible to find all \verb{} tags that match the css selector \verb{div .inner span}, then ask for the grandparent tag objects, then add a class to these grandparent -tag elements. This could be accomplished using code similar to\if{html}{\out{
}}\preformatted{span")$parent()$parent()$addClass("custom-class")$root() +tag elements. This could be accomplished using code similar to\if{html}{\out{
}}\preformatted{span")$parent()$parent()$addClass("custom-class")$allTags() }\if{html}{\out{
}} This style of alteration is not easily achieved when using typical "pass by @@ -53,7 +51,7 @@ reference). Meaning that if a css class is added to each selected tag environment using \verb{$addClass()} and the result of the method call is ignored, the selected tag environments within the tag query object will still contain the class addition. The added class will exist when the tag query tag -environment are converted back to standard tags objects with \verb{$selected()}. +environment are converted back to standard tags objects with \verb{$selectedTags()}. Tag environments also contain an extra field, \code{.$parent}. The \code{.$parent} value contains their parent tag environment. The top level tags supplied to @@ -71,7 +69,7 @@ parent to child relationship and up to 1 parent per child. A \code{tagQuery()} behaves simliar to an R6 object in that internal values are altered in place. (but a \code{tagQuery()} object is not implemented with \code{R6}). The \code{tagQuery()}'s methods will return itself as much as possible, unless the -method is directly asking for information, e.g. \verb{$root()} or \verb{$selected()}. +method is directly asking for information, e.g. \verb{$allTags()} or \verb{$selectedTags()}. Internally, two important pieces of information are maintained: the root elements and the selected elements. The root tag environment will always @@ -83,23 +81,23 @@ environment. All \code{tagQuery()} methods will act on the selected elements unless declared otherwise. Tag query objects can be created from other tag query objects. Note, unless -there is an intermediate call to \verb{$selected()}, the original and new tag query +there is an intermediate call to \verb{$selectedTags()}, the original and new tag query objects will share the same tag environments. The new tag query object will have its selected elements reset. For example:\if{html}{\out{
}}\preformatted{x <- tagQuery(div()) y <- tagQuery(x) -z <- tagQuery(x$root()) +z <- tagQuery(x$allTags()) # Add an example class y$addClass("example") # Show `x` and `y` both have the new class -x$selected() +x$selectedTags() #>
-y$selected() +y$selectedTags() #>
-# `z` is isolated from the changes in `x` and `y` due to the `$selected()` -z$selected() +# `z` is isolated from the changes in `x` and `y` due to the `$selectedTags()` +z$selectedTags() #>
}\if{html}{\out{
}} } @@ -109,7 +107,7 @@ z$selected() \code{tagQuery()}s can \strong{not} be used directly within typical \code{tag} locations. -An error should be thrown. Instead, please call \verb{$selected()} to retrieve the +An error should be thrown. Instead, please call \verb{$selectedTags()} to retrieve the tag structures of the selected tag elements or root element respectively. } @@ -162,7 +160,7 @@ elements. \item \verb{$closest(cssSelector = NULL)}: For each selected element, get the closest ancestor element (including itself) that matches the single-element CSS selector. If \code{cssSelector = NULL}, it is -equivalent to calling \verb{$selected()}. A new \code{tagQuery()} object will be +equivalent to calling \verb{$selectedTags()}. A new \code{tagQuery()} object will be created with the selected items set to the closest matching elements. \item \code{siblings(cssSelector = NULL)}: Get the siblings of each element in the set of matched elements. If a CSS selector is provided, only the @@ -176,7 +174,7 @@ the single-element CSS selector. A new \code{tagQuery()} object will be created with the selected items set to the filtered selected elements. Remember, any alterations to the provided tag environments will persist in calling tag query object. If you need to make local changes, consider -using \code{tagQuery(el)$selected()} to use standard tag objects. +using \code{tagQuery(el)$selectedTags()} to use standard tag objects. \item \verb{$resetSelected()}: A new \code{tagQuery()} object will be created with the selected items set to the top level tag objects. } @@ -244,18 +242,17 @@ consistent with other methods, the each of the selected tag environments will be given first, followed by the index position. Remember, any alterations to the provided tag environments will persist in calling tag query object. If you need to make local changes, consider -using \code{tagQuery(el)$selected()} to use standard tag objects. +using \code{tagQuery(el)$selectedTags()} to use standard tag objects. } } \subsection{Tag Query methods}{ \itemize{ -\item \verb{$root()}: Converts the top level tag +\item \verb{$allTags()}: Converts the top level (root) tag elements (and their descendants) from tag environments to -standard \code{\link{tag}} objects. If there is more than one element being -returned, a \code{\link[=tagList]{tagList()}} will be used to hold all of the -tags. -\item \verb{$selected()}: Converts the selected tag environments +standard \code{\link{tag}} objects. All root tags will be returned in a +\code{\link[=tagList]{tagList()}}. +\item \verb{$selectedTags()}: Converts the selected tag environments to standard \code{\link{tag}} objects. The selected tags will be returned in a \code{\link[=tagList]{tagList()}}. \item \verb{$rebuild()}: Makes sure that all tags have been upgraded to tag @@ -264,7 +261,7 @@ altered. This method is internally called before each method executes and after any alterations where standard tag objects could be introduced into the tag structure. \item \verb{$print()}: Internal print method. Called by -\code{print.htmltools.tag.query()} +\code{print.shiny.tag.query()} } } } diff --git a/tests/testthat/test-tag-query.R b/tests/testthat/test-tag-query.R index 41b05f21..553324c4 100644 --- a/tests/testthat/test-tag-query.R +++ b/tests/testthat/test-tag-query.R @@ -30,6 +30,10 @@ expect_equal_tags <- function(x, y) { } else if (is.list(x)) { if (isTagList(x)) { expect_true(isTagList(y)) + expect_equal( + attr(x, "print.as.list", exact = TRUE), + attr(y, "print.as.list", exact = TRUE) + ) } else { expect_true(is.list(y)) } @@ -76,7 +80,7 @@ test_that("asTagEnv upgrades objects", { x <- div(class = "test_class", span(class = "inner")) xTagEnv <- asTagEnv(x) - expect_s3_class(xTagEnv, "htmltools.tag.env") + expect_s3_class(xTagEnv, "shiny.tag.env") expect_s3_class(xTagEnv, "shiny.tag") expect_null(xTagEnv$parent) @@ -86,7 +90,7 @@ test_that("asTagEnv upgrades objects", { expect_equal(length(xTagEnv$children), length(x$children)) lapply(xTagEnv$children, function(child) { - expect_s3_class(child, "htmltools.tag.env") + expect_s3_class(child, "shiny.tag.env") expect_equal(child$parent$envKey, xTagEnv$envKey) }) @@ -131,28 +135,28 @@ test_that("tagQuery() root values", { expect_error(tagQuery(fakeTagFunction), "initial set") x <- tagQuery(div(span(), a()))$find("span") - # expect_equal_tags(x$selected(), visibleTagList(span())) - # expect_equal_tags(x$selected(), visibleTagList(div(span(), a()))) + # expect_equal_tags(x$selectedTags(), tagListPrintAsList(span())) + # expect_equal_tags(x$selectedTags(), tagListPrintAsList(div(span(), a()))) # supply a tag query object - expect_equal_tags(tagQuery(x)$selected(), x$selected()) - expect_equal_tags(tagQuery(x)$root(), x$root()) + expect_equal_tags(tagQuery(x)$selectedTags(), x$selectedTags()) + expect_equal_tags(tagQuery(x)$allTags(), x$allTags()) # supply a list of tag envs tagEnvs <- list() x$each(function(el, i) { tagEnvs[[length(tagEnvs) + 1]] <<- el}) - expect_equal_tags(tagQuery(tagEnvs)$selected(), x$selected()) - expect_equal_tags(tagQuery(tagEnvs)$root(), x$root()) + expect_equal_tags(tagQuery(tagEnvs)$selectedTags(), x$selectedTags()) + expect_equal_tags(tagQuery(tagEnvs)$allTags(), x$allTags()) # supply a single tag env - expect_equal_tags(tagQuery(tagEnvs[[1]])$selected(), x$selected()) - expect_equal_tags(tagQuery(tagEnvs[[1]])$root(), x$root()) + expect_equal_tags(tagQuery(tagEnvs[[1]])$selectedTags(), x$selectedTags()) + expect_equal_tags(tagQuery(tagEnvs[[1]])$allTags(), x$allTags()) }) test_that("tagQuery() structure", { x <- tagQuery(div()) - expect_s3_class(x, "htmltools.tag.query") + expect_s3_class(x, "shiny.tag.query") lapply(x, function(xI) { expect_true(is.function(xI)) }) }) @@ -163,26 +167,26 @@ test_that("tagQuery()$find()", { newX <- x$find("span") expect_failure( expect_equal( - x$selected(), - newX$selected() + x$selectedTags(), + newX$selectedTags() ) ) x <- x$find("span") - expect_length(x$selected(), 2) + expect_length(x$selectedTags(), 2) expect_equal_tags( - x$selected(), - tagList(span("a"), span("b")) + x$selectedTags(), + tagListPrintAsList(span("a"), span("b")) ) ul <- tags$ul li <- tags$li x <- tagQuery(div(div(div(ul(li("a"), li("b"), li("c")))))) - expect_length(x$selected(), 1) + expect_length(x$selectedTags(), 1) x <- x$find("div") - expect_length(x$selected(), 2) + expect_length(x$selectedTags(), 2) x <- x$find("div") - expect_length(x$selected(), 1) + expect_length(x$selectedTags(), 1) x <- tagQuery( div( @@ -192,50 +196,50 @@ test_that("tagQuery()$find()", { ) ) x <- x$find("a") - expect_length(x$selected(), 2) + expect_length(x$selectedTags(), 2) x <- x$resetSelected() x <- x$find("a > p") - expect_length(x$selected(), 1) - expect_equal_tags(x$selected(), tagList(p("text2"))) + expect_length(x$selectedTags(), 1) + expect_equal_tags(x$selectedTags(), tagListPrintAsList(p("text2"))) x <- x$resetSelected() x <- x$find("a > > p") - expect_length(x$selected(), 1) - expect_equal_tags(x$selected(), tagList(p("text1"))) + expect_length(x$selectedTags(), 1) + expect_equal_tags(x$selectedTags(), tagListPrintAsList(p("text1"))) x <- x$resetSelected() x <- x$find("div > *") - expect_length(x$selected(), 2) - expect_equal_tags(x$selected(), tagList(a(span(p("text1"))), a(p("text2")))) + expect_length(x$selectedTags(), 2) + expect_equal_tags(x$selectedTags(), tagListPrintAsList(a(span(p("text1"))), a(p("text2")))) x <- x$resetSelected() x <- x$find("div>>p") - expect_length(x$selected(), 1) - expect_equal_tags(x$selected(), tagList(p("text2"))) + expect_length(x$selectedTags(), 1) + expect_equal_tags(x$selectedTags(), tagListPrintAsList(p("text2"))) }) test_that("tagQuery()$filter()", { x <- tagQuery(div(span(1), span(2), span(3), span(4), span(5))) x <- x$find("span") - expect_length(x$selected(), 5) + expect_length(x$selectedTags(), 5) # keep the even found elements x <- x$filter(function(item, i) { # is even (i %% 2) == 0 }) - expect_length(x$selected(), 2) + expect_length(x$selectedTags(), 2) # keep the filtered even elements. Should only have the 4th one remaining x <- x$filter(function(item, i) { # is even (i %% 2) == 0 }) - expect_length(x$selected(), 1) + expect_length(x$selectedTags(), 1) - expect_equal_tags(x$selected(), tagList(span(4))) + expect_equal_tags(x$selectedTags(), tagListPrintAsList(span(4))) }) test_that("tagQuery()$children() & tagQuery()$parent()", { @@ -252,13 +256,13 @@ test_that("tagQuery()$children() & tagQuery()$parent()", { ) x <- x$find("div") - expect_length(x$selected(), 2) + expect_length(x$selectedTags(), 2) x <- x$children() - expect_length(x$selected(), 4) + expect_length(x$selectedTags(), 4) expect_equal_tags( - x$selected(), - tagList( + x$selectedTags(), + tagListPrintAsList( span(class = "A", "1"), span(class = "B", "2"), span(class = "C", "3"), @@ -267,18 +271,18 @@ test_that("tagQuery()$children() & tagQuery()$parent()", { ) x <- x$parent() - expect_length(x$selected(), 2) + expect_length(x$selectedTags(), 2) x <- x$children(".C") - expect_length(x$selected(), 1) + expect_length(x$selectedTags(), 1) x <- x$parent() - expect_length(x$selected(), 1) + expect_length(x$selectedTags(), 1) secondDiv <- div(class = "b", span(class = "C", "3"), span(class = "D", "4")) - expect_equal_tags(x$selected(), tagList(secondDiv)) + expect_equal_tags(x$selectedTags(), tagListPrintAsList(secondDiv)) x <- x$resetSelected()$find("span")$parents(".b") - expect_length(x$selected(), 1) - expect_equal_tags(x$selected(), tagList(secondDiv)) + expect_length(x$selectedTags(), 1) + expect_equal_tags(x$selectedTags(), tagListPrintAsList(secondDiv)) }) @@ -295,29 +299,29 @@ test_that("tagQuery()$parents() && tagQuery()$closest()", { ) x <- tagQuery(xTags) - expect_length(x$selected(), 1) + expect_length(x$selectedTags(), 1) xc <- x$find("span")$closest("div") - expect_length(xc$selected(), 1) + expect_length(xc$selectedTags(), 1) expect_true(xc$hasClass("inner")) xc <- x$find("span")$closest() - expect_length(xc$selected(), 5) + expect_length(xc$selectedTags(), 5) xc$each(function(el, i) { expect_equal(el$name, "span") }) xp <- x$find("span")$parents("div") - expect_length(xp$selected(), 2) + expect_length(xp$selectedTags(), 2) expect_equal(xp$hasClass("outer"), c(FALSE, TRUE)) expect_equal(xp$hasClass("inner"), c(TRUE, FALSE)) x <- x$find("span")$parents() - expect_length(x$selected(), 3) + expect_length(x$selectedTags(), 3) expect_equal_tags( - x$selected(), - tagList( + x$selectedTags(), + tagListPrintAsList( xTags$children[[1]]$children[[1]], xTags$children[[1]], xTags @@ -325,11 +329,11 @@ test_that("tagQuery()$parents() && tagQuery()$closest()", { ) x <- x$resetSelected()$find("span")$parents(".outer") - expect_length(x$selected(), 1) + expect_length(x$selectedTags(), 1) expect_equal_tags( - x$selected(), - tagList(xTags) + x$selectedTags(), + tagListPrintAsList(xTags) ) }) @@ -343,9 +347,9 @@ test_that("tagQuery()$siblings()", { span("e") ) x <- tagQuery(xTags) - expect_length(x$selected(), 5) + expect_length(x$selectedTags(), 5) x <- x$siblings() - expect_length(x$selected(), 5) + expect_length(x$selectedTags(), 5) xTags <- tagList( span("a"), @@ -355,11 +359,11 @@ test_that("tagQuery()$siblings()", { span("e") ) x <- tagQuery(xTags) - expect_length(x$selected(), 5) + expect_length(x$selectedTags(), 5) x <- x$filter(".middle") - expect_length(x$selected(), 1) + expect_length(x$selectedTags(), 1) x <- x$siblings() - expect_length(x$selected(), 4) + expect_length(x$selectedTags(), 4) }) test_that("tagQuery()$addClass()", { @@ -371,11 +375,11 @@ test_that("tagQuery()$addClass()", { ) x <- tagQuery(xTags) - expect_length(x$selected(), 1) + expect_length(x$selectedTags(), 1) x <- x$find("div.inner")$addClass("test-class") - expect_length(x$selected(), 1) + expect_length(x$selectedTags(), 1) - expect_equal(x$selected()[[1]]$attribs$class, "inner test-class") + expect_equal(x$selectedTags()[[1]]$attribs$class, "inner test-class") expect_silent({ x$addClass(NULL) @@ -407,7 +411,7 @@ test_that("tagQuery()$hasClass(), $toggleClass(), $removeClass()", { x <- tagQuery(xTags) x <- x$find("div.A") - expect_length(x$selected(), 1) + expect_length(x$selectedTags(), 1) expect_equal(x$hasClass("B A"), TRUE) expect_equal(x$hasClass("A B"), TRUE) expect_equal(x$hasClass("B"), TRUE) @@ -441,7 +445,7 @@ test_that("tagQuery()$addAttrs(), $removeAttrs(), $emptyAttrs(), $hasAttr", { ) x <- tagQuery(xTags) - expect_length(x$selected(), 5) + expect_length(x$selectedTags(), 5) expect_equal(x$hasAttr("key"), c(TRUE, TRUE, FALSE, FALSE, TRUE)) x$addAttrs(key2 = "val2", key3 = "val3") @@ -467,7 +471,7 @@ test_that("tagQuery()$append()", { newa <- span("a") x$append(newa) expect_equal_tags( - x$root(), + x$allTags(), div(span("child"), newa) ) @@ -476,7 +480,7 @@ test_that("tagQuery()$append()", { x$append(new1, new2) expect_equal_tags( - x$root(), + x$allTags(), div(span("child"), newa, new1, new2) ) }) @@ -488,7 +492,7 @@ test_that("tagQuery()$prepend()", { newa <- span("a") x$prepend(newa) expect_equal_tags( - x$root(), + x$allTags(), div(newa, span("child")) ) @@ -497,7 +501,7 @@ test_that("tagQuery()$prepend()", { x$prepend(new1, new2) expect_equal_tags( - x$root(), + x$allTags(), div(new1, new2, newa, span("child")) ) }) @@ -518,14 +522,14 @@ test_that("tagQuery()$each()", { }) expect_equal_tags( - x$root(), + x$allTags(), div(span("A"), h1("title"), span("B")) ) }) -test_that("tagQuery()$root() & tagQuery()$rebuild()", { +test_that("tagQuery()$allTags() & tagQuery()$rebuild()", { xTags <- div(span("a"), h1("title"), span("b")) x <- tagQuery(xTags) @@ -536,7 +540,7 @@ test_that("tagQuery()$root() & tagQuery()$rebuild()", { }) # retrieve the root (and direct children) from graph - rootChildren <- x$root()$children + rootChildren <- x$allTags()$children lastChild <- rootChildren[[length(rootChildren)]] # make sure the last child is a tag env (not a standard tag) @@ -557,20 +561,20 @@ test_that("tagQuery()$remove()", { span("e") ) x <- tagQuery(xTags)$find("span") - expect_length(x$selected(), 5) + expect_length(x$selectedTags(), 5) x <- x$filter(".A")$remove() - expect_length(x$selected(), 0) + expect_length(x$selectedTags(), 0) expect_equal_tags( - x$root(), + x$allTags(), div(span("a"), span("c"), span("e")) ) x <- x$resetSelected()$find("span") - expect_length(x$selected(), 3) + expect_length(x$selectedTags(), 3) x <- x$remove() expect_equal_tags( - x$root(), + x$allTags(), div() ) }) @@ -583,7 +587,7 @@ test_that("tagQuery()$after()", { newa <- span("a") x$after(newa) expect_equal_tags( - x$root(), + x$allTags(), tagList(xTags, newa) ) @@ -592,7 +596,7 @@ test_that("tagQuery()$after()", { x$after(new1, new2) expect_equal_tags( - x$root(), + x$allTags(), tagList(xTags, new1, new2, newa) ) }) @@ -604,7 +608,7 @@ test_that("tagQuery()$before()", { newa <- span("a") x$before(newa) expect_equal_tags( - x$root(), + x$allTags(), tagList(newa, xTags) ) @@ -613,13 +617,13 @@ test_that("tagQuery()$before()", { x$before(new1, new2) expect_equal_tags( - x$root(), + x$allTags(), tagList(newa, new1, new2, xTags) ) }) -test_that("tagQuery(x)$root()", { +test_that("tagQuery(x)$allTags()", { xTags <- tagList( fakeJqueryDep, @@ -631,8 +635,8 @@ test_that("tagQuery(x)$root()", { x <- tagQuery(xTags) expect_equal_tags( - x$root(), - xTags + x$allTags(), + tagList(!!!xTags) ) }) @@ -655,15 +659,15 @@ test_that("tagQuery() objects inherit from each other objects", { expected <- div(span(class="extra", "text")) - expect_equal_tags(x$selected(), tagList(expected$children[[1]])) - expect_equal_tags(y$selected(), tagList(expected$children[[1]])) - expect_equal_tags(z$selected(), tagList(expected$children[[1]])) - expect_equal_tags(w$selected(), tagList(expected$children[[1]])) + expect_equal_tags(x$selectedTags(), tagListPrintAsList(!!!expected$children)) + expect_equal_tags(y$selectedTags(), tagListPrintAsList(!!!expected$children)) + expect_equal_tags(z$selectedTags(), tagListPrintAsList(!!!expected$children)) + expect_equal_tags(w$selectedTags(), tagListPrintAsList(!!!expected$children)) - expect_equal_tags(x$root(), expected) - expect_equal_tags(y$root(), expected) - expect_equal_tags(z$root(), expected) - expect_equal_tags(w$root(), expected) + expect_equal_tags(x$allTags(), expected) + expect_equal_tags(y$allTags(), expected) + expect_equal_tags(z$allTags(), expected) + expect_equal_tags(w$allTags(), expected) }) @@ -705,24 +709,18 @@ test_that("rebuilding tag envs after inserting children is done", { xTags <- div(div(), div()) expect_equal_tags( - tagQuery(xTags)$find("div")$before(span())$root(), - # visibleTagList( - div(span(), div(), span(), div()) - # ) + tagQuery(xTags)$find("div")$before(span())$allTags(), + div(span(), div(), span(), div()) ) expect_equal_tags( - tagQuery(xTags)$find("div")$replaceWith(span())$root(), - # visibleTagList( - div(span(), span()) - # ) + tagQuery(xTags)$find("div")$replaceWith(span())$allTags(), + div(span(), span()) ) expect_equal_tags( - tagQuery(xTags)$find("div")$after(span())$root(), - # visibleTagList( - div(div(), span(), div(), span()) - # ) + tagQuery(xTags)$find("div")$after(span())$allTags(), + div(div(), span(), div(), span()) ) })