21.5 Tags (calls)

tag <- function(tag) {
  new_function(
    exprs(... = ), #arguments of new function
    expr({         #body of the new function
      
      #classify tags as named components
      dots <- dots_partition(...)
      
      #focus on named components as the tags
      attribs <- html_attributes(dots$named)
      
      # otherwise, nested code
      children <- map_chr(dots$unnamed, escape)

      # paste brackets, tag names, and attributes together
      # then unquote user arguments
      html(paste0(
        !!paste0("<", tag), attribs, ">",
        paste(children, collapse = ""),
        !!paste0("</", tag, ">")
      ))
    }),
    caller_env() #return the environment
  )
}
Void tags 
void_tag <- function(tag) {
  new_function(
    exprs(... = ), #allows for missing arguments
    expr({
      dots <- dots_partition(...)
      
      # error check
      if (length(dots$unnamed) > 0) {
        abort(!!paste0("<", tag, "> must not have unnamed arguments"))
      }
      attribs <- html_attributes(dots$named)

      html(paste0(!!paste0("<", tag), attribs, " />"))
    }),
    caller_env()
  )
}

21.5.1 Checks

tag("ol")
#> function (...) 
#> {
#>     dots <- dots_partition(...)
#>     attribs <- html_attributes(dots$named)
#>     children <- map_chr(dots$unnamed, escape)
#>     html(paste0("<ol", attribs, ">", paste(children, collapse = ""), 
#>         "</ol>"))
#> }
img <- void_tag("img")
img()

img(src = "images/translating/calculus_cat.png",
    width = 100,
    height = 100)
#> <HTML> <img src='images/translating/calculus_cat.png' width='100'
#> height='100' />