Simplify HTML()

Author: wch

NEWS.md

@@ -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)

R/tags.R

@@ -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)
@@ -1168,12 +1168,11 @@ 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(...))
   htmlText <- paste8(htmlText, collapse=" ")
-  attr(htmlText, "html") <- TRUE
   attr(htmlText, "noWS") <- .noWS
-  class(htmlText) <- c("html", "character")
+  class(htmlText) <- "html"
   htmlText
 }
 

tests/testthat/test-tags.r

@@ -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")
 })
 
 
@@ -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>")
 })