Add .noWS argument to withTags()

NEWS.md

@@ -7,6 +7,8 @@
 
 * Added `tagAddRenderHook()` for delaying modification of a tag object until it is rendered. A list of render-time hooks may also be added via the new `.renderHook` argument added to all `tag()` functions. (#215)
 
+* Closed #243: Added `withTags(.noWS)` to change the default whitespace behavior for all tags within the call to `withTags()`. (#245)
+
 * Closed #251: Added `.cssSelector` parameters to tag modifying functions such as `tagAppendChildren()` or `tagAppendChildren()`. The `.cssSelector` allows you to target particular (inner) tags of interest. See `tagAppendChildren()` for examples. (#224)
 
 * Closed #225: Added `tagInsertChildren()` to be able to insert child tag objects at a particular location. (#224)

R/tags.R

@@ -1157,6 +1157,9 @@ HTML <- function(text, ..., .noWS = NULL) {
 #' namespace, as in `base::source()` or `base::summary()`.
 #'
 #' @param code A set of tags.
+#' @param .noWS Default whitespace behavior for all tags within this call to
+#'   `withTags()`. Setting `.noWS` on an individual tag fuction inside
+#'   `withTags()` will override the default. See [tag()] for complete options.
 #'
 #' @examples
 #' # Using tags$ each time
@@ -1173,9 +1176,27 @@ HTML <- function(text, ..., .noWS = NULL) {
 #'   )
 #' )
 #'
+#' # Setting .noWS for all tags in withTags()
+#' withTags(
+#'   div(
+#'     class = "myclass",
+#'     h3("header"),
+#'     p("One", strong(span("two")), "three")
+#'   ),
+#'   .noWS = c("outside", "inside")
+#' )
+#'
 #'
 #' @export
-withTags <- function(code) {
+withTags <- function(code, .noWS = NULL) {
+  if (!is.null(.noWS)) {
+    .noWSWithTags <- .noWS
+    tags <- lapply(tags, function(tag) {
+      function(..., .noWS = .noWSWithTags) {
+        tag(..., .noWS = .noWS)
+      }
+    })
+  }
   eval(substitute(code), envir = as.list(tags), enclos = parent.frame())
 }
 

tests/testthat/test-tags.r

@@ -58,6 +58,70 @@ test_that("withTags works", {
   expect_identical(tags$p(100), foo())
 })
 
+test_that(".noWS argument of withTags()", {
+  get_noWS <- function(tag) tag[[".noWS"]]
+
+  default <- withTags(
+    div(
+      class = "myclass",
+      h3("header"),
+      p("One", strong(span("two")), "three")
+    )
+  )
+
+  expect_null(get_noWS(default))
+  expect_null(get_noWS(default$children[[1]]))
+  expect_null(get_noWS(default$children[[2]]))
+  expect_null(get_noWS(default$children[[2]]$children[[2]]))
+  expect_null(get_noWS(default$children[[2]]$children[[2]]$children[[1]]))
+
+  default_special <- withTags(
+    div(
+      class = "myclass",
+      h3("header", .noWS = "after-begin"),
+      p("One", strong(span("two")), "three", .noWS = "before-end")
+    )
+  )
+
+  expect_null(get_noWS(default_special))
+  expect_equal(get_noWS(default_special$children[[1]]), "after-begin")
+  expect_equal(get_noWS(default_special$children[[2]]), "before-end")
+  expect_null(get_noWS(default_special$children[[2]]$children[[2]]))
+  expect_null(get_noWS(default_special$children[[2]]$children[[2]]$children[[1]]))
+
+  all_same_noWS <- c("outside", "inside")
+  all_same <- withTags(
+    div(
+      class = "myclass",
+      h3("header"),
+      p("One", strong(span("two")), "three")
+    ),
+    .noWS = all_same_noWS
+  )
+
+  expect_equal(get_noWS(all_same), all_same_noWS)
+  expect_equal(get_noWS(all_same$children[[1]]), all_same_noWS)
+  expect_equal(get_noWS(all_same$children[[2]]), all_same_noWS)
+  expect_equal(get_noWS(all_same$children[[2]]$children[[2]]), all_same_noWS)
+  expect_equal(get_noWS(all_same$children[[2]]$children[[2]]$children[[1]]), all_same_noWS)
+
+  varied_default <- "outside"
+  varied_special <- "inside"
+  varied <- withTags(
+    div(
+      class = "myclass",
+      h3("header"),
+      p("One", strong(span("two"), .noWS = varied_special), "three")
+    ),
+    .noWS = varied_default
+  )
+
+  expect_equal(get_noWS(varied), varied_default)
+  expect_equal(get_noWS(varied$children[[1]]), varied_default)
+  expect_equal(get_noWS(varied$children[[2]]), varied_default)
+  expect_equal(get_noWS(varied$children[[2]]$children[[2]]), varied_special)
+  expect_equal(get_noWS(varied$children[[2]]$children[[2]]$children[[1]]), varied_default)
+})
 
 test_that("HTML escaping in tags", {
   # Regular text is escaped