1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
#' 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
}
|
