htmltools/0000755000175100001440000000000013100571072012311 5ustar hornikusershtmltools/tests/0000755000175100001440000000000013100230764013453 5ustar hornikusershtmltools/tests/testthat/0000755000175100001440000000000013100230764015313 5ustar hornikusershtmltools/tests/testthat/test-tags.r0000644000175100001440000004641313100230764017421 0ustar hornikuserscontext("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")), "one") expect_equal( as.character(tags$b("one", "two")), "\n one\n two\n") 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")), "
\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>
") # Text in HTML() isn't escaped expect_equivalent(format(div(HTML(""))), "
") # Text in a property is escaped expect_equivalent(format(div(class = "", "text")), '
text
') # HTML() has no effect in a property like 'class' expect_equivalent(format(div(class = HTML(""), "text")), '
text
') }) 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") ) # length-0 attributes are dropped expect_identical( div(a = character(), 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 ) # length-0 children are dropped expect_identical( renderTags(div("foo", character(), list(character(), list(list(), "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("&&") expect_identical(attr(x, "html", TRUE), TRUE) expect_equivalent(format(x), "&&") # Make sure attributes are preserved when wrapped in other tags x <- div(HTML("&&")) expect_equivalent(x$children[[1]], HTML("&&")) expect_identical(attr(x$children[[1]], "html", TRUE), TRUE) expect_equivalent(format(x), "
&&
") # Deeper nesting x <- div(p(HTML("&&"))) expect_equivalent(x$children[[1]]$children[[1]], HTML("&&")) expect_identical(attr(x$children[[1]]$children[[1]], "html", TRUE), TRUE) expect_equivalent(format(x), "
\n

&&

