Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Simplify HTML() #315

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,10 @@

* Closed #305: `htmlPreserve()` no longer uses _inline_ code blocks for Pandoc's raw attribute feature when used inside a _non_-inline knitr/rmarkdown code chunk, and as a result, in this case, an additional `<p>` tag is no longer wrapped around the HTML content. (#306)

## New Features & Improvements

* The `HTML()` function has been simplified. It now only adds an `"html"` class and no longer adds an `"html"` attribute. (#315)

## Bug fixes

* Closed #301: `tagQuery()` was failing to copy all `tagList()` html dependencies within nest child tag lists. `tagQuery()` will now relocate html dependencies as child objects. (#302)
Expand Down
17 changes: 9 additions & 8 deletions R/tags.R
Original file line number Diff line number Diff line change
Expand Up @@ -259,7 +259,7 @@ format.html <- function(x, ...) {
}

normalizeText <- function(text) {
if (!is.null(attr(text, "html", TRUE)))
if (inherits(text, "html"))
text
else
htmlEscape(text, attribute=FALSE)
Expand Down Expand Up @@ -1154,9 +1154,8 @@ resolveFunctionalDependencies <- function(dependencies) {
#' Marks the given text as HTML, which means the [tag] functions will know
#' not to perform HTML escaping on it.
#'
#' @param text The text value to mark with HTML
#' @param ... Any additional values to be converted to character and
#' concatenated together
#' @param ... Text to mark with HTML. Any additional values after the first will
#' to be converted to character, and all will be concatenated together.
#' @param .noWS Character vector used to omit some of the whitespace that would
#' normally be written around this HTML. Valid options include `before`,
#' `after`, and `outside` (equivalent to `before` and
Expand All @@ -1168,12 +1167,14 @@ resolveFunctionalDependencies <- function(dependencies) {
#' cat(as.character(el))
#'
#' @export
HTML <- function(text, ..., .noWS = NULL) {
htmlText <- c(text, as.character(dots_list(...)))
HTML <- function(..., .noWS = NULL) {
htmlText <- as.character(dots_list(...))
if (length(htmlText) == 0) {
stop("HTML() requires at least one item")
}
htmlText <- paste8(htmlText, collapse=" ")
attr(htmlText, "html") <- TRUE
attr(htmlText, "noWS") <- .noWS
class(htmlText) <- c("html", "character")
class(htmlText) <- "html"
htmlText
}

Expand Down
8 changes: 3 additions & 5 deletions man/HTML.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

39 changes: 23 additions & 16 deletions tests/testthat/test-tags.r
Original file line number Diff line number Diff line change
Expand Up @@ -211,13 +211,17 @@ test_that("Adding child tags", {
expect_identical(t2a, t2)


# tagSetChildren preserves attributes
x <- tagSetChildren(div(), HTML("text"))
expect_identical(attr(x$children[[1]], "html", TRUE), TRUE)
# tagSetChildren preserves classes and attributes
txt <- HTML("text")
attr(txt, "myattr") <- "foo"
x <- tagSetChildren(div(), txt)
expect_true(inherits(x$children[[1]], "html"))
expect_identical(attr(x$children[[1]], "myattr", TRUE), "foo")

# tagAppendChildren preserves attributes
x <- tagAppendChildren(div(), HTML("text"))
expect_identical(attr(x$children[[1]], "html", TRUE), TRUE)
x <- tagAppendChildren(div(), txt)
expect_true(inherits(x$children[[1]], "html"))
expect_identical(attr(x$children[[1]], "myattr", TRUE), "foo")
})


Expand Down Expand Up @@ -389,22 +393,25 @@ test_that("tag/s with invalid noWS fails fast", {
})

test_that("Attributes are preserved", {
# HTML() adds an attribute to the data structure (note that this is
# different from the 'attribs' field in the list)
x <- HTML("<tag>&&</tag>")
expect_identical(attr(x, "html", TRUE), TRUE)
expect_equivalent(format(x), "<tag>&&</tag>")
html_txt <- HTML("<tag>&&</tag>")
attr(html_txt, "myattr") <- "foo"

expect_true(inherits(html_txt, "html"))
expect_identical(attr(html_txt, "myattr", TRUE), "foo")
expect_equivalent(format(html_txt), "<tag>&&</tag>")

# Make sure attributes are preserved when wrapped in other tags
x <- div(HTML("<tag>&&</tag>"))
expect_equivalent(x$children[[1]], HTML("<tag>&&</tag>"))
expect_identical(attr(x$children[[1]], "html", TRUE), TRUE)
x <- div(html_txt)
expect_equivalent(x$children[[1]], html_txt)
expect_true(inherits(x$children[[1]], "html"))
expect_identical(attr(x$children[[1]], "myattr", TRUE), "foo")
expect_equivalent(format(x), "<div><tag>&&</tag></div>")

# Deeper nesting
x <- div(p(HTML("<tag>&&</tag>")))
expect_equivalent(x$children[[1]]$children[[1]], HTML("<tag>&&</tag>"))
expect_identical(attr(x$children[[1]]$children[[1]], "html", TRUE), TRUE)
x <- div(p(html_txt))
expect_equivalent(x$children[[1]]$children[[1]], html_txt)
expect_true(inherits(x$children[[1]]$children[[1]], "html"))
expect_identical(attr(x$children[[1]]$children[[1]], "myattr", TRUE), "foo")
expect_equivalent(format(x), "<div>\n <p><tag>&&</tag></p>\n</div>")
})

Expand Down