1#' Define an HTML dependency 2#' 3#' Define an HTML dependency (i.e. CSS and/or JavaScript bundled in a 4#' directory). HTML dependencies make it possible to use libraries like jQuery, 5#' Bootstrap, and d3 in a more composable and portable way than simply using 6#' script, link, and style tags. 7#' 8#' @param name Library name 9#' @param version Library version 10#' @param src Unnamed single-element character vector indicating the full path 11#' of the library directory. Alternatively, a named character string with one 12#' or more elements, indicating different places to find the library; see 13#' Details. 14#' @param meta Named list of meta tags to insert into document head 15#' @param script Script(s) to include within the document head (should be 16#' specified relative to the `src` parameter). 17#' @param stylesheet Stylesheet(s) to include within the document (should be 18#' specified relative to the `src` parameter). 19#' @param head Arbitrary lines of HTML to insert into the document head 20#' @param attachment Attachment(s) to include within the document head. See 21#' Details. 22#' @param package An R package name to indicate where to find the `src` 23#' directory when `src` is a relative path (see 24#' [resolveDependencies()]). 25#' @param all_files Whether all files under the `src` directory are 26#' dependency files. If `FALSE`, only the files specified in 27#' `script`, `stylesheet`, and `attachment` are treated as 28#' dependency files. 29#' 30#' @return An object that can be included in a list of dependencies passed to 31#' [attachDependencies()]. 32#' 33#' @details Each dependency can be located on the filesystem, at a relative or 34#' absolute URL, or both. The location types are indicated using the names of 35#' the `src` character vector: `file` for filesystem directory, 36#' `href` for URL. For example, a dependency that was both on disk and at 37#' a URL might use `src = c(file=filepath, href=url)`. 38#' 39#' `script` can be given as one of the following: 40#' \itemize{ 41#' \item a character vector specifying various scripts to include relative to the 42#' value of `src`. 43#' Each is expanded into its own `<script>` tag 44#' \item A named list with any of the following fields: 45#' \itemize{ 46#' \item `src`, 47#' \item `integrity`, & 48#' \item `crossorigin`, 49#' \item any other valid `<script>` attributes. 50#' } 51#' allowing the use of SRI to ensure the integrity of packages downloaded from 52#' remote servers. 53#' Eg: `script = list(src = "min.js", integrity = "hash")` 54#' \item An unamed list, containing a combination of named list with the fields 55#' mentioned previously, and strings. 56#' Eg: 57#' \itemize{ 58#' \item `script = list(list(src = "min.js"), "util.js", list(src = "log.js"))` 59#' \item `script = "pkg.js"` is equivalent to 60#' \item `script = list(src = "pkg.js")`. 61#' } 62#' } 63#' 64#' `attachment` can be used to make the indicated files available to the 65#' JavaScript on the page via URL. For each element of `attachment`, an 66#' element `<link id="DEPNAME-ATTACHINDEX-attachment" rel="attachment" 67#' href="...">` is inserted, where `DEPNAME` is `name`. The value of 68#' `ATTACHINDEX` depends on whether `attachment` is named or not; if 69#' so, then it's the name of the element, and if not, it's the 1-based index 70#' of the element. JavaScript can retrieve the URL using something like 71#' `document.getElementById(depname + "-" + index + "-attachment").href`. 72#' Note that depending on the rendering context, the runtime value of the href 73#' may be an absolute, relative, or data URI. 74#' 75#' `htmlDependency` should not be called from the top-level of a package 76#' namespace with absolute paths (or with paths generated by 77#' `system.file()`) and have the result stored in a variable. This is 78#' because, when a binary package is built, R will run `htmlDependency` 79#' and store the path from the building machine's in the package. This path is 80#' likely to differ from the correct path on a machine that downloads and 81#' installs the binary package. If there are any absolute paths, instead of 82#' calling `htmlDependency` at build-time, it should be called at 83#' run-time. This can be done by wrapping the `htmlDependency` call in a 84#' function. 85#' 86#' @seealso Use [attachDependencies()] to associate a list of 87#' dependencies with the HTML it belongs with. 88#' 89#' @export 90htmlDependency <- function(name, 91 version, 92 src, 93 meta = NULL, 94 script = NULL, 95 stylesheet = NULL, 96 head = NULL, 97 attachment = NULL, 98 package = NULL, 99 all_files = TRUE) { 100 101 # This function shouldn't be called from a namespace environment with 102 # absolute paths. 103 if (isNamespace(parent.frame()) && any(substr(src, 1, 1) == "/")) { 104 warning( 105 "htmlDependency shouldn't be called from a namespace environment", 106 " with absolute paths (or paths from system.file()).", 107 " See ?htmlDependency for more information." 108 ) 109 } 110 111 version <- as.character(version) 112 validateScalarName(name) 113 validateScalarName(version) 114 115 srcNames <- names(src) 116 if (is.null(srcNames)) 117 srcNames <- rep.int("", length(src)) 118 srcNames[!nzchar(srcNames)] <- "file" 119 names(src) <- srcNames 120 src <- as.list(src) 121 122 structure(class = "html_dependency", list( 123 name = name, 124 version = as.character(version), 125 src = src, 126 meta = meta, 127 script = script, 128 stylesheet = stylesheet, 129 head = head, 130 attachment = attachment, 131 package = package, 132 all_files = all_files 133 )) 134} 135 136validateScalarName <- function(x, name = deparse(substitute(x))) { 137 if (length(x) != 1 || x == "" || grepl("[/\\]", x)) stop( 138 "Invalid argument '", name, 139 "' (must be a non-empty character string and contain no '/' or '\\')" 140 ) 141} 142 143#' HTML dependency metadata 144#' 145#' Gets or sets the HTML dependencies associated with an object (such as a tag). 146#' 147#' `attachDependencies` provides an alternate syntax for setting 148#' dependencies. It is similar to \code{local(\{htmlDependencies(x) <- value; 149#' x\})}, except that if there are any existing dependencies, 150#' `attachDependencies` will add to them, instead of replacing them. 151#' 152#' As of htmltools 0.3.4, HTML dependencies can be attached without using 153#' `attachDependencies`. Instead, they can be added inline, like a child 154#' object of a tag or [tagList()]. 155#' 156#' @param x An object which has (or should have) HTML dependencies. 157#' @param value An HTML dependency, or a list of HTML dependencies. 158#' @param append If FALSE (the default), replace any existing dependencies. If 159#' TRUE, add the new dependencies to the existing ones. 160#' 161#' @examples 162#' # Create a JavaScript dependency 163#' dep <- htmlDependency("jqueryui", "1.11.4", c(href="shared/jqueryui"), 164#' script = "jquery-ui.min.js") 165#' 166#' # A CSS dependency 167#' htmlDependency( 168#' "font-awesome", "4.5.0", c(href="shared/font-awesome"), 169#' stylesheet = "css/font-awesome.min.css" 170#' ) 171#' 172#' # A few different ways to add the dependency to tag objects: 173#' # Inline as a child of the div() 174#' div("Code here", dep) 175#' # Inline in a tagList 176#' tagList(div("Code here"), dep) 177#' # With attachDependencies 178#' attachDependencies(div("Code here"), dep) 179#' 180#' @export 181htmlDependencies <- function(x) { 182 attr(x, "html_dependencies", TRUE) 183} 184 185#' @rdname htmlDependencies 186#' @export 187`htmlDependencies<-` <- function(x, value) { 188 attr(x, "html_dependencies") <- asDependencies(value) 189 x 190} 191 192#' @rdname htmlDependencies 193#' @export 194attachDependencies <- function(x, value, append = FALSE) { 195 value <- asDependencies(value) 196 197 if (append) { 198 old <- attr(x, "html_dependencies", TRUE) 199 htmlDependencies(x) <- c(old, value) 200 } else { 201 htmlDependencies(x) <- value 202 } 203 204 return(x) 205} 206 207# This will _not_ execute tagFunction(), which is important for attachDependencies() 208asDependencies <- function(x) { 209 if (!length(x)) { 210 return(x) 211 } 212 if (is_dependency_maybe(x)) { 213 return(list(x)) 214 } 215 x <- dropNulls(x) 216 if (all(vapply(x, is_dependency_maybe, logical(1)))) { 217 return(x) 218 } 219 stop("Could not coerce object of class '", class(x), "' into a list of HTML dependencies") 220} 221 222is_dependency_maybe <- function(x) { 223 is_html_dependency(x) || is_tag_function(x) 224} 225 226is_html_dependency <- function(x) { 227 inherits(x, "html_dependency") 228} 229 230is_tag_function <- function(x) { 231 inherits(x, "shiny.tag.function") 232} 233 234 235 236#' Suppress web dependencies 237#' 238#' This suppresses one or more web dependencies. It is meant to be used when a 239#' dependency (like a JavaScript or CSS file) is declared in raw HTML, in an 240#' HTML template. 241#' 242#' @param ... Names of the dependencies to suppress. For example, 243#' `"jquery"` or `"bootstrap"`. 244#' 245#' @seealso [htmlTemplate()] for more information about using HTML 246#' templates. 247#' @seealso [htmltools::htmlDependency()] 248#' @export 249suppressDependencies <- function(...) { 250 lapply(dots_list(...), function(name) { 251 attachDependencies( 252 character(0), 253 htmlDependency(name, "9999", c(href = "")) 254 ) 255 }) 256} 257 258#' @export 259print.html_dependency <- function(x, ...) str(x) 260 261dir_path <- function(dependency) { 262 if ("dir" %in% names(dependency$src)) 263 return(dependency$src[["dir"]]) 264 265 if (length(names(dependency$src)) == 0 || all(!nzchar(dependency$src))) 266 return(dependency$src[[1]]) 267 268 return(NULL) 269} 270 271href_path <- function(dependency) { 272 if ("href" %in% names(dependency$src)) 273 return(dependency$src[["href"]]) 274 else 275 return(NULL) 276} 277 278#' Encode a URL path 279#' 280#' Encode characters in a URL path. This is the same as 281#' [utils::URLencode()] with `reserved = TRUE` except that 282#' `/` is preserved. 283#' 284#' @param x A character vector. 285#' @export 286urlEncodePath <- function(x) { 287 vURLEncode <- Vectorize(URLencode, USE.NAMES = FALSE) 288 gsub("%2[Ff]", "/", vURLEncode(x, TRUE)) 289} 290 291#' Copy an HTML dependency to a directory 292#' 293#' Copies an HTML dependency to a subdirectory of the given directory. The 294#' subdirectory name will be *name*-*version* (for example, 295#' "outputDir/jquery-1.11.0"). You may set `options(htmltools.dir.version = 296#' FALSE)` to suppress the version number in the subdirectory name. 297#' 298#' In order for disk-based dependencies to work with static HTML files, it's 299#' generally necessary to copy them to either the directory of the referencing 300#' HTML file, or to a subdirectory of that directory. This function makes it 301#' easier to perform that copy. 302#' 303#' @param dependency A single HTML dependency object. 304#' @param outputDir The directory in which a subdirectory should be created for 305#' this dependency. 306#' @param mustWork If `TRUE` and `dependency` does not point to a 307#' directory on disk (but rather a URL location), an error is raised. If 308#' `FALSE` then non-disk dependencies are returned without modification. 309#' 310#' @return The dependency with its `src` value updated to the new 311#' location's absolute path. 312#' 313#' @seealso [makeDependencyRelative()] can be used with the returned 314#' value to make the path relative to a specific directory. 315#' 316#' @export 317copyDependencyToDir <- function(dependency, outputDir, mustWork = TRUE) { 318 319 dir <- dependency$src$file 320 321 if (is.null(dir)) { 322 if (mustWork) { 323 stop("Dependency ", dependency$name, " ", dependency$version, 324 " is not disk-based") 325 } else { 326 return(dependency) 327 } 328 } 329 # resolve the relative file path to absolute path in package 330 if (!is.null(dependency$package)) 331 dir <- system.file(dir, package = dependency$package) 332 333 if (length(outputDir) != 1 || outputDir %in% c("", "/")) 334 stop('outputDir must be of length 1 and cannot be "" or "/"') 335 336 if (!dir_exists(outputDir)) 337 dir.create(outputDir) 338 339 target_dir <- if (getOption('htmltools.dir.version', TRUE)) { 340 paste(dependency$name, dependency$version, sep = "-") 341 } else dependency$name 342 target_dir <- file.path(outputDir, target_dir) 343 344 # completely remove the target dir because we don't want possible leftover 345 # files in the target dir, e.g. we may have lib/foo.js last time, and it was 346 # removed from the original library, then the next time we copy the library 347 # over to the target dir, we want to remove this lib/foo.js as well; 348 # unlink(recursive = TRUE) can be dangerous, e.g. we certainly do not want 'rm 349 # -rf /' to happen; in htmlDependency() we have made sure dependency$name and 350 # dependency$version are not "" or "/" or contains no / or \; we have also 351 # made sure outputDir is not "" or "/" above, so target_dir here should be 352 # relatively safe to be removed recursively 353 if (dir_exists(target_dir)) unlink(target_dir, recursive = TRUE) 354 dir.create(target_dir) 355 356 files <- if (dependency$all_files) list.files(dir) else { 357 unlist(dependency[c('script', 'stylesheet', 'attachment')]) 358 } 359 srcfiles <- file.path(dir, files) 360 if (any(!file.exists(srcfiles))) { 361 stop( 362 sprintf( 363 "Can't copy dependency files that don't exist: '%s'", 364 paste(srcfiles, collapse = "', '") 365 ) 366 ) 367 } 368 destfiles <- file.path(target_dir, files) 369 isdir <- file.info(srcfiles)$isdir 370 destfiles <- ifelse(isdir, dirname(destfiles), destfiles) 371 372 mapply(function(from, to, isdir) { 373 if (!dir_exists(dirname(to))) 374 dir.create(dirname(to), recursive = TRUE) 375 if (isdir && !dir_exists(to)) 376 dir.create(to) 377 file.copy(from, to, overwrite = TRUE, recursive = isdir, copy.mode = FALSE) 378 }, srcfiles, destfiles, isdir) 379 380 dependency$src$file <- normalizePath(target_dir, "/", TRUE) 381 382 dependency 383} 384 385dir_exists <- function(paths) { 386 utils::file_test("-d", paths) 387} 388 389# given a directory and a file, return a relative path from the directory to the 390# file, or the unmodified file path if the file does not appear to be in the 391# directory 392relativeTo <- function(dir, file) { 393 # ensure directory ends with a / 394 if (!identical(substr(dir, nchar(dir), nchar(dir)), "/")) { 395 dir <- paste(dir, "/", sep="") 396 } 397 398 # if the file is prefixed with the directory, return a relative path 399 if (identical(substr(file, 1, nchar(dir)), dir)) 400 return(substr(file, nchar(dir) + 1, nchar(file))) 401 else 402 stop("The path ", file, " does not appear to be a descendant of ", dir) 403} 404 405#' Make an absolute dependency relative 406#' 407#' Change a dependency's absolute path to be relative to one of its parent 408#' directories. 409#' 410#' @param dependency A single HTML dependency with an absolute path. 411#' @param basepath The path to the directory that `dependency` should be 412#' made relative to. 413#' @param mustWork If `TRUE` and `dependency` does not point to a 414#' directory on disk (but rather a URL location), an error is raised. If 415#' `FALSE` then non-disk dependencies are returned without modification. 416#' 417#' @return The dependency with its `src` value updated to the new 418#' location's relative path. 419#' 420#' If `baspath` did not appear to be a parent directory of the dependency's 421#' directory, an error is raised (regardless of the value of `mustWork`). 422#' 423#' @seealso [copyDependencyToDir()] 424#' 425#' @export 426makeDependencyRelative <- function(dependency, basepath, mustWork = TRUE) { 427 basepath <- normalizePath(basepath, "/", TRUE) 428 dir <- dependency$src$file 429 if (is.null(dir)) { 430 if (!mustWork) 431 return(dependency) 432 else 433 stop("Could not make dependency ", dependency$name, " ", 434 dependency$version, " relative; it is not file-based") 435 } 436 437 dependency$src <- c(file=relativeTo(basepath, dir)) 438 439 dependency 440} 441 442#' Create HTML for dependencies 443#' 444#' Create the appropriate HTML markup for including dependencies in an HTML 445#' document. 446#' 447#' @param dependencies A list of `htmlDependency` objects. 448#' @param srcType The type of src paths to use; valid values are `file` or 449#' `href`. 450#' @param encodeFunc The function to use to encode the path part of a URL. The 451#' default should generally be used. 452#' @param hrefFilter A function used to transform the final, encoded URLs of 453#' script and stylesheet files. The default should generally be used. 454#' 455#' @return An [HTML()] object suitable for inclusion in the head of an 456#' HTML document. 457#' 458#' @export 459renderDependencies <- function(dependencies, 460 srcType = c("href", "file"), 461 encodeFunc = urlEncodePath, 462 hrefFilter = identity) { 463 464 html <- c() 465 466 for (dep in dependencies) { 467 468 usableType <- srcType[which(srcType %in% names(dep$src))] 469 if (length(usableType) == 0) 470 stop("Dependency ", dep$name, " ", dep$version, 471 " does not have a usable source") 472 473 dir <- dep$src[head(usableType, 1)] 474 475 srcpath <- if (usableType == "file") { 476 encodeFunc(dir) 477 } else { 478 # Assume that href is already URL encoded 479 href_path(dep) 480 } 481 482 # Drop trailing / 483 srcpath <- sub("/$", "\\1", srcpath) 484 485 # add meta content 486 if (length(dep$meta) > 0) { 487 html <- c(html, paste( 488 "<meta name=\"", htmlEscape(names(dep$meta)), "\" content=\"", 489 htmlEscape(dep$meta), "\" />", 490 sep = "" 491 )) 492 } 493 494 # add stylesheets 495 if (length(dep$stylesheet) > 0) { 496 html <- c(html, paste( 497 "<link href=\"", 498 htmlEscape(hrefFilter(file.path(srcpath, encodeFunc(dep$stylesheet)))), 499 "\" rel=\"stylesheet\" />", 500 sep = "" 501 )) 502 } 503 504 # add scripts 505 if (length(dep$script) > 0) { 506 html <- c(html, renderScript(dep$script, srcpath, encodeFunc, hrefFilter)) 507 } 508 509 if (length(dep$attachment) > 0) { 510 if (is.null(names(dep$attachment))) 511 names(dep$attachment) <- as.character(1:length(dep$attachment)) 512 html <- c(html, 513 sprintf("<link id=\"%s-%s-attachment\" rel=\"attachment\" href=\"%s\"/>", 514 htmlEscape(dep$name), 515 htmlEscape(names(dep$attachment)), 516 htmlEscape(hrefFilter(file.path(srcpath, encodeFunc(dep$attachment)))) 517 ) 518 ) 519 } 520 521 # add raw head content 522 html <- c(html, dep$head) 523 } 524 525 HTML(paste(html, collapse = "\n")) 526} 527 528 529 530renderScript <- function(script, srcpath, encodeFunc, hrefFilter) { 531 # If the input is a named list, transform it to an unnamed list 532 # whose only element is the input list 533 if (anyNamed(script)) { 534 if (anyUnnamed(script)) stop("script inputs cannot mix named and unnamed") 535 script <- list(script) 536 } 537 538 # For each element, if it's a scalar string, transform it to a named 539 # list with one element, "src". 540 script <- lapply(script, function(item) { 541 if (length(item) == 1 && is.character(item)) { 542 item = list(src = item) 543 } 544 545 if (length(names(item)) == 0) { 546 stop( 547 "Elements of script must be named lists, or scalar strings ", 548 "I got ", deparse(item) 549 ) 550 } 551 552 return(item) 553 }) 554 555 script <- vapply( 556 script, function(x) { 557 x$src <- hrefFilter(file.path(srcpath, encodeFunc(x$src))) 558 paste0( 559 "<script", 560 paste0( 561 " ", 562 htmlEscape(names(x)), 563 ifelse(is.na(x), "", paste0('="', htmlEscape(x), '"')), 564 collapse = '' 565 ), 566 "></script>", 567 collapse = "" 568 ) 569 }, 570 FUN.VALUE = character(1) 571 ) 572 573 return(script) 574} 575 576 577# html_dependencies_as_character(list( 578# htmlDependency("foo", "1.0", 579# c(href="http://foo.com/bar%20baz/"), 580# stylesheet="x y z.css" 581# ) 582# )) 583# <link href=\"http://foo.com/bar%20baz/x%20y%20z.css\" rel=\"stylesheet\" /> 584 585# html_dependencies_as_character(list( 586# htmlDependency("foo", "1.0", 587# c(href="http://foo.com/bar%20baz"), 588# stylesheet="x y z.css" 589# ) 590# )) 591# <link href=\"http://foo.com/bar%20baz/x%20y%20z.css\" rel=\"stylesheet\" /> 592 593# html_dependencies_as_character(list( 594# htmlDependency("foo", "1.0", 595# "foo bar/baz", 596# stylesheet="x y z.css" 597# ) 598# )) 599# <link href=\"foo%20bar/baz/x%20y%20z.css\" rel=\"stylesheet\" /> 600 601# html_dependencies_as_character(list( 602# htmlDependency("foo", "1.0", 603# "foo bar/baz/", 604# stylesheet="x y z.css" 605# ) 606# )) 607# <link href=\"foo%20bar/baz/x%20y%20z.css\" rel=\"stylesheet\" /> 608