[med-svn] [r-cran-htmltools] 04/06: New upstream version 0.3.5
Andreas Tille
tille at debian.org
Tue Oct 10 10:42:23 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-htmltools.
commit 91faebae45a0bbcc14849c7356596faeaf0b7d7c
Author: Andreas Tille <tille at debian.org>
Date: Tue Oct 10 12:40:43 2017 +0200
New upstream version 0.3.5
---
DESCRIPTION | 21 +
MD5 | 46 ++
NAMESPACE | 89 ++
NEWS | 77 ++
R/RcppExports.R | 7 +
R/html_dependency.R | 496 +++++++++++
R/html_escape.R | 51 ++
R/html_print.R | 104 +++
R/tags.R | 1463 +++++++++++++++++++++++++++++++++
R/template.R | 134 +++
debian/README.test | 9 -
debian/changelog | 11 -
debian/compat | 1 -
debian/control | 24 -
debian/copyright | 29 -
debian/docs | 3 -
debian/rules | 3 -
debian/source/format | 1 -
debian/tests/control | 3 -
debian/tests/run-unit-test | 12 -
debian/watch | 3 -
man/HTML.Rd | 27 +
man/as.tags.Rd | 19 +
man/browsable.Rd | 33 +
man/builder.Rd | 98 +++
man/copyDependencyToDir.Rd | 39 +
man/css.Rd | 48 ++
man/findDependencies.Rd | 18 +
man/htmlDependencies.Rd | 56 ++
man/htmlDependency.Rd | 81 ++
man/htmlEscape.Rd | 21 +
man/htmlPreserve.Rd | 66 ++
man/htmlTemplate.Rd | 32 +
man/html_print.Rd | 25 +
man/include.Rd | 47 ++
man/knitr_methods.Rd | 25 +
man/makeDependencyRelative.Rd | 33 +
man/print.html.Rd | 26 +
man/renderDependencies.Rd | 30 +
man/renderDocument.Rd | 32 +
man/renderTags.Rd | 52 ++
man/resolveDependencies.Rd | 21 +
man/save_html.Rd | 22 +
man/singleton.Rd | 23 +
man/singleton_tools.Rd | 36 +
man/subtractDependencies.Rd | 33 +
man/suppressDependencies.Rd | 24 +
man/tag.Rd | 74 ++
man/urlEncodePath.Rd | 17 +
man/validateCssUnit.Rd | 38 +
man/withTags.Rd | 42 +
src/RcppExports.cpp | 18 +
src/template.cpp | 163 ++++
tests/test-all.R | 4 +
tests/testthat/template-document.html | 12 +
tests/testthat/test-deps.r | 89 ++
tests/testthat/test-tags.r | 675 +++++++++++++++
tests/testthat/test-template.R | 204 +++++
58 files changed, 4791 insertions(+), 99 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..5fc1fae
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,21 @@
+Package: htmltools
+Type: Package
+Title: Tools for HTML
+Version: 0.3.5
+Date: 2016-03-19
+Author: RStudio, Inc.
+Maintainer: Joe Cheng <joe at rstudio.com>
+Description: Tools for HTML generation and output.
+Depends: R (>= 2.14.1)
+Imports: utils, digest, Rcpp
+Suggests: markdown, testthat
+Enhances: knitr
+License: GPL (>= 2)
+URL: https://github.com/rstudio/htmltools
+BugReports: https://github.com/rstudio/htmltools/issues
+RoxygenNote: 5.0.1
+LinkingTo: Rcpp
+NeedsCompilation: yes
+Packaged: 2016-03-21 21:26:31 UTC; jcheng
+Repository: CRAN
+Date/Publication: 2016-03-21 23:36:11
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..134ba3b
--- /dev/null
+++ b/MD5
@@ -0,0 +1,46 @@
+72c03ca6886933e00b494cea3217e13f *DESCRIPTION
+3eff63e6ff5eb3d2749b77f1e1a13ae1 *NAMESPACE
+6f4e14ce9f5b4301c0b44af926525e9b *NEWS
+c1e4413f5fc7eba2f785e76fdda026be *R/RcppExports.R
+9328debfe564d97e4c59eb9e02ad2235 *R/html_dependency.R
+7bee8b23618adb2848412fedc7164709 *R/html_escape.R
+b3e3d3353ebc757321b60abcad04397c *R/html_print.R
+6a300f33f56fc7d5a8ea0fb5c7634d77 *R/tags.R
+06648459a4195a4c81282ae5729edc97 *R/template.R
+747b00f84aac5d38d90c382b7acea766 *man/HTML.Rd
+5f6685813bb68b37c2cef66dc64ec6b4 *man/as.tags.Rd
+93da0c851632d533098dfa737ef69274 *man/browsable.Rd
+a1f0a58f58e94685b9fe09314dc949ef *man/builder.Rd
+9eb6d8d33eb3d7278c44f08a52c4c153 *man/copyDependencyToDir.Rd
+8487ea5a1d6d5d5a37f14e56776b263d *man/css.Rd
+033d3ca20f2ca5598f1a146aabe59184 *man/findDependencies.Rd
+2af4b1961a102b3ae97d80bfc652ebe2 *man/htmlDependencies.Rd
+ee1b263b7ca40387a68f9fca8e2eadb1 *man/htmlDependency.Rd
+e204dbba8c1854906529114e0d2e47f2 *man/htmlEscape.Rd
+4e6d962c82d788fbb49b51264eeb9123 *man/htmlPreserve.Rd
+c12e2e060c1f0a252c7339bbd946d3c2 *man/htmlTemplate.Rd
+823f31b10e4c759bd944eed49f8224da *man/html_print.Rd
+6ef8c0f2ba87b45f17817f7febda6365 *man/include.Rd
+4ee94c21c8d63531903bbff3bb75926f *man/knitr_methods.Rd
+26aa8ef492ac58d38483f14c8897a077 *man/makeDependencyRelative.Rd
+958b662a2a54e8030649e391e9ed1ded *man/print.html.Rd
+9e4c782f5ad5aed1b31f1bf70beca638 *man/renderDependencies.Rd
+8478bfe350d31adff0e94ebf5a3aea65 *man/renderDocument.Rd
+3f71ee0061e139ac0fc10f0e38e0765c *man/renderTags.Rd
+bf9c821c3fcac5b092940b1acbe8f4df *man/resolveDependencies.Rd
+517d1ed333b880fc0846d82f09d86f96 *man/save_html.Rd
+03a6dd0aab6a1150f8c0b575aacc0806 *man/singleton.Rd
+ef71b945ad76fb3a1d8e8d89fbecc19b *man/singleton_tools.Rd
+c27574242254c7379b602e957ecfb7d9 *man/subtractDependencies.Rd
+0b686655aaa750cff5d37a674207f6bd *man/suppressDependencies.Rd
+e7721483d5e136d7652edba62e64e54d *man/tag.Rd
+cb34418668e63388d3edd67d2dd90c52 *man/urlEncodePath.Rd
+60be5348923d73ebf9235e6e790628e3 *man/validateCssUnit.Rd
+4a499bda5c52e3a41a9d0d01e29b3536 *man/withTags.Rd
+978ffdd268a174b06c94b067b18c46d7 *src/RcppExports.cpp
+f7dbf02b3735f8a64fb1cc9264416713 *src/template.cpp
+d5386f261693f9f4a5dda7b6fe0aa9f0 *tests/test-all.R
+ce9c101bbebef449d432567b9a29e9f9 *tests/testthat/template-document.html
+bd23b1f0bd8705c3fe39c9f537cd1305 *tests/testthat/test-deps.r
+2d382055a6affd4f39407b0664c04041 *tests/testthat/test-tags.r
+0c93372a28e38db6c9e7146c6a1644af *tests/testthat/test-template.R
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..98c7a22
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,89 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(as.character,html)
+S3method(as.character,shiny.tag)
+S3method(as.character,shiny.tag.list)
+S3method(as.tags,character)
+S3method(as.tags,default)
+S3method(as.tags,html)
+S3method(as.tags,html_dependency)
+S3method(as.tags,shiny.tag)
+S3method(as.tags,shiny.tag.list)
+S3method(format,html)
+S3method(format,shiny.tag)
+S3method(format,shiny.tag.list)
+S3method(print,html)
+S3method(print,html_dependency)
+S3method(print,shiny.tag)
+S3method(print,shiny.tag.list)
+export("htmlDependencies<-")
+export(HTML)
+export(a)
+export(as.tags)
+export(attachDependencies)
+export(br)
+export(browsable)
+export(code)
+export(copyDependencyToDir)
+export(css)
+export(div)
+export(doRenderTags)
+export(em)
+export(extractPreserveChunks)
+export(findDependencies)
+export(h1)
+export(h2)
+export(h3)
+export(h4)
+export(h5)
+export(h6)
+export(hr)
+export(htmlDependencies)
+export(htmlDependency)
+export(htmlEscape)
+export(htmlPreserve)
+export(htmlTemplate)
+export(html_print)
+export(img)
+export(includeCSS)
+export(includeHTML)
+export(includeMarkdown)
+export(includeScript)
+export(includeText)
+export(is.browsable)
+export(is.singleton)
+export(knit_print.html)
+export(knit_print.shiny.tag)
+export(knit_print.shiny.tag.list)
+export(makeDependencyRelative)
+export(p)
+export(pre)
+export(renderDependencies)
+export(renderDocument)
+export(renderTags)
+export(resolveDependencies)
+export(restorePreserveChunks)
+export(save_html)
+export(singleton)
+export(span)
+export(strong)
+export(subtractDependencies)
+export(suppressDependencies)
+export(surroundSingletons)
+export(tag)
+export(tagAppendAttributes)
+export(tagAppendChild)
+export(tagAppendChildren)
+export(tagGetAttribute)
+export(tagHasAttribute)
+export(tagList)
+export(tagSetChildren)
+export(tags)
+export(takeSingletons)
+export(urlEncodePath)
+export(validateCssUnit)
+export(withTags)
+import(digest)
+import(utils)
+importFrom(Rcpp,sourceCpp)
+useDynLib(htmltools)
diff --git a/NEWS b/NEWS
new file mode 100644
index 0000000..1d3bf0e
--- /dev/null
+++ b/NEWS
@@ -0,0 +1,77 @@
+htmltools 0.3.5
+--------------------------------------------------------------------------------
+
+* `as.character` now returns a character vector with no other attributes.
+ Previously it returned a character vector of class 'html'. (#31, #41)
+
+* `htmlTemplate` now can use a string as a template instead of requiring a
+ file. (#41, #43)
+
+* HTML dependencies can now be added inline, instead of needing to use
+ `attachDependencies()`. (#40, #42)
+
+* `htmlDependency()` gained a new argument `all_files` to indicate whether all
+ files under the src directory should be copied when rendering dependencies,
+ or only those specified in the dependency objects. (#48)
+
+* `copyDependencyToDir()` will always completely overwrite the target directory
+ when copying HTML dependency files to make sure all dependency files are
+ definitely updated in the target directory when the original dependency
+ directory has been updated. In the past, the dependency files were not updated
+ if they already existed. (#36)
+
+* The version number in the directory name of an HTML dependency can be
+ suppressed by setting options(htmltools.dir.version = FALSE) when the
+ dependency is copied via `copyDependencyToDir()`. (#37)
+
+* Performance improvement rendering tags, by switching from `readLines` to
+ `readChar`.
+
+htmltools 0.3
+--------------------------------------------------------------------------------
+
+* Add `css` function for conveniently forming CSS declaration strings.
+
+* Add template support, with the `htmlTemplate()`, `renderDocument()`, and
+ `suppressDependencies()` functions.
+
+
+htmltools 0.2.9
+--------------------------------------------------------------------------------
+
+* Add check that `htmlDependency()` isn't called with an absolute path when a
+ binary package is built. (#22)
+
+* Allow HTML content to include UTF-8, Latin1, and system encoded content. All
+ will be converted to UTF-8 using enc2utf8() at render time. (#21)
+
+* Add `tagGetAttribute()` and `tagHasAttribute()` functions.
+
+
+htmltools 0.2.7
+--------------------------------------------------------------------------------
+
+* Add "append" parameter to attachDependencies, to allow adding dependencies,
+ instead of replacing them.
+
+
+htmltools 0.2.6
+--------------------------------------------------------------------------------
+
+* Add "attachment" parameter to htmlDependency, which can be used to allow any
+ file in the dependency directory to be available via URL at runtime.
+
+
+htmltools 0.2.5
+--------------------------------------------------------------------------------
+
+* Explicit library(htmltools) is no longer required for tags to be rendered in
+ knitr/rmarkdown documents.
+
+* Added "viewer" parameter to html_print.
+
+
+htmltools 0.2.4
+--------------------------------------------------------------------------------
+
+Initial release
diff --git a/R/RcppExports.R b/R/RcppExports.R
new file mode 100644
index 0000000..a7bbf42
--- /dev/null
+++ b/R/RcppExports.R
@@ -0,0 +1,7 @@
+# This file was generated by Rcpp::compileAttributes
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+template_dfa <- function(x) {
+ .Call('htmltools_template_dfa', PACKAGE = 'htmltools', x)
+}
+
diff --git a/R/html_dependency.R b/R/html_dependency.R
new file mode 100644
index 0000000..0f2011e
--- /dev/null
+++ b/R/html_dependency.R
@@ -0,0 +1,496 @@
+#' Define an HTML dependency
+#'
+#' Define an HTML dependency (i.e. CSS and/or JavaScript bundled in a
+#' directory). HTML dependencies make it possible to use libraries like jQuery,
+#' Bootstrap, and d3 in a more composable and portable way than simply using
+#' script, link, and style tags.
+#'
+#' @param name Library name
+#' @param version Library version
+#' @param src Unnamed single-element character vector indicating the full path
+#' of the library directory. Alternatively, a named character string with one
+#' or more elements, indicating different places to find the library; see
+#' Details.
+#' @param meta Named list of meta tags to insert into document head
+#' @param script Script(s) to include within the document head (should be
+#' specified relative to the \code{src} parameter).
+#' @param stylesheet Stylesheet(s) to include within the document (should be
+#' specified relative to the \code{src} parameter).
+#' @param head Arbitrary lines of HTML to insert into the document head
+#' @param attachment Attachment(s) to include within the document head. See
+#' Details.
+#' @param all_files Whether all files under the \code{src} directory are
+#' dependency files. If \code{FALSE}, only the files specified in
+#' \code{script}, \code{stylesheet}, and \code{attachment} are treated as
+#' dependency files.
+#'
+#' @return An object that can be included in a list of dependencies passed to
+#' \code{\link{attachDependencies}}.
+#'
+#' @details Each dependency can be located on the filesystem, at a relative or
+#' absolute URL, or both. The location types are indicated using the names of
+#' the \code{src} character vector: \code{file} for filesystem directory,
+#' \code{href} for URL. For example, a dependency that was both on disk and at
+#' a URL might use \code{src = c(file=filepath, href=url)}.
+#'
+#' \code{attachment} can be used to make the indicated files available to the
+#' JavaScript on the page via URL. For each element of \code{attachment}, an
+#' element \code{<link id="DEPNAME-ATTACHINDEX-attachment" rel="attachment"
+#' href="...">} is inserted, where \code{DEPNAME} is \code{name}. The value of
+#' \code{ATTACHINDEX} depends on whether \code{attachment} is named or not; if
+#' so, then it's the name of the element, and if not, it's the 1-based index
+#' of the element. JavaScript can retrieve the URL using something like
+#' \code{document.getElementById(depname + "-" + index + "-attachment").href}.
+#' Note that depending on the rendering context, the runtime value of the href
+#' may be an absolute, relative, or data URI.
+#'
+#' \code{htmlDependency} should not be called from the top-level of a package
+#' namespace with absolute paths (or with paths generated by
+#' \code{system.file()}) and have the result stored in a variable. This is
+#' because, when a binary package is built, R will run \code{htmlDependency}
+#' and store the path from the building machine's in the package. This path is
+#' likely to differ from the correct path on a machine that downloads and
+#' installs the binary package. If there are any absolute paths, instead of
+#' calling \code{htmlDependency} at build-time, it should be called at
+#' run-time. This can be done by wrapping the \code{htmlDependency} call in a
+#' function.
+#'
+#' @seealso Use \code{\link{attachDependencies}} to associate a list of
+#' dependencies with the HTML it belongs with.
+#'
+#' @export
+htmlDependency <- function(name,
+ version,
+ src,
+ meta = NULL,
+ script = NULL,
+ stylesheet = NULL,
+ head = NULL,
+ attachment = NULL,
+ all_files = TRUE) {
+
+ # This function shouldn't be called from a namespace environment with
+ # absolute paths.
+ if (isNamespace(parent.frame()) && any(substr(src, 1, 1) == "/")) {
+ warning(
+ "htmlDependency shouldn't be called from a namespace environment",
+ " with absolute paths (or paths from system.file()).",
+ " See ?htmlDependency for more information."
+ )
+ }
+
+ version <- as.character(version)
+ validateScalarName(name)
+ validateScalarName(version)
+
+ srcNames <- names(src)
+ if (is.null(srcNames))
+ srcNames <- rep.int("", length(src))
+ srcNames[!nzchar(srcNames)] <- "file"
+ names(src) <- srcNames
+ src <- as.list(src)
+
+ structure(class = "html_dependency", list(
+ name = name,
+ version = as.character(version),
+ src = src,
+ meta = meta,
+ script = script,
+ stylesheet = stylesheet,
+ head = head,
+ attachment = attachment,
+ all_files = all_files
+ ))
+}
+
+validateScalarName <- function(x, name = deparse(substitute(x))) {
+ if (length(x) != 1 || x == "" || grepl("[/\\]", x)) stop(
+ "Invalid argument '", name,
+ "' (must be a non-empty character string and contain no '/' or '\\')"
+ )
+}
+
+#' HTML dependency metadata
+#'
+#' Gets or sets the HTML dependencies associated with an object (such as a tag).
+#'
+#' \code{attachDependencies} provides an alternate syntax for setting
+#' dependencies. It is similar to \code{local(\{htmlDependencies(x) <- value;
+#' x\})}, except that if there are any existing dependencies,
+#' \code{attachDependencies} will add to them, instead of replacing them.
+#'
+#' As of htmltools 0.3.4, HTML dependencies can be attached without using
+#' \code{attachDependencies}. Instead, they can be added inline, like a child
+#' object of a tag or \code{\link{tagList}}.
+#'
+#' @param x An object which has (or should have) HTML dependencies.
+#' @param value An HTML dependency, or a list of HTML dependencies.
+#' @param append If FALSE (the default), replace any existing dependencies. If
+#' TRUE, add the new dependencies to the existing ones.
+#'
+#' @examples
+#' # Create a JavaScript dependency
+#' dep <- htmlDependency("jqueryui", "1.11.4", c(href="shared/jqueryui"),
+#' script = "jquery-ui.min.js")
+#'
+#' # A CSS dependency
+#' htmlDependency(
+#' "font-awesome", "4.5.0", c(href="shared/font-awesome"),
+#' stylesheet = "css/font-awesome.min.css"
+#' )
+#'
+#' # A few different ways to add the dependency to tag objects:
+#' # Inline as a child of the div()
+#' div("Code here", dep)
+#' # Inline in a tagList
+#' tagList(div("Code here"), dep)
+#' # With attachDependencies
+#' attachDependencies(div("Code here"), dep)
+#'
+#' @export
+htmlDependencies <- function(x) {
+ attr(x, "html_dependencies", TRUE)
+}
+
+#' @rdname htmlDependencies
+#' @export
+`htmlDependencies<-` <- function(x, value) {
+ if (inherits(value, "html_dependency"))
+ value <- list(value)
+ attr(x, "html_dependencies") <- value
+ x
+}
+
+#' @rdname htmlDependencies
+#' @export
+attachDependencies <- function(x, value, append = FALSE) {
+ if (append) {
+ if (inherits(value, "html_dependency"))
+ value <- list(value)
+
+ old <- attr(x, "html_dependencies", TRUE)
+ htmlDependencies(x) <- c(old, value)
+
+ } else {
+ htmlDependencies(x) <- value
+ }
+ return(x)
+}
+
+#' Suppress web dependencies
+#'
+#' This suppresses one or more web dependencies. It is meant to be used when a
+#' dependency (like a JavaScript or CSS file) is declared in raw HTML, in an
+#' HTML template.
+#'
+#' @param ... Names of the dependencies to suppress. For example,
+#' \code{"jquery"} or \code{"bootstrap"}.
+#'
+#' @seealso \code{\link{htmlTemplate}} for more information about using HTML
+#' templates.
+#' @seealso \code{\link[htmltools]{htmlDependency}}
+#' @export
+suppressDependencies <- function(...) {
+ lapply(list(...), function(name) {
+ attachDependencies(
+ character(0),
+ htmlDependency(name, "9999", c(href = ""))
+ )
+ })
+}
+
+#' @export
+print.html_dependency <- function(x, ...) str(x)
+
+dir_path <- function(dependency) {
+ if ("dir" %in% names(dependency$src))
+ return(dependency$src[["dir"]])
+
+ if (length(names(dependency$src)) == 0 || all(!nzchar(dependency$src)))
+ return(dependency$src[[1]])
+
+ return(NULL)
+}
+
+href_path <- function(dependency) {
+ if ("href" %in% names(dependency$src))
+ return(dependency$src[["href"]])
+ else
+ return(NULL)
+}
+
+#' Encode a URL path
+#'
+#' Encode characters in a URL path. This is the same as
+#' \code{\link[utils]{URLencode}} with \code{reserved = TRUE} except that
+#' \code{/} is preserved.
+#'
+#' @param x A character vector.
+#' @export
+urlEncodePath <- function(x) {
+ vURLEncode <- Vectorize(URLencode, USE.NAMES = FALSE)
+ gsub("%2[Ff]", "/", vURLEncode(x, TRUE))
+}
+
+#' Copy an HTML dependency to a directory
+#'
+#' Copies an HTML dependency to a subdirectory of the given directory. The
+#' subdirectory name will be \emph{name}-\emph{version} (for example,
+#' "outputDir/jquery-1.11.0"). You may set \code{options(htmltools.dir.version =
+#' FALSE)} to suppress the version number in the subdirectory name.
+#'
+#' In order for disk-based dependencies to work with static HTML files, it's
+#' generally necessary to copy them to either the directory of the referencing
+#' HTML file, or to a subdirectory of that directory. This function makes it
+#' easier to perform that copy.
+#'
+#' @param dependency A single HTML dependency object.
+#' @param outputDir The directory in which a subdirectory should be created for
+#' this dependency.
+#' @param mustWork If \code{TRUE} and \code{dependency} does not point to a
+#' directory on disk (but rather a URL location), an error is raised. If
+#' \code{FALSE} then non-disk dependencies are returned without modification.
+#'
+#' @return The dependency with its \code{src} value updated to the new
+#' location's absolute path.
+#'
+#' @seealso \code{\link{makeDependencyRelative}} can be used with the returned
+#' value to make the path relative to a specific directory.
+#'
+#' @export
+copyDependencyToDir <- function(dependency, outputDir, mustWork = TRUE) {
+
+ dir <- dependency$src$file
+
+ if (is.null(dir)) {
+ if (mustWork) {
+ stop("Dependency ", dependency$name, " ", dependency$version,
+ " is not disk-based")
+ } else {
+ return(dependency)
+ }
+ }
+
+ if (length(outputDir) != 1 || outputDir %in% c("", "/"))
+ stop('outputDir must be of length 1 and cannot be "" or "/"')
+
+ if (!dir_exists(outputDir))
+ dir.create(outputDir)
+
+ target_dir <- if (getOption('htmltools.dir.version', TRUE)) {
+ paste(dependency$name, dependency$version, sep = "-")
+ } else dependency$name
+ target_dir <- file.path(outputDir, target_dir)
+
+ # completely remove the target dir because we don't want possible leftover
+ # files in the target dir, e.g. we may have lib/foo.js last time, and it was
+ # removed from the original library, then the next time we copy the library
+ # over to the target dir, we want to remove this lib/foo.js as well;
+ # unlink(recursive = TRUE) can be dangerous, e.g. we certainly do not want 'rm
+ # -rf /' to happen; in htmlDependency() we have made sure dependency$name and
+ # dependency$version are not "" or "/" or contains no / or \; we have also
+ # made sure outputDir is not "" or "/" above, so target_dir here should be
+ # relatively safe to be removed recursively
+ if (dir_exists(target_dir)) unlink(target_dir, recursive = TRUE)
+ dir.create(target_dir)
+
+ files <- if (dependency$all_files) list.files(dir) else {
+ unlist(dependency[c('script', 'stylesheet', 'attachment')])
+ }
+ srcfiles <- file.path(dir, files)
+ destfiles <- file.path(target_dir, files)
+ isdir <- file.info(srcfiles)$isdir
+ destfiles <- ifelse(isdir, dirname(destfiles), destfiles)
+
+ mapply(function(from, to, isdir) {
+ if (!dir_exists(dirname(to)))
+ dir.create(dirname(to), recursive = TRUE)
+ if (isdir && !dir_exists(to))
+ dir.create(to)
+ file.copy(from, to, overwrite = TRUE, recursive = isdir)
+ }, srcfiles, destfiles, isdir)
+
+ dependency$src$file <- normalizePath(target_dir, "/", TRUE)
+
+ dependency
+}
+
+dir_exists <- function(paths) {
+ utils::file_test("-d", paths)
+}
+
+# given a directory and a file, return a relative path from the directory to the
+# file, or the unmodified file path if the file does not appear to be in the
+# directory
+relativeTo <- function(dir, file) {
+ # ensure directory ends with a /
+ if (!identical(substr(dir, nchar(dir), nchar(dir)), "/")) {
+ dir <- paste(dir, "/", sep="")
+ }
+
+ # if the file is prefixed with the directory, return a relative path
+ if (identical(substr(file, 1, nchar(dir)), dir))
+ return(substr(file, nchar(dir) + 1, nchar(file)))
+ else
+ stop("The path ", file, " does not appear to be a descendant of ", dir)
+}
+
+#' Make an absolute dependency relative
+#'
+#' Change a dependency's absolute path to be relative to one of its parent
+#' directories.
+#'
+#' @param dependency A single HTML dependency with an absolute path.
+#' @param basepath The path to the directory that \code{dependency} should be
+#' made relative to.
+#' @param mustWork If \code{TRUE} and \code{dependency} does not point to a
+#' directory on disk (but rather a URL location), an error is raised. If
+#' \code{FALSE} then non-disk dependencies are returned without modification.
+#'
+#' @return The dependency with its \code{src} value updated to the new
+#' location's relative path.
+#'
+#' If \code{baspath} did not appear to be a parent directory of the dependency's
+#' directory, an error is raised (regardless of the value of \code{mustWork}).
+#'
+#' @seealso \code{\link{copyDependencyToDir}}
+#'
+#' @export
+makeDependencyRelative <- function(dependency, basepath, mustWork = TRUE) {
+ basepath <- normalizePath(basepath, "/", TRUE)
+ dir <- dependency$src$file
+ if (is.null(dir)) {
+ if (!mustWork)
+ return(dependency)
+ else
+ stop("Could not make dependency ", dependency$name, " ",
+ dependency$version, " relative; it is not file-based")
+ }
+
+ dependency$src <- c(file=relativeTo(basepath, dir))
+
+ dependency
+}
+
+#' Create HTML for dependencies
+#'
+#' Create the appropriate HTML markup for including dependencies in an HTML
+#' document.
+#'
+#' @param dependencies A list of \code{htmlDependency} objects.
+#' @param srcType The type of src paths to use; valid values are \code{file} or
+#' \code{href}.
+#' @param encodeFunc The function to use to encode the path part of a URL. The
+#' default should generally be used.
+#' @param hrefFilter A function used to transform the final, encoded URLs of
+#' script and stylsheet files. The default should generally be used.
+#'
+#' @return An \code{\link{HTML}} object suitable for inclusion in the head of an
+#' HTML document.
+#'
+#' @export
+renderDependencies <- function(dependencies,
+ srcType = c("href", "file"),
+ encodeFunc = urlEncodePath,
+ hrefFilter = identity) {
+
+ html <- c()
+
+ for (dep in dependencies) {
+
+ usableType <- srcType[which(srcType %in% names(dep$src))]
+ if (length(usableType) == 0)
+ stop("Dependency ", dep$name, " ", dep$version,
+ " does not have a usable source")
+
+ dir <- dep$src[head(usableType, 1)]
+
+ srcpath <- if (usableType == "file") {
+ encodeFunc(dir)
+ } else {
+ # Assume that href is already URL encoded
+ href_path(dep)
+ }
+
+ # Drop trailing /
+ srcpath <- sub("/$", "\\1", srcpath)
+
+ # add meta content
+ if (length(dep$meta) > 0) {
+ html <- c(html, paste(
+ "<meta name=\"", htmlEscape(names(dep$meta)), "\" content=\"",
+ htmlEscape(dep$meta), "\" />",
+ sep = ""
+ ))
+ }
+
+ # add stylesheets
+ if (length(dep$stylesheet) > 0) {
+ html <- c(html, paste(
+ "<link href=\"",
+ htmlEscape(hrefFilter(file.path(srcpath, encodeFunc(dep$stylesheet)))),
+ "\" rel=\"stylesheet\" />",
+ sep = ""
+ ))
+ }
+
+ # add scripts
+ if (length(dep$script) > 0) {
+ html <- c(html, paste(
+ "<script src=\"",
+ htmlEscape(hrefFilter(file.path(srcpath, encodeFunc(dep$script)))),
+ "\"></script>",
+ sep = ""
+ ))
+ }
+
+ if (length(dep$attachment) > 0) {
+ if (is.null(names(dep$attachment)))
+ names(dep$attachment) <- as.character(1:length(dep$attachment))
+ html <- c(html,
+ sprintf("<link id=\"%s-%s-attachment\" rel=\"attachment\" href=\"%s\"/>",
+ htmlEscape(dep$name),
+ htmlEscape(names(dep$attachment)),
+ htmlEscape(hrefFilter(file.path(srcpath, encodeFunc(dep$attachment))))
+ )
+ )
+ }
+
+ # add raw head content
+ html <- c(html, dep$head)
+ }
+
+ HTML(paste(html, collapse = "\n"))
+}
+
+# html_dependencies_as_character(list(
+# htmlDependency("foo", "1.0",
+# c(href="http://foo.com/bar%20baz/"),
+# stylesheet="x y z.css"
+# )
+# ))
+# <link href=\"http://foo.com/bar%20baz/x%20y%20z.css\" rel=\"stylesheet\" />
+
+# html_dependencies_as_character(list(
+# htmlDependency("foo", "1.0",
+# c(href="http://foo.com/bar%20baz"),
+# stylesheet="x y z.css"
+# )
+# ))
+# <link href=\"http://foo.com/bar%20baz/x%20y%20z.css\" rel=\"stylesheet\" />
+
+# html_dependencies_as_character(list(
+# htmlDependency("foo", "1.0",
+# "foo bar/baz",
+# stylesheet="x y z.css"
+# )
+# ))
+# <link href=\"foo%20bar/baz/x%20y%20z.css\" rel=\"stylesheet\" />
+
+# html_dependencies_as_character(list(
+# htmlDependency("foo", "1.0",
+# "foo bar/baz/",
+# stylesheet="x y z.css"
+# )
+# ))
+# <link href=\"foo%20bar/baz/x%20y%20z.css\" rel=\"stylesheet\" />
diff --git a/R/html_escape.R b/R/html_escape.R
new file mode 100644
index 0000000..b4d9259
--- /dev/null
+++ b/R/html_escape.R
@@ -0,0 +1,51 @@
+
+#' Escape HTML entities
+#'
+#' Escape HTML entities contained in a character vector so that it can be safely
+#' included as text or an attribute value within an HTML document
+#'
+#' @param text Text to escape
+#' @param attribute Escape for use as an attribute value
+#'
+#' @return Character vector with escaped text.
+#'
+#' @export
+htmlEscape <- local({
+
+ .htmlSpecials <- list(
+ `&` = '&',
+ `<` = '<',
+ `>` = '>'
+ )
+ .htmlSpecialsPattern <- paste(names(.htmlSpecials), collapse='|')
+ .htmlSpecialsAttrib <- c(
+ .htmlSpecials,
+ `'` = ''',
+ `"` = '"',
+ `\r` = '
',
+ `\n` = '
'
+ )
+ .htmlSpecialsPatternAttrib <- paste(names(.htmlSpecialsAttrib), collapse='|')
+
+ function(text, attribute=FALSE) {
+ pattern <- if(attribute)
+ .htmlSpecialsPatternAttrib
+ else
+ .htmlSpecialsPattern
+
+ # Short circuit in the common case that there's nothing to escape
+ if (!any(grepl(pattern, text, useBytes = TRUE)))
+ return(text)
+
+ specials <- if(attribute)
+ .htmlSpecialsAttrib
+ else
+ .htmlSpecials
+
+ for (chr in names(specials)) {
+ text <- gsub(chr, specials[[chr]], text, fixed = TRUE, useBytes = TRUE)
+ }
+
+ return(text)
+ }
+})
diff --git a/R/html_print.R b/R/html_print.R
new file mode 100644
index 0000000..04c25c5
--- /dev/null
+++ b/R/html_print.R
@@ -0,0 +1,104 @@
+#' Make an HTML object browsable
+#'
+#' By default, HTML objects display their HTML markup at the console when
+#' printed. \code{browsable} can be used to make specific objects render as HTML
+#' by default when printed at the console.
+#'
+#' You can override the default browsability of an HTML object by explicitly
+#' passing \code{browse = TRUE} (or \code{FALSE}) to the \code{print} function.
+#'
+#' @param x The object to make browsable or not.
+#' @param value Whether the object should be considered browsable.
+#' @return \code{browsable} returns \code{x} with an extra attribute to indicate
+#' that the value is browsable.
+#' @export
+browsable <- function(x, value = TRUE) {
+ attr(x, "browsable_html") <- if (isTRUE(value)) TRUE else NULL
+ return(x)
+}
+
+#' @return \code{is.browsable} returns \code{TRUE} if the value is browsable, or
+#' \code{FALSE} if not.
+#' @rdname browsable
+#' @export
+is.browsable <- function(x) {
+ return(isTRUE(attr(x, "browsable_html", exact=TRUE)))
+}
+
+#' Implementation of the print method for HTML
+#'
+#' Convenience method that provides an implementation of the
+#' \code{\link[base:print]{print}} method for HTML content.
+#'
+#' @param html HTML content to print
+#' @param background Background color for web page
+#' @param viewer A function to be called with the URL or path to the generated
+#' HTML page. Can be \code{NULL}, in which case no viewer will be invoked.
+#'
+#' @return Invisibly returns the URL or path of the generated HTML page.
+#'
+#' @export
+html_print <- function(html, background = "white", viewer = getOption("viewer", utils::browseURL)) {
+
+ # define temporary directory for output
+ www_dir <- tempfile("viewhtml")
+ dir.create(www_dir)
+
+ # define output file
+ index_html <- file.path(www_dir, "index.html")
+
+ # save file
+ save_html(html, file = index_html, background = background, libdir = "lib")
+
+ # show it
+ if (!is.null(viewer))
+ viewer(index_html)
+
+ invisible(index_html)
+}
+
+#' Save an HTML object to a file
+#'
+#' Save the specified HTML object to a file, copying all of it's
+#' dependencies to the directory specified via \code{libdir}.
+#'
+#' @param html HTML content to print
+#' @param background Background color for web page
+#' @param file File to write content to
+#' @param libdir Directory to copy dependenies to
+#'
+#' @export
+save_html <- function(html, file, background = "white", libdir = "lib") {
+
+ # ensure that the paths to dependencies are relative to the base
+ # directory where the webpage is being built.
+ dir <- dirname(file)
+ oldwd <- setwd(dir)
+ on.exit(setwd(oldwd), add = TRUE)
+
+ rendered <- renderTags(html)
+
+ deps <- lapply(rendered$dependencies, function(dep) {
+ dep <- copyDependencyToDir(dep, libdir, FALSE)
+ dep <- makeDependencyRelative(dep, dir, FALSE)
+ dep
+ })
+
+ # build the web-page
+ html <- c("<!DOCTYPE html>",
+ "<html>",
+ "<head>",
+ "<meta charset=\"utf-8\"/>",
+ renderDependencies(deps, c("href", "file")),
+ rendered$head,
+ "</head>",
+ sprintf("<body style=\"background-color:%s;\">", htmlEscape(background)),
+ rendered$html,
+ "</body>",
+ "</html>")
+
+ # write it
+ writeLines(html, file, useBytes = TRUE)
+}
+
+
diff --git a/R/tags.R b/R/tags.R
new file mode 100644
index 0000000..1bcb86e
--- /dev/null
+++ b/R/tags.R
@@ -0,0 +1,1463 @@
+#' @import utils digest
+NULL
+
+# Like base::paste, but converts all string args to UTF-8 first.
+paste8 <- function(..., sep = " ", collapse = NULL) {
+ args <- c(
+ lapply(list(...), enc2utf8),
+ list(
+ sep = if (is.null(sep)) sep else enc2utf8(sep),
+ collapse = if (is.null(collapse)) collapse else enc2utf8(collapse)
+ )
+ )
+
+ do.call(paste, args)
+}
+
+# Reusable function for registering a set of methods with S3 manually. The
+# methods argument is a list of character vectors, each of which has the form
+# c(package, genname, class).
+registerMethods <- function(methods) {
+ lapply(methods, function(method) {
+ pkg <- method[[1]]
+ generic <- method[[2]]
+ class <- method[[3]]
+ func <- get(paste(generic, class, sep="."))
+ if (pkg %in% loadedNamespaces()) {
+ registerS3method(generic, class, func, envir = asNamespace(pkg))
+ }
+ setHook(
+ packageEvent(pkg, "onLoad"),
+ function(...) {
+ registerS3method(generic, class, func, envir = asNamespace(pkg))
+ }
+ )
+ })
+}
+
+.onLoad <- function(...) {
+ # htmltools provides methods for knitr::knit_print, but knitr isn't a Depends or
+ # Imports of htmltools, only an Enhances. Therefore, the NAMESPACE file has to
+ # declare it as an export, not an S3method. That means that R will only know to
+ # use our methods if htmltools is actually attached, i.e., you have to use
+ # library(htmltools) in a knitr document or else you'll get escaped HTML in your
+ # document. This code snippet manually registers our methods with S3 once both
+ # htmltools and knitr are loaded.
+ registerMethods(list(
+ # c(package, genname, class)
+ c("knitr", "knit_print", "html"),
+ c("knitr", "knit_print", "shiny.tag"),
+ c("knitr", "knit_print", "shiny.tag.list")
+ ))
+}
+
+depListToNamedDepList <- function(dependencies) {
+ if (inherits(dependencies, "html_dependency"))
+ dependencies <- list(dependencies)
+
+ if (is.null(names(dependencies))) {
+ names(dependencies) <- sapply(dependencies, `[[`, "name")
+ }
+ return(dependencies)
+}
+
+#' Resolve a list of dependencies
+#'
+#' Given a list of dependencies, removes any redundant dependencies (based on
+#' name equality). If multiple versions of a dependency are found, the copy with
+#' the latest version number is used.
+#'
+#' @param dependencies A list of \code{\link{htmlDependency}} objects.
+#' @return dependencies A list of \code{\link{htmlDependency}} objects with
+#' redundancies removed.
+#'
+#' @export
+resolveDependencies <- function(dependencies) {
+ # Remove nulls
+ deps <- dependencies[!sapply(dependencies, is.null)]
+
+ # Get names and numeric versions in vector/list form
+ depnames <- sapply(deps, `[[`, "name")
+ depvers <- numeric_version(sapply(deps, `[[`, "version"))
+
+ # Get latest version of each dependency. `unique` uses the first occurrence of
+ # each dependency name, which is important for inter-dependent libraries.
+ return(lapply(unique(depnames), function(depname) {
+ # Sort by depname equality, then by version. Since na.last=NA, all elements
+ # whose names do not match will not be included in the sorted vector.
+ sorted <- order(ifelse(depnames == depname, TRUE, NA), depvers,
+ na.last = NA, decreasing = TRUE)
+ # The first element in the list is the one with the largest version.
+ deps[[sorted[[1]]]]
+ }))
+}
+
+# Remove `remove` from `dependencies` if the name matches.
+# dependencies is a named list of dependencies.
+# remove is a named list of dependencies that take priority.
+# If warnOnConflict, then warn when a dependency is being removed because of an
+# older version already being loaded.
+
+#' Subtract dependencies
+#'
+#' Remove a set of dependencies from another list of dependencies. The set of
+#' dependencies to remove can be expressed as either a character vector or a
+#' list; if the latter, a warning can be emitted if the version of the
+#' dependency being removed is later than the version of the dependency object
+#' that is causing the removal.
+#'
+#' @param dependencies A list of \code{\link{htmlDependency}} objects from which
+#' dependencies should be removed.
+#' @param remove A list of \code{\link{htmlDependency}} objects indicating which
+#' dependencies should be removed, or a character vector indicating dependency
+#' names.
+#' @param warnOnConflict If \code{TRUE}, a warning is emitted for each
+#' dependency that is removed if the corresponding dependency in \code{remove}
+#' has a lower version number. Has no effect if \code{remove} is provided as a
+#' character vector.
+#'
+#' @return A list of \code{\link{htmlDependency}} objects that don't intersect
+#' with \code{remove}.
+#'
+#' @export
+subtractDependencies <- function(dependencies, remove, warnOnConflict = TRUE) {
+ depnames <- sapply(dependencies, `[[`, "name")
+ rmnames <- if (is.character(remove))
+ remove
+ else
+ sapply(remove, `[[`, "name")
+
+ matches <- depnames %in% rmnames
+ if (warnOnConflict && !is.character(remove)) {
+ for (loser in dependencies[matches]) {
+ winner <- remove[[head(rmnames == loser$name, 1)]]
+ if (compareVersion(loser$version, winner$version) > 0) {
+ warning(sprintf(paste("The dependency %s %s conflicts with",
+ "version %s"), loser$name, loser$version, winner$version
+ ))
+ }
+ }
+ }
+
+ # Return only deps that weren't in remove
+ return(dependencies[!matches])
+}
+
+
+# Given a vector or list, drop all the NULL items in it
+dropNulls <- function(x) {
+ x[!vapply(x, is.null, FUN.VALUE=logical(1))]
+}
+
+nullOrEmpty <- function(x) {
+ is.null(x) || length(x) == 0
+}
+# Given a vector or list, drop all the NULL items in it
+dropNullsOrEmpty <- function(x) {
+ x[!vapply(x, nullOrEmpty, FUN.VALUE=logical(1))]
+}
+
+isTag <- function(x) {
+ inherits(x, "shiny.tag")
+}
+
+#' @rdname print.html
+#' @export
+print.shiny.tag <- function(x, browse = is.browsable(x), ...) {
+ if (browse)
+ html_print(x)
+ else
+ print(HTML(as.character(x)), ...)
+ invisible(x)
+}
+
+# indent can be numeric to indicate an initial indent level,
+# or FALSE to suppress
+#' @export
+format.shiny.tag <- function(x, ..., singletons = character(0), indent = 0) {
+ as.character(renderTags(x, singletons = singletons, indent = indent)$html)
+}
+
+#' @export
+as.character.shiny.tag <- function(x, ...) {
+ as.character(renderTags(x)$html)
+}
+
+#' @export
+as.character.html <- function(x, ...) {
+ as.vector(enc2utf8(x))
+}
+
+#' @export
+print.shiny.tag.list <- print.shiny.tag
+
+#' @export
+format.shiny.tag.list <- format.shiny.tag
+
+#' @export
+as.character.shiny.tag.list <- as.character.shiny.tag
+
+#' Print method for HTML/tags
+#'
+#' S3 method for printing HTML that prints markup or renders HTML in a web
+#' browser.
+#'
+#' @param x The value to print.
+#' @param browse If \code{TRUE}, the HTML will be rendered and displayed in a
+#' browser (or possibly another HTML viewer supplied by the environment via
+#' the \code{viewer} option). If \code{FALSE} then the HTML object's markup
+#' will be rendered at the console.
+#' @param ... Additional arguments passed to print.
+#'
+#' @export
+print.html <- function(x, ..., browse = is.browsable(x)) {
+ if (browse)
+ html_print(HTML(x))
+ else
+ cat(x, "\n", sep = "")
+ invisible(x)
+}
+
+#' @export
+format.html <- function(x, ...) {
+ as.character(x)
+}
+
+normalizeText <- function(text) {
+ if (!is.null(attr(text, "html", TRUE)))
+ text
+ else
+ htmlEscape(text, attribute=FALSE)
+
+}
+
+#' @name tag
+#' @rdname tag
+#' @export
+tagList <- function(...) {
+ lst <- list(...)
+ class(lst) <- c("shiny.tag.list", "list")
+ return(lst)
+}
+
+#' @rdname tag
+#' @export
+tagAppendAttributes <- function(tag, ...) {
+ tag$attribs <- c(tag$attribs, list(...))
+ tag
+}
+
+#' @param attr The name of an attribute.
+#' @rdname tag
+#' @export
+tagHasAttribute <- function(tag, attr) {
+ result <- attr %in% names(tag$attribs)
+ result
+}
+
+#' @rdname tag
+#' @export
+tagGetAttribute <- function(tag, attr) {
+ # Find out which positions in the attributes list correspond to the given attr
+ attribs <- tag$attribs
+ attrIdx <- which(attr == names(attribs))
+
+ if (length(attrIdx) == 0) {
+ return (NULL)
+ }
+
+ # Convert all attribs to chars explicitly; prevents us from messing up factors
+ result <- lapply(attribs[attrIdx], as.character)
+ # Separate multiple attributes with the same name
+ result <- paste(result, collapse = " ")
+ result
+}
+
+#' @rdname tag
+#' @export
+tagAppendChild <- function(tag, child) {
+ tag$children[[length(tag$children)+1]] <- child
+ tag
+}
+
+#' @rdname tag
+#' @export
+tagAppendChildren <- function(tag, ..., list = NULL) {
+ tag$children <- c(tag$children, c(list(...), list))
+ tag
+}
+
+#' @rdname tag
+#' @export
+tagSetChildren <- function(tag, ..., list = NULL) {
+ tag$children <- c(list(...), list)
+ tag
+}
+
+#' HTML Tag Object
+#'
+#' \code{tag()} creates an HTML tag definition. Note that all of the valid HTML5
+#' tags are already defined in the \code{\link{tags}} environment so these
+#' functions should only be used to generate additional tags.
+#' \code{tagAppendChild()} and \code{tagList()} are for supporting package
+#' authors who wish to create their own sets of tags; see the contents of
+#' bootstrap.R for examples.
+#' @param _tag_name HTML tag name
+#' @param varArgs List of attributes and children of the element. Named list
+#' items become attributes, and unnamed list items become children. Valid
+#' children are tags, single-character character vectors (which become text
+#' nodes), and raw HTML (see \code{\link{HTML}}). You can also pass lists that
+#' contain tags, text nodes, and HTML.
+#' @param tag A tag to append child elements to.
+#' @param child A child element to append to a parent tag.
+#' @param ... Unnamed items that comprise this list of tags.
+#' @param list An optional list of elements. Can be used with or instead of the
+#' \code{...} items.
+#' @return An HTML tag object that can be rendered as HTML using
+#' \code{\link{as.character}()}.
+#' @export
+#' @examples
+#' tagList(tags$h1("Title"),
+#' tags$h2("Header text"),
+#' tags$p("Text here"))
+#'
+#' # Can also convert a regular list to a tagList (internal data structure isn't
+#' # exactly the same, but when rendered to HTML, the output is the same).
+#' x <- list(tags$h1("Title"),
+#' tags$h2("Header text"),
+#' tags$p("Text here"))
+#' tagList(x)
+tag <- function(`_tag_name`, varArgs) {
+ # Get arg names; if not a named list, use vector of empty strings
+ varArgsNames <- names(varArgs)
+ if (is.null(varArgsNames))
+ varArgsNames <- character(length=length(varArgs))
+
+ # Named arguments become attribs, dropping NULL values
+ named_idx <- nzchar(varArgsNames)
+ attribs <- dropNulls(varArgs[named_idx])
+
+ # Unnamed arguments are flattened and added as children.
+ # Use unname() to remove the names attribute from the list, which would
+ # consist of empty strings anyway.
+ children <- unname(varArgs[!named_idx])
+
+ # Return tag data structure
+ structure(
+ list(name = `_tag_name`,
+ attribs = attribs,
+ children = children),
+ class = "shiny.tag"
+ )
+}
+
+isTagList <- function(x) {
+ is.list(x) && (inherits(x, "shiny.tag.list") || identical(class(x), "list"))
+}
+
+tagWrite <- function(tag, textWriter, indent=0, eol = "\n") {
+
+ if (length(tag) == 0)
+ return (NULL)
+
+ # optionally process a list of tags
+ if (!isTag(tag) && isTagList(tag)) {
+ tag <- dropNullsOrEmpty(flattenTags(tag))
+ lapply(tag, tagWrite, textWriter, indent)
+ return (NULL)
+ }
+
+ nextIndent <- if (is.numeric(indent)) indent + 1 else indent
+ indent <- if (is.numeric(indent)) indent else 0
+
+ # compute indent text
+ indentText <- paste(rep(" ", indent*2), collapse="")
+
+ # Check if it's just text (may either be plain-text or HTML)
+ if (is.character(tag)) {
+ textWriter(indentText)
+ textWriter(normalizeText(tag))
+ textWriter(eol)
+ return (NULL)
+ }
+
+ # write tag name
+ textWriter(paste8(indentText, "<", tag$name, sep=""))
+
+ # Convert all attribs to chars explicitly; prevents us from messing up factors
+ attribs <- lapply(tag$attribs, as.character)
+ # concatenate attributes
+ # split() is very slow, so avoid it if possible
+ if (anyDuplicated(names(attribs)))
+ attribs <- lapply(split(attribs, names(attribs)), paste, collapse = " ")
+
+ # write attributes
+ for (attrib in names(attribs)) {
+ attribValue <- attribs[[attrib]]
+ if (!is.na(attribValue)) {
+ if (is.logical(attribValue))
+ attribValue <- tolower(attribValue)
+ text <- htmlEscape(attribValue, attribute=TRUE)
+ textWriter(paste8(" ", attrib,"=\"", text, "\"", sep=""))
+ }
+ else {
+ textWriter(paste8(" ", attrib, sep=""))
+ }
+ }
+
+ # write any children
+ children <- dropNullsOrEmpty(flattenTags(tag$children))
+ if (length(children) > 0) {
+ textWriter(">")
+
+ # special case for a single child text node (skip newlines and indentation)
+ if ((length(children) == 1) && is.character(children[[1]]) ) {
+ textWriter(paste8(normalizeText(children[[1]]), "</", tag$name, ">", eol,
+ sep=""))
+ }
+ else {
+ textWriter("\n")
+ for (child in children)
+ tagWrite(child, textWriter, nextIndent)
+ textWriter(paste8(indentText, "</", tag$name, ">", eol, sep=""))
+ }
+ }
+ else {
+ # only self-close void elements
+ # (see: http://dev.w3.org/html5/spec/single-page.html#void-elements)
+ if (tag$name %in% c("area", "base", "br", "col", "command", "embed", "hr",
+ "img", "input", "keygen", "link", "meta", "param",
+ "source", "track", "wbr")) {
+ textWriter(paste8("/>", eol, sep=""))
+ }
+ else {
+ textWriter(paste8("></", tag$name, ">", eol, sep=""))
+ }
+ }
+}
+
+#' Render tags into HTML
+#'
+#' Renders tags (and objects that can be converted into tags using
+#' \code{\link{as.tags}}) into HTML. (Generally intended to be called from web
+#' framework libraries, not directly by most users--see
+#' \code{\link{print.html}(browse=TRUE)} for higher level rendering.)
+#'
+#' @param x Tag object(s) to render
+#' @param singletons A list of \link{singleton} signatures to consider already
+#' rendered; any matching singletons will be dropped instead of rendered.
+#' (This is useful (only?) for incremental rendering.)
+#' @param indent Initial indent level, or \code{FALSE} if no indentation should
+#' be used.
+#'
+#' @return \code{renderTags} returns a list with the following variables:
+#' \describe{
+#' \item{\code{head}}{An \code{\link{HTML}} string that should be included in
+#' \code{<head>}.
+#' }
+#' \item{\code{singletons}}{Character vector of singleton signatures that are
+#' known after rendering.
+#' }
+#' \item{\code{dependencies}}{A list of \link[=resolveDependencies]{resolved}
+#' \code{\link{htmlDependency}} objects.
+#' }
+#' \item{\code{html}}{An \code{\link{HTML}} string that represents the main
+#' HTML that was rendered.
+#' }
+#' }
+#'
+#' @export
+renderTags <- function(x, singletons = character(0), indent = 0) {
+ x <- tagify(x)
+ # Do singleton and head processing before rendering
+ singletonInfo <- takeSingletons(x, singletons)
+ headInfo <- takeHeads(singletonInfo$ui)
+ deps <- resolveDependencies(findDependencies(singletonInfo$ui))
+
+ headIndent <- if (is.numeric(indent)) indent + 1 else indent
+ headHtml <- doRenderTags(headInfo$head, indent = headIndent)
+ bodyHtml <- doRenderTags(headInfo$ui, indent = indent)
+
+ return(list(head = headHtml,
+ singletons = singletonInfo$singletons,
+ dependencies = deps,
+ html = bodyHtml))
+}
+
+#' @details \code{doRenderTags} is intended for very low-level use; it ignores
+#' singleton, head, and dependency handling, and simply renders the given tag
+#' objects as HTML.
+#' @return \code{doRenderTags} returns a simple \code{\link{HTML}} string.
+#' @rdname renderTags
+#' @export
+doRenderTags <- function(x, indent = 0) {
+ # The text that is written to this connWriter will be converted to
+ # UTF-8 using enc2utf8. The rendered output will always be UTF-8
+ # encoded.
+ #
+ # We use a file() here instead of textConnection() or paste/c to
+ # avoid the overhead of copying, which is huge for moderately
+ # large numbers of calls to connWriter(). Generally when you want
+ # to incrementally build up a long string out of immutable ones,
+ # you want to use a mutable/growable string buffer of some kind;
+ # since R doesn't have something like that (that I know of),
+ # file() is the next best thing.
+ conn <- file(open="w+b", encoding = "UTF-8")
+ # Track how many bytes we write, so we can read in the right amount
+ # later with readChar.
+ bytes <- 0
+
+ connWriter <- function(text) {
+ raw <- charToRaw(enc2utf8(text))
+ bytes <<- bytes + length(raw)
+ # This is actually writing UTF-8 bytes, not chars
+ writeBin(raw, conn)
+ }
+
+ htmlResult <- tryCatch(
+ {
+ tagWrite(x, connWriter, indent)
+ flush(conn)
+
+ # Strip off trailing \n (which is always there) but make sure not to
+ # specify a negative number of chars.
+ bytes <- max(bytes - 1, 0)
+ readChar(conn, bytes, useBytes = TRUE)
+ },
+ finally = close(conn)
+ )
+ Encoding(htmlResult) <- "UTF-8"
+ return(HTML(htmlResult))
+}
+
+# Walk a tree of tag objects, rewriting objects according to func.
+# preorder=TRUE means preorder tree traversal, that is, an object
+# should be rewritten before its children.
+rewriteTags <- function(ui, func, preorder) {
+ if (preorder)
+ ui <- func(ui)
+
+ if (isTag(ui)) {
+ ui$children[] <- lapply(ui$children, rewriteTags, func, preorder)
+ } else if (isTagList(ui)) {
+ ui[] <- lapply(ui, rewriteTags, func, preorder)
+ }
+
+ if (!preorder)
+ ui <- func(ui)
+
+ return(ui)
+}
+
+#' Singleton manipulation functions
+#'
+#' Functions for manipulating \code{\link{singleton}} objects in tag
+#' hierarchies. Intended for framework authors.
+#'
+#' @rdname singleton_tools
+#' @name singleton_tools
+NULL
+
+#' @param ui Tag object or lists of tag objects. See \link{builder} topic.
+#' @return \code{surroundSingletons} preprocesses a tag object by changing any
+#' singleton X into <!--SHINY.SINGLETON[sig]-->X'<!--/SHINY.SINGLETON[sig]-->
+#' where sig is the sha1 of X, and X' is X minus the singleton attribute.
+#' @rdname singleton_tools
+#' @export
+surroundSingletons <- local({
+ # In the case of nested singletons, outer singletons are processed
+ # before inner singletons (otherwise the processing of inner
+ # singletons would cause the sha1 of the outer singletons to be
+ # different).
+ surroundSingleton <- function(uiObj) {
+ if (is.singleton(uiObj)) {
+ sig <- digest(uiObj, "sha1")
+ uiObj <- singleton(uiObj, FALSE)
+ return(tagList(
+ HTML(sprintf("<!--SHINY.SINGLETON[%s]-->", sig)),
+ uiObj,
+ HTML(sprintf("<!--/SHINY.SINGLETON[%s]-->", sig))
+ ))
+ } else {
+ uiObj
+ }
+ }
+
+ function(ui) {
+ rewriteTags(ui, surroundSingleton, TRUE)
+ }
+})
+
+#' @param singletons Character vector of singleton signatures that have already
+#' been encountered (i.e. returned from previous calls to
+#' \code{takeSingletons}).
+#' @param desingleton Logical value indicating whether singletons that are
+#' encountered should have the singleton attribute removed.
+#' @return \code{takeSingletons} returns a list with the elements \code{ui} (the
+#' processed tag objects with any duplicate singleton objects removed) and
+#' \code{singletons} (the list of known singleton signatures).
+#' @rdname singleton_tools
+#' @export
+takeSingletons <- function(ui, singletons=character(0), desingleton=TRUE) {
+ result <- rewriteTags(ui, function(uiObj) {
+ if (is.singleton(uiObj)) {
+ sig <- digest(uiObj, "sha1")
+ if (sig %in% singletons)
+ return(NULL)
+ singletons <<- append(singletons, sig)
+ if (desingleton)
+ uiObj <- singleton(uiObj, FALSE)
+ return(uiObj)
+ } else {
+ return(uiObj)
+ }
+ }, TRUE)
+
+ return(list(ui=result, singletons=singletons))
+}
+
+# Given a tag object, extract out any children of tags$head
+# and return them separate from the body.
+takeHeads <- function(ui) {
+ headItems <- list()
+ result <- rewriteTags(ui, function(uiObj) {
+ if (isTag(uiObj) && tolower(uiObj$name) == "head") {
+ headItems <<- append(headItems, uiObj$children)
+ return(NULL)
+ }
+ return(uiObj)
+ }, FALSE)
+
+ return(list(ui=result, head=headItems))
+}
+
+#' Collect attached dependencies from HTML tag object
+#'
+#' Walks a hierarchy of tags looking for attached dependencies.
+#'
+#' @param tags A tag-like object to search for dependencies.
+#'
+#' @return A list of \code{\link{htmlDependency}} objects.
+#'
+#' @export
+findDependencies <- function(tags) {
+ dep <- htmlDependencies(tagify(tags))
+ if (!is.null(dep) && inherits(dep, "html_dependency"))
+ dep <- list(dep)
+ children <- if (is.list(tags)) {
+ if (isTag(tags)) {
+ tags$children
+ } else {
+ tags
+ }
+ }
+ childDeps <- unlist(lapply(children, findDependencies), recursive = FALSE)
+ c(childDeps, if (!is.null(dep)) dep)
+}
+
+#' HTML Builder Functions
+#'
+#' Simple functions for constructing HTML documents.
+#'
+#' The \code{tags} environment contains convenience functions for all valid
+#' HTML5 tags. To generate tags that are not part of the HTML5 specification,
+#' you can use the \code{\link{tag}()} function.
+#'
+#' Dedicated functions are available for the most common HTML tags that do not
+#' conflict with common R functions.
+#'
+#' The result from these functions is a tag object, which can be converted using
+#' \code{\link{as.character}()}.
+#'
+#' @name builder
+#' @param ... Attributes and children of the element. Named arguments become
+#' attributes, and positional arguments become children. Valid children are
+#' tags, single-character character vectors (which become text nodes), raw
+#' HTML (see \code{\link{HTML}}), and \code{html_dependency} objects. You can
+#' also pass lists that contain tags, text nodes, or HTML.
+#' @export tags
+#' @examples
+#' doc <- tags$html(
+#' tags$head(
+#' tags$title('My first page')
+#' ),
+#' tags$body(
+#' h1('My first heading'),
+#' p('My first paragraph, with some ',
+#' strong('bold'),
+#' ' text.'),
+#' div(id='myDiv', class='simpleDiv',
+#' 'Here is a div with some attributes.')
+#' )
+#' )
+#' cat(as.character(doc))
+NULL
+
+#' @rdname builder
+#' @format NULL
+#' @docType NULL
+#' @keywords NULL
+tags <- list(
+ a = function(...) tag("a", list(...)),
+ abbr = function(...) tag("abbr", list(...)),
+ address = function(...) tag("address", list(...)),
+ area = function(...) tag("area", list(...)),
+ article = function(...) tag("article", list(...)),
+ aside = function(...) tag("aside", list(...)),
+ audio = function(...) tag("audio", list(...)),
+ b = function(...) tag("b", list(...)),
+ base = function(...) tag("base", list(...)),
+ bdi = function(...) tag("bdi", list(...)),
+ bdo = function(...) tag("bdo", list(...)),
+ blockquote = function(...) tag("blockquote", list(...)),
+ body = function(...) tag("body", list(...)),
+ br = function(...) tag("br", list(...)),
+ button = function(...) tag("button", list(...)),
+ canvas = function(...) tag("canvas", list(...)),
+ caption = function(...) tag("caption", list(...)),
+ cite = function(...) tag("cite", list(...)),
+ code = function(...) tag("code", list(...)),
+ col = function(...) tag("col", list(...)),
+ colgroup = function(...) tag("colgroup", list(...)),
+ command = function(...) tag("command", list(...)),
+ data = function(...) tag("data", list(...)),
+ datalist = function(...) tag("datalist", list(...)),
+ dd = function(...) tag("dd", list(...)),
+ del = function(...) tag("del", list(...)),
+ details = function(...) tag("details", list(...)),
+ dfn = function(...) tag("dfn", list(...)),
+ div = function(...) tag("div", list(...)),
+ dl = function(...) tag("dl", list(...)),
+ dt = function(...) tag("dt", list(...)),
+ em = function(...) tag("em", list(...)),
+ embed = function(...) tag("embed", list(...)),
+ eventsource = function(...) tag("eventsource", list(...)),
+ fieldset = function(...) tag("fieldset", list(...)),
+ figcaption = function(...) tag("figcaption", list(...)),
+ figure = function(...) tag("figure", list(...)),
+ footer = function(...) tag("footer", list(...)),
+ form = function(...) tag("form", list(...)),
+ h1 = function(...) tag("h1", list(...)),
+ h2 = function(...) tag("h2", list(...)),
+ h3 = function(...) tag("h3", list(...)),
+ h4 = function(...) tag("h4", list(...)),
+ h5 = function(...) tag("h5", list(...)),
+ h6 = function(...) tag("h6", list(...)),
+ head = function(...) tag("head", list(...)),
+ header = function(...) tag("header", list(...)),
+ hgroup = function(...) tag("hgroup", list(...)),
+ hr = function(...) tag("hr", list(...)),
+ html = function(...) tag("html", list(...)),
+ i = function(...) tag("i", list(...)),
+ iframe = function(...) tag("iframe", list(...)),
+ img = function(...) tag("img", list(...)),
+ input = function(...) tag("input", list(...)),
+ ins = function(...) tag("ins", list(...)),
+ kbd = function(...) tag("kbd", list(...)),
+ keygen = function(...) tag("keygen", list(...)),
+ label = function(...) tag("label", list(...)),
+ legend = function(...) tag("legend", list(...)),
+ li = function(...) tag("li", list(...)),
+ link = function(...) tag("link", list(...)),
+ mark = function(...) tag("mark", list(...)),
+ map = function(...) tag("map", list(...)),
+ menu = function(...) tag("menu", list(...)),
+ meta = function(...) tag("meta", list(...)),
+ meter = function(...) tag("meter", list(...)),
+ nav = function(...) tag("nav", list(...)),
+ noscript = function(...) tag("noscript", list(...)),
+ object = function(...) tag("object", list(...)),
+ ol = function(...) tag("ol", list(...)),
+ optgroup = function(...) tag("optgroup", list(...)),
+ option = function(...) tag("option", list(...)),
+ output = function(...) tag("output", list(...)),
+ p = function(...) tag("p", list(...)),
+ param = function(...) tag("param", list(...)),
+ pre = function(...) tag("pre", list(...)),
+ progress = function(...) tag("progress", list(...)),
+ q = function(...) tag("q", list(...)),
+ ruby = function(...) tag("ruby", list(...)),
+ rp = function(...) tag("rp", list(...)),
+ rt = function(...) tag("rt", list(...)),
+ s = function(...) tag("s", list(...)),
+ samp = function(...) tag("samp", list(...)),
+ script = function(...) tag("script", list(...)),
+ section = function(...) tag("section", list(...)),
+ select = function(...) tag("select", list(...)),
+ small = function(...) tag("small", list(...)),
+ source = function(...) tag("source", list(...)),
+ span = function(...) tag("span", list(...)),
+ strong = function(...) tag("strong", list(...)),
+ style = function(...) tag("style", list(...)),
+ sub = function(...) tag("sub", list(...)),
+ summary = function(...) tag("summary", list(...)),
+ sup = function(...) tag("sup", list(...)),
+ table = function(...) tag("table", list(...)),
+ tbody = function(...) tag("tbody", list(...)),
+ td = function(...) tag("td", list(...)),
+ textarea = function(...) tag("textarea", list(...)),
+ tfoot = function(...) tag("tfoot", list(...)),
+ th = function(...) tag("th", list(...)),
+ thead = function(...) tag("thead", list(...)),
+ time = function(...) tag("time", list(...)),
+ title = function(...) tag("title", list(...)),
+ tr = function(...) tag("tr", list(...)),
+ track = function(...) tag("track", list(...)),
+ u = function(...) tag("u", list(...)),
+ ul = function(...) tag("ul", list(...)),
+ var = function(...) tag("var", list(...)),
+ video = function(...) tag("video", list(...)),
+ wbr = function(...) tag("wbr", list(...))
+)
+
+#' Mark Characters as HTML
+#'
+#' Marks the given text as HTML, which means the \link{tag} functions will know
+#' not to perform HTML escaping on it.
+#'
+#' @param text The text value to mark with HTML
+#' @param ... Any additional values to be converted to character and
+#' concatenated together
+#' @return The same value, but marked as HTML.
+#'
+#' @examples
+#' el <- div(HTML("I like <u>turtles</u>"))
+#' cat(as.character(el))
+#'
+#' @export
+HTML <- function(text, ...) {
+ htmlText <- c(text, as.character(list(...)))
+ htmlText <- paste8(htmlText, collapse=" ")
+ attr(htmlText, "html") <- TRUE
+ class(htmlText) <- c("html", "character")
+ htmlText
+}
+
+#' Evaluate an expression using \code{tags}
+#'
+#' This function makes it simpler to write HTML-generating code. Instead of
+#' needing to specify \code{tags} each time a tag function is used, as in
+#' \code{tags$div()} and \code{tags$p()}, code inside \code{withTags} is
+#' evaluated with \code{tags} searched first, so you can simply use
+#' \code{div()} and \code{p()}.
+#'
+#' If your code uses an object which happens to have the same name as an
+#' HTML tag function, such as \code{source()} or \code{summary()}, it will call
+#' the tag function. To call the intended (non-tags function), specify the
+#' namespace, as in \code{base::source()} or \code{base::summary()}.
+#'
+#' @param code A set of tags.
+#'
+#' @examples
+#' # Using tags$ each time
+#' tags$div(class = "myclass",
+#' tags$h3("header"),
+#' tags$p("text")
+#' )
+#'
+#' # Equivalent to above, but using withTags
+#' withTags(
+#' div(class = "myclass",
+#' h3("header"),
+#' p("text")
+#' )
+#' )
+#'
+#'
+#' @export
+withTags <- function(code) {
+ eval(substitute(code), envir = as.list(tags), enclos = parent.frame())
+}
+
+# Make sure any objects in the tree that can be converted to tags, have been
+tagify <- function(x) {
+ rewriteTags(x, function(uiObj) {
+ if (isTag(uiObj) || isTagList(uiObj) || is.character(uiObj))
+ return(uiObj)
+ else
+ return(tagify(as.tags(uiObj)))
+ }, FALSE)
+}
+
+# Given a list of tags, lists, and other items, return a flat list, where the
+# items from the inner, nested lists are pulled to the top level, recursively.
+flattenTags <- function(x) {
+ if (isTag(x)) {
+ # For tags, wrap them into a list (which will be unwrapped by caller)
+ list(x)
+ } else if (isTagList(x)) {
+ if (length(x) == 0) {
+ # Empty lists are simply returned
+ x
+ } else {
+ # For items that are lists (but not tags), recurse
+ unlist(lapply(x, flattenTags), recursive = FALSE)
+ }
+
+ } else if (is.character(x)){
+ # This will preserve attributes if x is a character with attribute,
+ # like what HTML() produces
+ list(x)
+
+ } else {
+ # For other items, coerce to character and wrap them into a list (which
+ # will be unwrapped by caller). Note that this will strip attributes.
+ flattenTags(as.tags(x))
+ }
+}
+
+#' Convert a value to tags
+#'
+#' An S3 method for converting arbitrary values to a value that can be used as
+#' the child of a tag or \code{tagList}. The default implementation simply calls
+#' \code{\link[base]{as.character}}.
+#'
+#' @param x Object to be converted.
+#' @param ... Any additional parameters.
+#'
+#' @export
+as.tags <- function(x, ...) {
+ UseMethod("as.tags")
+}
+
+#' @export
+as.tags.default <- function(x, ...) {
+ if (is.list(x) && !isTagList(x))
+ unclass(x)
+ else
+ tagList(as.character(x))
+}
+
+#' @export
+as.tags.html <- function(x, ...) {
+ x
+}
+
+#' @export
+as.tags.shiny.tag <- function(x, ...) {
+ x
+}
+
+#' @export
+as.tags.shiny.tag.list <- function(x, ...) {
+ x
+}
+
+#' @export
+as.tags.character <- function(x, ...) {
+ # For printing as.tags("<strong>") directly at console, without dropping any
+ # attached dependencies
+ tagList(x)
+}
+
+#' @export
+as.tags.html_dependency <- function(x, ...) {
+ attachDependencies(tagList(), x)
+}
+
+#' Preserve HTML regions
+#'
+#' Use "magic" HTML comments to protect regions of HTML from being modified by
+#' text processing tools.
+#'
+#' Text processing tools like markdown and pandoc are designed to turn
+#' human-friendly markup into common output formats like HTML. This works well
+#' for most prose, but components that generate their own HTML may break if
+#' their markup is interpreted as the input language. The \code{htmlPreserve}
+#' function is used to mark regions of an input document as containing pure HTML
+#' that must not be modified. This is achieved by substituting each such region
+#' with a benign but unique string before processing, and undoing those
+#' substitutions after processing.
+#'
+#' @param x A character vector of HTML to be preserved.
+#'
+#' @return \code{htmlPreserve} returns a single-element character vector with
+#' "magic" HTML comments surrounding the original text (unless the original
+#' text was empty, in which case an empty string is returned).
+#'
+#' @examples
+#' # htmlPreserve will prevent "<script>alert(10*2*3);</script>"
+#' # from getting an <em> tag inserted in the middle
+#' markup <- paste(sep = "\n",
+#' "This is *emphasized* text in markdown.",
+#' htmlPreserve("<script>alert(10*2*3);</script>"),
+#' "Here is some more *emphasized text*."
+#' )
+#' extracted <- extractPreserveChunks(markup)
+#' markup <- extracted$value
+#' # Just think of this next line as Markdown processing
+#' output <- gsub("\\*(.*?)\\*", "<em>\\1</em>", markup)
+#' output <- restorePreserveChunks(output, extracted$chunks)
+#' output
+#'
+#' @export
+htmlPreserve <- function(x) {
+ x <- paste(x, collapse = "\r\n")
+ if (nzchar(x))
+ sprintf("<!--html_preserve-->%s<!--/html_preserve-->", x)
+ else
+ x
+}
+
+# Temporarily set x in env to value, evaluate expr, and
+# then restore x to its original state
+withTemporary <- function(env, x, value, expr, unset = FALSE) {
+
+ if (exists(x, envir = env, inherits = FALSE)) {
+ oldValue <- get(x, envir = env, inherits = FALSE)
+ on.exit(
+ assign(x, oldValue, envir = env, inherits = FALSE),
+ add = TRUE)
+ } else {
+ on.exit(
+ rm(list = x, envir = env, inherits = FALSE),
+ add = TRUE
+ )
+ }
+
+ if (!missing(value) && !isTRUE(unset))
+ assign(x, value, envir = env, inherits = FALSE)
+ else {
+ if (exists(x, envir = env, inherits = FALSE))
+ rm(list = x, envir = env, inherits = FALSE)
+ }
+ force(expr)
+}
+
+# Evaluate an expression using Shiny's own private stream of
+# randomness (not affected by set.seed).
+withPrivateSeed <- local({
+ ownSeed <- NULL
+ function(expr) {
+ withTemporary(.GlobalEnv, ".Random.seed",
+ ownSeed, unset=is.null(ownSeed), {
+ tryCatch({
+ expr
+ }, finally = {ownSeed <<- .Random.seed})
+ }
+ )
+ }
+})
+
+# extract_preserve_chunks looks for regions in strval marked by
+# <!--html_preserve-->...<!--/html_preserve--> and replaces each such region
+# with a long unique ID. The return value is a list with $value as the string
+# with the regions replaced, and $chunks as a named character vector where the
+# names are the IDs and the values are the regions that were extracted.
+#
+# Nested regions are handled appropriately; the outermost region is what's used
+# and any inner regions simply have their boundaries removed before the values
+# are stashed in $chunks.
+
+#' @return \code{extractPreserveChunks} returns a list with two named elements:
+#' \code{value} is the string with the regions replaced, and \code{chunks} is
+#' a named character vector where the names are the IDs and the values are the
+#' regions that were extracted.
+#' @rdname htmlPreserve
+#' @export
+extractPreserveChunks <- function(strval) {
+
+ # Literal start/end marker text. Case sensitive.
+ startmarker <- "<!--html_preserve-->"
+ endmarker <- "<!--/html_preserve-->"
+ # Start and end marker length MUST be different, it's how we tell them apart
+ startmarker_len <- nchar(startmarker)
+ endmarker_len <- nchar(endmarker)
+ # Pattern must match both start and end markers
+ pattern <- "<!--/?html_preserve-->"
+
+ # It simplifies string handling greatly to collapse multiple char elements
+ if (length(strval) != 1)
+ strval <- paste(strval, collapse = "\n")
+
+ # matches contains the index of all the start and end markers
+ matches <- gregexpr(pattern, strval)[[1]]
+ lengths <- attr(matches, "match.length", TRUE)
+
+ # No markers? Just return.
+ if (matches[[1]] == -1)
+ return(list(value = strval, chunks = character(0)))
+
+ # If TRUE, it's a start; if FALSE, it's an end
+ boundary_type <- lengths == startmarker_len
+
+ # Positive number means we're inside a region, zero means we just exited to
+ # the top-level, negative number means error (an end without matching start).
+ # For example:
+ # boundary_type - TRUE TRUE FALSE FALSE TRUE FALSE
+ # preserve_level - 1 2 1 0 1 0
+ preserve_level <- cumsum(ifelse(boundary_type, 1, -1))
+
+ # Sanity check.
+ if (any(preserve_level < 0) || tail(preserve_level, 1) != 0) {
+ stop("Invalid nesting of html_preserve directives")
+ }
+
+ # Identify all the top-level boundary markers. We want to find all of the
+ # elements of preserve_level whose value is 0 and preceding value is 1, or
+ # whose value is 1 and preceding value is 0. Since we know that preserve_level
+ # values can only go up or down by 1, we can simply shift preserve_level by
+ # one element and add it to preserve_level; in the result, any value of 1 is a
+ # match.
+ is_top_level <- 1 == (preserve_level + c(0, preserve_level[-length(preserve_level)]))
+
+ preserved <- character(0)
+
+ top_level_matches <- matches[is_top_level]
+ # Iterate backwards so string mutation doesn't screw up positions for future
+ # iterations
+ for (i in seq.int(length(top_level_matches) - 1, 1, by = -2)) {
+ start_outer <- top_level_matches[[i]]
+ start_inner <- start_outer + startmarker_len
+ end_inner <- top_level_matches[[i+1]]
+ end_outer <- end_inner + endmarker_len
+
+ id <- withPrivateSeed(
+ paste("preserve", paste(
+ format(as.hexmode(sample(256, 8, replace = TRUE)-1), width=2),
+ collapse = ""),
+ sep = "")
+ )
+
+ preserved[id] <- gsub(pattern, "", substr(strval, start_inner, end_inner-1))
+
+ strval <- paste(
+ substr(strval, 1, start_outer - 1),
+ id,
+ substr(strval, end_outer, nchar(strval)),
+ sep="")
+ substr(strval, start_outer, end_outer-1) <- id
+ }
+
+ list(value = strval, chunks = preserved)
+}
+
+#' @param strval Input string from which to extract/restore chunks.
+#' @param chunks The \code{chunks} element of the return value of
+#' \code{extractPreserveChunks}.
+#' @return \code{restorePreserveChunks} returns a character vector with the
+#' chunk IDs replaced with their original values.
+#' @rdname htmlPreserve
+#' @export
+restorePreserveChunks <- function(strval, chunks) {
+ for (id in names(chunks))
+ strval <- gsub(id, chunks[[id]], strval, fixed = TRUE, useBytes = TRUE)
+ strval
+}
+
+#' Knitr S3 methods
+#'
+#' These S3 methods are necessary to allow HTML tags to print themselves in
+#' knitr/rmarkdown documents.
+#'
+#' @name knitr_methods
+#' @param x Object to knit_print
+#' @param ... Additional knit_print arguments
+NULL
+
+#' @rdname knitr_methods
+#' @export
+knit_print.shiny.tag <- function(x, ...) {
+ x <- tagify(x)
+ output <- surroundSingletons(x)
+ deps <- resolveDependencies(findDependencies(x))
+ content <- takeHeads(output)
+ head_content <- doRenderTags(tagList(content$head))
+
+ meta <- if (length(head_content) > 1 || head_content != "") {
+ list(structure(head_content, class = "shiny_head"))
+ }
+ meta <- c(meta, deps)
+
+ knitr::asis_output(
+ htmlPreserve(format(content$ui, indent=FALSE)),
+ meta = meta)
+}
+
+#' @rdname knitr_methods
+#' @export
+knit_print.html <- function(x, ...) {
+ deps <- resolveDependencies(findDependencies(x))
+ knitr::asis_output(htmlPreserve(as.character(x)),
+ meta = if (length(deps)) list(deps))
+}
+
+#' @rdname knitr_methods
+#' @export
+knit_print.shiny.tag.list <- knit_print.shiny.tag
+
+
+
+#' @rdname builder
+#' @export
+p <- function(...) tags$p(...)
+
+#' @rdname builder
+#' @export
+h1 <- function(...) tags$h1(...)
+
+#' @rdname builder
+#' @export
+h2 <- function(...) tags$h2(...)
+
+#' @rdname builder
+#' @export
+h3 <- function(...) tags$h3(...)
+
+#' @rdname builder
+#' @export
+h4 <- function(...) tags$h4(...)
+
+#' @rdname builder
+#' @export
+h5 <- function(...) tags$h5(...)
+
+#' @rdname builder
+#' @export
+h6 <- function(...) tags$h6(...)
+
+#' @rdname builder
+#' @export
+a <- function(...) tags$a(...)
+
+#' @rdname builder
+#' @export
+br <- function(...) tags$br(...)
+
+#' @rdname builder
+#' @export
+div <- function(...) tags$div(...)
+
+#' @rdname builder
+#' @export
+span <- function(...) tags$span(...)
+
+#' @rdname builder
+#' @export
+pre <- function(...) tags$pre(...)
+
+#' @rdname builder
+#' @export
+code <- function(...) tags$code(...)
+
+#' @rdname builder
+#' @export
+img <- function(...) tags$img(...)
+
+#' @rdname builder
+#' @export
+strong <- function(...) tags$strong(...)
+
+#' @rdname builder
+#' @export
+em <- function(...) tags$em(...)
+
+#' @rdname builder
+#' @export
+hr <- function(...) tags$hr(...)
+
+#' Include Content From a File
+#'
+#' Load HTML, text, or rendered Markdown from a file and turn into HTML.
+#'
+#' These functions provide a convenient way to include an extensive amount of
+#' HTML, textual, Markdown, CSS, or JavaScript content, rather than using a
+#' large literal R string.
+#'
+#' @param path The path of the file to be included. It is highly recommended to
+#' use a relative path (the base path being the Shiny application directory),
+#' not an absolute path.
+#'
+#' @rdname include
+#' @name include
+#' @aliases includeHTML
+#' @export
+includeHTML <- function(path) {
+ lines <- readLines(path, warn=FALSE, encoding='UTF-8')
+ return(HTML(paste8(lines, collapse='\r\n')))
+}
+
+#' @note \code{includeText} escapes its contents, but does no other processing.
+#' This means that hard breaks and multiple spaces will be rendered as they
+#' usually are in HTML: as a single space character. If you are looking for
+#' preformatted text, wrap the call with \code{\link{pre}}, or consider using
+#' \code{includeMarkdown} instead.
+#'
+#' @rdname include
+#' @export
+includeText <- function(path) {
+ lines <- readLines(path, warn=FALSE, encoding='UTF-8')
+ return(paste8(lines, collapse='\r\n'))
+}
+
+#' @note The \code{includeMarkdown} function requires the \code{markdown}
+#' package.
+#' @rdname include
+#' @export
+includeMarkdown <- function(path) {
+ html <- markdown::markdownToHTML(path, fragment.only=TRUE)
+ Encoding(html) <- 'UTF-8'
+ return(HTML(html))
+}
+
+#' @param ... Any additional attributes to be applied to the generated tag.
+#' @rdname include
+#' @export
+includeCSS <- function(path, ...) {
+ lines <- readLines(path, warn=FALSE, encoding='UTF-8')
+ args <- list(...)
+ if (is.null(args$type))
+ args$type <- 'text/css'
+ return(do.call(tags$style,
+ c(list(HTML(paste8(lines, collapse='\r\n'))), args)))
+}
+
+#' @rdname include
+#' @export
+includeScript <- function(path, ...) {
+ lines <- readLines(path, warn=FALSE, encoding='UTF-8')
+ return(tags$script(HTML(paste8(lines, collapse='\r\n')), ...))
+}
+
+#' Include content only once
+#'
+#' Use \code{singleton} to wrap contents (tag, text, HTML, or lists) that should
+#' be included in the generated document only once, yet may appear in the
+#' document-generating code more than once. Only the first appearance of the
+#' content (in document order) will be used.
+#'
+#' @param x A \code{\link{tag}}, text, \code{\link{HTML}}, or list.
+#' @param value Whether the object should be a singleton.
+#'
+#' @export
+singleton <- function(x, value = TRUE) {
+ attr(x, "htmltools.singleton") <- if (isTRUE(value)) TRUE else NULL
+ return(x)
+}
+
+#' @rdname singleton
+#' @export
+is.singleton <- function(x) {
+ isTRUE(attr(x, "htmltools.singleton"))
+}
+
+
+#' Validate proper CSS formatting of a unit
+#'
+#' Checks that the argument is valid for use as a CSS unit of length.
+#'
+#' \code{NULL} and \code{NA} are returned unchanged.
+#'
+#' Single element numeric vectors are returned as a character vector with the
+#' number plus a suffix of \code{"px"}.
+#'
+#' Single element character vectors must be \code{"auto"} or \code{"inherit"},
+#' or a number. If the number has a suffix, it must be valid: \code{px},
+#' \code{\%}, \code{em}, \code{pt}, \code{in}, \code{cm}, \code{mm}, \code{ex},
+#' or \code{pc}. If the number has no suffix, the suffix \code{"px"} is
+#' appended.
+#'
+#' Any other value will cause an error to be thrown.
+#'
+#' @param x The unit to validate. Will be treated as a number of pixels if a
+#' unit is not specified.
+#' @return A properly formatted CSS unit of length, if possible. Otherwise, will
+#' throw an error.
+#' @examples
+#' validateCssUnit("10%")
+#' validateCssUnit(400) #treated as '400px'
+#' @export
+validateCssUnit <- function(x) {
+ if (is.null(x) || is.na(x))
+ return(x)
+
+ if (length(x) > 1 || (!is.character(x) && !is.numeric(x)))
+ stop('CSS units must be a single-element numeric or character vector')
+
+ # if the input is a character vector consisting only of digits (e.g. "960"),
+ # coerce it to a numeric value
+ if (is.character(x) && nchar(x) > 0 && gsub("\\d*", "", x) == "")
+ x <- as.numeric(x)
+
+ pattern <-
+ "^(auto|inherit|((\\.\\d+)|(\\d+(\\.\\d+)?))(%|in|cm|mm|em|ex|pt|pc|px))$"
+
+ if (is.character(x) &&
+ !grepl(pattern, x)) {
+ stop('"', x, '" is not a valid CSS unit (e.g., "100%", "400px", "auto")')
+ } else if (is.numeric(x)) {
+ x <- paste(x, "px", sep = "")
+ }
+ x
+}
+
+#' CSS string helper
+#'
+#' Convenience function for building CSS style declarations (i.e. the string
+#' that goes into a style attribute, or the parts that go inside curly braces in
+#' a full stylesheet).
+#'
+#' CSS uses \code{'-'} (minus) as a separator character in property names, but
+#' this is an inconvenient character to use in an R function argument name.
+#' Instead, you can use \code{'.'} (period) and/or \code{'_'} (underscore) as
+#' separator characters. For example, \code{css(font.size = "12px")} yields
+#' \code{"font-size:12px;"}.
+#'
+#' To mark a property as \code{!important}, add a \code{'!'} character to the end
+#' of the property name. (Since \code{'!'} is not normally a character that can be
+#' used in an identifier in R, you'll need to put the name in double quotes or
+#' backticks.)
+#'
+#' Argument values will be converted to strings using
+#' \code{paste(collapse = " ")}. Any property with a value of \code{NULL} or
+#' \code{""} (after paste) will be dropped.
+#'
+#' @param ... Named style properties, where the name is the property name and
+#' the argument is the property value. See Details for conversion rules.
+#' @param collapse_ (Note that the parameter name has a trailing underscore
+#' character.) Character to use to collapse properties into a single string;
+#' likely \code{""} (the default) for style attributes, and either \code{"\n"}
+#' or \code{NULL} for style blocks.
+#'
+#' @examples
+#' padding <- 6
+#' css(
+#' font.family = "Helvetica, sans-serif",
+#' margin = paste0(c(10, 20, 10, 20), "px"),
+#' "padding!" = if (!is.null(padding)) padding
+#' )
+#'
+#' @export
+css <- function(..., collapse_ = "") {
+ props <- list(...)
+ if (length(props) == 0) {
+ return("")
+ }
+
+ if (is.null(names(props)) || any(names(props) == "")) {
+ stop("cssList expects all arguments to be named")
+ }
+
+ # Necessary to make factors show up as level names, not numbers
+ props[] <- lapply(props, paste, collapse = " ")
+
+ # Drop null args
+ props <- props[!sapply(props, empty)]
+ if (length(props) == 0) {
+ return("")
+ }
+
+ # Replace all '.' and '_' in property names to '-'
+ names(props) <- gsub("[._]", "-", tolower(gsub("([A-Z])", "-\\1", names(props))))
+
+ # Create "!important" suffix for each property whose name ends with !, then
+ # remove the ! from the property name
+ important <- ifelse(grepl("!$", names(props), perl = TRUE), " !important", "")
+ names(props) <- sub("!$", "", names(props), perl = TRUE)
+
+ paste0(names(props), ":", props, important, ";", collapse = collapse_)
+}
+
+empty <- function(x) {
+ length(x) == 0 || (is.character(x) && !any(nzchar(x)))
+}
diff --git a/R/template.R b/R/template.R
new file mode 100644
index 0000000..24d8022
--- /dev/null
+++ b/R/template.R
@@ -0,0 +1,134 @@
+#' 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
+#' \code{html_document}, and can be passed to the function
+#' \code{\link{renderDocument}} to get the final HTML text.
+#'
+#' @param filename Path to an HTML template file. Incompatible with
+#' \code{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 \code{filename}.
+#' @param document_ Is this template a complete HTML document (\code{TRUE}), or
+#' a fragment of HTML that is to be inserted into an HTML document
+#' (\code{FALSE})? With \code{"auto"} (the default), auto-detect by searching
+#' for the string \code{"<HTML>"} within the template.
+#'
+#' @seealso \code{\link{renderDocument}}
+#' @export
+#' @useDynLib htmltools
+#' @importFrom Rcpp sourceCpp
+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 <- 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 <- 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 if (piece == "") {
+ # Don't add leading/trailing '\n' if empty HTML string.
+ NULL
+ } else {
+ HTML(piece)
+ }
+ },
+ 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 \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
+#' (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
+#' dependencies.
+#'
+#' @param x An object of class \code{html_document}, typically generated by the
+#' \code{\link{htmlTemplate}} function.
+#' @param deps Any extra web dependencies to add to the html document. This can
+#' be an object created by \code{\link{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 \code{renderDocument} is
+#' called from Shiny, the function \code{\link[shiny]{createWebDependency}} is
+#' used; it modifies the href and tells Shiny to serve a particular path on
+#' the filesystem.
+#'
+#' @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"/>',
+ sprintf(' <script type="application/shiny-singletons">%s</script>',
+ paste(result$singletons, collapse = ',')
+ ),
+ sprintf(' <script type="application/html-dependencies">%s</script>',
+ depStr
+ ),
+ depHtml,
+ c(result$head, recursive = TRUE)
+ )
+ sub("<!-- HEAD_CONTENT -->", head_content, result$html, fixed = TRUE)
+}
diff --git a/debian/README.test b/debian/README.test
deleted file mode 100644
index 4fe93f7..0000000
--- a/debian/README.test
+++ /dev/null
@@ -1,9 +0,0 @@
-Notes on how this package can be tested.
-────────────────────────────────────────
-
-This package can be tested by running the provided test:
-
-cd tests
-LC_ALL=C R --no-save < test-all.R
-
-in order to confirm its integrity.
diff --git a/debian/changelog b/debian/changelog
deleted file mode 100644
index 738093b..0000000
--- a/debian/changelog
+++ /dev/null
@@ -1,11 +0,0 @@
-r-cran-htmltools (0.3.5-2) unstable; urgency=medium
-
- * Add missing Dependency: r-cran-rcpp
-
- -- Andreas Tille <tille at debian.org> Wed, 27 Apr 2016 21:42:12 +0200
-
-r-cran-htmltools (0.3.5-1) unstable; urgency=low
-
- * Initial release (Closes: #819070)
-
- -- Andreas Tille <tille at debian.org> Wed, 23 Mar 2016 14:44:17 +0100
diff --git a/debian/compat b/debian/compat
deleted file mode 100644
index ec63514..0000000
--- a/debian/compat
+++ /dev/null
@@ -1 +0,0 @@
-9
diff --git a/debian/control b/debian/control
deleted file mode 100644
index b4b5792..0000000
--- a/debian/control
+++ /dev/null
@@ -1,24 +0,0 @@
-Source: r-cran-htmltools
-Maintainer: Debian Med Packaging Team <debian-med-packaging at lists.alioth.debian.org>
-Uploaders: Andreas Tille <tille at debian.org>
-Section: gnu-r
-Priority: optional
-Build-Depends: debhelper (>= 9),
- cdbs,
- r-base-dev,
- r-cran-rcpp,
- r-cran-digest
-Standards-Version: 3.9.7
-Vcs-Browser: https://anonscm.debian.org/viewvc/debian-med/trunk/packages/R/r-cran-htmltools/trunk/
-Vcs-Svn: svn://anonscm.debian.org/debian-med/trunk/packages/R/r-cran-htmltools/trunk/
-Homepage: https://cran.r-project.org/web/packages/htmltools/
-
-Package: r-cran-htmltools
-Architecture: any
-Depends: ${misc:Depends},
- ${shlibs:Depends},
- ${R:Depends},
- r-cran-rcpp,
- r-cran-digest
-Description: GNU R tools for HTML
- This GNU R package provides tools for HTML generation and output.
diff --git a/debian/copyright b/debian/copyright
deleted file mode 100644
index 7a47d82..0000000
--- a/debian/copyright
+++ /dev/null
@@ -1,29 +0,0 @@
-Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
-Upstream-Contact: Joe Cheng <joe at rstudio.com>
-Source: https://cran.r-project.org/web/packages/shiny/
-
-Files: *
-Copyright: 2013-2016 Joe Cheng <joe at rstudio.com>
-License: GPL-2+
-
-Files: debian/*
-Copyright: 2016 Andreas Tille <tille at debian.org>
-License: GPL-2+
-
-License: GPL-2+
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- .
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- .
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
- .
- On Debian systems, the complete text of the GNU General Public
- License can be found in `/usr/share/common-licenses/GPL-2'.
diff --git a/debian/docs b/debian/docs
deleted file mode 100644
index 960011c..0000000
--- a/debian/docs
+++ /dev/null
@@ -1,3 +0,0 @@
-tests
-debian/README.test
-debian/tests/run-unit-test
diff --git a/debian/rules b/debian/rules
deleted file mode 100755
index 2fbba2d..0000000
--- a/debian/rules
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/usr/bin/make -f
-
-include /usr/share/R/debian/r-cran.mk
diff --git a/debian/source/format b/debian/source/format
deleted file mode 100644
index 163aaf8..0000000
--- a/debian/source/format
+++ /dev/null
@@ -1 +0,0 @@
-3.0 (quilt)
diff --git a/debian/tests/control b/debian/tests/control
deleted file mode 100644
index b044b0c..0000000
--- a/debian/tests/control
+++ /dev/null
@@ -1,3 +0,0 @@
-Tests: run-unit-test
-Depends: @, r-cran-testthat
-Restrictions: allow-stderr
diff --git a/debian/tests/run-unit-test b/debian/tests/run-unit-test
deleted file mode 100644
index 1811d7d..0000000
--- a/debian/tests/run-unit-test
+++ /dev/null
@@ -1,12 +0,0 @@
-#!/bin/sh -e
-
-oname=htmltools
-pkg=r-cran-`echo $oname | tr [A-Z] [a-z]`
-
-if [ "$ADTTMP" = "" ] ; then
- ADTTMP=`mktemp -d /tmp/${pkg}-test.XXXXXX`
-fi
-cd $ADTTMP
-cp -a /usr/share/doc/${pkg}/tests/* $ADTTMP
-LC_ALL=C R --no-save < test-all.R
-rm -fr $ADTTMP/*
diff --git a/debian/watch b/debian/watch
deleted file mode 100644
index c4de29f..0000000
--- a/debian/watch
+++ /dev/null
@@ -1,3 +0,0 @@
-version=3
-http://cran.r-project.org/src/contrib/htmltools_([-0-9\.]*).tar.gz
-
diff --git a/man/HTML.Rd b/man/HTML.Rd
new file mode 100644
index 0000000..48cd613
--- /dev/null
+++ b/man/HTML.Rd
@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{HTML}
+\alias{HTML}
+\title{Mark Characters as HTML}
+\usage{
+HTML(text, ...)
+}
+\arguments{
+\item{text}{The text value to mark with HTML}
+
+\item{...}{Any additional values to be converted to character and
+concatenated together}
+}
+\value{
+The same value, but marked as HTML.
+}
+\description{
+Marks the given text as HTML, which means the \link{tag} functions will know
+not to perform HTML escaping on it.
+}
+\examples{
+el <- div(HTML("I like <u>turtles</u>"))
+cat(as.character(el))
+
+}
+
diff --git a/man/as.tags.Rd b/man/as.tags.Rd
new file mode 100644
index 0000000..7b056fd
--- /dev/null
+++ b/man/as.tags.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{as.tags}
+\alias{as.tags}
+\title{Convert a value to tags}
+\usage{
+as.tags(x, ...)
+}
+\arguments{
+\item{x}{Object to be converted.}
+
+\item{...}{Any additional parameters.}
+}
+\description{
+An S3 method for converting arbitrary values to a value that can be used as
+the child of a tag or \code{tagList}. The default implementation simply calls
+\code{\link[base]{as.character}}.
+}
+
diff --git a/man/browsable.Rd b/man/browsable.Rd
new file mode 100644
index 0000000..1b0c68a
--- /dev/null
+++ b/man/browsable.Rd
@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/html_print.R
+\name{browsable}
+\alias{browsable}
+\alias{is.browsable}
+\title{Make an HTML object browsable}
+\usage{
+browsable(x, value = TRUE)
+
+is.browsable(x)
+}
+\arguments{
+\item{x}{The object to make browsable or not.}
+
+\item{value}{Whether the object should be considered browsable.}
+}
+\value{
+\code{browsable} returns \code{x} with an extra attribute to indicate
+ that the value is browsable.
+
+\code{is.browsable} returns \code{TRUE} if the value is browsable, or
+ \code{FALSE} if not.
+}
+\description{
+By default, HTML objects display their HTML markup at the console when
+printed. \code{browsable} can be used to make specific objects render as HTML
+by default when printed at the console.
+}
+\details{
+You can override the default browsability of an HTML object by explicitly
+passing \code{browse = TRUE} (or \code{FALSE}) to the \code{print} function.
+}
+
diff --git a/man/builder.Rd b/man/builder.Rd
new file mode 100644
index 0000000..9a79291
--- /dev/null
+++ b/man/builder.Rd
@@ -0,0 +1,98 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{builder}
+\alias{a}
+\alias{br}
+\alias{builder}
+\alias{code}
+\alias{div}
+\alias{em}
+\alias{h1}
+\alias{h2}
+\alias{h3}
+\alias{h4}
+\alias{h5}
+\alias{h6}
+\alias{hr}
+\alias{img}
+\alias{p}
+\alias{pre}
+\alias{span}
+\alias{strong}
+\alias{tags}
+\title{HTML Builder Functions}
+\usage{
+tags
+
+p(...)
+
+h1(...)
+
+h2(...)
+
+h3(...)
+
+h4(...)
+
+h5(...)
+
+h6(...)
+
+a(...)
+
+br(...)
+
+div(...)
+
+span(...)
+
+pre(...)
+
+code(...)
+
+img(...)
+
+strong(...)
+
+em(...)
+
+hr(...)
+}
+\arguments{
+\item{...}{Attributes and children of the element. Named arguments become
+attributes, and positional arguments become children. Valid children are
+tags, single-character character vectors (which become text nodes), raw
+HTML (see \code{\link{HTML}}), and \code{html_dependency} objects. You can
+also pass lists that contain tags, text nodes, or HTML.}
+}
+\description{
+Simple functions for constructing HTML documents.
+}
+\details{
+The \code{tags} environment contains convenience functions for all valid
+HTML5 tags. To generate tags that are not part of the HTML5 specification,
+you can use the \code{\link{tag}()} function.
+
+Dedicated functions are available for the most common HTML tags that do not
+conflict with common R functions.
+
+The result from these functions is a tag object, which can be converted using
+\code{\link{as.character}()}.
+}
+\examples{
+doc <- tags$html(
+ tags$head(
+ tags$title('My first page')
+ ),
+ tags$body(
+ h1('My first heading'),
+ p('My first paragraph, with some ',
+ strong('bold'),
+ ' text.'),
+ div(id='myDiv', class='simpleDiv',
+ 'Here is a div with some attributes.')
+ )
+)
+cat(as.character(doc))
+}
+
diff --git a/man/copyDependencyToDir.Rd b/man/copyDependencyToDir.Rd
new file mode 100644
index 0000000..99b27b4
--- /dev/null
+++ b/man/copyDependencyToDir.Rd
@@ -0,0 +1,39 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/html_dependency.R
+\name{copyDependencyToDir}
+\alias{copyDependencyToDir}
+\title{Copy an HTML dependency to a directory}
+\usage{
+copyDependencyToDir(dependency, outputDir, mustWork = TRUE)
+}
+\arguments{
+\item{dependency}{A single HTML dependency object.}
+
+\item{outputDir}{The directory in which a subdirectory should be created for
+this dependency.}
+
+\item{mustWork}{If \code{TRUE} and \code{dependency} does not point to a
+directory on disk (but rather a URL location), an error is raised. If
+\code{FALSE} then non-disk dependencies are returned without modification.}
+}
+\value{
+The dependency with its \code{src} value updated to the new
+ location's absolute path.
+}
+\description{
+Copies an HTML dependency to a subdirectory of the given directory. The
+subdirectory name will be \emph{name}-\emph{version} (for example,
+"outputDir/jquery-1.11.0"). You may set \code{options(htmltools.dir.version =
+FALSE)} to suppress the version number in the subdirectory name.
+}
+\details{
+In order for disk-based dependencies to work with static HTML files, it's
+generally necessary to copy them to either the directory of the referencing
+HTML file, or to a subdirectory of that directory. This function makes it
+easier to perform that copy.
+}
+\seealso{
+\code{\link{makeDependencyRelative}} can be used with the returned
+ value to make the path relative to a specific directory.
+}
+
diff --git a/man/css.Rd b/man/css.Rd
new file mode 100644
index 0000000..3921316
--- /dev/null
+++ b/man/css.Rd
@@ -0,0 +1,48 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{css}
+\alias{css}
+\title{CSS string helper}
+\usage{
+css(..., collapse_ = "")
+}
+\arguments{
+\item{...}{Named style properties, where the name is the property name and
+the argument is the property value. See Details for conversion rules.}
+
+\item{collapse_}{(Note that the parameter name has a trailing underscore
+character.) Character to use to collapse properties into a single string;
+likely \code{""} (the default) for style attributes, and either \code{"\n"}
+or \code{NULL} for style blocks.}
+}
+\description{
+Convenience function for building CSS style declarations (i.e. the string
+that goes into a style attribute, or the parts that go inside curly braces in
+a full stylesheet).
+}
+\details{
+CSS uses \code{'-'} (minus) as a separator character in property names, but
+this is an inconvenient character to use in an R function argument name.
+Instead, you can use \code{'.'} (period) and/or \code{'_'} (underscore) as
+separator characters. For example, \code{css(font.size = "12px")} yields
+\code{"font-size:12px;"}.
+
+To mark a property as \code{!important}, add a \code{'!'} character to the end
+of the property name. (Since \code{'!'} is not normally a character that can be
+used in an identifier in R, you'll need to put the name in double quotes or
+backticks.)
+
+Argument values will be converted to strings using
+\code{paste(collapse = " ")}. Any property with a value of \code{NULL} or
+\code{""} (after paste) will be dropped.
+}
+\examples{
+padding <- 6
+css(
+ font.family = "Helvetica, sans-serif",
+ margin = paste0(c(10, 20, 10, 20), "px"),
+ "padding!" = if (!is.null(padding)) padding
+)
+
+}
+
diff --git a/man/findDependencies.Rd b/man/findDependencies.Rd
new file mode 100644
index 0000000..37e0834
--- /dev/null
+++ b/man/findDependencies.Rd
@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{findDependencies}
+\alias{findDependencies}
+\title{Collect attached dependencies from HTML tag object}
+\usage{
+findDependencies(tags)
+}
+\arguments{
+\item{tags}{A tag-like object to search for dependencies.}
+}
+\value{
+A list of \code{\link{htmlDependency}} objects.
+}
+\description{
+Walks a hierarchy of tags looking for attached dependencies.
+}
+
diff --git a/man/htmlDependencies.Rd b/man/htmlDependencies.Rd
new file mode 100644
index 0000000..7e1fcf5
--- /dev/null
+++ b/man/htmlDependencies.Rd
@@ -0,0 +1,56 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/html_dependency.R
+\name{htmlDependencies}
+\alias{attachDependencies}
+\alias{htmlDependencies}
+\alias{htmlDependencies<-}
+\title{HTML dependency metadata}
+\usage{
+htmlDependencies(x)
+
+htmlDependencies(x) <- value
+
+attachDependencies(x, value, append = FALSE)
+}
+\arguments{
+\item{x}{An object which has (or should have) HTML dependencies.}
+
+\item{value}{An HTML dependency, or a list of HTML dependencies.}
+
+\item{append}{If FALSE (the default), replace any existing dependencies. If
+TRUE, add the new dependencies to the existing ones.}
+}
+\description{
+Gets or sets the HTML dependencies associated with an object (such as a tag).
+}
+\details{
+\code{attachDependencies} provides an alternate syntax for setting
+dependencies. It is similar to \code{local(\{htmlDependencies(x) <- value;
+x\})}, except that if there are any existing dependencies,
+\code{attachDependencies} will add to them, instead of replacing them.
+
+As of htmltools 0.3.4, HTML dependencies can be attached without using
+\code{attachDependencies}. Instead, they can be added inline, like a child
+object of a tag or \code{\link{tagList}}.
+}
+\examples{
+# Create a JavaScript dependency
+dep <- htmlDependency("jqueryui", "1.11.4", c(href="shared/jqueryui"),
+ script = "jquery-ui.min.js")
+
+# A CSS dependency
+htmlDependency(
+ "font-awesome", "4.5.0", c(href="shared/font-awesome"),
+ stylesheet = "css/font-awesome.min.css"
+)
+
+# A few different ways to add the dependency to tag objects:
+# Inline as a child of the div()
+div("Code here", dep)
+# Inline in a tagList
+tagList(div("Code here"), dep)
+# With attachDependencies
+attachDependencies(div("Code here"), dep)
+
+}
+
diff --git a/man/htmlDependency.Rd b/man/htmlDependency.Rd
new file mode 100644
index 0000000..891a0be
--- /dev/null
+++ b/man/htmlDependency.Rd
@@ -0,0 +1,81 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/html_dependency.R
+\name{htmlDependency}
+\alias{htmlDependency}
+\title{Define an HTML dependency}
+\usage{
+htmlDependency(name, version, src, meta = NULL, script = NULL,
+ stylesheet = NULL, head = NULL, attachment = NULL, all_files = TRUE)
+}
+\arguments{
+\item{name}{Library name}
+
+\item{version}{Library version}
+
+\item{src}{Unnamed single-element character vector indicating the full path
+of the library directory. Alternatively, a named character string with one
+or more elements, indicating different places to find the library; see
+Details.}
+
+\item{meta}{Named list of meta tags to insert into document head}
+
+\item{script}{Script(s) to include within the document head (should be
+specified relative to the \code{src} parameter).}
+
+\item{stylesheet}{Stylesheet(s) to include within the document (should be
+specified relative to the \code{src} parameter).}
+
+\item{head}{Arbitrary lines of HTML to insert into the document head}
+
+\item{attachment}{Attachment(s) to include within the document head. See
+Details.}
+
+\item{all_files}{Whether all files under the \code{src} directory are
+dependency files. If \code{FALSE}, only the files specified in
+\code{script}, \code{stylesheet}, and \code{attachment} are treated as
+dependency files.}
+}
+\value{
+An object that can be included in a list of dependencies passed to
+ \code{\link{attachDependencies}}.
+}
+\description{
+Define an HTML dependency (i.e. CSS and/or JavaScript bundled in a
+directory). HTML dependencies make it possible to use libraries like jQuery,
+Bootstrap, and d3 in a more composable and portable way than simply using
+script, link, and style tags.
+}
+\details{
+Each dependency can be located on the filesystem, at a relative or
+ absolute URL, or both. The location types are indicated using the names of
+ the \code{src} character vector: \code{file} for filesystem directory,
+ \code{href} for URL. For example, a dependency that was both on disk and at
+ a URL might use \code{src = c(file=filepath, href=url)}.
+
+ \code{attachment} can be used to make the indicated files available to the
+ JavaScript on the page via URL. For each element of \code{attachment}, an
+ element \code{<link id="DEPNAME-ATTACHINDEX-attachment" rel="attachment"
+ href="...">} is inserted, where \code{DEPNAME} is \code{name}. The value of
+ \code{ATTACHINDEX} depends on whether \code{attachment} is named or not; if
+ so, then it's the name of the element, and if not, it's the 1-based index
+ of the element. JavaScript can retrieve the URL using something like
+ \code{document.getElementById(depname + "-" + index + "-attachment").href}.
+ Note that depending on the rendering context, the runtime value of the href
+ may be an absolute, relative, or data URI.
+
+ \code{htmlDependency} should not be called from the top-level of a package
+ namespace with absolute paths (or with paths generated by
+ \code{system.file()}) and have the result stored in a variable. This is
+ because, when a binary package is built, R will run \code{htmlDependency}
+ and store the path from the building machine's in the package. This path is
+ likely to differ from the correct path on a machine that downloads and
+ installs the binary package. If there are any absolute paths, instead of
+ calling \code{htmlDependency} at build-time, it should be called at
+ run-time. This can be done by wrapping the \code{htmlDependency} call in a
+ function.
+}
+\seealso{
+Use \code{\link{attachDependencies}} to associate a list of
+ dependencies with the HTML it belongs with.
+}
+
diff --git a/man/htmlEscape.Rd b/man/htmlEscape.Rd
new file mode 100644
index 0000000..1f99b75
--- /dev/null
+++ b/man/htmlEscape.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/html_escape.R
+\name{htmlEscape}
+\alias{htmlEscape}
+\title{Escape HTML entities}
+\usage{
+htmlEscape(text, attribute = FALSE)
+}
+\arguments{
+\item{text}{Text to escape}
+
+\item{attribute}{Escape for use as an attribute value}
+}
+\value{
+Character vector with escaped text.
+}
+\description{
+Escape HTML entities contained in a character vector so that it can be safely
+included as text or an attribute value within an HTML document
+}
+
diff --git a/man/htmlPreserve.Rd b/man/htmlPreserve.Rd
new file mode 100644
index 0000000..5f60569
--- /dev/null
+++ b/man/htmlPreserve.Rd
@@ -0,0 +1,66 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{htmlPreserve}
+\alias{extractPreserveChunks}
+\alias{htmlPreserve}
+\alias{restorePreserveChunks}
+\title{Preserve HTML regions}
+\usage{
+htmlPreserve(x)
+
+extractPreserveChunks(strval)
+
+restorePreserveChunks(strval, chunks)
+}
+\arguments{
+\item{x}{A character vector of HTML to be preserved.}
+
+\item{strval}{Input string from which to extract/restore chunks.}
+
+\item{chunks}{The \code{chunks} element of the return value of
+\code{extractPreserveChunks}.}
+}
+\value{
+\code{htmlPreserve} returns a single-element character vector with
+ "magic" HTML comments surrounding the original text (unless the original
+ text was empty, in which case an empty string is returned).
+
+\code{extractPreserveChunks} returns a list with two named elements:
+ \code{value} is the string with the regions replaced, and \code{chunks} is
+ a named character vector where the names are the IDs and the values are the
+ regions that were extracted.
+
+\code{restorePreserveChunks} returns a character vector with the
+ chunk IDs replaced with their original values.
+}
+\description{
+Use "magic" HTML comments to protect regions of HTML from being modified by
+text processing tools.
+}
+\details{
+Text processing tools like markdown and pandoc are designed to turn
+human-friendly markup into common output formats like HTML. This works well
+for most prose, but components that generate their own HTML may break if
+their markup is interpreted as the input language. The \code{htmlPreserve}
+function is used to mark regions of an input document as containing pure HTML
+that must not be modified. This is achieved by substituting each such region
+with a benign but unique string before processing, and undoing those
+substitutions after processing.
+}
+\examples{
+# htmlPreserve will prevent "<script>alert(10*2*3);</script>"
+# from getting an <em> tag inserted in the middle
+markup <- paste(sep = "\\n",
+ "This is *emphasized* text in markdown.",
+ htmlPreserve("<script>alert(10*2*3);</script>"),
+ "Here is some more *emphasized text*."
+)
+extracted <- extractPreserveChunks(markup)
+markup <- extracted$value
+# Just think of this next line as Markdown processing
+output <- gsub("\\\\*(.*?)\\\\*", "<em>\\\\1</em>", markup)
+output <- restorePreserveChunks(output, extracted$chunks)
+output
+
+}
+
diff --git a/man/htmlTemplate.Rd b/man/htmlTemplate.Rd
new file mode 100644
index 0000000..165fa65
--- /dev/null
+++ b/man/htmlTemplate.Rd
@@ -0,0 +1,32 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/template.R
+\name{htmlTemplate}
+\alias{htmlTemplate}
+\title{Process an HTML template}
+\usage{
+htmlTemplate(filename = NULL, ..., text_ = NULL, document_ = "auto")
+}
+\arguments{
+\item{filename}{Path to an HTML template file. Incompatible with
+\code{text_}.}
+
+\item{...}{Variable values to use when processing the template.}
+
+\item{text_}{A string to use as the template, instead of a file. Incompatible
+with \code{filename}.}
+
+\item{document_}{Is this template a complete HTML document (\code{TRUE}), or
+a fragment of HTML that is to be inserted into an HTML document
+(\code{FALSE})? With \code{"auto"} (the default), auto-detect by searching
+for the string \code{"<HTML>"} within the template.}
+}
+\description{
+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
+\code{html_document}, and can be passed to the function
+\code{\link{renderDocument}} to get the final HTML text.
+}
+\seealso{
+\code{\link{renderDocument}}
+}
+
diff --git a/man/html_print.Rd b/man/html_print.Rd
new file mode 100644
index 0000000..67b8bac
--- /dev/null
+++ b/man/html_print.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/html_print.R
+\name{html_print}
+\alias{html_print}
+\title{Implementation of the print method for HTML}
+\usage{
+html_print(html, background = "white", viewer = getOption("viewer",
+ utils::browseURL))
+}
+\arguments{
+\item{html}{HTML content to print}
+
+\item{background}{Background color for web page}
+
+\item{viewer}{A function to be called with the URL or path to the generated
+HTML page. Can be \code{NULL}, in which case no viewer will be invoked.}
+}
+\value{
+Invisibly returns the URL or path of the generated HTML page.
+}
+\description{
+Convenience method that provides an implementation of the
+\code{\link[base:print]{print}} method for HTML content.
+}
+
diff --git a/man/include.Rd b/man/include.Rd
new file mode 100644
index 0000000..4a5d8ce
--- /dev/null
+++ b/man/include.Rd
@@ -0,0 +1,47 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{include}
+\alias{include}
+\alias{includeCSS}
+\alias{includeHTML}
+\alias{includeMarkdown}
+\alias{includeScript}
+\alias{includeText}
+\title{Include Content From a File}
+\usage{
+includeHTML(path)
+
+includeText(path)
+
+includeMarkdown(path)
+
+includeCSS(path, ...)
+
+includeScript(path, ...)
+}
+\arguments{
+\item{path}{The path of the file to be included. It is highly recommended to
+use a relative path (the base path being the Shiny application directory),
+not an absolute path.}
+
+\item{...}{Any additional attributes to be applied to the generated tag.}
+}
+\description{
+Load HTML, text, or rendered Markdown from a file and turn into HTML.
+}
+\details{
+These functions provide a convenient way to include an extensive amount of
+HTML, textual, Markdown, CSS, or JavaScript content, rather than using a
+large literal R string.
+}
+\note{
+\code{includeText} escapes its contents, but does no other processing.
+ This means that hard breaks and multiple spaces will be rendered as they
+ usually are in HTML: as a single space character. If you are looking for
+ preformatted text, wrap the call with \code{\link{pre}}, or consider using
+ \code{includeMarkdown} instead.
+
+The \code{includeMarkdown} function requires the \code{markdown}
+ package.
+}
+
diff --git a/man/knitr_methods.Rd b/man/knitr_methods.Rd
new file mode 100644
index 0000000..fc48f49
--- /dev/null
+++ b/man/knitr_methods.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{knitr_methods}
+\alias{knit_print.html}
+\alias{knit_print.shiny.tag}
+\alias{knit_print.shiny.tag.list}
+\alias{knitr_methods}
+\title{Knitr S3 methods}
+\usage{
+knit_print.shiny.tag(x, ...)
+
+knit_print.html(x, ...)
+
+knit_print.shiny.tag.list(x, ...)
+}
+\arguments{
+\item{x}{Object to knit_print}
+
+\item{...}{Additional knit_print arguments}
+}
+\description{
+These S3 methods are necessary to allow HTML tags to print themselves in
+knitr/rmarkdown documents.
+}
+
diff --git a/man/makeDependencyRelative.Rd b/man/makeDependencyRelative.Rd
new file mode 100644
index 0000000..9f9eb07
--- /dev/null
+++ b/man/makeDependencyRelative.Rd
@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/html_dependency.R
+\name{makeDependencyRelative}
+\alias{makeDependencyRelative}
+\title{Make an absolute dependency relative}
+\usage{
+makeDependencyRelative(dependency, basepath, mustWork = TRUE)
+}
+\arguments{
+\item{dependency}{A single HTML dependency with an absolute path.}
+
+\item{basepath}{The path to the directory that \code{dependency} should be
+made relative to.}
+
+\item{mustWork}{If \code{TRUE} and \code{dependency} does not point to a
+directory on disk (but rather a URL location), an error is raised. If
+\code{FALSE} then non-disk dependencies are returned without modification.}
+}
+\value{
+The dependency with its \code{src} value updated to the new
+location's relative path.
+
+If \code{baspath} did not appear to be a parent directory of the dependency's
+directory, an error is raised (regardless of the value of \code{mustWork}).
+}
+\description{
+Change a dependency's absolute path to be relative to one of its parent
+directories.
+}
+\seealso{
+\code{\link{copyDependencyToDir}}
+}
+
diff --git a/man/print.html.Rd b/man/print.html.Rd
new file mode 100644
index 0000000..d3b51fa
--- /dev/null
+++ b/man/print.html.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{print.shiny.tag}
+\alias{print.html}
+\alias{print.shiny.tag}
+\title{Print method for HTML/tags}
+\usage{
+\method{print}{shiny.tag}(x, browse = is.browsable(x), ...)
+
+\method{print}{html}(x, ..., browse = is.browsable(x))
+}
+\arguments{
+\item{x}{The value to print.}
+
+\item{browse}{If \code{TRUE}, the HTML will be rendered and displayed in a
+browser (or possibly another HTML viewer supplied by the environment via
+the \code{viewer} option). If \code{FALSE} then the HTML object's markup
+will be rendered at the console.}
+
+\item{...}{Additional arguments passed to print.}
+}
+\description{
+S3 method for printing HTML that prints markup or renders HTML in a web
+browser.
+}
+
diff --git a/man/renderDependencies.Rd b/man/renderDependencies.Rd
new file mode 100644
index 0000000..7c23b38
--- /dev/null
+++ b/man/renderDependencies.Rd
@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/html_dependency.R
+\name{renderDependencies}
+\alias{renderDependencies}
+\title{Create HTML for dependencies}
+\usage{
+renderDependencies(dependencies, srcType = c("href", "file"),
+ encodeFunc = urlEncodePath, hrefFilter = identity)
+}
+\arguments{
+\item{dependencies}{A list of \code{htmlDependency} objects.}
+
+\item{srcType}{The type of src paths to use; valid values are \code{file} or
+\code{href}.}
+
+\item{encodeFunc}{The function to use to encode the path part of a URL. The
+default should generally be used.}
+
+\item{hrefFilter}{A function used to transform the final, encoded URLs of
+script and stylsheet files. The default should generally be used.}
+}
+\value{
+An \code{\link{HTML}} object suitable for inclusion in the head of an
+ HTML document.
+}
+\description{
+Create the appropriate HTML markup for including dependencies in an HTML
+document.
+}
+
diff --git a/man/renderDocument.Rd b/man/renderDocument.Rd
new file mode 100644
index 0000000..ea59f41
--- /dev/null
+++ b/man/renderDocument.Rd
@@ -0,0 +1,32 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/template.R
+\name{renderDocument}
+\alias{renderDocument}
+\title{Render an html_document object}
+\usage{
+renderDocument(x, deps = NULL, processDep = identity)
+}
+\arguments{
+\item{x}{An object of class \code{html_document}, typically generated by the
+\code{\link{htmlTemplate}} function.}
+
+\item{deps}{Any extra web dependencies to add to the html document. This can
+be an object created by \code{\link{htmlDependency}}, or a list of such
+objects. These dependencies will be added first, before other dependencies.}
+
+\item{processDep}{A function that takes a "raw" html_dependency object and
+does further processing on it. For example, when \code{renderDocument} is
+called from Shiny, the function \code{\link[shiny]{createWebDependency}} is
+used; it modifies the href and tells Shiny to serve a particular path on
+the filesystem.}
+}
+\description{
+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
+(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
+dependencies.
+}
+
diff --git a/man/renderTags.Rd b/man/renderTags.Rd
new file mode 100644
index 0000000..2213675
--- /dev/null
+++ b/man/renderTags.Rd
@@ -0,0 +1,52 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{renderTags}
+\alias{doRenderTags}
+\alias{renderTags}
+\title{Render tags into HTML}
+\usage{
+renderTags(x, singletons = character(0), indent = 0)
+
+doRenderTags(x, indent = 0)
+}
+\arguments{
+\item{x}{Tag object(s) to render}
+
+\item{singletons}{A list of \link{singleton} signatures to consider already
+rendered; any matching singletons will be dropped instead of rendered.
+(This is useful (only?) for incremental rendering.)}
+
+\item{indent}{Initial indent level, or \code{FALSE} if no indentation should
+be used.}
+}
+\value{
+\code{renderTags} returns a list with the following variables:
+\describe{
+ \item{\code{head}}{An \code{\link{HTML}} string that should be included in
+ \code{<head>}.
+ }
+ \item{\code{singletons}}{Character vector of singleton signatures that are
+ known after rendering.
+ }
+ \item{\code{dependencies}}{A list of \link[=resolveDependencies]{resolved}
+ \code{\link{htmlDependency}} objects.
+ }
+ \item{\code{html}}{An \code{\link{HTML}} string that represents the main
+ HTML that was rendered.
+ }
+}
+
+\code{doRenderTags} returns a simple \code{\link{HTML}} string.
+}
+\description{
+Renders tags (and objects that can be converted into tags using
+\code{\link{as.tags}}) into HTML. (Generally intended to be called from web
+framework libraries, not directly by most users--see
+\code{\link{print.html}(browse=TRUE)} for higher level rendering.)
+}
+\details{
+\code{doRenderTags} is intended for very low-level use; it ignores
+ singleton, head, and dependency handling, and simply renders the given tag
+ objects as HTML.
+}
+
diff --git a/man/resolveDependencies.Rd b/man/resolveDependencies.Rd
new file mode 100644
index 0000000..f08ce85
--- /dev/null
+++ b/man/resolveDependencies.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{resolveDependencies}
+\alias{resolveDependencies}
+\title{Resolve a list of dependencies}
+\usage{
+resolveDependencies(dependencies)
+}
+\arguments{
+\item{dependencies}{A list of \code{\link{htmlDependency}} objects.}
+}
+\value{
+dependencies A list of \code{\link{htmlDependency}} objects with
+ redundancies removed.
+}
+\description{
+Given a list of dependencies, removes any redundant dependencies (based on
+name equality). If multiple versions of a dependency are found, the copy with
+the latest version number is used.
+}
+
diff --git a/man/save_html.Rd b/man/save_html.Rd
new file mode 100644
index 0000000..736eeff
--- /dev/null
+++ b/man/save_html.Rd
@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/html_print.R
+\name{save_html}
+\alias{save_html}
+\title{Save an HTML object to a file}
+\usage{
+save_html(html, file, background = "white", libdir = "lib")
+}
+\arguments{
+\item{html}{HTML content to print}
+
+\item{file}{File to write content to}
+
+\item{background}{Background color for web page}
+
+\item{libdir}{Directory to copy dependenies to}
+}
+\description{
+Save the specified HTML object to a file, copying all of it's
+dependencies to the directory specified via \code{libdir}.
+}
+
diff --git a/man/singleton.Rd b/man/singleton.Rd
new file mode 100644
index 0000000..9bcbcf6
--- /dev/null
+++ b/man/singleton.Rd
@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{singleton}
+\alias{is.singleton}
+\alias{singleton}
+\title{Include content only once}
+\usage{
+singleton(x, value = TRUE)
+
+is.singleton(x)
+}
+\arguments{
+\item{x}{A \code{\link{tag}}, text, \code{\link{HTML}}, or list.}
+
+\item{value}{Whether the object should be a singleton.}
+}
+\description{
+Use \code{singleton} to wrap contents (tag, text, HTML, or lists) that should
+be included in the generated document only once, yet may appear in the
+document-generating code more than once. Only the first appearance of the
+content (in document order) will be used.
+}
+
diff --git a/man/singleton_tools.Rd b/man/singleton_tools.Rd
new file mode 100644
index 0000000..9ff54d2
--- /dev/null
+++ b/man/singleton_tools.Rd
@@ -0,0 +1,36 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{singleton_tools}
+\alias{singleton_tools}
+\alias{surroundSingletons}
+\alias{takeSingletons}
+\title{Singleton manipulation functions}
+\usage{
+surroundSingletons(ui)
+
+takeSingletons(ui, singletons = character(0), desingleton = TRUE)
+}
+\arguments{
+\item{ui}{Tag object or lists of tag objects. See \link{builder} topic.}
+
+\item{singletons}{Character vector of singleton signatures that have already
+been encountered (i.e. returned from previous calls to
+\code{takeSingletons}).}
+
+\item{desingleton}{Logical value indicating whether singletons that are
+encountered should have the singleton attribute removed.}
+}
+\value{
+\code{surroundSingletons} preprocesses a tag object by changing any
+ singleton X into <!--SHINY.SINGLETON[sig]-->X'<!--/SHINY.SINGLETON[sig]-->
+ where sig is the sha1 of X, and X' is X minus the singleton attribute.
+
+\code{takeSingletons} returns a list with the elements \code{ui} (the
+ processed tag objects with any duplicate singleton objects removed) and
+ \code{singletons} (the list of known singleton signatures).
+}
+\description{
+Functions for manipulating \code{\link{singleton}} objects in tag
+hierarchies. Intended for framework authors.
+}
+
diff --git a/man/subtractDependencies.Rd b/man/subtractDependencies.Rd
new file mode 100644
index 0000000..2816d27
--- /dev/null
+++ b/man/subtractDependencies.Rd
@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{subtractDependencies}
+\alias{subtractDependencies}
+\title{Subtract dependencies}
+\usage{
+subtractDependencies(dependencies, remove, warnOnConflict = TRUE)
+}
+\arguments{
+\item{dependencies}{A list of \code{\link{htmlDependency}} objects from which
+dependencies should be removed.}
+
+\item{remove}{A list of \code{\link{htmlDependency}} objects indicating which
+dependencies should be removed, or a character vector indicating dependency
+names.}
+
+\item{warnOnConflict}{If \code{TRUE}, a warning is emitted for each
+dependency that is removed if the corresponding dependency in \code{remove}
+has a lower version number. Has no effect if \code{remove} is provided as a
+character vector.}
+}
+\value{
+A list of \code{\link{htmlDependency}} objects that don't intersect
+ with \code{remove}.
+}
+\description{
+Remove a set of dependencies from another list of dependencies. The set of
+dependencies to remove can be expressed as either a character vector or a
+list; if the latter, a warning can be emitted if the version of the
+dependency being removed is later than the version of the dependency object
+that is causing the removal.
+}
+
diff --git a/man/suppressDependencies.Rd b/man/suppressDependencies.Rd
new file mode 100644
index 0000000..675ba0f
--- /dev/null
+++ b/man/suppressDependencies.Rd
@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/html_dependency.R
+\name{suppressDependencies}
+\alias{suppressDependencies}
+\title{Suppress web dependencies}
+\usage{
+suppressDependencies(...)
+}
+\arguments{
+\item{...}{Names of the dependencies to suppress. For example,
+\code{"jquery"} or \code{"bootstrap"}.}
+}
+\description{
+This suppresses one or more web dependencies. It is meant to be used when a
+dependency (like a JavaScript or CSS file) is declared in raw HTML, in an
+HTML template.
+}
+\seealso{
+\code{\link{htmlTemplate}} for more information about using HTML
+ templates.
+
+\code{\link[htmltools]{htmlDependency}}
+}
+
diff --git a/man/tag.Rd b/man/tag.Rd
new file mode 100644
index 0000000..8743c67
--- /dev/null
+++ b/man/tag.Rd
@@ -0,0 +1,74 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{tag}
+\alias{tag}
+\alias{tagAppendAttributes}
+\alias{tagAppendChild}
+\alias{tagAppendChildren}
+\alias{tagGetAttribute}
+\alias{tagHasAttribute}
+\alias{tagList}
+\alias{tagSetChildren}
+\title{HTML Tag Object}
+\usage{
+tagList(...)
+
+tagAppendAttributes(tag, ...)
+
+tagHasAttribute(tag, attr)
+
+tagGetAttribute(tag, attr)
+
+tagAppendChild(tag, child)
+
+tagAppendChildren(tag, ..., list = NULL)
+
+tagSetChildren(tag, ..., list = NULL)
+
+tag(`_tag_name`, varArgs)
+}
+\arguments{
+\item{...}{Unnamed items that comprise this list of tags.}
+
+\item{tag}{A tag to append child elements to.}
+
+\item{attr}{The name of an attribute.}
+
+\item{child}{A child element to append to a parent tag.}
+
+\item{list}{An optional list of elements. Can be used with or instead of the
+\code{...} items.}
+
+\item{_tag_name}{HTML tag name}
+
+\item{varArgs}{List of attributes and children of the element. Named list
+items become attributes, and unnamed list items become children. Valid
+children are tags, single-character character vectors (which become text
+nodes), and raw HTML (see \code{\link{HTML}}). You can also pass lists that
+contain tags, text nodes, and HTML.}
+}
+\value{
+An HTML tag object that can be rendered as HTML using
+ \code{\link{as.character}()}.
+}
+\description{
+\code{tag()} creates an HTML tag definition. Note that all of the valid HTML5
+tags are already defined in the \code{\link{tags}} environment so these
+functions should only be used to generate additional tags.
+\code{tagAppendChild()} and \code{tagList()} are for supporting package
+authors who wish to create their own sets of tags; see the contents of
+bootstrap.R for examples.
+}
+\examples{
+tagList(tags$h1("Title"),
+ tags$h2("Header text"),
+ tags$p("Text here"))
+
+# Can also convert a regular list to a tagList (internal data structure isn't
+# exactly the same, but when rendered to HTML, the output is the same).
+x <- list(tags$h1("Title"),
+ tags$h2("Header text"),
+ tags$p("Text here"))
+tagList(x)
+}
+
diff --git a/man/urlEncodePath.Rd b/man/urlEncodePath.Rd
new file mode 100644
index 0000000..a78bd28
--- /dev/null
+++ b/man/urlEncodePath.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/html_dependency.R
+\name{urlEncodePath}
+\alias{urlEncodePath}
+\title{Encode a URL path}
+\usage{
+urlEncodePath(x)
+}
+\arguments{
+\item{x}{A character vector.}
+}
+\description{
+Encode characters in a URL path. This is the same as
+\code{\link[utils]{URLencode}} with \code{reserved = TRUE} except that
+\code{/} is preserved.
+}
+
diff --git a/man/validateCssUnit.Rd b/man/validateCssUnit.Rd
new file mode 100644
index 0000000..61052cb
--- /dev/null
+++ b/man/validateCssUnit.Rd
@@ -0,0 +1,38 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{validateCssUnit}
+\alias{validateCssUnit}
+\title{Validate proper CSS formatting of a unit}
+\usage{
+validateCssUnit(x)
+}
+\arguments{
+\item{x}{The unit to validate. Will be treated as a number of pixels if a
+unit is not specified.}
+}
+\value{
+A properly formatted CSS unit of length, if possible. Otherwise, will
+ throw an error.
+}
+\description{
+Checks that the argument is valid for use as a CSS unit of length.
+}
+\details{
+\code{NULL} and \code{NA} are returned unchanged.
+
+Single element numeric vectors are returned as a character vector with the
+number plus a suffix of \code{"px"}.
+
+Single element character vectors must be \code{"auto"} or \code{"inherit"},
+or a number. If the number has a suffix, it must be valid: \code{px},
+\code{\%}, \code{em}, \code{pt}, \code{in}, \code{cm}, \code{mm}, \code{ex},
+or \code{pc}. If the number has no suffix, the suffix \code{"px"} is
+appended.
+
+Any other value will cause an error to be thrown.
+}
+\examples{
+validateCssUnit("10\%")
+validateCssUnit(400) #treated as '400px'
+}
+
diff --git a/man/withTags.Rd b/man/withTags.Rd
new file mode 100644
index 0000000..58c3bf8
--- /dev/null
+++ b/man/withTags.Rd
@@ -0,0 +1,42 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tags.R
+\name{withTags}
+\alias{withTags}
+\title{Evaluate an expression using \code{tags}}
+\usage{
+withTags(code)
+}
+\arguments{
+\item{code}{A set of tags.}
+}
+\description{
+This function makes it simpler to write HTML-generating code. Instead of
+needing to specify \code{tags} each time a tag function is used, as in
+\code{tags$div()} and \code{tags$p()}, code inside \code{withTags} is
+evaluated with \code{tags} searched first, so you can simply use
+\code{div()} and \code{p()}.
+}
+\details{
+If your code uses an object which happens to have the same name as an
+HTML tag function, such as \code{source()} or \code{summary()}, it will call
+the tag function. To call the intended (non-tags function), specify the
+namespace, as in \code{base::source()} or \code{base::summary()}.
+}
+\examples{
+# Using tags$ each time
+tags$div(class = "myclass",
+ tags$h3("header"),
+ tags$p("text")
+)
+
+# Equivalent to above, but using withTags
+withTags(
+ div(class = "myclass",
+ h3("header"),
+ p("text")
+ )
+)
+
+
+}
+
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
new file mode 100644
index 0000000..792e3d1
--- /dev/null
+++ b/src/RcppExports.cpp
@@ -0,0 +1,18 @@
+// This file was generated by Rcpp::compileAttributes
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#include <Rcpp.h>
+
+using namespace Rcpp;
+
+// template_dfa
+std::vector<std::string> template_dfa(CharacterVector x);
+RcppExport SEXP htmltools_template_dfa(SEXP xSEXP) {
+BEGIN_RCPP
+ Rcpp::RObject __result;
+ Rcpp::RNGScope __rngScope;
+ Rcpp::traits::input_parameter< CharacterVector >::type x(xSEXP);
+ __result = Rcpp::wrap(template_dfa(x));
+ return __result;
+END_RCPP
+}
diff --git a/src/template.cpp b/src/template.cpp
new file mode 100644
index 0000000..cf57dd0
--- /dev/null
+++ b/src/template.cpp
@@ -0,0 +1,163 @@
+#include <Rcpp.h>
+using namespace Rcpp;
+
+// Break template text into character vector. The first element element of the
+// resulting vector is HTML, the next is R code, and they continue alternating.
+// [[Rcpp::export]]
+std::vector<std::string> template_dfa(CharacterVector x) {
+ enum State {
+ html,
+ code,
+ html_oneOpenBracket,
+ code_oneCloseBracket,
+ code_string1,
+ code_string1_backslash,
+ code_string2,
+ code_string2_backslash,
+ code_backtick,
+ code_backtick_backslash,
+ code_percentOp,
+ code_comment,
+ code_comment_oneCloseBracket
+ };
+
+ if (x.length() != 1) {
+ stop("Input HTML must be a character vector of length 1");
+ }
+ std::string input = Rcpp::as<std::string>(x[0]);
+ std::vector<std::string> pieces(0);
+
+ int pieceStartIdx = 0;
+ int len = input.length();
+ char c;
+ State state = html;
+ for (int i=0; i < len; i++) {
+ c = input[i];
+ switch (state) {
+
+ case html:
+ switch (c) {
+ case '{':
+ state = html_oneOpenBracket; break;
+ }
+ break;
+
+ case html_oneOpenBracket:
+ switch (c) {
+ case '{':
+ state = code;
+ pieces.push_back(input.substr(pieceStartIdx, i - pieceStartIdx - 1));
+ pieceStartIdx = i + 1;
+ break;
+ default:
+ state = html;
+ }
+ break;
+
+ case code:
+ switch (c) {
+ case '}':
+ state = code_oneCloseBracket; break;
+ case '\'':
+ state = code_string1; break;
+ case '"':
+ state = code_string2; break;
+ case '`':
+ state = code_backtick; break;
+ case '%':
+ state = code_percentOp; break;
+ case '#':
+ state = code_comment; break;
+ }
+ break;
+
+ case code_oneCloseBracket:
+ switch (c) {
+ case '}':
+ state = html;
+ pieces.push_back(input.substr(pieceStartIdx, i - pieceStartIdx - 1));
+ pieceStartIdx = i + 1;
+ break;
+ default: state = code;
+ }
+ break;
+
+ case code_string1:
+ switch (c) {
+ case '\\':
+ state = code_string1_backslash; break;
+ case '\'':
+ state = code; break;
+ }
+ break;
+
+ case code_string1_backslash:
+ state = code_string1;
+ break;
+
+ case code_string2:
+ switch (c) {
+ case '\\':
+ state = code_string2_backslash; break;
+ case '\"':
+ state = code; break;
+ }
+ break;
+
+ case code_string2_backslash:
+ state = code_string2;
+ break;
+
+ case code_backtick:
+ switch (c) {
+ case '\\':
+ state = code_backtick_backslash; break;
+ case '`':
+ state = code; break;
+ }
+ break;
+
+ case code_backtick_backslash:
+ state = code_backtick;
+ break;
+
+ case code_percentOp:
+ switch (c) {
+ case '%':
+ state = code; break;
+ }
+ break;
+
+ case code_comment:
+ switch (c) {
+ case '}':
+ state = code_comment_oneCloseBracket; break;
+ case '\n':
+ state = code; break;
+ }
+ break;
+
+ case code_comment_oneCloseBracket:
+ switch (c) {
+ case '}':
+ state = html;
+ pieces.push_back(input.substr(pieceStartIdx, i - pieceStartIdx - 1));
+ pieceStartIdx = i + 1;
+ break;
+ default:
+ state = code;
+ }
+ break;
+
+ }
+ }
+
+ if (!(state == html || state == html_oneOpenBracket)) {
+ stop("HTML template did not end in html state (missing closing \"}}\").");
+ }
+
+ // Add ending HTML piece
+ pieces.push_back(input.substr(pieceStartIdx, len - pieceStartIdx));
+
+ return pieces;
+}
diff --git a/tests/test-all.R b/tests/test-all.R
new file mode 100644
index 0000000..ec81ca3
--- /dev/null
+++ b/tests/test-all.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(htmltools)
+
+test_check("htmltools")
diff --git a/tests/testthat/template-document.html b/tests/testthat/template-document.html
new file mode 100644
index 0000000..2f7a71e
--- /dev/null
+++ b/tests/testthat/template-document.html
@@ -0,0 +1,12 @@
+<html>
+ <head>
+ {{ suppressDependencies("jquery") }}
+ {{ headContent() }}
+ </head>
+ <body>
+ <div>
+ {{ x }}
+ </div>
+ <span>UTF-8 chars:Δ★😎</span>
+ </body>
+</html>
diff --git a/tests/testthat/test-deps.r b/tests/testthat/test-deps.r
new file mode 100644
index 0000000..20bc2db
--- /dev/null
+++ b/tests/testthat/test-deps.r
@@ -0,0 +1,89 @@
+context("dependencies")
+
+format.html_dependency <- function(x, ...) {
+ sprintf("%s v%s @ %s", x$name, x$version, format(x$src))
+}
+print.html_dependency <- function(x, ...) {
+ cat(format(x), "\n")
+ invisible(x)
+}
+
+test_that("Dependency resolution works", {
+
+ a1.1 <- htmlDependency("a", "1.1", c(href="/"))
+ a1.2 <- htmlDependency("a", "1.2", c(href="/"))
+ a1.2.1 <- htmlDependency("a", "1.2.1", c(href="/"))
+ b1.0.0 <- htmlDependency("b", "1.0.0", c(href="/"))
+ b1.0.1 <- htmlDependency("b", "1.0.1", c(href="/"))
+ c1.0 <- htmlDependency("c", "1.0", c(href="/"))
+
+ result1 <- resolveDependencies(
+ list(a1.1, b1.0.0, b1.0.1, a1.2, a1.2.1, b1.0.0, b1.0.1, c1.0)
+ )
+ expect_identical(result1, list(a1.2.1, b1.0.1, c1.0))
+
+ result2 <- subtractDependencies(result1, list(a1.1), warnOnConflict = FALSE)
+ expect_identical(result2, list(b1.0.1, c1.0))
+
+ expect_warning(subtractDependencies(result1, list(a1.1)))
+})
+
+test_that("Inline dependencies", {
+ # Test out renderTags and findDependencies when tags are inline
+ a1.1 <- htmlDependency("a", "1.1", c(href="/"))
+ a1.2 <- htmlDependency("a", "1.2", c(href="/"))
+
+ # tagLists ----------------------------------------------------------
+ x <- tagList(a1.1, div("foo"), "bar")
+ expect_identical(findDependencies(x), list(a1.1))
+ expect_identical(as.character(renderTags(x)$html), "<div>foo</div>\nbar")
+
+ x <- tagList(a1.1, div("foo"), a1.2, "bar")
+ expect_identical(findDependencies(x), list(a1.1, a1.2))
+ expect_identical(as.character(renderTags(x)$html), "<div>foo</div>\nbar")
+
+ # Mixing inline and attribute dependencies
+ x <- attachDependencies(tagList(a1.1, div("foo"), "bar"), a1.2, append = TRUE)
+ expect_identical(findDependencies(x), list(a1.1, a1.2))
+ expect_identical(as.character(renderTags(x)$html), "<div>foo</div>\nbar")
+
+ # tags with children ------------------------------------------------
+ x <- div(a1.1, div("foo"), "bar")
+ expect_identical(findDependencies(x), list(a1.1))
+ expect_identical(as.character(renderTags(x)$html),
+ "<div>\n <div>foo</div>\n bar\n</div>")
+
+ x <- div(div("foo"), a1.2, "bar", a1.1)
+ expect_identical(findDependencies(x), list(a1.2, a1.1))
+ expect_identical(as.character(renderTags(x)$html),
+ "<div>\n <div>foo</div>\n bar\n</div>")
+
+ x <- attachDependencies(div(a1.1, div("foo"), "bar"), a1.2, append = TRUE)
+ expect_identical(findDependencies(x), list(a1.1, a1.2))
+ expect_identical(as.character(renderTags(x)$html),
+ "<div>\n <div>foo</div>\n bar\n</div>")
+
+ # Passing normal lists to tagLists and tag functions ---------------
+ x <- tagList(list(a1.1, div("foo")), "bar")
+ expect_identical(findDependencies(x), list(a1.1))
+
+ x <- div(list(a1.1, div("foo")), "bar")
+ expect_identical(findDependencies(x), list(a1.1))
+})
+
+test_that("Modifying children using dependencies", {
+ a1.1 <- htmlDependency("a", "1.1", c(href="/"))
+ a1.2 <- htmlDependency("a", "1.2", c(href="/"))
+
+ x <- tagAppendChild(div(a1.1), a1.2)
+ expect_identical(findDependencies(x), list(a1.1, a1.2))
+
+ x <- tagAppendChild(div(a1.1), list(a1.2))
+ expect_identical(findDependencies(x), list(a1.1, a1.2))
+
+ x <- tagAppendChildren(div(), a1.1, list(a1.2))
+ expect_identical(findDependencies(x), list(a1.1, a1.2))
+
+ x <- tagSetChildren(div("foo", a1.1), a1.2)
+ expect_identical(findDependencies(x), list(a1.2))
+})
diff --git a/tests/testthat/test-tags.r b/tests/testthat/test-tags.r
new file mode 100644
index 0000000..250087d
--- /dev/null
+++ b/tests/testthat/test-tags.r
@@ -0,0 +1,675 @@
+context("tags")
+
+test_that("Basic tag writing works", {
+ expect_equal(as.character(tagList("hi")), "hi")
+ expect_equal(
+ as.character(tagList("one", "two", tagList("three"))),
+ "one\ntwo\nthree")
+ expect_equal(
+ as.character(tags$b("one")),
+ "<b>one</b>")
+ expect_equal(
+ as.character(tags$b("one", "two")),
+ "<b>\n one\n two\n</b>")
+ expect_equal(
+ as.character(tagList(list("one"))),
+ "one")
+ expect_equal(
+ as.character(tagList(list(tagList("one")))),
+ "one")
+ expect_equal(
+ as.character(tagList(tags$br(), "one")),
+ "<br/>\none")
+})
+
+
+test_that("withTags works", {
+ output_tags <- tags$div(class = "myclass",
+ tags$h3("header"),
+ tags$p("text here")
+ )
+ output_withhtml <- withTags(
+ div(class = "myclass",
+ h3("header"),
+ p("text here")
+ )
+ )
+ expect_identical(output_tags, output_withhtml)
+
+
+ # Check that current environment is searched
+ x <- 100
+ expect_identical(tags$p(x), withTags(p(x)))
+
+ # Just to make sure, run it in a function, which has its own environment
+ foo <- function() {
+ y <- 100
+ withTags(p(y))
+ }
+ expect_identical(tags$p(100), foo())
+})
+
+
+test_that("HTML escaping in tags", {
+ # Regular text is escaped
+ expect_equivalent(format(div("<a&b>")), "<div><a&b></div>")
+
+ # Text in HTML() isn't escaped
+ expect_equivalent(format(div(HTML("<a&b>"))), "<div><a&b></div>")
+
+ # Text in a property is escaped
+ expect_equivalent(format(div(class = "<a&b>", "text")),
+ '<div class="<a&b>">text</div>')
+
+ # HTML() has no effect in a property like 'class'
+ expect_equivalent(format(div(class = HTML("<a&b>"), "text")),
+ '<div class="<a&b>">text</div>')
+})
+
+
+test_that("Adding child tags", {
+ tag_list <- list(tags$p("tag1"), tags$b("tag2"), tags$i("tag3"))
+
+ # Creating nested tags by calling the tag$div function and passing a list
+ t1 <- tags$div(class="foo", tag_list)
+ expect_equal(length(t1$children), 1)
+ expect_equal(length(t1$children[[1]]), 3)
+ expect_equal(t1$children[[1]][[1]]$name, "p")
+ expect_equal(t1$children[[1]][[1]]$children[[1]], "tag1")
+ expect_equal(t1$children[[1]][[2]]$name, "b")
+ expect_equal(t1$children[[1]][[2]]$children[[1]], "tag2")
+ expect_equal(t1$children[[1]][[3]]$name, "i")
+ expect_equal(t1$children[[1]][[3]]$children[[1]], "tag3")
+
+
+ # div tag used as starting point for tests below
+ div_tag <- tags$div(class="foo")
+
+ # Appending each child
+ t2 <- tagAppendChild(div_tag, tag_list[[1]])
+ t2 <- tagAppendChild(t2, tag_list[[2]])
+ t2 <- tagAppendChild(t2, tag_list[[3]])
+ t2a <- do.call(tags$div, c(tag_list, class="foo"))
+ expect_identical(t2a, t2)
+
+
+ # tagSetChildren, using list argument
+ t2 <- tagSetChildren(div_tag, list = tag_list)
+ expect_identical(t2a, t2)
+
+ # tagSetChildren, using ... arguments
+ t2 <- tagSetChildren(div_tag, tag_list[[1]], tag_list[[2]], tag_list[[3]])
+ expect_identical(t2a, t2)
+
+ # tagSetChildren, using ... and list arguments
+ t2 <- tagSetChildren(div_tag, tag_list[[1]], list = tag_list[2:3])
+ expect_identical(t2a, t2)
+
+ # tagSetChildren overwrites existing children
+ t2 <- tagAppendChild(div_tag, p("should replace this tag"))
+ t2 <- tagSetChildren(div_tag, list = tag_list)
+ expect_identical(t2a, t2)
+
+
+ # tagAppendChildren, using list argument
+ t2 <- tagAppendChild(div_tag, tag_list[[1]])
+ t2 <- tagAppendChildren(t2, list = tag_list[2:3])
+ expect_identical(t2a, t2)
+
+ # tagAppendChildren, using ... arguments
+ t2 <- tagAppendChild(div_tag, tag_list[[1]])
+ t2 <- tagAppendChildren(t2, tag_list[[2]], tag_list[[3]])
+ expect_identical(t2a, t2)
+
+ # tagAppendChildren, using ... and list arguments
+ t2 <- tagAppendChild(div_tag, tag_list[[1]])
+ t2 <- tagAppendChildren(t2, tag_list[[2]], list = list(tag_list[[3]]))
+ expect_identical(t2a, t2)
+
+ # tagAppendChildren can start with no children
+ t2 <- tagAppendChildren(div_tag, list = tag_list)
+ expect_identical(t2a, t2)
+
+
+ # tagSetChildren preserves attributes
+ x <- tagSetChildren(div(), HTML("text"))
+ expect_identical(attr(x$children[[1]], "html", TRUE), TRUE)
+
+ # tagAppendChildren preserves attributes
+ x <- tagAppendChildren(div(), HTML("text"))
+ expect_identical(attr(x$children[[1]], "html", TRUE), TRUE)
+})
+
+
+test_that("Creating simple tags", {
+ # Empty tag
+ expect_identical(
+ div(),
+ structure(
+ list(name = "div", attribs = list(), children = list()),
+ .Names = c("name", "attribs", "children"),
+ class = "shiny.tag"
+ )
+ )
+
+ # Tag with text
+ expect_identical(
+ div("text"),
+ structure(
+ list(name = "div", attribs = list(), children = list("text")),
+ .Names = c("name", "attribs", "children"),
+ class = "shiny.tag"
+ )
+ )
+
+ # NULL attributes are dropped
+ expect_identical(
+ div(a = NULL, b = "value"),
+ div(b = "value")
+ )
+
+ # NULL children are dropped
+ expect_identical(
+ renderTags(div("foo", NULL, list(NULL, list(NULL, "bar"))))$html,
+ renderTags(div("foo", "bar"))$html
+ )
+
+ # Numbers are coerced to strings
+ expect_identical(
+ renderTags(div(1234))$html,
+ renderTags(div("1234"))$html
+ )
+})
+
+
+test_that("Creating nested tags", {
+ # Simple version
+ # Note that the $children list should not have a names attribute
+ expect_identical(
+ div(class="foo", list("a", "b")),
+ structure(
+ list(name = "div",
+ attribs = structure(list(class = "foo"), .Names = "class"),
+ children = list(list("a", "b"))),
+ .Names = c("name", "attribs", "children"),
+ class = "shiny.tag"
+ )
+ )
+
+ # More complex version
+ t1 <- withTags(
+ div(class = "foo",
+ p("child tag"),
+ list(
+ p("in-list child tag 1"),
+ "in-list character string",
+ p(),
+ p("in-list child tag 2")
+ ),
+ "character string",
+ 1234
+ )
+ )
+
+ # t1 should be identical to this data structure.
+ # The nested list should be flattened, and non-tag, non-strings should be
+ # converted to strings
+ t1_full <- structure(
+ list(
+ name = "div",
+ attribs = list(class = "foo"),
+ children = list(
+ structure(list(name = "p",
+ attribs = list(),
+ children = list("child tag")),
+ class = "shiny.tag"
+ ),
+ structure(list(name = "p",
+ attribs = list(),
+ children = list("in-list child tag 1")),
+ class = "shiny.tag"
+ ),
+ "in-list character string",
+ structure(list(name = "p",
+ attribs = list(),
+ children = list()),
+ class = "shiny.tag"
+ ),
+ structure(list(name = "p",
+ attribs = list(),
+ children = list("in-list child tag 2")),
+ class = "shiny.tag"
+ ),
+ "character string",
+ "1234"
+ )
+ ),
+ class = "shiny.tag"
+ )
+
+ expect_identical(renderTags(t1)$html, renderTags(t1_full)$html)
+})
+
+test_that("Attributes are preserved", {
+ # HTML() adds an attribute to the data structure (note that this is
+ # different from the 'attribs' field in the list)
+ x <- HTML("<tag>&&</tag>")
+ expect_identical(attr(x, "html", TRUE), TRUE)
+ expect_equivalent(format(x), "<tag>&&</tag>")
+
+ # Make sure attributes are preserved when wrapped in other tags
+ x <- div(HTML("<tag>&&</tag>"))
+ expect_equivalent(x$children[[1]], HTML("<tag>&&</tag>"))
+ expect_identical(attr(x$children[[1]], "html", TRUE), TRUE)
+ expect_equivalent(format(x), "<div><tag>&&</tag></div>")
+
+ # Deeper nesting
+ x <- div(p(HTML("<tag>&&</tag>")))
+ expect_equivalent(x$children[[1]]$children[[1]], HTML("<tag>&&</tag>"))
+ expect_identical(attr(x$children[[1]]$children[[1]], "html", TRUE), TRUE)
+ expect_equivalent(format(x), "<div>\n <p><tag>&&</tag></p>\n</div>")
+})
+
+test_that("Adding attributes to tags", {
+ t1 <- tags$div("foo")
+
+ # Adding attributes to empty tag
+ expect_identical(t1$attribs, list())
+ expect_identical(
+ tagAppendAttributes(t1, class = "c1")$attribs,
+ list(class = "c1")
+ )
+
+ # Adding attribute with multiple values
+ expect_identical(
+ tagAppendAttributes(t1, class = "c1 c2")$attribs,
+ list(class = "c1 c2")
+ )
+
+ # Adding two different attributes
+ expect_identical(
+ tagAppendAttributes(t1, class = "c1", id = "foo")$attribs,
+ list(class = "c1", id = "foo")
+ )
+
+ # Adding attributes in two successive calls
+ expect_identical(
+ tagAppendAttributes(
+ tagAppendAttributes(t1, class = "c1 c2"), class = "c3")$attribs,
+ list(class = "c1 c2", class = "c3")
+ )
+
+ t2 <- tags$div("foo", class = "c1")
+
+ # Adding attributes on a tag with other attributes
+ expect_identical(
+ tagAppendAttributes(t2, id = "foo")$attribs,
+ list(class = "c1", id = "foo")
+ )
+
+ # Adding attributes on a tag with the same attribute
+ expect_identical(
+ tagAppendAttributes(t2, class = "c2")$attribs,
+ list(class = "c1", class = "c2")
+ )
+})
+
+test_that("Testing for attributes on tags", {
+ t1 <- tags$div("foo", class = "c1", class = "c2", id = "foo")
+
+ # Testing for attribute that does not exist
+ expect_identical(
+ tagHasAttribute(t1, "nope"),
+ FALSE
+ )
+
+ # Testing for an attribute that exists once
+ expect_identical(
+ tagHasAttribute(t1, "id"),
+ TRUE
+ )
+
+ # Testing for an attribute that exists multiple times
+ expect_identical(
+ tagHasAttribute(t1, "class"),
+ TRUE
+ )
+
+ # Testing for substring of an attribute that exists
+ expect_identical(
+ tagHasAttribute(t1, "clas"),
+ FALSE
+ )
+
+ # Testing for superstring of an attribute that exists
+ expect_identical(
+ tagHasAttribute(t1, "classes"),
+ FALSE
+ )
+
+ # Testing for attribute with empty value
+ t2 <- tags$div("foo", foo = "")
+ expect_identical(
+ tagHasAttribute(t2, "foo"),
+ TRUE
+ )
+
+ # Testing for attribute with NULL value
+ t3 <- tags$div("foo", foo = NULL)
+ expect_identical(
+ tagHasAttribute(t3, "foo"),
+ FALSE
+ )
+})
+
+test_that("Getting attributes from tags", {
+ # Getting an attribute from a tag with no attributes
+ t1 <- tags$div("foo")
+ expect_identical(
+ tagGetAttribute(t1, "class"),
+ NULL
+ )
+
+ t2 <- tags$div("foo", class = "c1")
+
+ # Getting an attribute from a tag without the correct attribute
+ expect_identical(
+ tagGetAttribute(t2, "id"),
+ NULL
+ )
+
+ # Getting an attribute from a tag with the a single value for the attribute
+ expect_identical(
+ tagGetAttribute(t2, "class"),
+ "c1"
+ )
+
+ # Getting an attribute from a tag with multiple matching attributes
+ t3 <- tags$div("foo", class = "c1", id = "foo", class = "c2")
+ expect_identical(
+ tagGetAttribute(t3, "class"),
+ "c1 c2"
+ )
+
+ # Getting an attribute from a tag where the attributes were factors
+ t4 <- tags$div("foo", class = as.factor("c1"), class = as.factor("c2"))
+ expect_identical(
+ tagGetAttribute(t4, "class"),
+ "c1 c2"
+ )
+
+ # Getting a numeric attribute from a tag
+ t5 <- tags$div("foo", class = 78)
+ expect_identical(
+ tagGetAttribute(t5, "class"),
+ "78"
+ )
+})
+
+test_that("Flattening a list of tags", {
+ # Flatten a nested list
+ nested <- list(
+ "a1",
+ list(
+ "b1",
+ list("c1", "c2"),
+ list(),
+ "b2",
+ list("d1", "d2")
+ ),
+ "a2"
+ )
+
+ flat <- list("a1", "b1", "c1", "c2", "b2", "d1", "d2", "a2")
+ expect_identical(flattenTags(nested), flat)
+
+ # no-op for flat lists
+ expect_identical(flattenTags(list(a="1", "b")), list(a="1", "b"))
+
+ # numbers are coerced to character
+ expect_identical(flattenTags(list(a=1, "b")), list(a="1", "b"))
+
+ # empty list results in empty list
+ expect_identical(flattenTags(list()), list())
+
+ # preserve attributes
+ nested <- list("txt1", list(structure("txt2", prop="prop2")))
+ flat <- list("txt1",
+ structure("txt2", prop="prop2"))
+ expect_identical(flattenTags(nested), flat)
+})
+
+test_that("Head and singleton behavior", {
+ result <- renderTags(tagList(
+ tags$head(singleton("hello"))
+ ))
+
+ expect_identical(result$html, HTML(""))
+ expect_identical(result$head, HTML(" hello"))
+ expect_identical(result$singletons, "089cce0335cf2bae2bcb08cc753ba56f8e1ea8ed")
+
+ # Ensure that "hello" actually behaves like a singleton
+ result2 <- renderTags(tagList(
+ tags$head(singleton("hello"))
+ ), singletons = result$singletons)
+
+ expect_identical(result$singletons, result2$singletons)
+ expect_identical(result2$head, HTML(""))
+ expect_identical(result2$html, HTML(""))
+
+ result3 <- renderTags(tagList(
+ tags$head(singleton("hello"), singleton("hello"))
+ ))
+ expect_identical(result$singletons, result3$singletons)
+ expect_identical(result3$head, HTML(" hello"))
+
+ # Ensure that singleton can be applied to lists, not just tags
+ result4 <- renderTags(list(singleton(list("hello")), singleton(list("hello"))))
+ expect_identical(result4$singletons, "110d1f0ef6762db2c6863523a7c379a697b43ea3")
+ expect_identical(result4$html, renderTags(HTML("hello"))$html)
+
+ result5 <- renderTags(tagList(singleton(list(list("hello")))))
+ expect_identical(result5$html, renderTags("hello")$html)
+})
+
+test_that("Factors are treated as characters, not numbers", {
+ myfactors <- factor(LETTERS[1:3])
+ expect_identical(
+ as.character(tags$option(value=myfactors[[1]], myfactors[[1]])),
+ '<option value="A">A</option>'
+ )
+
+ expect_identical(
+ as.character(tags$option(value=myfactors[[1]], value='B', value=3, myfactors[[1]])),
+ '<option value="A B 3">A</option>'
+ )
+})
+
+test_that("Unusual list contents are rendered correctly", {
+ expect_identical(renderTags(list(NULL)), renderTags(HTML("")))
+ expect_identical(renderTags(list(100)), renderTags(HTML("100")))
+ expect_identical(renderTags(list(list(100))), renderTags(HTML("100")))
+ expect_identical(renderTags(list(list())), renderTags(HTML("")))
+ expect_identical(renderTags(NULL), renderTags(HTML("")))
+})
+
+test_that("Low-level singleton manipulation methods", {
+ # Default arguments drop singleton duplicates and strips the
+ # singletons it keeps of the singleton bit
+ result1 <- takeSingletons(tags$div(
+ singleton(tags$head(tags$script("foo"))),
+ singleton(tags$head(tags$script("foo")))
+ ))
+
+ expect_identical(result1$ui$children[[2]], NULL)
+ expect_false(is.singleton(result1$ui$children[[1]]))
+
+ # desingleton=FALSE means drop duplicates but don't strip the
+ # singleton bit
+ result2 <- takeSingletons(tags$div(
+ singleton(tags$head(tags$script("foo"))),
+ singleton(tags$head(tags$script("foo")))
+ ), desingleton=FALSE)
+
+ expect_identical(result2$ui$children[[2]], NULL)
+ expect_true(is.singleton(result2$ui$children[[1]]))
+
+ result3 <- surroundSingletons(tags$div(
+ singleton(tags$script("foo")),
+ singleton(tags$script("foo"))
+ ))
+
+ expect_identical(
+ renderTags(result3)$html,
+ HTML("<div>
+ <!--SHINY.SINGLETON[e2c5bca2641bfa9885e43fd0afd994a659829b32]-->
+ <script>foo</script>
+ <!--/SHINY.SINGLETON[e2c5bca2641bfa9885e43fd0afd994a659829b32]-->
+ <!--SHINY.SINGLETON[e2c5bca2641bfa9885e43fd0afd994a659829b32]-->
+ <script>foo</script>
+ <!--/SHINY.SINGLETON[e2c5bca2641bfa9885e43fd0afd994a659829b32]-->
+</div>")
+ )
+})
+
+test_that("Indenting can be controlled/suppressed", {
+ expect_identical(
+ renderTags(tags$div("a", "b"))$html,
+ HTML("<div>\n a\n b\n</div>")
+ )
+ expect_identical(
+ format(tags$div("a", "b")),
+ "<div>\n a\n b\n</div>"
+ )
+
+ expect_identical(
+ renderTags(tags$div("a", "b"), indent = 2)$html,
+ HTML(" <div>\n a\n b\n </div>")
+ )
+ expect_identical(
+ format(tags$div("a", "b"), indent = 2),
+ " <div>\n a\n b\n </div>"
+ )
+
+ expect_identical(
+ renderTags(tags$div("a", "b"), indent = FALSE)$html,
+ HTML("<div>\na\nb\n</div>")
+ )
+ expect_identical(
+ format(tags$div("a", "b"), indent = FALSE),
+ "<div>\na\nb\n</div>"
+ )
+
+ expect_identical(
+ renderTags(tagList(tags$div("a", "b")), indent = FALSE)$html,
+ HTML("<div>\na\nb\n</div>")
+ )
+ expect_identical(
+ format(tagList(tags$div("a", "b")), indent = FALSE),
+ "<div>\na\nb\n</div>"
+ )
+})
+
+test_that("cssList tests", {
+ expect_identical("", css())
+ expect_identical("", css())
+ expect_identical(
+ css(
+ font.family = 'Helvetica, "Segoe UI"',
+ font_size = "12px",
+ `font-style` = "italic",
+ font.variant = NULL,
+ "font-weight!" = factor("bold"),
+ padding = c("10px", "9px", "8px")
+ ),
+ "font-family:Helvetica, \"Segoe UI\";font-size:12px;font-style:italic;font-weight:bold !important;padding:10px 9px 8px;"
+ )
+
+ # Unnamed args not allowed
+ expect_error(css("10"))
+ expect_error(css(1, b=2))
+
+ # NULL and empty string are dropped
+ expect_identical(css(a="", b = NULL, "c!" = NULL), "")
+
+ # We are dumb about duplicated properties. Probably don't do that.
+ expect_identical(css(a=1, a=2), "a:1;a:2;")
+})
+
+test_that("Non-tag objects can be coerced", {
+
+ .GlobalEnv$as.tags.testcoerce1 <- function(x) {
+ list(singleton(list("hello")))
+ }
+ on.exit(rm("as.tags.testcoerce1", pos = .GlobalEnv), add = TRUE)
+
+ # Make sure tag-coerceable objects are tagified
+ result1 <- renderTags(structure(TRUE, class = "testcoerce1"))
+ expect_identical(result1$html, HTML("hello"))
+ expect_identical(result1$singletons, "110d1f0ef6762db2c6863523a7c379a697b43ea3")
+
+ # Make sure tag-coerceable objects are tagified before singleton handling
+ # occurs, but that over-flattening doesn't happen
+ result2 <- renderTags(tagList(
+ singleton(list("hello")),
+ structure(TRUE, class = "testcoerce1")
+ ))
+ expect_identical(result2$html, HTML("hello"))
+ expect_identical(result2$singletons, "110d1f0ef6762db2c6863523a7c379a697b43ea3")
+
+})
+
+test_that("Latin1 and system encoding are converted to UTF-8", {
+ #Sys.setlocale(, "Chinese")
+ latin1_str <- rawToChar(as.raw(0xFF))
+ Encoding(latin1_str) <- "latin1"
+
+ divLatin1 <- as.character(tags$div(latin1_str))
+ expect_identical(
+ charToRaw(divLatin1),
+ as.raw(c(0x3c, 0x64, 0x69, 0x76, 0x3e, 0xc3, 0xbf, 0x3c, 0x2f,
+ 0x64, 0x69, 0x76, 0x3e))
+ )
+ expect_identical(Encoding(divLatin1), "UTF-8")
+
+ expect_identical(Encoding("\u4E11"), "UTF-8")
+ divUTF8 <- as.character(tags$div("\u4E11"))
+ expect_identical(
+ charToRaw(divUTF8),
+ as.raw(c(0x3c, 0x64, 0x69, 0x76, 0x3e, 0xe4, 0xb8, 0x91, 0x3c,
+ 0x2f, 0x64, 0x69, 0x76, 0x3e))
+ )
+ expect_identical(Encoding(divUTF8), "UTF-8")
+
+ divMixed <- format(tags$div(
+ "\u4E11", latin1_str,
+ tags$span(a="\u4E11", latin1_str),
+ tags$span(b=latin1_str, HTML("\u4E11"))
+ ))
+ expect_identical(
+ charToRaw(divMixed),
+ as.raw(c(0x3c, 0x64, 0x69, 0x76, 0x3e, 0x0a, 0x20, 0x20, 0xe4,
+ 0xb8, 0x91, 0x0a, 0x20, 0x20, 0xc3, 0xbf, 0x0a, 0x20, 0x20, 0x3c,
+ 0x73, 0x70, 0x61, 0x6e, 0x20, 0x61, 0x3d, 0x22, 0xe4, 0xb8, 0x91,
+ 0x22, 0x3e, 0xc3, 0xbf, 0x3c, 0x2f, 0x73, 0x70, 0x61, 0x6e, 0x3e,
+ 0x0a, 0x20, 0x20, 0x3c, 0x73, 0x70, 0x61, 0x6e, 0x20, 0x62, 0x3d,
+ 0x22, 0xc3, 0xbf, 0x22, 0x3e, 0xe4, 0xb8, 0x91, 0x3c, 0x2f, 0x73,
+ 0x70, 0x61, 0x6e, 0x3e, 0x0a, 0x3c, 0x2f, 0x64, 0x69, 0x76, 0x3e
+ ))
+ )
+ expect_identical(Encoding(divMixed), "UTF-8")
+
+ # Encoding(HTML(latin1_str)) is "UTF-8" on Linux; even just
+ # paste(latin1_str) returns a UTF-8 encoded string
+ #expect_identical(Encoding(HTML(latin1_str)), "latin1")
+
+ expect_identical(Encoding(format(HTML(latin1_str))), "UTF-8")
+ expect_identical(Encoding(format(tagList(latin1_str))), "UTF-8")
+})
+
+test_that("Printing tags works", {
+ expect_identical(
+ capture.output(print(tags$a(href = "#", "link"))),
+ '<a href="#">link</a>'
+ )
+})
diff --git a/tests/testthat/test-template.R b/tests/testthat/test-template.R
new file mode 100644
index 0000000..176c2df
--- /dev/null
+++ b/tests/testthat/test-template.R
@@ -0,0 +1,204 @@
+context("templates")
+
+# Searches for an html dependency of format name[version], as in "d3[3.5.10]",
+# within the html-dependencies script tag
+findDep <- function(x, name, version) {
+ deps <- sub(
+ '.*<script type="application/html-dependencies">([^<]*)</script>.*',
+ "\\1",
+ x
+ )
+ grepl(paste0(name, "[", version, "]"), deps, fixed = TRUE)
+}
+
+test_that("Code blocks are evaluated and rendered correctly", {
+ template <- htmlTemplate("template-document.html",
+ x = div(class = "foo", "bar")
+ )
+ html <- renderDocument(template)
+
+ expect_true(grepl('<div class="foo">bar</div>', html))
+
+ # With text_ argument
+ template <- htmlTemplate(text_ = "a {{ foo + 1 }} b", foo = 10)
+ expect_identical(as.character(as.character(template)), "a \n11\n b")
+
+ # Make char vectors are pasted together
+ template <- htmlTemplate(text_ = c("a", "{{ foo + 1 }} b"), foo = 10)
+ expect_identical(as.character(as.character(template)), "a\n\n11\n b")
+})
+
+test_that("UTF-8 characters in templates", {
+ template <- htmlTemplate("template-document.html", x = "")
+ html <- renderDocument(template)
+
+ # Create the string 'Δ★😎', making sure it's UTF-8 encoded on all platforms.
+ # These characters are 2, 3, and 4 bytes long, respectively.
+ pat <- rawToChar(as.raw(c(0xce, 0x94, 0xe2, 0x98, 0x85, 0xf0, 0x9f, 0x98, 0x8e)))
+ Encoding(pat) <- "UTF-8"
+ expect_true(grepl(pat, html))
+
+ # If template is passed text_ argument, make sure it's converted from native
+ # to UTF-8.
+ latin1_str <- rawToChar(as.raw(0xFF))
+ Encoding(latin1_str) <- "latin1"
+ text <- as.character(htmlTemplate(text_ = latin1_str))
+ expect_identical(charToRaw(text), as.raw(c(0xc3, 0xbf)))
+})
+
+
+test_that("Dependencies are added properly", {
+ dep <- htmlDependency("d3", "3.5.10", c(href="shared"), script = "d3.js")
+
+ # Add dependency by inserting a tag with a dependency
+ template <- htmlTemplate("template-document.html",
+ x = attachDependencies(div(), dep)
+ )
+ html <- renderDocument(template)
+ expect_true(findDep(html, "d3", "3.5.10"))
+ expect_true(grepl('<script src="shared/d3.js"></script>', html, fixed = TRUE))
+
+ # Add dependency via a renderDocument
+ template <- htmlTemplate("template-document.html", x = "")
+ html <- renderDocument(template, dep)
+ expect_true(findDep(html, "d3", "3.5.10"))
+ expect_true(grepl('<script src="shared/d3.js"></script>', html, fixed = TRUE))
+})
+
+
+test_that("Dependencies can be suppressed", {
+ # The template includes suppressDependencies("jquery"), so we shouldn't see
+ # this dependency in the final output.
+ dep <- htmlDependency("jquery", "1.11.3", c(href="shared"), script = "jquery.js")
+
+ # Add dependency by inserting a tag with a dependency
+ template <- htmlTemplate("template-document.html",
+ x = attachDependencies(div(), dep)
+ )
+ html <- renderDocument(template)
+ expect_true(findDep(html, "jquery", "9999"))
+ expect_false(grepl('<script[^>]+jquery[^>]+>', html))
+
+ # Add dependency via a renderDocument
+ template <- htmlTemplate("template-document.html", x = "")
+ html <- renderDocument(template, dep)
+ expect_true(findDep(html, "jquery", "9999"))
+ expect_false(grepl('<script[^>]+jquery[^>]+>', html))
+})
+
+test_that("Errors for mismatched brackets", {
+ # Error if unmatched opening brackets
+ expect_error(htmlTemplate(text_ = "text {{ code"))
+ # No error if we didn't open a code block
+ expect_identical(
+ as.character(htmlTemplate(text_ = "code }} text")),
+ "code }} text"
+ )
+
+ # Error if unmatched brackets, when no leading or trailing space
+ expect_error(htmlTemplate(text_ = "{{ code"))
+ # No error if we didn't open a code block
+ expect_identical(
+ as.character(htmlTemplate(text_ = "code }}")),
+ "code }}"
+ )
+
+})
+
+test_that("Brackets at start or end of text", {
+ # Code and text
+ expect_identical(
+ as.character(htmlTemplate(text_ = "text {{ code }} text", code = 1)),
+ "text \n1\n text"
+ )
+ expect_identical(
+ as.character(htmlTemplate(text_ = "text{{code}}text", code = 1)),
+ "text\n1\ntext"
+ )
+
+ # No brackets
+ expect_identical(
+ as.character(htmlTemplate(text_ = "text", code = 1)),
+ "text"
+ )
+
+ # No leading or trailing text
+ expect_identical(
+ as.character(htmlTemplate(text_ = "{{ code }}", code = 1)),
+ "1"
+ )
+ expect_identical(
+ as.character(htmlTemplate(text_ = " {{ code }}", code = 1)),
+ " \n1"
+ )
+ expect_identical(
+ as.character(htmlTemplate(text_ = "{{ code }} ", code = 1)),
+ "1\n "
+ )
+
+ # Edge cases
+ expect_identical(as.character(htmlTemplate(text_ = "")), "")
+ expect_identical(as.character(htmlTemplate(text_ = "X")), "X")
+ expect_identical(as.character(htmlTemplate(text_ = " ")), " ")
+ expect_identical(as.character(htmlTemplate(text_ = "{{}}")), "")
+ expect_identical(as.character(htmlTemplate(text_ = " {{}} ")), " \n ")
+ expect_identical(as.character(htmlTemplate(text_ = "{{ }}")), "")
+ expect_identical(as.character(htmlTemplate(text_ = "{{}}{{}}")), "")
+ expect_identical(as.character(htmlTemplate(text_ = "{{1}}{{2}}")), "1\n2")
+ expect_error(as.character(htmlTemplate(text_ = "{{")))
+ expect_error(as.character(htmlTemplate(text_ = " {{")))
+ expect_error(as.character(htmlTemplate(text_ = "{{ ")))
+ expect_identical(as.character(htmlTemplate(text_ = "}}")), "}}")
+ expect_identical(as.character(htmlTemplate(text_ = " }}")), " }}")
+ expect_identical(as.character(htmlTemplate(text_ = "}} ")), "}} ")
+})
+
+
+test_that("Template DFA edge cases", {
+ # Single quotes
+ expect_identical(as.character(htmlTemplate(text_ = "{{ '' }}")), "")
+ expect_identical(as.character(htmlTemplate(text_ = " {{ '' }} ")), " \n\n ")
+ expect_identical(as.character(htmlTemplate(text_ = "{{ '\\'' }}")), "'")
+ expect_identical(as.character(htmlTemplate(text_ = "{{ '\\\\' }}")), "\\")
+ expect_identical(as.character(htmlTemplate(text_ = "{{ '}}' }}")), "}}")
+
+ # Double quotes
+ expect_identical(as.character(htmlTemplate(text_ = '{{ "" }}')), '')
+ expect_identical(as.character(htmlTemplate(text_ = ' {{ "" }} ')), ' \n\n ')
+ expect_identical(as.character(htmlTemplate(text_ = '{{ "\\"" }}')), '"')
+ expect_identical(as.character(htmlTemplate(text_ = '{{ "\\\\" }}')), '\\')
+ expect_identical(as.character(htmlTemplate(text_ = '{{ "}}" }}')), '}}')
+
+ # Backticks in code
+ expect_identical(as.character(htmlTemplate(text_ = "{{ `}}`<-1 }}")), "1")
+ expect_identical(as.character(htmlTemplate(text_ = "{{ `x\\`x`<-1 }}")), "1")
+
+
+ # Percent operator - various delimiters in percent operator
+ expect_identical(
+ as.character(htmlTemplate(text_ = "a{{ `%'%` <- function(x, y) 1; 2 %'% 3 }}b")),
+ "a\n1\nb"
+ )
+ expect_identical(
+ as.character(htmlTemplate(text_ = "a{{ `%}}%` <- function(x, y) 1; 2 %}}% 3 }}b")),
+ "a\n1\nb"
+ )
+
+ # Comments
+ expect_identical(
+ as.character(htmlTemplate(text_ = "a{{ 1 #2 }}b")),
+ "a\n1\nb"
+ )
+ expect_identical(
+ as.character(htmlTemplate(text_ = "a{{ 1 #2\n3 }}b")),
+ "a\n3\nb"
+ )
+ expect_identical(
+ as.character(htmlTemplate(text_ = "a{{ 1 #2'3 }}b")),
+ "a\n1\nb"
+ )
+ expect_identical(
+ as.character(htmlTemplate(text_ = "a{{ 1 #2}3 }}b")),
+ "a\n1\nb"
+ )
+})
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-htmltools.git
More information about the debian-med-commit
mailing list