\n
") }) 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]])), '' ) expect_identical( as.character(tags$option(value=myfactors[[1]], value='B', value=3, myfactors[[1]])), '' ) }) 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("
") ) }) test_that("Indenting can be controlled/suppressed", { expect_identical( renderTags(tags$div("a", "b"))$html, HTML("
\n a\n b\n
") ) expect_identical( format(tags$div("a", "b")), "
\n a\n b\n
" ) expect_identical( renderTags(tags$div("a", "b"), indent = 2)$html, HTML("
\n a\n b\n
") ) expect_identical( format(tags$div("a", "b"), indent = 2), "
\n a\n b\n
" ) expect_identical( renderTags(tags$div("a", "b"), indent = FALSE)$html, HTML("
\na\nb\n
") ) expect_identical( format(tags$div("a", "b"), indent = FALSE), "
\na\nb\n
" ) expect_identical( renderTags(tagList(tags$div("a", "b")), indent = FALSE)$html, HTML("
\na\nb\n
") ) expect_identical( format(tagList(tags$div("a", "b")), indent = FALSE), "
\na\nb\n
" ) }) 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, d = character()), "") # 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"))), 'link' ) }) htmltools/tests/testthat/template-document.html0000644000175100001440000000030013100230764021621 0ustar hornikusers {{ suppressDependencies("jquery") }} {{ headContent() }}
{{ x }}
UTF-8 chars:Δ★😎 htmltools/tests/testthat/test-deps.r0000644000175100001440000000647313100230764017420 0ustar hornikuserscontext("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), "
foo
\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), "
foo
\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), "
foo
\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), "
\n
foo
\n bar\n
") 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), "
\n
foo
\n bar\n
") 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), "
\n
foo
\n bar\n
") # 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)) }) htmltools/tests/testthat/test-template.R0000644000175100001440000001725613100230764020241 0ustar hornikuserscontext("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( '.*.*', "\\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('
bar
', 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("UTF-8 characters in template head but not body", { # On Windows, a string with "中文" will automatically be marked as UTF-8. ui <- tagList( tags$head(tags$script("alert('中文')")), "test" ) html <- htmlTemplate("template-basic.html", body = ui) res <- renderDocument(html) expect_identical(Encoding(res), "UTF-8") expect_true(grepl("中文", res, fixed = TRUE)) # On Windows, a string with "á" will automatically be marked as latin1. ui <- tagList( tags$head(tags$script("alert('á')")), "test" ) html <- htmlTemplate("template-basic.html", body = ui) res <- renderDocument(html) expect_identical(Encoding(res), "UTF-8") expect_true(grepl("á", res, fixed = TRUE)) }) 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('', 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('', 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(']+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(']+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" ) }) htmltools/tests/testthat/template-basic.html0000644000175100001440000000011413100230764021067 0ustar hornikusers {{ headContent() }} {{ body }} htmltools/tests/test-all.R0000644000175100001440000000007613100230764015326 0ustar hornikuserslibrary(testthat) library(htmltools) test_check("htmltools") htmltools/src/0000755000175100001440000000000013100232620013071 5ustar hornikusershtmltools/src/template.cpp0000644000175100001440000000673113100232620015417 0ustar hornikusers#include 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 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(x[0]); std::vector 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; } htmltools/src/init.c0000644000175100001440000000066713100232620014211 0ustar hornikusers#include #include #include // for NULL #include /* .Call calls */ extern SEXP htmltools_template_dfa(SEXP); static const R_CallMethodDef CallEntries[] = { {"htmltools_template_dfa", (DL_FUNC) &htmltools_template_dfa, 1}, {NULL, NULL, 0} }; void R_init_htmltools(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } htmltools/src/RcppExports.cpp0000644000175100001440000000103513100232620016065 0ustar hornikusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; // template_dfa std::vector template_dfa(CharacterVector x); RcppExport SEXP htmltools_template_dfa(SEXP xSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< CharacterVector >::type x(xSEXP); rcpp_result_gen = Rcpp::wrap(template_dfa(x)); return rcpp_result_gen; END_RCPP } htmltools/NAMESPACE0000644000175100001440000000362213100232577013537 0ustar hornikusers# 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, .registration = TRUE) htmltools/NEWS0000644000175100001440000000631213100231023012777 0ustar hornikusershtmltools 0.3.6 -------------------------------------------------------------------------------- * `validateCssUnit()` now accepts viewport units (vw, vh, vmin, vmax). (#56) * `restorePreserveChunks()` marks the output with the correct encoding now (UTF-8). * Length-0 attributes are now dropped, like NULLs. (#65) * Fixed #69: On Windows, `renderDocument()` did not mark output as UTF-8 if the head was UTF-8 but body was ASCII. (#71) 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 htmltools/R/0000755000175100001440000000000013100232533012506 5ustar hornikusershtmltools/R/html_dependency.R0000644000175100001440000004240413100230764016003 0ustar hornikusers#' 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 package An R package name to indicate where to find the \code{src} #' directory when \code{src} is a relative path (see #' \code{\link{resolveDependencies}}). #' @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{} 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, package = 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, package = package, 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) } } # resolve the relative file path to absolute path in package if (!is.null(dependency$package)) dir <- system.file(dir, package = dependency$package) 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( "", sep = "" )) } # add stylesheets if (length(dep$stylesheet) > 0) { html <- c(html, paste( "", sep = "" )) } # add scripts if (length(dep$script) > 0) { html <- c(html, paste( "", 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("", 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" # ) # )) # # html_dependencies_as_character(list( # htmlDependency("foo", "1.0", # c(href="http://foo.com/bar%20baz"), # stylesheet="x y z.css" # ) # )) # # html_dependencies_as_character(list( # htmlDependency("foo", "1.0", # "foo bar/baz", # stylesheet="x y z.css" # ) # )) # # html_dependencies_as_character(list( # htmlDependency("foo", "1.0", # "foo bar/baz/", # stylesheet="x y z.css" # ) # )) # htmltools/R/tags.R0000644000175100001440000013633613100230764013607 0ustar hornikusers#' @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. #' @param resolvePackageDir Whether to resolve the relative path to an absolute #' path via \code{\link{system.file}} when the \code{package} attribute is #' present in a dependency object. #' @return dependencies A list of \code{\link{htmlDependency}} objects with #' redundancies removed. #' #' @export resolveDependencies <- function(dependencies, resolvePackageDir = TRUE) { # 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. dep <- deps[[sorted[[1]]]] if (resolvePackageDir && !is.null(dep$package)) { dir <- dep$src$file if (!is.null(dir)) dep$src$file <- system.file(dir, package = dep$package) dep$package <- NULL } dep })) } # 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) { length(x) == 0 } # Given a vector or list, drop all the NULL or length-0 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 and length-0 values named_idx <- nzchar(varArgsNames) attribs <- dropNullsOrEmpty(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]]), "", eol, sep="")) } else { textWriter("\n") for (child in children) tagWrite(child, textWriter, nextIndent) textWriter(paste8(indentText, "", 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(">", 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{}. #' } #' \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, tagify = FALSE)) 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 X' #' 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("", sig)), uiObj, HTML(sprintf("", 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. #' @param tagify Whether to tagify the input before searching for dependencies. #' #' @return A list of \code{\link{htmlDependency}} objects. #' #' @export findDependencies <- function(tags, tagify = TRUE) { if (isTRUE(tagify)) { tags <- tagify(tags) } dep <- htmlDependencies(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, tagify = FALSE), 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 turtles")) #' 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("") 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 "" #' # from getting an tag inserted in the middle #' markup <- paste(sep = "\n", #' "This is *emphasized* text in markdown.", #' htmlPreserve(""), #' "Here is some more *emphasized text*." #' ) #' extracted <- extractPreserveChunks(markup) #' markup <- extracted$value #' # Just think of this next line as Markdown processing #' output <- gsub("\\*(.*?)\\*", "\\1", markup) #' output <- restorePreserveChunks(output, extracted$chunks) #' output #' #' @export htmlPreserve <- function(x) { x <- paste(x, collapse = "\r\n") if (nzchar(x)) sprintf("%s", 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 # ... 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 <- "" endmarker <- "" # 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 <- "" # 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) { strval <- enc2utf8(strval) chunks <- enc2utf8(chunks) for (id in names(chunks)) strval <- gsub(id, chunks[[id]], strval, fixed = TRUE, useBytes = TRUE) Encoding(strval) <- 'UTF-8' 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, tagify = FALSE), resolvePackageDir = FALSE) 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, tagify = FALSE)) 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}, #' \code{pc}, \code{vh}, \code{vw}, \code{vmin}, or \code{vmax}. #' 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|vh|vw|vmin|vmax))$" 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))) } htmltools/R/template.R0000644000175100001440000001235313100232533014450 0ustar hornikusers#' 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{""} within the template. #' #' @seealso \code{\link{renderDocument}} #' @export #' @useDynLib htmltools, .registration = TRUE #' @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("") 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, 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{""} 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 section head_content <- paste0( ' \n', sprintf(' \n', paste(result$singletons, collapse = ',') ), sprintf(' \n', depStr ), depHtml, c(result$head, recursive = TRUE) ) # Need to mark result as UTF-8. If body is ASCII, it will be marked with # encoding "unknown". If the head has UTF-8 characters and is marked as # "UTF-8", the output string here will have the correct UTF-8 byte sequences, # but will be marked as "unknown", which causes the wrong text to be # displayed. See https://github.com/rstudio/shiny/issues/1395 res <- sub("", head_content, result$html, fixed = TRUE) Encoding(res) <- "UTF-8" res } htmltools/R/RcppExports.R0000644000175100001440000000033613100231664015130 0ustar hornikusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 template_dfa <- function(x) { .Call('htmltools_template_dfa', PACKAGE = 'htmltools', x) } htmltools/R/html_escape.R0000644000175100001440000000230513100230764015121 0ustar hornikusers #' 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) } }) htmltools/R/html_print.R0000644000175100001440000000626113100230764015022 0ustar hornikusers#' 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("", "", "", "", renderDependencies(deps, c("href", "file")), rendered$head, "", sprintf("", htmlEscape(background)), rendered$html, "", "") # write it writeLines(html, file, useBytes = TRUE) } htmltools/MD50000644000175100001440000000501713100571072012624 0ustar hornikusers630310adf5be92835b9544240f92376c *DESCRIPTION 41ac34eea891be5f999ed8b44f87e476 *NAMESPACE 738bee7e0dd52e6d69ccfe44c8dc0394 *NEWS aa9302feb5eec2cedcb00f9d88e5af74 *R/RcppExports.R 411239656a10eb50c5d1d217b9b57ede *R/html_dependency.R 7bee8b23618adb2848412fedc7164709 *R/html_escape.R b3e3d3353ebc757321b60abcad04397c *R/html_print.R f02106c1cda38dbdd97d40370f99e4e1 *R/tags.R 31064a678bc8589cfd29497262ba2110 *R/template.R ebcfaa458d3bdefadded43a4d64cfff9 *man/HTML.Rd c00712c215b7bbb80a6287fee17f3c24 *man/as.tags.Rd 88494342535e91fa8972fd2fc3f1fde5 *man/browsable.Rd 6bfa2d7cdaca48f17caaa6b11902e28e *man/builder.Rd bcfebb5f9577a5013fe33242fdec9645 *man/copyDependencyToDir.Rd 11bd91091ffdde442e05a6a26823a84d *man/css.Rd 83f5a6962792ba50b19b48dc1c65fd39 *man/findDependencies.Rd b1b2d807ab611007bdf9b582b64e5f24 *man/htmlDependencies.Rd 9f7aaeaaa75598fbb0ab71e20359965d *man/htmlDependency.Rd 91c1824deb08f57376108765fd29dbaa *man/htmlEscape.Rd 475bf569370053b828bf69e4bb283825 *man/htmlPreserve.Rd 516afef01fac034a4e414e7515a7b71e *man/htmlTemplate.Rd f0a6e81826dcaf3e212e70c63e67189e *man/html_print.Rd 4f34e99b07220d7a2fa41b9029a16862 *man/include.Rd 93bd5afcdac04bc4c5322122f0710e75 *man/knitr_methods.Rd 2b18a3612062f7783435b8dfd1e215f4 *man/makeDependencyRelative.Rd 16159aa45a251fb364e5fd1fd144d1d7 *man/print.html.Rd 504914f9f04e3a96f20d707b5acc341f *man/renderDependencies.Rd dee26db7dd1d20fc2f13746ef9e9ae1d *man/renderDocument.Rd 5943238916b4b5866e49846183c95f98 *man/renderTags.Rd 3d7d639046044b164f7dabe61158c67d *man/resolveDependencies.Rd 3e8fac6287e21baa2e492fb2e581689b *man/save_html.Rd 72d8cd938a5a644116813539b07d0576 *man/singleton.Rd 0c319382fa19718f0d0da795c20501ce *man/singleton_tools.Rd f0de725705e4f99a532bc4a9cc58664c *man/subtractDependencies.Rd 127fb8880888366a5c37c0b3b7eac069 *man/suppressDependencies.Rd c36b122e98a5f4a6e89892f9cf8336ba *man/tag.Rd cd3894dd85e4d84cc4ff5dc2a567fd4b *man/urlEncodePath.Rd b107695e665e7daf7fb074bfd1ad4d94 *man/validateCssUnit.Rd dec0c8e4a1f951e26daa06e9c07f986b *man/withTags.Rd 3305b464312f0fccbc917c491e79201d *src/RcppExports.cpp a941e5cc1f933a4245b62b772a9263c5 *src/init.c f7dbf02b3735f8a64fb1cc9264416713 *src/template.cpp d5386f261693f9f4a5dda7b6fe0aa9f0 *tests/test-all.R 4de059d582d96a7c86907beb670b819d *tests/testthat/template-basic.html ce9c101bbebef449d432567b9a29e9f9 *tests/testthat/template-document.html bd23b1f0bd8705c3fe39c9f537cd1305 *tests/testthat/test-deps.r f619582da6617e70858b2c462f956f9b *tests/testthat/test-tags.r 2d57750590f71f1bb6a96604a05a7d23 *tests/testthat/test-template.R htmltools/DESCRIPTION0000644000175100001440000000107513100571072014022 0ustar hornikusersPackage: htmltools Type: Package Title: Tools for HTML Version: 0.3.6 Date: 2017-04-26 Author: RStudio, Inc. Maintainer: Joe Cheng 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: 6.0.1 LinkingTo: Rcpp NeedsCompilation: yes Packaged: 2017-04-27 00:04:32 UTC; jcheng Repository: CRAN Date/Publication: 2017-04-28 07:41:46 UTC htmltools/man/0000755000175100001440000000000013100230764013064 5ustar hornikusershtmltools/man/knitr_methods.Rd0000644000175100001440000000104113100232577016225 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tags.R \name{knitr_methods} \alias{knitr_methods} \alias{knit_print.shiny.tag} \alias{knit_print.html} \alias{knit_print.shiny.tag.list} \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. } htmltools/man/browsable.Rd0000644000175100001440000000165313100232577015344 0ustar hornikusers% 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. } htmltools/man/htmlEscape.Rd0000644000175100001440000000077113100232577015451 0ustar hornikusers% 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 } htmltools/man/include.Rd0000644000175100001440000000246013100232577015004 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tags.R \name{include} \alias{include} \alias{includeHTML} \alias{includeText} \alias{includeMarkdown} \alias{includeCSS} \alias{includeScript} \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. } htmltools/man/save_html.Rd0000644000175100001440000000105613100232577015343 0ustar hornikusers% 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}. } htmltools/man/resolveDependencies.Rd0000644000175100001440000000146213100232577017350 0ustar hornikusers% 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, resolvePackageDir = TRUE) } \arguments{ \item{dependencies}{A list of \code{\link{htmlDependency}} objects.} \item{resolvePackageDir}{Whether to resolve the relative path to an absolute path via \code{\link{system.file}} when the \code{package} attribute is present in a dependency object.} } \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. } htmltools/man/tag.Rd0000644000175100001440000000404013100232577014130 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tags.R \name{tag} \alias{tag} \alias{tagList} \alias{tagAppendAttributes} \alias{tagHasAttribute} \alias{tagGetAttribute} \alias{tagAppendChild} \alias{tagAppendChildren} \alias{tagSetChildren} \alias{tag} \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) } htmltools/man/validateCssUnit.Rd0000644000175100001440000000220713100232577016462 0ustar hornikusers% 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}, \code{pc}, \code{vh}, \code{vw}, \code{vmin}, or \code{vmax}. 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' } htmltools/man/builder.Rd0000644000175100001440000000325213100232577015007 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tags.R \name{builder} \alias{builder} \alias{tags} \alias{p} \alias{h1} \alias{h2} \alias{h3} \alias{h4} \alias{h5} \alias{h6} \alias{a} \alias{br} \alias{div} \alias{span} \alias{pre} \alias{code} \alias{img} \alias{strong} \alias{em} \alias{hr} \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)) } htmltools/man/css.Rd0000644000175100001440000000323213100232577014147 0ustar hornikusers% 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 ) } htmltools/man/copyDependencyToDir.Rd0000644000175100001440000000265113100232577017276 0ustar hornikusers% 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. } htmltools/man/htmlDependencies.Rd0000644000175100001440000000330013100232577016626 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/html_dependency.R \name{htmlDependencies} \alias{htmlDependencies} \alias{htmlDependencies<-} \alias{attachDependencies} \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) } htmltools/man/HTML.Rd0000644000175100001440000000107213100232577014123 0ustar hornikusers% 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 turtles")) cat(as.character(el)) } htmltools/man/renderTags.Rd0000644000175100001440000000315213100232577015456 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tags.R \name{renderTags} \alias{renderTags} \alias{doRenderTags} \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{}. } \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. } htmltools/man/renderDependencies.Rd0000644000175100001440000000164113100232577017147 0ustar hornikusers% 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. } htmltools/man/htmlDependency.Rd0000644000175100001440000000726513100232577016334 0ustar hornikusers% 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, package = 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{package}{An R package name to indicate where to find the \code{src} directory when \code{src} is a relative path (see \code{\link{resolveDependencies}}).} \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{} 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. } htmltools/man/singleton_tools.Rd0000644000175100001440000000235513100232577016606 0ustar hornikusers% 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 X' 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. } htmltools/man/htmlTemplate.Rd0000644000175100001440000000210113100232577016011 0ustar hornikusers% 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{""} 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}} } htmltools/man/urlEncodePath.Rd0000644000175100001440000000061713100232577016120 0ustar hornikusers% 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. } htmltools/man/print.html.Rd0000644000175100001440000000137013100232577015457 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tags.R \name{print.shiny.tag} \alias{print.shiny.tag} \alias{print.html} \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. } htmltools/man/html_print.Rd0000644000175100001440000000133313100232577015537 0ustar hornikusers% 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. } htmltools/man/makeDependencyRelative.Rd0000644000175100001440000000205413100232577017770 0ustar hornikusers% 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}} } htmltools/man/findDependencies.Rd0000644000175100001440000000102013100232577016577 0ustar hornikusers% 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, tagify = TRUE) } \arguments{ \item{tags}{A tag-like object to search for dependencies.} \item{tagify}{Whether to tagify the input before searching for dependencies.} } \value{ A list of \code{\link{htmlDependency}} objects. } \description{ Walks a hierarchy of tags looking for attached dependencies. } htmltools/man/withTags.Rd0000644000175100001440000000206613100232577015155 0ustar hornikusers% 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") ) ) } htmltools/man/suppressDependencies.Rd0000644000175100001440000000121413100232577017550 0ustar hornikusers% 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}} } htmltools/man/subtractDependencies.Rd0000644000175100001440000000227613100232577017524 0ustar hornikusers% 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. } htmltools/man/singleton.Rd0000644000175100001440000000120713100232577015361 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tags.R \name{singleton} \alias{singleton} \alias{is.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. } htmltools/man/htmlPreserve.Rd0000644000175100001440000000444713100232577016050 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tags.R \name{htmlPreserve} \alias{htmlPreserve} \alias{extractPreserveChunks} \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 "" # from getting an tag inserted in the middle markup <- paste(sep = "\\n", "This is *emphasized* text in markdown.", htmlPreserve(""), "Here is some more *emphasized text*." ) extracted <- extractPreserveChunks(markup) markup <- extracted$value # Just think of this next line as Markdown processing output <- gsub("\\\\*(.*?)\\\\*", "\\\\1", markup) output <- restorePreserveChunks(output, extracted$chunks) output } htmltools/man/as.tags.Rd0000644000175100001440000000072213100232577014720 0ustar hornikusers% 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}}. } htmltools/man/renderDocument.Rd0000644000175100001440000000255613100232577016345 0ustar hornikusers% 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{""} in the document, and replaces it with the web dependencies. }