# File src/library/tools/R/Rd2HTML.R # # Copyright (C) 1995-2016 The R Core Team # Part of the R package, https://www.R-project.org # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # https://www.R-project.org/Licenses/ ## also used by Rd2latex, but only 'topic' and 'dest' get_link <- function(arg, tag, Rdfile) { ## 'topic' is the name to display, 'dest' is the topic to link to ## optionaly in package 'pkg'. If 'target' is set it is the file ## to link to in HTML help ## \link[=bar]{foo} means shows foo but treat this as a link to bar. ## \link[pkg]{bar} means show bar and link to *file* bar in package pkg ## \link{pkg:bar]{foo} means show foo and link to file bar in package pkg. ## As from 2.10.0, look for topic 'bar' if file not found. if (!all(RdTags(arg) == "TEXT")) stopRd(arg, Rdfile, "Bad \\link text") option <- attr(arg, "Rd_option") topic <- dest <- paste(unlist(arg), collapse = "") targetfile <- NULL pkg <- NULL if (!is.null(option)) { if (!identical(attr(option, "Rd_tag"), "TEXT")) stopRd(option, Rdfile, "Bad \\link option -- must be text") if (grepl("^=", option, perl = TRUE, useBytes = TRUE)) dest <- psub1("^=", "", option) else if (grepl(":", option, perl = TRUE, useBytes = TRUE)) { targetfile <- psub1("^[^:]*:", "", option) pkg <- psub1(":.*", "", option) } else { targetfile <- dest pkg <- as.character(option) } } if (tag == "\\linkS4class") dest <- paste0(dest, "-class") list(topic = topic, dest = dest, pkg = pkg, targetfile = targetfile) } ## translation of Utils.pm function of the same name, plus "unknown" mime_canonical_encoding <- function(encoding) { encoding[encoding %in% c("", "unknown")] <- utils::localeToCharset()[1L] encoding <- tolower(encoding) encoding <- sub("iso_8859-([0-9]+)", "iso-8859-\\1", encoding) encoding <- sub("iso8859-([0-9]+)", "iso-8859-\\1", encoding) encoding[encoding == "latin1"] <- "iso-8859-1" encoding[encoding == "latin2"] <- "iso-8859-2" encoding[encoding == "latin3"] <- "iso-8859-3" encoding[encoding == "latin4"] <- "iso-8859-4" encoding[encoding == "cyrillic"] <-"iso-8859-5" encoding[encoding == "arabic"] <- "iso-8859-6" encoding[encoding == "greek"] <- "iso-8859-7" encoding[encoding == "hebrew"] <- "iso-8859-8" encoding[encoding == "latin5"] <- "iso-8859-9" encoding[encoding == "latin6"] <- "iso-8859-10" encoding[encoding == "latin8"] <- "iso-8859-14" encoding[encoding == "latin-9"] <- "iso-8859-15" encoding[encoding == "latin10"] <- "iso-8859-16" encoding[encoding == "utf8"] <- "utf-8" encoding[encoding == "ascii"] <- "us-ascii" # from W3C validator encoding } htmlify <- function(x) { x <- fsub("&", "&", x) x <- fsub("---", "—", x) x <- fsub("--", "–", x) x <- fsub("``", "“", x) x <- fsub("''", "”", x) x <- psub("`([^']+)'", "‘\\1’", x) x <- fsub("`", "'", x) x <- fsub("<", "<", x) x <- fsub(">", ">", x) x <- fsub('"\\{"', '"{"', x) x <- fsub('"', '"', x) x } vhtmlify <- function(x, inEqn = FALSE) { # code version x <- fsub("&", "&", x) x <- fsub("<", "<", x) x <- fsub(">", ">", x) x <- fsub('"\\{"', '"{"', x) ## http://htmlhelp.com/reference/html40/entities/symbols.html if(inEqn) { x <- psub("\\\\(Alpha|Beta|Gamma|Delta|Epsilon|Zeta|Eta|Theta|Iota|Kappa|Lambda|Mu|Nu|Xi|Omicron|Pi|Rho|Sigma|Tau|Upsilon|Phi|Chi|Psi|Omega|alpha|beta|gamma|delta|epsilon|zeta|eta|theta|iota|kappa|lambda|mu|nu|xi|omicron|pi|rho|sigma|tau|upsilon|phi|chi|psi|omega|le|ge|sum|prod)", "&\\1;", x) x <- psub("\\\\(dots|ldots)", "&\\hellip;", x) x <- fsub("\\infty", "∞", x) x <- fsub("\\sqrt", "√", x) } x } shtmlify <- function(s) { s <- gsub("&", "&", s, fixed = TRUE) s <- gsub("<", "<", s, fixed = TRUE) s <- gsub(">", ">", s, fixed = TRUE) s } ## URL encode anything other than alphanumeric, . - _ $ and reserved ## characters in URLs. urlify <- function(x) { ## Like utils::URLencode(reserved = FALSE), but with '&' replaced by ## '&' and hence directly usable for href attributes. ## See ## ## ## RFC 3986 ## We do not want to mess with already-encoded URLs if(grepl("%[[:xdigit:]]{2}", x, useBytes = TRUE)) { gsub("&", "&", x, fixed = TRUE) } else { chars <- unlist(strsplit(x, "")) hex <- vapply(chars, function(x) paste0("%", toupper(as.character(charToRaw(x))), collapse = ""), "") todo <- paste0("[^", "][!$&'()*+,;=:/?@ #", "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz0123456789._~-", "]") mixed <- ifelse(grepl(todo, chars), hex, chars) gsub("&", "&", paste(mixed, collapse = ""), fixed = TRUE) } } ## (Equivalently, could use escapeAmpersand(utils::URLencode(x)).) ## Ampersands should be escaped in proper HTML URIs escapeAmpersand <- function(x) gsub("&", "&", x, fixed = TRUE) invalid_HTML_chars_re <- "[\u0001-\u0008\u000b\u000c\u000e-\u001f\u007f-\u009f]" ## This gets used two ways: ## 1) With dynamic = TRUE from tools:::httpd() ## Here generated links are of the forms ## ../../pkg/help/topic ## file.html ## ../../pkg/html/file.html ## and links are never missing: topics are always linked as ## ../../pkg/help/topic for the current packages, and this means ## 'search this package then all the others, and show all matches ## if we need to go outside this packages' ## 2) With dynamic = FALSE from .convertRdfiles (with Links[2], used for ## prebuilt HTML pages) and .Rdconv (no link lookup) ## Here generated links are of the forms ## file.html ## ../../pkg/html/file.html ## and missing links (those without an explicit package, and ## those topics not in Links[2]) don't get linked anywhere. Rd2HTML <- function(Rd, out = "", package = "", defines = .Platform$OS.type, Links = NULL, Links2 = NULL, stages = "render", outputEncoding = "UTF-8", dynamic = FALSE, no_links = FALSE, fragment=FALSE, stylesheet = "R.css", ...) { if (missing(no_links) && is.null(Links) && !dynamic) no_links <- TRUE version <- "" if(!identical(package, "")) { if(length(package) > 1L) { version <- package[2L] package <- package[1L] } else { dir <- dirname(package) if(nzchar(dir) && file_test("-f", dfile <- file.path(package, "DESCRIPTION"))) { version <- .read_description(dfile)["Version"] package <- basename(package) } else { ## Should we really do this? ## Used when Rdconv is given a package argument. version <- utils::packageDescription(package, fields = "Version") } } if(is.na(version)) version <- "" } ## writeLines by default re-encodes strings to the local encoding. ## Avoid that by useBytes=TRUE writeLinesUTF8 <- if (outputEncoding == "UTF-8" || (outputEncoding == "" && l10n_info()[["UTF-8"]])) { function(x, con, outputEncoding, ...) writeLines(x, con, useBytes = TRUE, ...) } else { function(x, con, outputEncoding, ...) { x <- iconv(x, "UTF-8", outputEncoding, sub="byte", mark=FALSE) writeLines(x, con, useBytes = TRUE, ...) } } of0 <- function(...) writeLinesUTF8(paste0(...), con, outputEncoding, sep = "") of1 <- function(text) writeLinesUTF8(text, con, outputEncoding, sep = "") pendingClose <- pendingOpen <- character() # Used for infix methods inEqn <- FALSE # Should we do edits needed in an eqn? sectionLevel <- 0L # How deeply nested within section/subsection inPara <- FALSE # Are we in a

