Nothing
#' Process an HTML template
#'
#' Process an HTML template and return a tagList object. If the template is a
#' complete HTML document, then the returned object will also have class
#' `html_document`, and can be passed to the function
#' [renderDocument()] to get the final HTML text.
#'
#' @param filename Path to an HTML template file. Incompatible with
#' `text_`.
#' @param ... Variable values to use when processing the template.
#' @param text_ A string to use as the template, instead of a file. Incompatible
#' with `filename`.
#' @param document_ Is this template a complete HTML document (`TRUE`), or
#' a fragment of HTML that is to be inserted into an HTML document
#' (`FALSE`)? With `"auto"` (the default), auto-detect by searching
#' for the string `"<HTML>"` within the template.
#'
#' @seealso [renderDocument()]
#' @export
#' @useDynLib htmltools, .registration = TRUE
htmlTemplate <- function(filename = NULL, ..., text_ = NULL, document_ = "auto") {
if (!xor(is.null(filename), is.null(text_))) {
stop("htmlTemplate requires either `filename` or `text_`.")
}
if (!is.null(filename)) {
html <- readChar(filename, file.info(filename)$size, useBytes = TRUE)
Encoding(html) <- "UTF-8"
} else if(!is.null(text_)) {
text_ <- paste8(text_, collapse = "\n")
html <- enc2utf8(text_)
}
pieces <- .Call(template_dfa, html)
Encoding(pieces) <- "UTF-8"
# Create environment to evaluate code, as a child of the global env. This
# environment gets the ... arguments assigned as variables.
vars <- dots_list(...)
if ("headContent" %in% names(vars)) {
stop("Can't use reserved argument name 'headContent'.")
}
vars$headContent <- function() HTML("<!-- HEAD_CONTENT -->")
env <- list2env(vars, parent = globalenv())
# All the odd-numbered pieces are HTML; all the even-numbered pieces are code
pieces <- mapply(
pieces,
rep_len(c(FALSE, TRUE), length.out = length(pieces)),
FUN = function(piece, isCode) {
if (isCode) {
eval(parse(text = piece), env)
} else {
HTML(piece, .noWS = "outside")
}
},
SIMPLIFY = FALSE
)
result <- tagList(pieces)
if (document_ == "auto") {
document_ = grepl("<HTML(\\s[^<]*)?>", html, ignore.case = TRUE)
}
if (document_) {
# The html.document class indicates that it's a complete document, and not
# just a set of tags.
class(result) <- c("html_document", class(result))
}
result
}
#' Render an html_document object
#'
#' This function renders `html_document` objects, and returns a string with
#' the final HTML content. It calls the [renderTags()] function to
#' convert any shiny.tag objects to HTML. It also finds any any web dependencies
#' (created by [htmlDependency()]) that are attached to the tags, and
#' inserts those. To do the insertion, this function finds the string
#' `"<!-- HEAD_CONTENT -->"` in the document, and replaces it with the web
#' dependencies.
#'
#' @param x An object of class `html_document`, typically generated by the
#' [htmlTemplate()] function.
#' @param deps Any extra web dependencies to add to the html document. This can
#' be an object created by [htmlDependency()], or a list of such
#' objects. These dependencies will be added first, before other dependencies.
#' @param processDep A function that takes a "raw" html_dependency object and
#' does further processing on it. For example, when `renderDocument` is
#' called from Shiny, the function [shiny::createWebDependency()] is
#' used; it modifies the href and tells Shiny to serve a particular path on
#' the filesystem.
#'
#' @return An [HTML()] string, with UTF-8 encoding.
#'
#' @export
renderDocument <- function(x, deps = NULL, processDep = identity) {
if (!inherits(x, "html_document")) {
stop("Object must be an object of class html_document")
}
if (inherits(deps, "html_dependency")) {
deps <- list(deps)
}
result <- renderTags(x)
# Figure out dependencies
deps <- c(deps, result$dependencies)
deps <- resolveDependencies(deps)
deps <- lapply(deps, processDep)
depStr <- paste(sapply(deps, function(dep) {
sprintf("%s[%s]", dep$name, dep$version)
}), collapse = ";")
depHtml <- renderDependencies(deps, "href")
# Put content in the <head> section
head_content <- paste0(
' <meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>\n',
sprintf(' <script type="application/shiny-singletons">%s</script>\n',
paste(result$singletons, collapse = ',')
),
sprintf(' <script type="application/html-dependencies">%s</script>\n',
depStr
),
depHtml,
c(result$head, recursive = TRUE)
)
# Need to mark result as UTF-8. If body is ASCII, it will be marked with
# encoding "unknown". If the head has UTF-8 characters and is marked as
# "UTF-8", the output string here will have the correct UTF-8 byte sequences,
# but will be marked as "unknown", which causes the wrong text to be
# displayed. See https://github.com/rstudio/shiny/issues/1395
res <- sub("<!-- HEAD_CONTENT -->", head_content, result$html, fixed = TRUE)
Encoding(res) <- "UTF-8"
res
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.