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{