paragraph? If NA, we're not, but we're not allowed to be inAsIs <- FALSE # Should we show characters "as is"? ### These correspond to HTML wrappers HTMLTags <- c("\\bold"="b", "\\cite"="cite", "\\code"="code", "\\command"="code", "\\dfn"="dfn", "\\emph"="em", "\\kbd"="kbd", "\\preformatted"="pre", # "\\special"="pre", "\\strong"="strong", "\\var"="var") # These have simple substitutions HTMLEscapes <- c("\\R"='R', "\\cr"="
", "\\dots"="...", "\\ldots"="...") ## These correspond to idiosyncratic wrappers HTMLLeft <- c("\\acronym"='', "\\donttest"="", "\\env"='', "\\file"='‘', "\\option"='', "\\pkg"='', "\\samp"='', "\\sQuote"="‘", "\\dQuote"="“", "\\verb"='') HTMLRight <- c("\\acronym"='', "\\donttest"="", "\\env"="", "\\file"='’', "\\option"="", "\\pkg"="", "\\samp"="", "\\sQuote"="’", "\\dQuote"="”", "\\verb"="") addParaBreaks <- function(x) { if (isBlankLineRd(x) && isTRUE(inPara)) { inPara <<- FALSE return("

\n") } start <- attr(x, "srcref")[2L] # FIXME: what if no srcref?, start col if (start == 1) x <- psub("^\\s+", "", x) if (isTRUE(!inPara) && !all(grepl("^[[:blank:]\n]*$", x, perl = TRUE))) { x <- c("

