Add tagFunction() awareness to tag modifying functions

NAMESPACE

@@ -18,6 +18,14 @@ S3method(print,html)
 S3method(print,html_dependency)
 S3method(print,shiny.tag)
 S3method(print,shiny.tag.list)
+S3method(tagAppendAttributes,default)
+S3method(tagAppendAttributes,shiny.tag.function)
+S3method(tagAppendChild,default)
+S3method(tagAppendChild,shiny.tag.function)
+S3method(tagAppendChildren,default)
+S3method(tagAppendChildren,shiny.tag.function)
+S3method(tagSetChildren,default)
+S3method(tagSetChildren,shiny.tag.function)
 export("htmlDependencies<-")
 export(HTML)
 export(a)

R/tags.R

@@ -291,24 +291,38 @@ tagFunction <- function(func) {
 #' @rdname tag
 #' @export
 tagAppendAttributes <- function(tag, ...) {
-  throw_if_tag_function(tag)
+  UseMethod("tagAppendAttributes")
+}
+
+#' @export
+tagAppendAttributes.default <- function(tag, ...) {
   tag$attribs <- c(tag$attribs, dropNullsOrEmpty(dots_list(...)))
   tag
 }
 
+#' @export
+tagAppendAttributes.shiny.tag.function <- function(tag, ...) {
+  force(tag)
+  force(...)
+  tagFunction(function() {
+    tag <- doTagFunction(tag)
+    tagAppendAttributes(tag, ...)
+  })
+}
+
 #' @param attr The name of an attribute.
 #' @rdname tag
 #' @export
 tagHasAttribute <- function(tag, attr) {
-  throw_if_tag_function(tag)
+  if (is_tag_function(tag)) stop("`tag` can not be a `tagFunction()`")
   result <- attr %in% names(tag$attribs)
   result
 }
 
 #' @rdname tag
 #' @export
 tagGetAttribute <- function(tag, attr) {
-  throw_if_tag_function(tag)
+  if (is_tag_function(tag)) stop("`tag` can not be a `tagFunction()`")
   # Find out which positions in the attributes list correspond to the given attr
   attribs <- tag$attribs
   attrIdx <- which(attr == names(attribs))
@@ -327,30 +341,76 @@ tagGetAttribute <- function(tag, attr) {
 #' @rdname tag
 #' @export
 tagAppendChild <- function(tag, child) {
-  throw_if_tag_function(tag)
-  tag$children[[length(tag$children)+1]] <- child
+  UseMethod("tagAppendChild")
+}
+
+#' @export
+tagAppendChild.default <- function(tag, child) {
+  tag$children[[length(tag$children) + 1]] <- child
   tag
 }
 
+#' @export
+tagAppendChild.shiny.tag.function <- function(tag, child) {
+  force(tag)
+  force(child)
+  tagFunction(function() {
+    tag <- doTagFunction(tag)
+    tagAppendChild(tag, child)
+  })
+}
+
+
 #' @rdname tag
 #' @export
 tagAppendChildren <- function(tag, ..., list = NULL) {
-  throw_if_tag_function(tag)
+  UseMethod("tagAppendChildren")
+}
+
+#' @export
+tagAppendChildren.default <- function(tag, ..., list = NULL) {
   tag$children <- unname(c(tag$children, c(dots_list(...), list)))
   tag
 }
 
+#' @export
+tagAppendChildren.shiny.tag.function <- function(tag, ..., list = NULL) {
+  force(tag)
+  force(...)
+  force(list)
+  tagFunction(function() {
+    tag <- doTagFunction(tag)
+    tagAppendChildren(tag, ..., list)
+  })
+}
+
 #' @rdname tag
 #' @export
 tagSetChildren <- function(tag, ..., list = NULL) {
-  throw_if_tag_function(tag)
+  UseMethod("tagSetChildren")
+}
+
+#' @export
+tagSetChildren.default <- function(tag, ..., list = NULL) {
   tag$children <- unname(c(dots_list(...), list))
   tag
 }
 
-throw_if_tag_function <- function(tag) {
-  if (is_tag_function(tag))
-    stop("`tag` can not be a `tagFunction()`")
+#' @export
+tagSetChildren.shiny.tag.function <- function(tag, ..., list = NULL) {
+  force(tag)
+  force(...)
+  force(list)
+  tagFunction(function() {
+    tag <- doTagFunction(tag)
+    tagSetChildren(tag, ..., list)
+  })
+}
+
+doTagFunction <- function(x) {
+  y <- x()
+  if (!isTag(y)) stop("tagFunction() must return a shiny.tag object")
+  y
 }
 
 #' HTML Tag Object

R/template.R

@@ -77,7 +77,7 @@ htmlTemplate <- function(filename = NULL, ..., text_ = NULL, document_ = "auto")
 #'
 #' This function renders \code{html_document} objects, and returns a string with
 #' the final HTML content. It calls the \code{\link{renderTags}} function to
-#' convert any shiny.tag objects to HTML. It also finds any any web dependencies
+#' convert any shiny.tag objects to HTML. It also finds any web dependencies
 #' (created by \code{\link{htmlDependency}}) that are attached to the tags, and
 #' inserts those. To do the insertion, this function finds the string
 #' \code{"<!-- HEAD_CONTENT -->"} in the document, and replaces it with the web