1 + 2
3 + 4
No hightlight" ) downlit_html_node(html) expect_snapshot_output(show_xml(html)) }) test_that("special package string gets linked", { skip_if_not_installed("xml2") html <- xml2::read_xml("
before {downlit} after
before {notapkg} after
base::t(1)
> cat(downlit_md_string(brio::read_lines(test_path("markdown-table.md"))))
Table: Caption [`base::t`](https://rdrr.io/r/base/t.html)
| [`base::t`](https://rdrr.io/r/base/t.html) | xx |
|-------------------------------------------:|:----|
| [`base::t`](https://rdrr.io/r/base/t.html) | yy |
downlit/tests/testthat/test-metadata.R 0000644 0001762 0000144 00000002660 14447367567 017647 0 ustar ligges users test_that("can extract urls for package", {
# since the package urls might potentially change
skip_on_cran()
expect_equal(package_urls("base"), character())
expect_equal(package_urls("packagethatdoesn'texist"), character())
expect_equal(package_urls(""), character())
expect_equal(package_urls("MASS"), "http://www.stats.ox.ac.uk/pub/MASS4/")
})
test_that("can extract urls for uninstalled packages from CRAN", {
# Pretend that rlang isn't installed
local_mocked_bindings(is_installed = function(...) FALSE)
rlang_urls <- c("https://rlang.r-lib.org", "https://github.com/r-lib/rlang")
expect_equal(package_urls("rlang"), rlang_urls)
# Always adds CRAN
expect_equal(package_urls("rlang", repos = c()), rlang_urls)
# But prefers user specified repo
fake_repo <- paste0("file:", test_path("fake-repo"))
expect_equal(package_urls("rlang", repos = fake_repo), "https://trick-url.com/")
# even if CRAN comes first
cran_repo <- "https://cran.rstudio.com"
expect_equal(
package_urls("rlang", repos = c(CRAN = cran_repo, fake_repo)),
"https://trick-url.com/"
)
})
test_that("handle common url formats", {
ab <- c("https://a.com", "https://b.com")
expect_equal(parse_urls("https://a.com,https://b.com"), ab)
expect_equal(parse_urls("https://a.com, https://b.com"), ab)
expect_equal(parse_urls("https://a.com https://b.com"), ab)
expect_equal(parse_urls("https://a.com (comment) https://b.com"), ab)
})
downlit/tests/testthat/autolink.html 0000644 0001762 0000144 00000000540 14122441320 017440 0 ustar ligges users
# This is a comment stats::median()
stats::median()
stats::median()stats::median()
stats::median()
# This is a comment
stats::median()
stats::median()stats::median()
stats::median()
---
Code
f3 <- (function() {
plot(1)
plot(2)
})
test_evaluate("f3()")
Output
f3()
# handles other plots
f3()
f4()
# ansi escapes are translated to html
Code
blue <- (function(x) paste0("\033[34m", x, "\033[39m"))
f <- (function(x) {
cat("Output: ", blue("blue"), "\n", sep = "")
message(paste0("Message: ", blue("blue")))
warning(blue("blue"), call. = FALSE)
stop(blue("blue"), call. = FALSE)
})
test_evaluate("f()\n")
Output
f()
#> Output: blue
#> Message: blue
#> Warning: blue
#> Error: blue
downlit/tests/testthat/_snaps/highlight.md 0000644 0001762 0000144 00000002563 14625414262 020524 0 ustar ligges users # custom infix operators are linked, but regular are not
x %in% y
---
x + y
# syntax can span multiple lines
Code
cat(highlight("f(\n\n)"))
Output
f(
)
---
Code
cat(highlight("'\n\n'"))
Output
'
'
# ansi escapes are converted to html
[1] "# hello"
---
[1] "# hello"
# placeholder in R pipe gets highlighted and not linked
Code
highlight("1:10 |> mean(x = _)", classes = classes_pandoc())
Output
[1] "1:10 |> mean(x = _)"
downlit/tests/testthat/_snaps/downlit-html.md 0000644 0001762 0000144 00000001221 14625414257 021171 0 ustar ligges users # highlight all pre inside div.downlit
1 + 2
3 + 4
No hightlight# special package string gets linked
before downlit after
---before {notapkg} after
base::t(1)
> cat(downlit_md_string(brio::read_lines(test_path("markdown-table.md"))))
Table: Caption [`base::t`](https://rdrr.io/r/base/t.html)
| [`base::t`](https://rdrr.io/r/base/t.html) | xx |
| -----------------------------------------: | :- |
| [`base::t`](https://rdrr.io/r/base/t.html) | yy |
downlit/tests/testthat/test-downlit-md.R 0000644 0001762 0000144 00000004004 14630623777 020127 0 ustar ligges users # Sys.setenv("RSTUDIO_PANDOC" = "")
# rmarkdown::find_pandoc(cache = FALSE)
test_that("common across multiple versions", {
skip_if_not_installed("rmarkdown")
skip_if_not(rmarkdown::pandoc_version() > "2.0.0")
verify_output(test_path("test-downlit-md.txt"), {
"Bare code"
cat(downlit_md_string("`base::t`"))
"No transforms"
cat(downlit_md_string("## `base::t`"))
cat(downlit_md_string("[`base::t`](http://google.com)"))
"Nested"
cat(downlit_md_string("*`base::t`*"))
cat(downlit_md_string("`base::t`"))
cat(downlit_md_string("1. `base::t`"))
"Markdown extensions not in GFM"
cat(downlit_md_string("| `base::t`", format = "markdown"))
md <- brio::read_lines(test_path("markdown-definition.md"))
cat(downlit_md_string(md, "markdown"))
})
})
test_that("pandoc AST v1.20", {
skip_if_not_installed("rmarkdown")
skip_if_not(rmarkdown::pandoc_version() > "2.0.0")
skip_if_not(rmarkdown::pandoc_version() < "2.10")
verify_output(test_path("test-downlit-md-v20.txt"), {
cat(downlit_md_string("* `base::t`"))
cat(downlit_md_string("```\nbase::t(1)\n```"))
cat(downlit_md_string(brio::read_lines(test_path("markdown-table.md"))))
})
})
test_that("pandoc AST v1.21", {
skip_if_not_installed("rmarkdown")
skip_if_not(rmarkdown::pandoc_version() >= "2.10")
skip_if_not(rmarkdown::pandoc_version() < "2.11")
verify_output(test_path("test-downlit-md-v21.txt"), {
cat(downlit_md_string("* `base::t`"))
cat(downlit_md_string("```\nbase::t(1)\n```"))
cat(downlit_md_string(brio::read_lines(test_path("markdown-table.md"))))
})
})
test_that("Special package string gets linked", {
# needed for eof setting on windows
skip_if_not_installed("rmarkdown")
skip_if_not(rmarkdown::pandoc_version() > "2.0.0")
expect_equal(
downlit_md_string("`{downlit}`"),
"[downlit](https://downlit.r-lib.org/)\n"
)
expect_equal(
downlit_md_string("`{thisisrealltnotapackagename}`"),
"`{thisisrealltnotapackagename}`\n"
)
})
downlit/tests/testthat.R 0000644 0001762 0000144 00000000072 13663736745 015102 0 ustar ligges users library(testthat)
library(downlit)
test_check("downlit")
downlit/MD5 0000644 0001762 0000144 00000007024 14631541352 012251 0 ustar ligges users ccd6e981a9deb62a005550d359d73bb5 *DESCRIPTION
fe14fc721eb4432259e3710581db6050 *LICENSE
5f93eb2a34eccb91bb5379c84dba1935 *NAMESPACE
62abd160dd5a4dd45b41b042386b8581 *NEWS.md
da7b2ae5c8bbe42fa41d6a0dc8c12628 *R/article-index.R
3eaad0707043123b20c37144c378b943 *R/downlit-html.R
ed06d7a2ece79072f81aa27d99ce8c20 *R/downlit-md.R
3d9b3aee602ef40039102704bf6943d6 *R/downlit-package.R
1222eb77e1a14a705266a604c35f182e *R/evaluate.R
f56891d9088454f0896a0f29b5a30883 *R/highlight.R
862af0012e5f333a6545f4fdb5f8d75f *R/link.R
ea2e8dd1b7c0f078d77e31adfc73e97b *R/metadata.R
8c6310047b0d8d3a2fc87fe771abdcbb *R/packages.R
2797b5e117659cbf98c03cc126c091c7 *R/rd.R
e9e788b6c703d7c5dc19d855d3898a4f *R/test-helpers.R
6e459cd330c4500728ef240cbb0fa3c9 *R/topic-index.R
2211b009ec6c370c06347e793dfbb074 *R/utils.R
54260ad0b69c0d945b654f03124f520b *R/zzz.R
a859213845b1bd2fe5103c6c94bc6a8e *README.md
2f5ded4720a7ee335439f52c56978e56 *inst/WORDLIST
2f8ad11d48a00bc5c546498f66647399 *man/autolink.Rd
5041f58b707396d59064c7ac99b37a8e *man/downlit-package.Rd
e1e01b425993be0de6ad24b81d3cf87c *man/downlit_html_path.Rd
dfc83a74060ab882e487d06f440ad5e5 *man/downlit_md_path.Rd
d8a95da1a4b1acaca630fc1006409fa1 *man/evaluate_and_highlight.Rd
1da661de3745613b4292cc76acc65ee5 *man/highlight.Rd
62cfd33db37ea134463d39f20ec6f9bc *man/href_topic.Rd
5897699c6c5697490bd8e96a2552200b *man/is_low_change.Rd
57552b43f20ac10efa0ea1c0d326fd25 *tests/testthat.R
d5636e9a01f46b5018eaa6a85b695351 *tests/testthat/_snaps/downlit-html.md
7307b352258855d80370d252e7bf350b *tests/testthat/_snaps/evaluate.md
5cb84cbc1983602902d93661d2234f63 *tests/testthat/_snaps/highlight.md
1e058d3a949c29a03d8a6d6e68cae954 *tests/testthat/autolink.html
6d8c7188032c6043863c475c0763e4b8 *tests/testthat/fake-repo/src/contrib/PACKAGES
a9414277155b5cb45700110e1975f57a *tests/testthat/index/DESCRIPTION
92f87050d2894835fbd50002fc4a28b0 *tests/testthat/index/LICENSE
2cb41eabeb5cfba6a8ba143c4bb472dc *tests/testthat/index/LICENSE.md
a75c6241d729146e8dccca76ba49b2d4 *tests/testthat/index/NAMESPACE
e948a22eabd9accca8b07baad7cc695d *tests/testthat/index/R/basic.R
b4e842ed76441c222cd7b1fd24a3ecf8 *tests/testthat/index/index.Rproj
c645215df63b558e0388839ce4783544 *tests/testthat/index/man/a.Rd
576ad046290a96fd2a54e9bb258037ee *tests/testthat/index/man/b.Rd
b6cf9ccb2335d528d46fd530e420b29e *tests/testthat/index/vignettes/test-1.Rmd
dc56a11410d7de3cc75bef53b3b8d7fc *tests/testthat/index/vignettes/test-2.Rmd
d07e39cd2f266c6a2c31b9ba0b09a36f *tests/testthat/markdown-definition.md
897a79e3540dd87cafd229077eb4548e *tests/testthat/markdown-table.md
e2890009006dbe577de6dec264fb6466 *tests/testthat/test-article-index.R
3d6c685681fde3df75ebe7679d03c436 *tests/testthat/test-downlit-html.R
62cec245efaf9cb62b6c8d376f85d1ac *tests/testthat/test-downlit-html.txt
3099dd991ee9f63453a349c6550505bc *tests/testthat/test-downlit-md-v20.txt
f948f865dfeff71e91cf5b2cff9fefcb *tests/testthat/test-downlit-md-v21.txt
0bdaadb5225f31cc6ab35de6d02a9626 *tests/testthat/test-downlit-md.R
2dea158374a8df3a3ea316487edbfe29 *tests/testthat/test-downlit-md.txt
9f7c3a5772e62df6fba17929317e1b5f *tests/testthat/test-evaluate.R
1ab3e137a38d3cb4acd6b7f71ffadb4c *tests/testthat/test-highlight.R
1eae92541c8a5be0f6a7027797415829 *tests/testthat/test-highlight.txt
ed1d294ca7a17d5a8ad9a2b61a2275bb *tests/testthat/test-link.R
24913ce190cca89c8fdc229db570d900 *tests/testthat/test-metadata.R
cc46254ea8c668499f14de29dfb6d540 *tests/testthat/test-packages.R
8e8b4619a99799d99e2d97d454980535 *tests/testthat/test-topic-index.R
129036723e843e024fb5a26d450b0287 *tests/testthat/test-utils.R
downlit/R/ 0000755 0001762 0000144 00000000000 14630623777 012152 5 ustar ligges users downlit/R/rd.R 0000644 0001762 0000144 00000001070 13664033224 012664 0 ustar ligges users package_rd <- function(path) {
rd <- dir(path, pattern = "\\.[Rr]d$", full.names = TRUE)
names(rd) <- basename(rd)
lapply(rd, rd_file, pkg_path = dirname(path))
}
rd_file <- function(path, pkg_path = NULL) {
if (getRversion() >= "3.4.0") {
macros <- tools::loadPkgRdMacros(pkg_path)
} else {
macros <- tools::loadPkgRdMacros(pkg_path, TRUE)
}
tools::parse_Rd(path, macros = macros, encoding = "UTF-8")
}
extract_alias <- function(x, tag) {
is_alias <- vapply(x, function(x) attr(x, "Rd_tag") == "\\alias", logical(1))
unlist(x[is_alias])
}
downlit/R/highlight.R 0000644 0001762 0000144 00000026012 14255166156 014241 0 ustar ligges users #' Highlight and link a code block
#'
#' @description
#' This function:
#' * syntax highlights code
#' * links function calls to their documentation (where possible)
#' * in comments, translates ANSI escapes in to HTML equivalents.
#'
#' # Options
#'
#' downlit provides a number of options to control the details of the linking.
#' They are particularly important if you want to generate "local" links.
#'
#' * `downlit.package`: name of the current package. Determines when
#' `topic_index` and `article_index`
#'
#' * `downlit.topic_index` and `downlit.article_index`: named character
#' vector that maps from topic/article name to path.
#'
#' * `downlit.rdname`: name of current Rd file being documented (if any);
#' used to avoid self-links.
#'
#' * `downlit.attached`: character vector of currently attached R packages.
#'
#' * `downlit.local_packages`: named character vector providing relative
#' paths (value) to packages (name) that can be reached with relative links
#' from the target HTML document.
#'
#' * `downlit.topic_path` and `downlit.article_path`: paths to reference
#' topics and articles/vignettes relative to the "current" file.
#' @export
#' @param text String of code to highlight and link.
#' @param classes A mapping between token names and CSS class names.
#' Bundled `classes_pandoc()` and `classes_chroma()` provide mappings
#' that (roughly) match Pandoc and chroma (used by hugo) classes so you
#' can use existing themes.
#' @param pre_class Class(es) to give output ``.
#' @param code If `TRUE`, wrap output in a `` block
#' @return If `text` is valid R code, an HTML `` tag. Otherwise,
#' `NA`.
#' @return A string containing syntax highlighted HTML or `NA` (if `text`
#' isn't parseable).
#' @examples
#' cat(highlight("1 + 1"))
#' cat(highlight("base::t(1:3)"))
#'
#' # Unparseable R code returns NA
#' cat(highlight("base::t("))
highlight <- function(text, classes = classes_chroma(), pre_class = NULL, code = FALSE) {
parsed <- parse_data(text)
if (is.null(parsed)) {
return(NA_character_)
}
# Figure out which packages are attached to the search path. This is a
# hack because loading a package will affect code _before_ the library()
# call. But it should lead to relatively few false positives and is simple.
packages <- extract_package_attach(parsed$expr)
register_attached_packages(packages)
# Highlight, link, and escape
out <- parsed$data
out$class <- token_class(out$token, out$text, classes)
out$href <- token_href(out$token, out$text)
out$escaped <- token_escape(out$token, out$text)
# Update input - basic idea from prettycode
changed <- !is.na(out$href) | !is.na(out$class) | out$text != out$escaped
changes <- out[changed, , drop = FALSE]
loc <- line_col(parsed$text)
start <- vctrs::vec_match(data.frame(line = changes$line1, col = changes$col1), loc)
end <- vctrs::vec_match(data.frame(line = changes$line2, col = changes$col2), loc)
new <- style_token(changes$escaped, changes$href, changes$class)
out <- replace_in_place(parsed$text, start, end, replacement = new)
# Add per-line span to match pandoc
lines <- strsplit(out, "\n")[[1]]
if (length(lines) > 0) {
lines <- paste0("", lines, "")
}
out <- paste0(lines, collapse = "\n")
if (!is.null(pre_class)) {
out <- paste0(
"\n",
if (code) paste0(""),
out,
if (code) paste(""),
""
)
}
Encoding(out) <- "UTF-8"
out
}
style_token <- function(x, href = NA, class = NA) {
# Split tokens in to lines
lines <- strsplit(x, "\n")
n <- lengths(lines)
xs <- unlist(lines)
href <- rep(href, n)
class <- rep(class, n)
# Add links and class
xs <- ifelse(is.na(href), xs, paste0("", xs, ""))
xs <- ifelse(is.na(class), xs, paste0("", xs, ""))
# Re-combine back into lines
new_lines <- split(xs, rep(seq_along(x), n))
map_chr(new_lines, paste0, collapse = "\n")
}
# From prettycode:::replace_in_place
replace_in_place <- function(str, start, end, replacement) {
stopifnot(
length(str) == 1, length(start) == length(end),
length(end) == length(replacement)
)
keep <- substring(str, c(1, end + 1), c(start - 1, nchar(str)))
pieces <- character(length(replacement) * 2 + 1)
even <- seq_along(replacement) * 2
odd <- c(1, even + 1)
pieces[even] <- replacement
pieces[odd] <- keep
paste0(pieces, collapse = "")
}
line_col <- function(x) {
char <- strsplit(x, "")[[1]]
nl <- char == "\n"
line <- cumsum(c(TRUE, nl[-length(char)]))
col <- sequence(rle(line)$lengths)
data.frame(line, col)
}
# utils::getParseData will truncate very long strings or tokens;
# this function checks for that and uses the slow
# utils::getParseText function when necessary.
getFullParseData <- function(x) {
res <- utils::getParseData(x)
truncated <- res$terminal &
substr(res$text, 1, 1) == "[" &
nchar(res$text) > 5 # 5 is arbitrary, 2 would probably be enough
if (any(truncated))
res$text[truncated] <- utils::getParseText(res, res$id[truncated])
res
}
parse_data <- function(text) {
text <- standardise_text(text)
stopifnot(is.character(text), length(text) == 1)
expr <- safe_parse(text, standardise = FALSE)
if (is.null(expr)) {
return(NULL)
}
list(text = text, expr = expr, data = getFullParseData(expr))
}
# Highlighting ------------------------------------------------------------
token_class <- function(token, text, classes) {
token <- token_type(token, text)
unname(classes[token])
}
# Collapse token types to a smaller set of categories that we care about
# for syntax highlighting
# https://github.com/wch/r-source/blob/trunk/src/main/gram.c#L511
token_type <- function(x, text) {
special <- c(
"FUNCTION",
"FOR", "IN", "BREAK", "NEXT", "REPEAT", "WHILE",
"IF", "ELSE"
)
rstudio_special <- c(
"return", "switch", "try", "tryCatch", "stop",
"warning", "require", "library", "attach", "detach",
"source", "setMethod", "setGeneric", "setGroupGeneric",
"setClass", "setRefClass", "R6Class", "UseMethod", "NextMethod"
)
x[x %in% special] <- "special"
x[x == "SYMBOL_FUNCTION_CALL" & text %in% rstudio_special] <- "special"
infix <- c(
# algebra
"'-'", "'+'", "'~'", "'*'", "'/'", "'^'",
# comparison
"LT", "GT", "EQ", "GE", "LE", "NE",
# logical
"'!'", "AND", "AND2", "OR", "OR2",
# assignment / equals
"LEFT_ASSIGN", "RIGHT_ASSIGN", "EQ_ASSIGN", "EQ_FORMALS", "EQ_SUB",
# miscellaneous
"'$'", "'@'","'~'", "'?'", "':'", "SPECIAL",
# pipes
"PIPE", "PIPEBIND"
)
x[x %in% infix] <- "infix"
parens <- c("LBB", "'['", "']'", "'('", "')'", "'{'", "'}'")
x[x %in% parens] <- "parens"
# Matches treatment of constants in RStudio
constant <- c(
"NA", "Inf", "NaN", "TRUE", "FALSE",
"NA_integer_", "NA_real_", "NA_character_", "NA_complex_"
)
x[x == "NUM_CONST" & text %in% constant] <- "constant"
x[x == "SYMBOL" & text %in% c("T", "F")] <- "constant"
x[x == "NULL_CONST"] <- "constant"
x[x == "NULL_CONST"] <- "constant"
# Treats pipe's placeholder '_' as a SYMBOL
x[x == "PLACEHOLDER"] <- "SYMBOL"
x
}
# Pandoc styles are based on KDE default styles:
# https://docs.kde.org/stable5/en/applications/katepart/highlight.html#kate-highlight-default-styles
# But in HTML use two letter abbreviations:
# https://github.com/jgm/skylighting/blob/a1d02a0db6260c73aaf04aae2e6e18b569caacdc/skylighting-core/src/Skylighting/Format/HTML.hs#L117-L147
# Summary at
# https://docs.google.com/spreadsheets/d/1JhBtQSCtQ2eu2RepLTJONFdLEnhM3asUyMMLYE3tdYk/edit#gid=0
#
# Default syntax highlighting def for R:
# https://github.com/KDE/syntax-highlighting/blob/master/data/syntax/r.xml
#' @export
#' @rdname highlight
classes_pandoc <- function() {
c(
"constant" = "cn",
"NUM_CONST" = "fl",
"STR_CONST" = "st",
"special" = "kw",
"parens" = "op",
"infix" = "op",
"SLOT" = "va",
"SYMBOL" = "va",
"SYMBOL_FORMALS" = "va",
"NS_GET" = "fu",
"NS_GET_INT" = "fu",
"SYMBOL_FUNCTION_CALL" = "fu",
"SYMBOL_PACKAGE" = "fu",
"COMMENT" = "co"
)
}
# Derived from https://github.com/ropensci/roweb2/blob/master/themes/ropensci/static/css/pygments.css
#' @export
#' @rdname highlight
classes_chroma <- function() {
c(
"constant" = "kc",
"NUM_CONST" = "m",
"STR_CONST" = "s",
"special" = "kr",
"parens" = "o",
"infix" = "o",
"SLOT" = "nv",
"SYMBOL" = "nv",
"SYMBOL_FORMALS" = "nv",
"NS_GET" = "nf",
"NS_GET_INT" = "nf",
"SYMBOL_FUNCTION_CALL" = "nf",
"SYMBOL_PACKAGE" = "nf",
"COMMENT" = "c"
)
}
classes_show <- function(x, classes = classes_pandoc()) {
text <- paste0(deparse(substitute(x)), collapse = "\n")
out <- parse_data(text)$data
out$class <- token_class(out$token, out$text, classes)
out$class[is.na(out$class)] <- ""
out <- out[out$terminal, c("token", "text", "class")]
rownames(out) <- NULL
out
}
# Linking -----------------------------------------------------------------
token_href <- function(token, text) {
href <- rep(NA, length(token))
to_end <- length(token) - seq_along(token) + 1
# Highlight namespaced function calls. In the parsed tree, these are
# SYMBOL_PACKAGE then NS_GET/NS_GET_INT then SYMBOL_FUNCTION_CALL/SYMBOL
ns_pkg <- which(token %in% "SYMBOL_PACKAGE" & to_end > 2)
ns_fun <- ns_pkg + 2L
href[ns_fun] <- map2_chr(text[ns_fun], text[ns_pkg], href_topic)
# Then highlight all remaining calls, using loaded packages registered
# above. These maintained at a higher-level, because (e.g) in .Rmds you want
# earlier library() statements to affect the highlighting of later blocks
fun <- which(token %in% "SYMBOL_FUNCTION_CALL")
fun <- setdiff(fun, ns_fun)
fun <- fun[token[fun-1] != "'$'"]
# Include custom infix operators
fun <- c(fun, which(token %in% "SPECIAL"))
# Highlight R6 instantiation
r6_new_call <- which(
text == "new" & token == "SYMBOL_FUNCTION_CALL"
)
r6_new_call <- r6_new_call[token[r6_new_call - 1] == "'$'"]
r6_new_call <- r6_new_call[token[r6_new_call - 3] == "SYMBOL"]
fun <- c(fun, r6_new_call - 3)
href[fun] <- map_chr(text[fun], href_topic_local, is_fun = TRUE)
# Highlight packages
lib_call <- which(
token == "SYMBOL_FUNCTION_CALL" &
text %in% c("library", "require") &
to_end > 3
)
pkg <- lib_call + 3 # expr + '(' + STR_CONST
href[pkg] <- map_chr(gsub("['\"]", "", text[pkg]), href_package)
href
}
map_chr <- function(.x, .f, ...) {
vapply(.x, .f, ..., FUN.VALUE = character(1), USE.NAMES = FALSE)
}
map2_chr <- function(.x, .y, .f, ...) {
vapply(seq_along(.x), function(i) .f(.x[[i]], .y[[i]], ...), character(1))
}
# Escaping ----------------------------------------------------------------
token_escape <- function(token, text) {
text <- escape_html(text)
is_comment <- token == "COMMENT"
text[is_comment] <- fansi::sgr_to_html(text[is_comment])
text
}
escape_html <- function(x) {
x <- gsub("&", "&", x)
x <- gsub("<", "<", x)
x <- gsub(">", ">", x)
x
}
downlit/R/packages.R 0000644 0001762 0000144 00000003534 14447373707 014061 0 ustar ligges users extract_package_attach <- function(expr) {
if (is.expression(expr)) {
packages <- lapply(expr, extract_package_attach)
unlist(packages)
} else if (is_call(expr)) {
if (is_call(expr, c("library", "require"))) {
if (is_call(expr, "library")) {
expr <- match.call(library, expr)
} else {
expr <- match.call(require, expr)
}
if (!is_true(expr$character.only)) {
as.character(expr$package)
} else {
character()
}
} else {
args <- as.list(expr[-1])
unlist(lapply(args, extract_package_attach))
}
} else {
character()
}
}
# Helper for testing
extract_package_attach_ <- function(expr) {
extract_package_attach(enexpr(expr))
}
register_attached_packages <- function(packages) {
packages <- add_depends(packages)
options("downlit.attached" = union(packages, getOption("downlit.attached")))
}
add_depends <- function(packages) {
if ("tidyverse" %in% packages && is_installed("tidyverse")) {
core <- getNamespace("tidyverse")$core
packages <- union(packages, core)
}
# add packages attached by depends
depends <- unlist(lapply(packages, package_depends))
union(packages, depends)
}
package_depends <- function(package) {
if (!is_installed(package)) {
return(character())
}
if (!is.null(devtools_meta(package))) {
path_desc <- system.file("DESCRIPTION", package = "pkgdown")
deps <- desc::desc_get_deps(path_desc)
depends <- deps$package[deps$type == "Depends"]
depends <- depends[depends != "R"]
return(depends)
}
path_meta <- system.file("Meta", "package.rds", package = package)
meta <- readRDS(path_meta)
names(meta$Depends)
}
# from https://github.com/r-lib/pkgdown/blob/8e0838e273462cec420dfa20f240c684a33425d9/R/utils.r#L62
devtools_meta <- function(x) {
ns <- .getNamespace(x)
ns[[".__DEVTOOLS__"]]
}
downlit/R/downlit-package.R 0000644 0001762 0000144 00000000333 14122441316 015324 0 ustar ligges users #' @keywords internal
"_PACKAGE"
# The following block is used by usethis to automatically manage
# roxygen namespace tags. Modify with care!
## usethis namespace: start
#' @import rlang
## usethis namespace: end
NULL
downlit/R/test-helpers.R 0000644 0001762 0000144 00000000546 14136776231 014714 0 ustar ligges users local_devtools_package <- function(path, ..., env = parent.frame()) {
pkgload::load_all(path, ..., quiet = TRUE)
defer(pkgload::unload(pkgload::pkg_name(path)), scope = env)
}
defer <- function(expr, scope = parent.frame()) {
expr <- enquo(expr)
call <- expr(on.exit(rlang::eval_tidy(!!expr), add = TRUE))
eval_bare(call, scope)
invisible()
}
downlit/R/downlit-html.R 0000644 0001762 0000144 00000006107 14630625504 014711 0 ustar ligges users #' Syntax highlight and link an HTML page
#'
#' @description
#' * Code blocks, identified by `` tags with class `sourceCode r`
#' or any `` tag inside of ``, are
#' processed with [highlight()].
#'
#' * Inline code, identified by `` tags that contain only text
#' (and don't have a header tag (e.g. ``) or `` as an ancestor)
#' are processed processed with [autolink()].
#'
#' Use `downlit_html_path()` to process an `.html` file on disk;
#' use `downlit_html_node()` to process an in-memory `xml_node` as part of a
#' larger pipeline.
#'
#' @param in_path,out_path Input and output paths for HTML file
#' @inheritParams highlight
#' @param x An `xml2::xml_node`
#' @return `downlit_html_path()` invisibly returns `output_path`;
#' `downlit_html_node()` modifies `x` in place and returns nothing.
#' @export
#' @examplesIf rlang::is_installed("xml2")
#' node <- xml2::read_xml("base::t()
")
#' node
#'
#' # node is modified in place
#' downlit_html_node(node)
#' node
downlit_html_path <- function(in_path, out_path, classes = classes_pandoc()) {
if (!is_installed("xml2")) {
abort("xml2 package required .html transformation")
}
html <- xml2::read_html(in_path, encoding = "UTF-8")
downlit_html_node(html, classes = classes)
xml2::write_html(html, out_path, format = FALSE)
invisible(out_path)
}
#' @export
#' @rdname downlit_html_path
downlit_html_node <- function(x, classes = classes_pandoc()) {
stopifnot(inherits(x, "xml_node"))
xpath <- c(
# Usual block generated by pandoc (after syntax highlighting)
".//pre[contains(@class, 'sourceCode r')]",
# Special case that allows us to override usual rules if needed
".//div[contains(@class, 'downlit')]//pre"
)
xpath_block <- paste(xpath, collapse = "|")
tweak_children(x, xpath_block, highlight,
pre_class = "downlit sourceCode r",
classes = classes,
replace = "node",
code = TRUE
)
# Identify containing only text (i.e. no children)
# that are not descendants of an element where links are undesirable
bad_ancestor <- c("h1", "h2", "h3", "h4", "h5", "a", "summary")
bad_ancestor <- paste0("ancestor::", bad_ancestor, collapse = "|")
xpath_inline <- paste0(".//code[count(*) = 0 and not(", bad_ancestor, ")]")
# replace inline code "{packagename}" with linked text if possible
tweak_children(x, xpath_inline, autolink_curly, replace = "node")
# handle remaining inline code
tweak_children(x, xpath_inline, autolink, replace = "contents")
invisible()
}
tweak_children <- function(node, xpath, fun, ..., replace = c("node", "contents")) {
replace <- arg_match(replace)
nodes <- xml2::xml_find_all(node, xpath)
text <- xml2::xml_text(nodes)
replacement <- map_chr(text, fun, ...)
to_update <- !is.na(replacement)
old <- nodes[to_update]
if (replace == "contents") {
old <- xml2::xml_contents(old)
}
new <- lapply(replacement[to_update], as_xml)
xml2::xml_replace(old, new, .copy = FALSE)
invisible()
}
as_xml <- function(x) {
xml2::xml_contents(xml2::xml_contents(xml2::read_html(x)))[[1]]
}
downlit/R/zzz.R 0000644 0001762 0000144 00000000334 14260703760 013120 0 ustar ligges users .onLoad <- function(libname, pkgname) {
repo_urls <<- memoise::memoise(repo_urls)
CRAN_urls <<- memoise::memoise(CRAN_urls)
# Silence R CMD check note, since only used in memoised function
withr::local_envvar
}
downlit/R/topic-index.R 0000644 0001762 0000144 00000003234 14257417776 014527 0 ustar ligges users # Compute topic index -----------------------------------------------------
# The topic index is a character vector that maps aliases to Rd file names
# (sans extension). Memoised for performance.
topic_index <- function(package) {
if (is.null(package)) {
getOption("downlit.topic_index")
} else if (devtools_loaded(package)) {
# Use live docs for in-development packages
topic_index_source(package)
} else {
topic_index_installed(package)
}
}
topic_index_source <- function(package) {
path <- file.path(find.package(package), "man")
if (!file.exists(path)) {
return(character())
}
rd <- package_rd(path)
aliases <- lapply(rd, extract_alias)
names(aliases) <- gsub("\\.Rd$", "", names(rd))
unlist(invert_index(aliases))
}
topic_index_installed <- function(package) {
path <- system.file("help", "aliases.rds", package = package)
if (path == "")
return(character())
readRDS(path)
}
find_rdname <- function(package, topic) {
index <- topic_index(package)
if (has_name(index, topic)) {
index[[topic]]
} else {
NULL
}
}
find_rdname_attached <- function(topic, is_fun = FALSE) {
packages <- c(
getOption("downlit.attached"),
c("datasets", "utils", "grDevices", "graphics", "stats", "base")
)
for (package in packages) {
if (!is_installed(package)) {
next
}
if (is_fun && !is_exported(topic, package)) {
next
}
rdname <- find_rdname(package, topic)
if (!is.null(rdname)) {
return(list(rdname = rdname, package = package))
}
}
NULL
}
# https://github.com/r-lib/rlang/issues/1434
is_installed <- function(x) {
!identical(system.file(package = x), "")
}
downlit/R/evaluate.R 0000644 0001762 0000144 00000016347 14625413210 014075 0 ustar ligges users #' Evaluate code and syntax highlight the results
#'
#' This function runs `code` and captures the output using
#' [evaluate::evaluate()]. It syntax higlights code with [highlight()], and
#' intermingles it with output.
#'
#' @param code Code to evaluate (as a string).
#' @param fig_save A function with arguments `plot` and `id` that is
#' responsible for saving `plot` to a file (using `id` to disambiguate
#' multiple plots in the same chunk). It should return a list with
#' components `path`, `width`, and `height`.
#' @param env Environment in which to evaluate code; if not supplied,
#' defaults to a child of the global environment.
#' @param output_handler Custom output handler for [evaluate::evaluate()].
#' @param highlight Optionally suppress highlighting. This is useful for tests.
#' @return An string containing HTML with a `dependencies` attribute
#' giving an additional htmltools dependencies required to render the HTML.
#' @inheritParams highlight
#' @export
#' @examples
#' cat(evaluate_and_highlight("1 + 2"))
#' cat(evaluate_and_highlight("x <- 1:10\nmean(x)"))
#'
#' # -----------------------------------------------------------------
#' # evaluate_and_highlight() powers pkgdown's documentation formatting so
#' # here I include a few examples to make sure everything looks good
#' # -----------------------------------------------------------------
#'
#' blue <- function(x) paste0("\033[34m", x, "\033[39m")
#' f <- function(x) {
#' cat("This is some output. My favourite colour is ", blue("blue"), ".\n", sep = "")
#' message("This is a message. My favourite fruit is ", blue("blueberries"))
#' warning("Now at stage ", blue("blue"), "!")
#' }
#' f()
#'
#' plot(1:10)
evaluate_and_highlight <- function(code,
fig_save,
classes = downlit::classes_pandoc(),
env = NULL,
output_handler = evaluate::new_output_handler(),
highlight = TRUE) {
env <- env %||% child_env(global_env())
expr <- evaluate::evaluate(code, child_env(env), new_device = TRUE,
output_handler = output_handler)
replay_html(expr,
fig_save = fig_save,
fig_id = unique_id(),
classes = classes,
highlight = highlight
)
}
test_evaluate <- function(code, ..., highlight = FALSE) {
fig_save <- function(plot, id) {
list(path = paste0(id, ".png"), width = 10, height = 10)
}
cat(evaluate_and_highlight(
code,
fig_save = fig_save,
env = caller_env(),
highlight = highlight,
...
))
}
replay_html <- function(x, ...) UseMethod("replay_html", x)
#' @export
replay_html.list <- function(x, ...) {
# keep only high level plots
x <- merge_low_plot(x)
html <- lapply(x, replay_html, ...)
dependencies <- unlist(lapply(html, attr, "dependencies"), recursive = FALSE)
structure(
paste0(html, collapse = ""),
dependencies = dependencies
)
}
#' @export
replay_html.NULL <- function(x, ...) ""
#' @export
replay_html.character <- function(x, ...) {
label_output(escape_html(x), "r-out")
}
#' @export
replay_html.source <- function(x, ..., classes, highlight = FALSE) {
if (highlight) {
html <- highlight(x$src, classes = classes)
}
if (!highlight || is.na(html)) {
html <- escape_html(x$src)
}
label_input(html, "r-in")
}
#' @export
replay_html.warning <- function(x, ...) {
message <- paste0(span("Warning: ", class = "warning"), escape_html(conditionMessage(x)))
label_output(message, "r-wrn")
}
#' @export
replay_html.message <- function(x, ...) {
message <- escape_html(paste0(gsub("\n$", "", conditionMessage(x))))
label_output(message, "r-msg")
}
#' @export
replay_html.error <- function(x, ...) {
if (is.null(x$call)) {
prefix <- "Error:"
} else {
prefix <- paste0("Error in ", escape_html(paste0(deparse(x$call), collapse = "")), ":")
}
message <- paste0(span(prefix, class = "error"), " ", escape_html(conditionMessage(x)))
label_output(message, "r-err")
}
#' @export
replay_html.recordedplot <- function(x, fig_save, fig_id, ...) {
fig <- fig_save(x, fig_id())
img <- paste0(
"![]()
"
)
paste0(span(img, class = "r-plt img"), "\n")
}
# htmltools ---------------------------------------------------------------
# These will only be encountered if output_handler has a custom value
# callback that returns HTML.
#' @export
replay_html.html <- function(x, ...) {
rendered <- htmltools::renderTags(x)
structure(
rendered$html,
dependencies = rendered$dependencies,
class = "downlit_html"
)
}
#' @export
replay_html.shiny.tag <- replay_html.html
#' @export
replay_html.shiny.tag.function <- replay_html.html
#' @export
replay_html.shiny.tag.list <- replay_html.html
#' @export
replay_html.htmlwidget <- replay_html.html
# helpers -----------------------------------------------------------------
label_output <- function(x, class) {
prompt <- span("#>", class = "r-pr")
lines <- strsplit(x, "\n")[[1]]
lines <- fansi::sgr_to_html(lines)
lines <- paste0(prompt, " ", lines)
lines <- span(lines, class = paste(class, "co"))
paste0(lines, "\n", collapse = "")
}
label_input <- function(x, class) {
lines <- strsplit(x, "\n")[[1]]
lines <- span(lines, class = class)
paste0(lines, "\n", collapse = "")
}
span <- function(..., class = NULL) {
paste0(
"",
...,
""
)
}
unique_id <- function() {
i <- 0
function() {
i <<- i + 1
i
}
}
# Knitr functions ------------------------------------------------------------
# The functions below come from package knitr (Yihui Xie) in file plot.R
# get MD5 digests of recorded plots so that merge_low_plot works
digest_plot = function(x, level = 1) {
if (inherits(x, "otherRecordedplot"))
return(x)
if (!is.list(x) || level >= 3) return(structure(digest::digest(x),
class = "plot_digest"))
lapply(x, digest_plot, level = level + 1)
}
is_plot_output = function(x) {
evaluate::is.recordedplot(x) || inherits(x, 'otherRecordedplot')
}
# merge low-level plotting changes
merge_low_plot = function(x, idx = vapply(x, is_plot_output, logical(1L))) {
idx = which(idx); n = length(idx); m = NULL # store indices that will be removed
if (n <= 1) return(x)
# digest of recorded plots
rp_dg <- lapply(x[idx], digest_plot)
i1 = idx[1]; i2 = idx[2] # compare plots sequentially
for (i in 1:(n - 1)) {
# remove the previous plot and move its index to the next plot
if (is_low_change(rp_dg[[i]], rp_dg[[i+1]])) m = c(m, i1)
i1 = idx[i + 1]
i2 = idx[i + 2]
}
if (is.null(m)) x else x[-m]
}
#' Compare two recorded plots
#'
#' @param p1,p2 Plot results
#'
#' @return Logical value indicating whether `p2` is a low-level update of `p1`.
#' @export
is_low_change = function(p1, p2) {
UseMethod("is_low_change")
}
#' @export
is_low_change.default = function(p1, p2) {
p1 = p1[[1]]; p2 = p2[[1]] # real plot info is in [[1]]
if ((n2 <- length(p2)) < (n1 <- length(p1))) return(FALSE) # length must increase
identical(p1[1:n1], p2[1:n1])
}
downlit/R/utils.R 0000644 0001762 0000144 00000002760 14625436640 013435 0 ustar ligges users devtools_loaded <- function(x) {
if (!x %in% loadedNamespaces()) {
return(FALSE)
}
ns <- .getNamespace(x)
env_has(ns, ".__DEVTOOLS__")
}
invert_index <- function(x) {
stopifnot(is.list(x))
if (length(x) == 0)
return(list())
key <- rep(names(x), lengths(x))
val <- unlist(x, use.names = FALSE)
split(key, val)
}
standardise_text <- function(x) {
x <- enc2utf8(x)
x <- gsub("\t", " ", x, fixed = TRUE, useBytes = TRUE)
x <- gsub("\r", "", x, fixed = TRUE, useBytes = TRUE)
# \033 can't be represented in xml (and hence is ignored by xml2)
# so we convert to \u2029 in order to survive a round trip
x <- gsub("\u2029", "\033", x, fixed = TRUE, useBytes = TRUE)
x
}
safe_parse <- function(text, standardise = TRUE) {
if (standardise) {
text <- standardise_text(text)
}
lines <- strsplit(text, "\n", fixed = TRUE, useBytes = TRUE)[[1]]
srcfile <- srcfilecopy("test.r", lines)
tryCatch(
parse(text = text, keep.source = TRUE, encoding = "UTF-8", srcfile = srcfile),
error = function(e) NULL
)
}
extract_curly_package <- function(x) {
# regex adapted from https://github.com/r-lib/usethis/blob/d5857737b4780c3c3d8fe6fb44ef70e81796ac8e/R/description.R#L134
if (! grepl("^\\{[a-zA-Z][a-zA-Z0-9.]+\\}$", x)) {
return(NA)
}
# remove first curly brace
x <- sub("\\{", "", x)
# remove second curly brace and return
x <- sub("\\}", "", x)
x
}
show_xml <- function(x) {
cat(as.character(x, options = c("format", "no_declaration")))
}
downlit/R/downlit-md.R 0000644 0001762 0000144 00000016031 14630654142 014342 0 ustar ligges users #' Syntax highlight and link a md document
#'
#' @description
#' `downlit_md_*` works by traversing the markdown AST generated by Pandoc.
#' It applies [highlight()] to `CodeBlock`s and [autolink()] to inline `Code`.
#'
#' Use `downlit_md_path()` to transform a file on disk; use
#' `downlit_md_string()` to transform a string containing markdown as part
#' of a larger pipeline.
#'
#' Needs pandoc 1.19 or later.
#'
#' @export
#' @param in_path,out_path Input and output paths for markdown file.
#' @param x A string containing markdown.
#' @param format Pandoc format; defaults to "gfm" if you have pandoc 2.0.0 or
#' greater, otherwise "markdown_github".
#' @return `downlit_md_path()` invisibly returns `output_path`;
#' `downlit_md_string()` returns a string containing markdown.
#' @examplesIf rlang::is_installed("rmarkdown")
#' if (rmarkdown::pandoc_available("1.19")) {
#' downlit_md_string("`base::t()`")
#' downlit_md_string("`base::t`")
#' downlit_md_string("* `base::t`")
#'
#' # But don't highlight in headings
#' downlit_md_string("## `base::t`")
#' }
downlit_md_path <- function(in_path, out_path, format = NULL) {
check_packages()
ast_path <- tempfile()
on.exit(unlink(ast_path))
md2ast(in_path, ast_path, format = format)
ast <- jsonlite::read_json(ast_path)
ast$blocks <- transform_code(ast$blocks, ast_version(ast))
jsonlite::write_json(ast, ast_path, auto_unbox = TRUE, null = "null")
ast2md(ast_path, out_path, format = format)
}
#' @export
#' @rdname downlit_md_path
downlit_md_string <- function(x, format = NULL) {
check_packages()
path <- tempfile()
on.exit(unlink(path))
brio::write_lines(x, path)
downlit_md_path(path, path, format = format)
brio::read_file(path)
}
# Markdown <-> pandoc AST -------------------------------------------------
md2ast <- function(path, out_path, format = NULL) {
format <- format %||% md_format()
rmarkdown::pandoc_convert(
input = normalizePath(path, mustWork = FALSE),
output = normalizePath(out_path, mustWork = FALSE),
from = format,
to = "json"
)
invisible(out_path)
}
ast2md <- function(path, out_path, format = NULL) {
format <- format %||% md_format()
options <- c(
if (rmarkdown::pandoc_available("2.0")) "--eol=lf",
if (rmarkdown::pandoc_version() < "2.11.2") "--atx-headers", # 1.19-2.11.2
"--wrap=none" # 1.16
)
rmarkdown::pandoc_convert(
input = normalizePath(path, mustWork = FALSE),
output = normalizePath(out_path, mustWork = FALSE),
from = "json",
to = format,
options = options
)
invisible(out_path)
}
ast_version <- function(ast) {
string <- paste(unlist(ast$`pandoc-api-version`), collapse = ".")
package_version(string)
}
md_format <- function() {
if (rmarkdown::pandoc_available("2.0.0")) {
"gfm"
} else {
"markdown_github"
}
}
# Code transformation -----------------------------------------------------
# Data types at
# https://hackage.haskell.org/package/pandoc-types-1.20/docs/Text-Pandoc-Definition.html
transform_code <- function(x, version) {
stopifnot(is.list(x))
# Blocks that are a list of blocks
block_list <- c(
# Block
"Plain", "Para", "LineBlock", "BlockQuote", "BulletList",
# Inline
"Emph", "Strong", "Strikeout", "Superscript", "Subscript",
"SmallCaps", "Note", "Underline"
)
# Blocks that have a list of blocks as second child
block_list2 <- c(
"OrderedList", "Quoted",
"Div", "Span",
"Caption", "TableHead", "TableFoot", "Row"
)
skip <- c(
"Header", "CodeBlock", "RawBlock", "HorizontalRule", "Null",
"Math", "RawInline", "Link", "Image", "Cite",
"Str", "Space", "SoftBreak", "LineBreak"
)
if (!is_named(x)) {
lapply(x, transform_code, version = version)
} else {
if (x$t == "Code") {
package_name <- extract_curly_package(x$c[[2]])
# packages à la {pkgname}
if(!is.na(package_name)) {
href <- href_package(package_name)
if (!is.na(href)) {
x <- list(t = "Str", c = package_name)
x <- pandoc_link(pandoc_attr(), list(x), pandoc_target(href))
} # otherwise we do not touch x
} else {
# other cases
href <- autolink_url(x$c[[2]])
if (!is.na(href)) {
x <- pandoc_link(pandoc_attr(), list(x), pandoc_target(href))
}
}
} else if (x$t == "CodeBlock") {
out <- highlight(x$c[[2]], pre_class = "chroma")
if (!is.na(out)) {
x <- pandoc_raw_block("html", out)
}
} else if (x$t %in% block_list) {
# Plain [Inline]
# Para [Inline]
# LineBlock [[Inline]]
# BlockQuote [Block]
# BulletList [[Block]]
# Emph [Inline]
# Strong [Inline]
# Strikeout [Inline]
# Superscript [Inline]
# Subscript [Inline]
# SmallCaps [Inline]
# Note [Block]
# Underline [Inline]
x$c <- lapply(x$c, transform_code, version = version)
} else if (x$t %in% block_list2) {
# OrderedList ListAttributes [[Block]]
# Quoted QuoteType [Inline]
# Div Attr [Block]
# Span Attr [Inline]
# TableHead Attr [Row]
# TableFoot Attr [Row]
# Caption (Maybe ShortCaption) [Block]
x$c[[2]] <- lapply(x$c[[2]], transform_code, version = version)
} else if (x$t %in% "Table") {
if (version >= "1.21") {
# Attr Caption [ColSpec] TableHead [TableBody] TableFoot
x$c[c(2, 4, 5, 6)] <- lapply(x$c[c(2, 4, 5, 6)], transform_code, version = version)
} else {
# [Inline] [Alignment] [Double] [TableCell] [[TableCell]]
x$c[c(1, 4, 5)] <- lapply(x$c[c(1, 4, 5)], transform_code, version = version)
}
} else if (x$t %in% "TableBody") {
# Attr RowHeadColumns [Row] [Row]
x$c[c(3, 4)] <- lapply(x$c[c(3, 4)], transform_code, version = version)
} else if (x$t %in% "Cell") {
# Attr Alignment RowSpan ColSpan [Block]
x$c[[5]] <- lapply(x$c[[5]], transform_code, version = version)
} else if (x$t %in% "DefinitionList") {
# DefinitionList [([Inline], [[Block]])]
x$c <- lapply(x$c,
function(x) list(
transform_code(x[[1]], version = version),
transform_code(x[[2]], version = version)
)
)
} else if (x$t %in% skip) {
} else {
inform(paste0("Unknown type: ", x$t))
}
x
}
}
# Pandoc AST constructors -------------------------------------------------
pandoc_node <- function(type, ...) {
list(t = type, c = list(...))
}
pandoc_raw_block <- function(format, text) {
# Format Text
pandoc_node("RawBlock", format, text)
}
pandoc_link <- function(attr, contents, target) {
# Attr [Inline] Target
pandoc_node("Link", attr, contents, target)
}
pandoc_attr <- function(id = "", classes = list(), keyval = list()) {
list(id, classes, keyval)
}
pandoc_target <- function(url, title = "") {
list(url, title)
}
# Helpers -----------------------------------------------------------------
check_packages <- function() {
if (!is_installed("rmarkdown") || !is_installed("jsonlite")) {
abort("rmarkdown and jsonlite required for .md transformation")
}
}
downlit/R/link.R 0000644 0001762 0000144 00000022553 14447367602 013237 0 ustar ligges users #' Automatically link inline code
#'
#' @param text String of code to highlight and link.
#' @return
#' If `text` is linkable, an HTML link for `autolink()`, and or just
#' the URL for `autolink_url()`. Both return `NA` if the text is not
#' linkable.
#' @inheritSection highlight Options
#' @export
#' @examples
#' autolink("stats::median()")
#' autolink("vignette('grid', package = 'grid')")
#'
#' autolink_url("stats::median()")
autolink <- function(text) {
href <- autolink_url(text)
if (identical(href, NA_character_)) {
return(NA_character_)
}
paste0("", escape_html(text), "")
}
#' @export
#' @rdname autolink
autolink_url <- function(text) {
expr <- safe_parse(text)
if (length(expr) == 0) {
return(NA_character_)
}
href_expr(expr[[1]])
}
autolink_curly <- function(text) {
package_name <- extract_curly_package(text)
if (is.na(package_name)) {
return(NA_character_)
}
href <- href_package(package_name)
if (is.na(href)) {
return(NA_character_)
}
paste0("", package_name, "")
}
# Helper for testing
href_expr_ <- function(expr, ...) {
href_expr(substitute(expr), ...)
}
href_expr <- function(expr) {
if (!is_call(expr)) {
return(NA_character_)
}
fun <- expr[[1]]
if (is_call(fun, "::", n = 2)) {
pkg <- as.character(fun[[2]])
fun <- fun[[3]]
} else {
pkg <- NULL
}
if (!is_symbol(fun))
return(NA_character_)
fun_name <- as.character(fun)
n_args <- length(expr) - 1
if (n_args == 0) {
href_topic(fun_name, pkg, is_fun = TRUE)
} else if (fun_name %in% c("library", "require", "requireNamespace")) {
simple_call <- n_args == 1 &&
is.null(names(expr)) &&
(is_string(expr[[2]]) || (fun_name != "requireNamespace") && is_symbol(expr[[2]]))
if (simple_call) {
pkg <- as.character(expr[[2]])
topic <- href_package(pkg)
if (is.na(topic)) {
href_topic(fun_name)
} else {
topic
}
} else {
href_topic(fun_name, is_fun = TRUE)
}
} else if (fun_name == "vignette" && n_args >= 1) {
# vignette("foo", "package")
expr <- match.call(utils::vignette, expr)
topic_ok <- is.character(expr$topic)
package_ok <- is.character(expr$package) || is.null(expr$package)
if (topic_ok && package_ok) {
href_article(expr$topic, expr$package)
} else {
NA_character_
}
} else if (fun_name == "?" && n_args == 1) {
topic <- expr[[2]]
if (is_call(topic, "::")) {
# ?pkg::x
href_topic(as.character(topic[[3]]), as.character(topic[[2]]))
} else if (is_symbol(topic) || is_string(topic)) {
# ?x
href_topic(as.character(expr[[2]]))
} else {
NA_character_
}
} else if (fun_name == "?" && n_args == 2) {
# package?x
href_topic(paste0(expr[[3]], "-", expr[[2]]))
} else if (fun_name == "help" && n_args >= 1) {
expr <- match.call(utils::help, expr)
if (is_help_literal(expr$topic) && is_help_literal(expr$package)) {
href_topic(as.character(expr$topic), as.character(expr$package))
} else if (is_help_literal(expr$topic) && is.null(expr$package)) {
href_topic(as.character(expr$topic))
} else if (is.null(expr$topic) && is_help_literal(expr$package)) {
href_package_ref(as.character(expr$package))
} else {
NA_character_
}
} else if (fun_name == "::" && n_args == 2) {
href_topic(as.character(expr[[3]]), as.character(expr[[2]]))
} else {
NA_character_
}
}
is_help_literal <- function(x) is_string(x) || is_symbol(x)
# Topics ------------------------------------------------------------------
#' Generate url for topic/article/package
#'
#' @param topic,article Topic/article name
#' @param package Optional package name. If not supplied, will search
#' in all attached packages.
#' @param is_fun Only return topics that are (probably) for functions.
#' @keywords internal
#' @export
#' @return URL topic or article; `NA` if can't find one.
#' @examples
#' href_topic("t")
#' href_topic("DOESN'T EXIST")
#' href_topic("href_topic", "downlit")
#'
#' href_package("downlit")
href_topic <- function(topic, package = NULL, is_fun = FALSE) {
if (length(topic) != 1L) {
return(NA_character_)
}
if (is_package_local(package)) {
href_topic_local(topic, is_fun = is_fun)
} else {
href_topic_remote(topic, package)
}
}
is_package_local <- function(package) {
if (is.null(package)) {
return(TRUE)
}
cur <- getOption("downlit.package")
if (is.null(cur)) {
return(FALSE)
}
package == cur
}
href_topic_local <- function(topic, is_fun = FALSE) {
rdname <- find_rdname(NULL, topic)
if (is.null(rdname)) {
# Check attached packages
loc <- find_rdname_attached(topic, is_fun = is_fun)
if (is.null(loc)) {
return(NA_character_)
} else {
return(href_topic_remote(topic, loc$package))
}
}
if (rdname == "reexports") {
return(href_topic_reexported(topic, getOption("downlit.package")))
}
cur_rdname <- getOption("downlit.rdname", "")
if (rdname == cur_rdname) {
return(NA_character_)
}
if (cur_rdname != "") {
paste0(rdname, ".html")
} else {
paste0(getOption("downlit.topic_path"), rdname, ".html")
}
}
href_topic_remote <- function(topic, package) {
rdname <- find_rdname(package, topic)
if (is.null(rdname)) {
return(NA_character_)
}
if (is_reexported(topic, package)) {
href_topic_reexported(topic, package)
} else {
paste0(href_package_ref(package), "/", rdname, ".html")
}
}
is_reexported <- function(name, package) {
if (package == "base") {
return(FALSE)
}
is_imported <- env_has(ns_imports_env(package), name)
is_imported && is_exported(name, package)
}
is_exported <- function(name, package) {
name %in% getNamespaceExports(ns_env(package))
}
# If it's a re-exported function, we need to work a little harder to
# find out its source so that we can link to it.
href_topic_reexported <- function(topic, package) {
ns <- ns_env(package)
if (!env_has(ns, topic, inherit = TRUE)) {
return(NA_character_)
}
obj <- env_get(ns, topic, inherit = TRUE)
ex_package <- find_reexport_source(obj, ns, topic)
# Give up if we're stuck in an infinite loop
if (package == ex_package) {
return(NA_character_)
}
href_topic_remote(topic, ex_package)
}
find_reexport_source <- function(obj, ns, topic) {
if (is.primitive(obj)) {
# primitive functions all live in base
"base"
} else if (is.function(obj)) {
## For functions, we can just take their environment.
ns_env_name(get_env(obj))
} else {
## For other objects, we need to check the import env of the package,
## to see where 'topic' is coming from. The import env has redundant
## information. It seems that we just need to find a named list
## entry that contains `topic`.
imp <- getNamespaceImports(ns)
imp <- imp[names(imp) != ""]
wpkgs <- vapply(imp, `%in%`, x = topic, FUN.VALUE = logical(1))
if (!any(wpkgs)) {
return(NA_character_)
}
pkgs <- names(wpkgs)[wpkgs]
# Take the last match, in case imports have name clashes.
pkgs[[length(pkgs)]]
}
}
# Articles ----------------------------------------------------------------
#' @export
#' @rdname href_topic
href_article <- function(article, package = NULL) {
if (is_package_local(package)) {
path <- find_article(NULL, article)
if (!is.null(path)) {
return(paste0(getOption("downlit.article_path"), path))
}
}
if (is.null(package)) {
package <- find_vignette_package(article)
if (is.null(package)) {
return(NA_character_)
}
}
path <- find_article(package, article)
if (is.null(path)) {
return(NA_character_)
}
base_url <- remote_package_article_url(package)
if (!is.null(base_url)) {
paste0(base_url, "/", path)
} else if (is_bioc_pkg(package)) {
paste0("https://bioconductor.org/packages/release/bioc/vignettes/", package, "/inst/doc/", path)
} else {
paste0("https://cran.rstudio.com/web/packages/", package, "/vignettes/", path)
}
}
# Returns NA if package is not installed.
# Returns TRUE if `package` is from Bioconductor, FALSE otherwise
is_bioc_pkg <- function(package) {
if (!rlang::is_installed(package)) {
return(FALSE)
}
biocviews <- utils::packageDescription(package, fields = "biocViews")
!is.na(biocviews) && biocviews != ""
}
# Try to figure out package name from attached packages
find_vignette_package <- function(x) {
for (pkg in getOption("downlit.attached")) {
if (!is_installed(pkg)) {
next
}
info <- tools::getVignetteInfo(pkg)
if (x %in% info[, "Topic"]) {
return(pkg)
}
}
NULL
}
# Packages ----------------------------------------------------------------
#' @export
#' @rdname href_topic
href_package <- function(package) {
urls <- package_urls(package)
if (length(urls) == 0) {
NA_character_
} else {
urls[[1]]
}
}
href_package_ref <- function(package) {
reference_url <- remote_package_reference_url(package)
if (!is.null(reference_url)) {
reference_url
} else {
# Fall back to rdrr.io
if (is_base_package(package)) {
paste0("https://rdrr.io/r/", package)
} else {
paste0("https://rdrr.io/pkg/", package, "/man")
}
}
}
is_base_package <- function(x) {
x %in% c(
"base", "compiler", "datasets", "graphics", "grDevices", "grid",
"methods", "parallel", "splines", "stats", "stats4", "tcltk",
"tools", "utils"
)
}
downlit/R/article-index.R 0000644 0001762 0000144 00000002462 13750523135 015016 0 ustar ligges users article_index <- function(package) {
if (is.null(package)) {
getOption("downlit.article_index")
} else if (devtools_loaded(package)) {
# Use live docs for in-development packages
article_index_source(package)
} else {
article_index_remote(package)
}
}
article_index_source <- function(package) {
path <- file.path(find.package(package), "vignettes")
if (!file.exists(path)) {
return(character())
}
vig_path <- dir(path, pattern = "\\.[rR]md$", recursive = TRUE)
out_path <- gsub("\\.[rR]md$", ".html", vig_path)
vig_name <- gsub("\\.[rR]md$", "", basename(vig_path))
set_names(out_path, vig_name)
}
article_index_remote <- function(package) {
# Ideally will use published metadata because that includes all articles
# not just vignettes
metadata <- remote_metadata(package)
if (!is.null(metadata) && !is.null(metadata$articles)) {
return(metadata$articles)
}
# Otherwise, fallback to vignette index
path <- system.file("Meta", "vignette.rds", package = package)
if (path == "") {
return(character())
}
meta <- readRDS(path)
name <- tools::file_path_sans_ext(meta$File)
set_names(meta$PDF, name)
}
find_article <- function(package, name) {
index <- article_index(package)
if (has_name(index, name)) {
index[[name]]
} else {
NULL
}
}
downlit/R/metadata.R 0000644 0001762 0000144 00000007634 14630352676 014064 0 ustar ligges users remote_urls <- function(package) {
local <- getOption("downlit.local_packages")
if (has_name(local, package)) {
base_url <- local[[package]]
list(
reference = file.path(base_url, "reference"),
article = file.path(base_url, "articles")
)
} else {
remote_metadata(package)$urls
}
}
remote_package_reference_url <- function(package) {
remote_urls(package)$reference
}
remote_package_article_url <- function(package) {
remote_urls(package)$article
}
# Retrieve remote metadata ------------------------------------------------
remote_metadata <- function(package) {
# Is the metadata installed with the package?
meta <- local_metadata(package)
if (!is.null(meta)) {
return(meta)
}
# Otherwise, look in package websites, caching since this is a slow operation
tempdir <- Sys.getenv("RMARKDOWN_PREVIEW_DIR", unset = tempdir())
dir.create(file.path(tempdir, "downlit"), showWarnings = FALSE)
cache_path <- file.path(tempdir, "downlit", package)
if (file.exists(cache_path)) {
readRDS(cache_path)
} else {
meta <- remote_metadata_slow(package)
saveRDS(meta, cache_path)
meta
}
}
local_metadata <- function(package) {
local_path <- system.file("pkgdown.yml", package = package)
if (local_path == "") {
NULL
} else {
yaml::read_yaml(local_path)
}
}
remote_metadata_slow <- function(package) {
urls <- package_urls(package)
for (url in urls) {
url <- paste0(url, "/pkgdown.yml")
yaml <- tryCatch(fetch_yaml(url), error = function(e) NULL)
if (is.list(yaml)) {
if (has_name(yaml, "articles")) {
yaml$articles <- unlist(yaml$articles)
}
if (!has_name(yaml, "urls")) {
base_url <- dirname(url)
yaml$urls <- list(
reference = paste0(base_url, "/reference"),
article = paste0(base_url, "/articles")
)
}
return(yaml)
}
}
NULL
}
fetch_yaml <- function(url) {
path <- tempfile()
if (suppressWarnings(utils::download.file(url, path, quiet = TRUE) != 0)) {
abort("Failed to download")
}
# This call may warn if the URL doesn't have a final LF;
# see pkgdown issue #1419
suppressWarnings(yaml::read_yaml(path))
}
# Helpers -----------------------------------------------------------------
package_urls <- function(package, repos = getOption("repos")) {
if (package == "") { # if e.g. library(a$pkg) then pkg is ""
return(character())
}
if (is_installed(package)) {
path <- system.file("DESCRIPTION", package = package)
# If the package is installed, use its DESCRIPTION
url <- read.dcf(path, fields = "URL")[[1]]
} else {
# Otherwise try repo metadata, always trying CRAN last
user_repos <- repos[names2(repos) != "CRAN"]
meta <- c(lapply(user_repos, repo_urls), list(CRAN_urls()))
urls <- unlist(lapply(meta, function(pkgs) pkgs$URL[match(package, pkgs[["Package"]])]))
# Take first non-NA (if any)
url <- urls[!is.na(urls)]
if (all(is.na(urls))) {
url <- NA_character_
} else {
url <- urls[!is.na(urls)][[1]]
}
}
parse_urls(url)
}
parse_urls <- function(x) {
urls <- trimws(strsplit(trimws(x), "[,\\s]+", perl = TRUE)[[1]])
urls <- urls[grepl("^http", urls)]
sub_special_cases(urls)
}
# Both memoised in .onLoad
repo_urls <- function(repo) {
# Only works if the repo exposes the URL field in PACKAGES, and most don't
as.data.frame(
utils::available.packages(repos = repo, fields = "URL"),
stringsAsFactors = FALSE
)
}
CRAN_urls <- function() {
# Substantially faster to use RStudio mirror: in my testing this reduced
# download time from ~2s to 0.6s
withr::local_envvar(R_CRAN_WEB = "https://cran.rstudio.com")
tools::CRAN_package_db()
}
# All rOpenSci repositories have a known pkgdown URL.
# Todo: could generalise this concept for other orgs.
sub_special_cases <- function(urls){
sub("^https?://github.com/ropensci/(\\w+).*$", "https://docs.ropensci.org/\\1", urls)
}
downlit/NAMESPACE 0000644 0001762 0000144 00000001464 14137022063 013154 0 ustar ligges users # Generated by roxygen2: do not edit by hand
S3method(is_low_change,default)
S3method(replay_html,"NULL")
S3method(replay_html,character)
S3method(replay_html,error)
S3method(replay_html,html)
S3method(replay_html,htmlwidget)
S3method(replay_html,list)
S3method(replay_html,message)
S3method(replay_html,recordedplot)
S3method(replay_html,shiny.tag)
S3method(replay_html,shiny.tag.function)
S3method(replay_html,shiny.tag.list)
S3method(replay_html,source)
S3method(replay_html,warning)
export(autolink)
export(autolink_url)
export(classes_chroma)
export(classes_pandoc)
export(downlit_html_node)
export(downlit_html_path)
export(downlit_md_path)
export(downlit_md_string)
export(evaluate_and_highlight)
export(highlight)
export(href_article)
export(href_package)
export(href_topic)
export(is_low_change)
import(rlang)
downlit/LICENSE 0000644 0001762 0000144 00000000055 14520262710 012736 0 ustar ligges users YEAR: 2023
COPYRIGHT HOLDER: downlit authors
downlit/NEWS.md 0000644 0001762 0000144 00000011503 14630654541 013040 0 ustar ligges users # downlit 0.4.4
* Use simpler parsing algorithm for R 4.0, which avoids crash with certain UTF-8 characters (#189).
# downlit 0.4.3
* Fix for upcoming R-devel (#169).
# downlit 0.4.2
* `highlight()` no longer errors if a package imputed to have been attached
isn't installed.
* Correctly link `requireNamespace(MASS)` (#151).
# downlit 0.4.1
## Syntax highlighting
* Supports new base pipe `|>` syntax (#126).
* Every line get its own `` to match pandoc (#122).
* Multi-line tokens (e.g. strings) now get a `` per line (#139).
* Very long strings or other tokens are no longer truncated (@dmurdoch, #128).
## Auto-linkg
* Function calls (in inline and code blocks) will no longer to non-function
topics (#135).
* Re-exports detection no longer relies on name of `.Rd` file (#134).
* Link to correct topic with `::()` and `utils::help()` (@IndrajeetPatil, #131).
* Generate correct link for Bioconductor vignettes (@zeehio, #145)
# downlit 0.4.0
## Syntax highlighting
* Messages, warnings, and errors now get a much more minimal style.
Messages are styled the same way as output; and warnings and errors
only style the "Warning" or "Error" text. This makes these types of
output easier to read, and easier for package developers to style
themselves.
* Messages, warnings, and errors now retrieve their text using
`conditionMessage()`, which supports more advanced types of conditions
(@davidchall, #100).
* The overall structure of the syntax highlighting has been overhauled.
Now each line is wrapped in a `` with class `r-in` (input code),
`r-out` (output printed to console), `r-plot` (plots), `r-msg` (messages),
`r-wrn` (warnings), and `r-err` (errors). Additionally, the prompt (`#>`)
is wrapped in a ``. Altogether, these changes
should give much more flexibility for styling with CSS (#90).
* ANSI escapes no longer generate invalid HTML (#79).
* Changes to better support for HTML widgets and rgl in pkgdown
(@dmurdoch, #78). In particular, `evaluate_and_highlight()` now returns
an additional attribute containing all extra dependencies needed to render
the returned HTML.
## Auto-linking
* Packages attached when you call `library(package)` (including by the
tidyverse), are now taken into account when autolinking (#87).
* In code blocks, custom infix operators are now autolinked (#89).
In inline code, infix operators are no longer autolinked; this lead to too
many false positives. You can still link with (e.g.) `?"-"` (#86).
* Inline calls with arguments (e.g. `foo(1, 2)`) are no longer auto-linked,
as intended and documented (#82).
* Autolinking `vignette(foo, package = "pkg")` no longer errors if `pkg` is not
installed (#85).
* Unusual help calls (e.g. `help(a$b)`), no longer generate errors (#77).
* Rare warning about incomplete final line in `autolink_url("pkgname::foo")`
is now suppressed (@dmurdoch, pkgdown#1419).
* `href_package()` is now exported (#103).
* Auto-linking is more likely to succeed when the remote package is not
installed as downlit now looks for the URL using `tools::CRAN_package_db()`
for CRAN packages, and and `available.packages()` for packages installed
from non-CRAN repos (@ARawles, #108).
* Functions in HTML `` elements are no longer autolinked
(@gadenbuie, #105).
# downlit 0.2.1
* When auto-linking `vignette(foo)`, downlit now looks for a vignette named
foo in the packages it knows to be attached (#61).
* Can now force highlighting of any `` by wrapping it inside a ``
with `class = "downlit"`. This is useful in cases where it may otherwise
be hard to set the class of the ``.
* In comments, `\u2029` is converted to `\033` to make it possible to preserve
ANSI escapes when passed through xml2.
* No longer errors on library calls with named but empty arguments.
# downlit 0.2.0
* Autolinking can use metadata stored in package itself with pkgdown setting
`deploy.install_metadata`; this is useful for packages that only have
private websites (@matthewstrasiotto, #29)
* Autolinking guesses reference and article urls for pkgdown sites that haven't
set url (@krlmlr, #44).
* R6 classes are autolinked when a new object is created i.e. in
`r6_object$new()`, `r6_object` will link to its docs (#59, @maelle).
* R6 methods are no longer autolinked as if they were functions of the same
name (#54, @maelle).
* `classes_pandoc()` and `classes_chroma()` have been thoroughly revieweed to
produce syntax highlighting as similar as possible to RStudio.
* `downlit_html_path()` has a more flexible XPath identifying R code blocks,
and a `classes` argument (#53, @maelle, @cderv)
* Trailing `/` are no longer stripped from URLs (#45, @krlmlr).
* Removed extra newline in `` output (#42, @krlmlr).
# downlit 0.1.0
* Added a `NEWS.md` file to track changes to the package.
downlit/inst/ 0000755 0001762 0000144 00000000000 13731234742 012715 5 ustar ligges users downlit/inst/WORDLIST 0000644 0001762 0000144 00000000144 13731234742 014106 0 ustar ligges users AST
bookdown
chroma
dplyr
dplyr's
fansi
findable
hugo
hugodown
linkable
md
Pandoc
pkgdown
RMarkdown
downlit/README.md 0000644 0001762 0000144 00000007376 14250475251 013233 0 ustar ligges users # downlit
[](https://github.com/r-lib/downlit/actions/workflows/R-CMD-check.yaml)
[](https://app.codecov.io/gh/r-lib/downlit?branch=main)
[](https://CRAN.R-project.org/package=downlit)
The goal of downlit is to provide syntax highlighting and automatic linking of R code in a way that is easily used from RMarkdown packages like [pkgdown](https://pkgdown.r-lib.org/), [bookdown](https://bookdown.org), and [hugodown](https://hugodown.r-lib.org/).
## Installation
Install downlit from CRAN with:
```r
install.packages("downlit")
```
## Features
downlit has two slightly different highlighting/linking engines:
* `highlight()` works with multiline code blocks and does syntax highlighting,
function linking, and comment styling.
* `autolink()` works with inline code and only does linking.
Multiline code blocks have:
* Code syntax highlighted using R's parser.
* Function calls automatically linked to their corresponding documentation.
* Comments styled by transforming ANSI escapes sequences to their HTML
equivalents (thanks [fansi](https://github.com/brodieG/fansi) package).
The following forms of inline code are recognized and automatically linked:
* `fun()`, `pkg::fun()`.
* `?fun`, `pkg::fun`, `type?topic`.
* `help("fun")`, `help("fun", package = "package")`, `help(package = "package")`.
* `vignette("name")`, `vignette("name", package = "package")`.
* `library(package)`, `require(package)`, `requireNamespace("package")`.
* `{package}` gets linked (if possible) _and formatted as plain text_.
### Cross-package links
If downlit can find a pkgdown site for the remote package, it will link to it; otherwise it will link to }.}
\item{code}{If \code{TRUE}, wrap output in a \verb{} block}
}
\value{
If \code{text} is valid R code, an HTML \verb{} tag. Otherwise,
\code{NA}.
A string containing syntax highlighted HTML or \code{NA} (if \code{text}
isn't parseable).
}
\description{
This function:
\itemize{
\item syntax highlights code
\item links function calls to their documentation (where possible)
\item in comments, translates ANSI escapes in to HTML equivalents.
}
}
\section{Options}{
downlit provides a number of options to control the details of the linking.
They are particularly important if you want to generate "local" links.
\itemize{
\item \code{downlit.package}: name of the current package. Determines when
\code{topic_index} and \code{article_index}
\item \code{downlit.topic_index} and \code{downlit.article_index}: named character
vector that maps from topic/article name to path.
\item \code{downlit.rdname}: name of current Rd file being documented (if any);
used to avoid self-links.
\item \code{downlit.attached}: character vector of currently attached R packages.
\item \code{downlit.local_packages}: named character vector providing relative
paths (value) to packages (name) that can be reached with relative links
from the target HTML document.
\item \code{downlit.topic_path} and \code{downlit.article_path}: paths to reference
topics and articles/vignettes relative to the "current" file.
}
}
\examples{
cat(highlight("1 + 1"))
cat(highlight("base::t(1:3)"))
# Unparseable R code returns NA
cat(highlight("base::t("))
}
downlit/man/downlit-package.Rd 0000644 0001762 0000144 00000001617 14520262710 016051 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/downlit-package.R
\docType{package}
\name{downlit-package}
\alias{downlit}
\alias{downlit-package}
\title{downlit: Syntax Highlighting and Automatic Linking}
\description{
Syntax highlighting of R code, specifically designed for the needs of 'RMarkdown' packages like 'pkgdown', 'hugodown', and 'bookdown'. It includes linking of function calls to their documentation on the web, and automatic translation of ANSI escapes in output to the equivalent HTML.
}
\seealso{
Useful links:
\itemize{
\item \url{https://downlit.r-lib.org/}
\item \url{https://github.com/r-lib/downlit}
\item Report bugs at \url{https://github.com/r-lib/downlit/issues}
}
}
\author{
\strong{Maintainer}: Hadley Wickham \email{hadley@posit.co}
Other contributors:
\itemize{
\item Posit Software, PBC [copyright holder, funder]
}
}
\keyword{internal}
downlit/man/autolink.Rd 0000644 0001762 0000144 00000003052 14122441316 014620 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/link.R
\name{autolink}
\alias{autolink}
\alias{autolink_url}
\title{Automatically link inline code}
\usage{
autolink(text)
autolink_url(text)
}
\arguments{
\item{text}{String of code to highlight and link.}
}
\value{
If \code{text} is linkable, an HTML link for \code{autolink()}, and or just
the URL for \code{autolink_url()}. Both return \code{NA} if the text is not
linkable.
}
\description{
Automatically link inline code
}
\section{Options}{
downlit provides a number of options to control the details of the linking.
They are particularly important if you want to generate "local" links.
\itemize{
\item \code{downlit.package}: name of the current package. Determines when
\code{topic_index} and \code{article_index}
\item \code{downlit.topic_index} and \code{downlit.article_index}: named character
vector that maps from topic/article name to path.
\item \code{downlit.rdname}: name of current Rd file being documented (if any);
used to avoid self-links.
\item \code{downlit.attached}: character vector of currently attached R packages.
\item \code{downlit.local_packages}: named character vector providing relative
paths (value) to packages (name) that can be reached with relative links
from the target HTML document.
\item \code{downlit.topic_path} and \code{downlit.article_path}: paths to reference
topics and articles/vignettes relative to the "current" file.
}
}
\examples{
autolink("stats::median()")
autolink("vignette('grid', package = 'grid')")
autolink_url("stats::median()")
}
downlit/man/is_low_change.Rd 0000644 0001762 0000144 00000000565 14042044644 015605 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/evaluate.R
\name{is_low_change}
\alias{is_low_change}
\title{Compare two recorded plots}
\usage{
is_low_change(p1, p2)
}
\arguments{
\item{p1, p2}{Plot results}
}
\value{
Logical value indicating whether \code{p2} is a low-level update of \code{p1}.
}
\description{
Compare two recorded plots
}
downlit/man/evaluate_and_highlight.Rd 0000644 0001762 0000144 00000004412 14250475251 017461 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/evaluate.R
\name{evaluate_and_highlight}
\alias{evaluate_and_highlight}
\title{Evaluate code and syntax highlight the results}
\usage{
evaluate_and_highlight(
code,
fig_save,
classes = downlit::classes_pandoc(),
env = NULL,
output_handler = evaluate::new_output_handler(),
highlight = TRUE
)
}
\arguments{
\item{code}{Code to evaluate (as a string).}
\item{fig_save}{A function with arguments \code{plot} and \code{id} that is
responsible for saving \code{plot} to a file (using \code{id} to disambiguate
multiple plots in the same chunk). It should return a list with
components \code{path}, \code{width}, and \code{height}.}
\item{classes}{A mapping between token names and CSS class names.
Bundled \code{classes_pandoc()} and \code{classes_chroma()} provide mappings
that (roughly) match Pandoc and chroma (used by hugo) classes so you
can use existing themes.}
\item{env}{Environment in which to evaluate code; if not supplied,
defaults to a child of the global environment.}
\item{output_handler}{Custom output handler for \code{\link[evaluate:evaluate]{evaluate::evaluate()}}.}
\item{highlight}{Optionally suppress highlighting. This is useful for tests.}
}
\value{
An string containing HTML with a \code{dependencies} attribute
giving an additional htmltools dependencies required to render the HTML.
}
\description{
This function runs \code{code} and captures the output using
\code{\link[evaluate:evaluate]{evaluate::evaluate()}}. It syntax higlights code with \code{\link[=highlight]{highlight()}}, and
intermingles it with output.
}
\examples{
cat(evaluate_and_highlight("1 + 2"))
cat(evaluate_and_highlight("x <- 1:10\nmean(x)"))
# -----------------------------------------------------------------
# evaluate_and_highlight() powers pkgdown's documentation formatting so
# here I include a few examples to make sure everything looks good
# -----------------------------------------------------------------
blue <- function(x) paste0("\033[34m", x, "\033[39m")
f <- function(x) {
cat("This is some output. My favourite colour is ", blue("blue"), ".\n", sep = "")
message("This is a message. My favourite fruit is ", blue("blueberries"))
warning("Now at stage ", blue("blue"), "!")
}
f()
plot(1:10)
}
downlit/man/downlit_html_path.Rd 0000644 0001762 0000144 00000003320 14630625505 016520 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/downlit-html.R
\name{downlit_html_path}
\alias{downlit_html_path}
\alias{downlit_html_node}
\title{Syntax highlight and link an HTML page}
\usage{
downlit_html_path(in_path, out_path, classes = classes_pandoc())
downlit_html_node(x, classes = classes_pandoc())
}
\arguments{
\item{in_path, out_path}{Input and output paths for HTML file}
\item{classes}{A mapping between token names and CSS class names.
Bundled \code{classes_pandoc()} and \code{classes_chroma()} provide mappings
that (roughly) match Pandoc and chroma (used by hugo) classes so you
can use existing themes.}
\item{x}{An \code{xml2::xml_node}}
}
\value{
\code{downlit_html_path()} invisibly returns \code{output_path};
\code{downlit_html_node()} modifies \code{x} in place and returns nothing.
}
\description{
\itemize{
\item Code blocks, identified by \verb{} tags with class \verb{sourceCode r}
or any \verb{} tag inside of \verb{