", x) inPara <<- TRUE } x } enterPara <- function(enter = TRUE) { if (enter && isTRUE(!inPara)) { of0("

") inPara <<- TRUE } } leavePara <- function(newval) { if (isTRUE(inPara)) of0("

\n") inPara <<- newval } writeWrapped <- function(tag, block, doParas) { if (!doParas || HTMLTags[tag] == "pre") leavePara(NA) else enterPara() saveAsIs <- inAsIs asis <- !is.na(match(tag, "\\command")) if(asis) inAsIs <<- TRUE if (!isBlankRd(block)) { of0("<", HTMLTags[tag], ">") writeContent(block, tag) of0("") } if(HTMLTags[tag] == "pre") inPara <<- FALSE if(asis) inAsIs <<- saveAsIs } writeLink <- function(tag, block, doParas) { parts <- get_link(block, tag, Rdfile) writeHref <- function() { enterPara(doParas) savePara <- inPara inPara <<- NA if (!no_links) of0('') writeContent(block, tag) if (!no_links) of1('') inPara <<- savePara } if (is.null(parts$targetfile)) { ## ---------------- \link{topic} and \link[=topic]{foo} topic <- parts$dest if (dynamic) { # never called with package="" htmlfile <- paste0("../../", urlify(package), "/help/", urlify(topic)) writeHref() return() } else { htmlfile <- NA_character_ if (!is.null(Links)) { tmp <- Links[topic] if (!is.na(tmp)) htmlfile <- tmp else { tmp <- Links2[topic] if (!is.na(tmp)) htmlfile <- tmp } } } if (is.na(htmlfile)) { ## Used to use the search engine, but we no longer have one, ## and we don't get here for dynamic help. if (!no_links) warnRd(block, Rdfile, "missing link ", sQuote(topic)) writeContent(block, tag) } else { ## treat links in the same package specially -- was needed for CHM pkg_regexp <- paste0("^../../", urlify(package), "/html/") if (grepl(pkg_regexp, htmlfile)) { htmlfile <- sub(pkg_regexp, "", htmlfile) } writeHref() } } else { ## ----------------- \link[pkg]{file} and \link[pkg:file]{bar} htmlfile <- paste0(urlify(parts$targetfile), ".html") if (!dynamic && !no_links && nzchar(pkgpath <- system.file(package = parts$pkg))) { ## check the link, only if the package is found OK <- FALSE if (!file.exists(file.path(pkgpath, "html", htmlfile))) { ## does not exist as static HTML, so look harder f <- file.path(pkgpath, "help", "paths.rds") if (file.exists(f)) { paths <- sub("\\.[Rr]d$", "", basename(readRDS(f))) OK <- parts$targetfile %in% paths } } else OK <- TRUE if (!OK) { ## so how about as a topic? file <- utils:::index.search(parts$targetfile, pkgpath) if (!length(file)) { warnRd(block, Rdfile, "file link ", sQuote(parts$targetfile), " in package ", sQuote(parts$pkg), " does not exist and so has been treated as a topic") parts$targetfile <- basename(file) } else { warnRd(block, Rdfile, "missing file link ", sQuote(parts$targetfile)) } } } if (parts$pkg == package) { ## use href = "file.html" writeHref() } else { ## href = "../../pkg/html/file.html" htmlfile <- paste0("../../", urlify(parts$pkg), "/html/", htmlfile) writeHref() } } } writeLR <- function(block, tag, doParas) { enterPara(doParas) of1(HTMLLeft[tag]) writeContent(block, tag) of1(HTMLRight[tag]) } writeDR <- function(block, tag) { if (length(block) > 1L) { of1('## Not run: ') writeContent(block, tag) of1('\n## End(Not run)') } else { of1('## Not run: ') writeContent(block, tag) } } writeBlock <- function(block, tag, blocktag) { doParas <- !(blocktag %in% c("\\tabular")) switch(tag, UNKNOWN =, VERB = of1(vhtmlify(block, inEqn)), RCODE = of1(vhtmlify(block)), TEXT = of1(if(doParas && !inAsIs) addParaBreaks(htmlify(block)) else vhtmlify(block)), USERMACRO =, "\\newcommand" =, "\\renewcommand" =, COMMENT = {}, LIST = writeContent(block, tag), "\\describe"=, "\\enumerate"=, "\\itemize" = { leavePara(FALSE) writeContent(block, tag) }, "\\bold" =, "\\cite" =, "\\code" =, "\\command" =, "\\dfn" =, "\\emph" =, "\\kbd" =, "\\preformatted" =, "\\strong" =, "\\var" = writeWrapped(tag, block, doParas), "\\special" = writeContent(block, tag), ## FIXME, verbatim? "\\linkS4class" =, "\\link" = writeLink(tag, block, doParas), ## cwhmisc has an empty \\email "\\email" = if (length(block)) { url <- paste(as.character(block), collapse="") url <- gsub("\n", "", url) enterPara(doParas) of0('', htmlify(url), '')}, ## watch out for empty URLs (TeachingDemos had one) "\\url" = if(length(block)) { url <- paste(as.character(block), collapse = "") url <- trimws(gsub("\n", "", url, fixed = TRUE, useBytes = TRUE)) enterPara(doParas) of0('', htmlify(url), '') }, "\\href" = { if(length(block[[1L]])) { url <- paste(as.character(block[[1L]]), collapse = "") url <- trimws(gsub("\n", "", url, fixed = TRUE, useBytes = TRUE)) enterPara(doParas) of0('') closing <- "" } else closing <- "" savePara <- inPara inPara <<- NA writeContent(block[[2L]], tag) of0(closing) inPara <<- savePara }, "\\Sexpr"= of0(as.character.Rd(block, deparse=TRUE)), "\\cr" =, "\\dots" =, "\\ldots" =, "\\R" = { enterPara(doParas) of1(HTMLEscapes[tag]) }, "\\acronym" =, "\\donttest" =, "\\env" =, "\\file" =, "\\option" =, "\\pkg" =, "\\samp" =, "\\sQuote" =, "\\dQuote" =, "\\verb" = writeLR(block, tag, doParas), "\\dontrun"= writeDR(block, tag), "\\enc" = writeContent(block[[1L]], tag), "\\eqn" = { enterPara(doParas) inEqn <<- TRUE of1("") block <- block[[length(block)]]; ## FIXME: space stripping needed: see Special.html writeContent(block, tag) of1("") inEqn <<- FALSE }, "\\deqn" = { inEqn <<- TRUE leavePara(TRUE) of1('

') block <- block[[length(block)]]; writeContent(block, tag) of0('') leavePara(FALSE) inEqn <<- FALSE }, "\\figure" = { enterPara(doParas) ## This is what is needed for static html pages if(dynamic) of1(' 1L && length(imgoptions <- .Rd_get_latex(block[[2]])) && startsWith(imgoptions, "options: ")) { # There may be escaped percent signs within imgoptions <- gsub("\\%", "%", imgoptions, fixed=TRUE) of1(sub("^options: ", "", imgoptions)) } else { of1('alt="') writeContent(block[[length(block)]], tag) of1('"') } of1(' />') }, "\\dontshow" =, "\\testonly" = {}, # do nothing "\\method" =, "\\S3method" =, "\\S4method" = { # Should not get here }, "\\tabular" = writeTabular(block), "\\subsection" = writeSection(block, tag), "\\if" =, "\\ifelse" = if (testRdConditional("html", block, Rdfile)) writeContent(block[[2L]], tag) else if (tag == "\\ifelse") writeContent(block[[3L]], tag), "\\out" = for (i in seq_along(block)) of1(block[[i]]), stopRd(block, Rdfile, "Tag ", tag, " not recognized") ) } writeTabular <- function(table) { format <- table[[1L]] content <- table[[2L]] if (length(format) != 1 || RdTags(format) != "TEXT") stopRd(table, Rdfile, "\\tabular format must be simple text") format <- strsplit(format[[1L]], "", fixed = TRUE)[[1L]] if (!all(format %in% c("l", "c", "r"))) stopRd(table, Rdfile, "Unrecognized \\tabular format: ", table[[1L]][[1L]]) format <- c(l="left", c="center", r="right")[format] tags <- RdTags(content) leavePara(NA) of1('\n\n') newrow <- TRUE newcol <- TRUE for (i in seq_along(tags)) { if (newrow) { of1("\n ") newrow <- FALSE col <- 0 } if (newcol) { col <- col + 1L if (col > length(format)) stopRd(table, Rdfile, "Only ", length(format), " columns allowed in this table") of0('') newcol <- TRUE }, "\\cr" = { if (!newcol) of1('') of1('\n\n') newrow <- TRUE newcol <- TRUE }, writeBlock(content[[i]], tags[i], "\\tabular")) } if (!newcol) of1('') if (!newrow) of1('\n\n') of1('\n
') newcol <- FALSE } switch(tags[i], "\\tab" = { of1('
\n') inPara <<- FALSE } writeContent <- function(blocks, blocktag) { inlist <- FALSE itemskip <- FALSE tags <- RdTags(blocks) i <- 0 while (i < length(tags)) { i <- i + 1 tag <- tags[i] block <- blocks[[i]] if (length(pendingOpen)) { # Handle $, [ or [[ methods if (tag == "RCODE" && startsWith(block, "(")) { block <- sub("^\\(", "", block) arg1 <- sub("[,)[:space:]].*", "", block) block <- sub(paste0(arg1, "[[:space:]]*,[[:space:]]*"), "", block) of0(arg1, pendingOpen) if (pendingOpen == "$") pendingClose <<- "" else pendingClose <<- chartr("[", "]", pendingOpen) } else of0("`", pendingOpen, "`") pendingOpen <<- character() } if (length(pendingClose) && tag == "RCODE" && grepl("\\)", block)) { # Finish it off... of0(sub("\\).*", "", block), pendingClose) block <- sub("[^)]*\\)", "", block) pendingClose <<- character() } switch(tag, "\\method" =, "\\S3method" =, "\\S4method" = { blocks <- transformMethod(i, blocks, Rdfile) tags <- RdTags(blocks) i <- i - 1 }, "\\item" = { leavePara(FALSE) if (!inlist) { switch(blocktag, "\\value" = of1('\n'), "\\arguments" = of1('
\n'), "\\itemize" = of1("
    \n"), "\\enumerate" = of1("
      \n"), "\\describe" = of1("
      \n")) inlist <- TRUE } else { if (blocktag %in% c("\\itemize", "\\enumerate")) { of1("\n") ## We have \item ..., so need to skip the space. itemskip <- TRUE } } switch(blocktag, "\\value"=, "\\arguments"={ of1('
\n') }, "\\describe"= { of1("
") inPara <<- NA writeContent(block[[1L]], tag) of1("
") inPara <<- FALSE writeContent(block[[2L]], tag) leavePara(FALSE) of1("
") }, "\\enumerate" =, "\\itemize"= { inPara <<- FALSE of1("
  • ") }) }, { # default if (inlist && !(blocktag %in% c("\\itemize", "\\enumerate")) && !(tag == "TEXT" && isBlankRd(block))) { switch(blocktag, "\\arguments" =, "\\value" = of1("
    • ') inPara <<- NA writeContent(block[[1L]], tag) of1('\n') inPara <<- FALSE writeContent(block[[2L]], tag) leavePara(FALSE) of1('
    \n"), "\\describe" = of1("\n")) inlist <- FALSE inPara <<- FALSE } if (itemskip) { ## The next item must be TEXT, and start with a space. itemskip <- FALSE if (tag == "TEXT") { txt <- addParaBreaks(htmlify(block)) of1(txt) } else writeBlock(block, tag, blocktag) # should not happen } else writeBlock(block, tag, blocktag) }) } if (inlist) { leavePara(FALSE) switch(blocktag, "\\value"=, "\\arguments" = of1("\n"), "\\itemize" = of1("\n"), "\\enumerate" = of1("\n"), # "\\value"=, "\\describe" = of1("\n")) } } writeSection <- function(section, tag) { if (tag %in% c("\\alias", "\\concept", "\\encoding", "\\keyword")) return() ## \alias only used on CHM header leavePara(NA) save <- sectionLevel sectionLevel <<- sectionLevel + 1L of1(paste0("\n\n")) if (tag == "\\section" || tag == "\\subsection") { title <- section[[1L]] section <- section[[2L]] ## FIXME: this needs trimming of whitespace writeContent(title, tag) } else of1(sectionTitles[tag]) of1(paste0("\n\n")) if (tag %in% c("\\examples", "\\usage")) { of1("

    ")
            inPara <<- NA
            pre <- TRUE
        } else {
            inPara <<- FALSE
            pre <- FALSE
        }
    	if (length(section)) {
	    ## There may be an initial \n, so remove that
	    s1 <- section[[1L]][1L]
	    if (RdTags(section)[1] == "TEXT" && s1 == "\n") section <- section[-1L]
	    writeContent(section, tag)
	}
	leavePara(FALSE)
	if (pre) of0("
    \n") sectionLevel <<- save } if (is.character(out)) { if (out == "") { con <- stdout() } else { con <- file(out, "wt") on.exit(close(con)) } } else { con <- out out <- summary(con)$description } Rd <- prepare_Rd(Rd, defines = defines, stages = stages, fragment = fragment, ...) Rdfile <- attr(Rd, "Rdfile") sections <- RdTags(Rd) if (fragment) { if (sections[1L] %in% names(sectionOrder)) for (i in seq_along(sections)) writeSection(Rd[[i]], sections[i]) else for (i in seq_along(sections)) writeBlock(Rd[[i]], sections[i], "") } else { name <- htmlify(Rd[[2L]][[1L]]) of0('', '', '') headtitle <- strwrap(.Rd_format_title(.Rd_get_title(Rd)), width=65, initial="R: ") if (length(headtitle) > 1) headtitle <- paste0(headtitle[1], "...") of1(htmlify(headtitle)) of0('\n', '\n') of0('\n', '\n\n', '
    ',name,' {', package,'}') else of0('">
    ',name) of0('R Documentation
    \n\n') of1("

    ") inPara <- NA title <- Rd[[1L]] writeContent(title,sections[1]) of1("

    ") inPara <- FALSE for (i in seq_along(sections)[-(1:2)]) writeSection(Rd[[i]], sections[i]) if(nzchar(version)) version <- paste0('Package ',package,' version ',version,' ') of0('\n') if(nzchar(version)) of0('
    [', version, if (!no_links) 'Index', ']
    ') of0('\n', '\n') } invisible(out) } findHTMLlinks <- function(pkgDir = "", lib.loc = NULL, level = 0:2) { ## The priority order is ## This package (level 0) ## The standard packages (level 1) ## along lib.loc (level 2) if (is.null(lib.loc)) lib.loc <- .libPaths() Links <- list() if (2 %in% level) Links <- c(Links, lapply(rev(lib.loc), .find_HTML_links_in_library)) if (1 %in% level) { base <- unlist(.get_standard_package_names()[c("base", "recommended")], use.names = FALSE) Links <- c(Links, lapply(file.path(.Library, base), .find_HTML_links_in_package)) } if (0 %in% level && nzchar(pkgDir)) Links <- c(Links, list(.find_HTML_links_in_package(pkgDir))) Links <- unlist(Links) ## now latest names are newest, so Links <- rev(Links) Links <- Links[!duplicated(names(Links))] gsub("[Rr]d$", "html", Links) } .find_HTML_links_in_package <- function(dir) { if (file_test("-f", f <- file.path(dir, "Meta", "links.rds"))) readRDS(f) else if (file_test("-f", f <- file.path(dir, "Meta", "Rd.rds"))) .build_links_index(readRDS(f), basename(dir)) else character() } .find_HTML_links_in_library <- function(dir) { if (file_test("-f", f <- file.path(dir, ".Meta", "links.rds"))) readRDS(f) else .build_library_links_index(dir) } .build_library_links_index <- function(dir) { unlist(lapply(rev(dir(dir, full.names = TRUE)), .find_HTML_links_in_package)) }