Skip to content

Commit 8279a15

Browse files
maxheld83maxheld83
authored
Apply knitr print method for inline r code (#1193)
Fixes #1179
1 parent 6ea92ed commit 8279a15

File tree

6 files changed

+228
-99
lines changed

6 files changed

+228
-99
lines changed

‎NEWS.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
# roxygen2 (development version)
22

3+
* Inline R code is now powered by knitr. Where available, (knit) print methods
4+
are applied (#1179). This change alters outputs and brings roxygen in line
5+
with console and R markdown behavior. `x <- "foo"` no longer inserts anything
6+
into the resulting documentation, but `x <- "foo"; x` will.
37
* roxygen2 can once again read UTF-8 paths on windows (#1277).
48

59
* `@exportS3method pkg::generic` now works even when `pkg::generic` isn't

‎R/markdown.R‎

Lines changed: 19 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
21
markdown <- function(text, tag = NULL, sections = FALSE) {
32
tag <- tag %||% list(file = NA, line = NA)
43
expanded_text <- tryCatch(
@@ -27,7 +26,7 @@ markdown <- function(text, tag = NULL, sections = FALSE) {
2726
#' To insert the name of the current package: `r packageName()`.
2827
#'
2928
#' The `iris` data set has `r ncol(iris)` columns:
30-
#' `r paste0("``", colnames(iris), "``", collapse = ", ")`.
29+
#' `r paste0("\x60\x60", colnames(iris), "\x60\x60", collapse = ", ")`.
3130
#'
3231
#' ```{r}
3332
#' # Code block demo
@@ -46,10 +45,13 @@ markdown <- function(text, tag = NULL, sections = FALSE) {
4645
#' ```{r test-figure}
4746
#' plot(1:10)
4847
#' ```
49-
#'
48+
#'
49+
#' Also see `vignette("rd-formatting")`.
50+
#'
5051
#' @param text Input text.
51-
#' @return Text with the inline code expanded. A character vector of the
52-
#' same length as the input `text`.
52+
#' @return
53+
#' Text with R code expanded.
54+
#' A character vector of the same length as the input `text`.
5355
#'
5456
#' @importFrom xml2 xml_ns_strip xml_find_all xml_attr
5557
#' @importFrom purrr keep
@@ -95,20 +97,23 @@ eval_code_nodes <- function(nodes) {
9597

9698
eval_code_node <- function(node, env) {
9799
if (xml_name(node) == "code") {
98-
text <- str_replace(xml_text(node), "^r ", "")
99-
paste(eval(parse(text = text), envir = env), collapse = "\n")
100-
100+
# write knitr markup for inline code
101+
text <- paste0("`", xml_text(node), "`")
101102
} else {
103+
# write knitr markup for fenced code
102104
text <- paste0("```", xml_attr(node, "info"), "\n", xml_text(node), "```\n")
103-
opts_chunk$set(
104-
error = FALSE,
105-
fig.path = "man/figures/",
106-
fig.process = function(path) basename(path)
107-
)
108-
knit(text = text, quiet = TRUE, envir = env)
109105
}
106+
old_opts <- purrr::exec(opts_chunk$set, knitr_chunk_defaults)
107+
withr::defer(purrr::exec(opts_chunk$set, old_opts))
108+
knit(text = text, quiet = TRUE, envir = env)
110109
}
111110

111+
knitr_chunk_defaults <- list(
112+
error = FALSE,
113+
fig.path = "man/figures/",
114+
fig.process = function(path) basename(path)
115+
)
116+
112117
str_set_all_pos <- function(text, pos, value, nodes) {
113118
# Cmark has a bug when reporting source positions for multi-line
114119
# code tags, and it does not count the indenting space in the

‎man/markdown_pass1.Rd‎

Lines changed: 4 additions & 2 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/_snaps/markdown-code.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,10 @@
1212

1313
Code
1414
out <- roc_proc_text(rd_roclet(), block)[[1]]
15+
Output
16+
17+
Message
18+
Quitting from lines 1-1 ()
1519
Condition
1620
Warning:
1721
[<text>:4] @description failed to evaluate inline markdown code

‎tests/testthat/test-markdown-code.R‎

Lines changed: 72 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,33 +1,74 @@
1-
2-
test_that("can eval", {
1+
test_that("can eval inline code", {
32
out1 <- roc_proc_text(rd_roclet(), "
3+
44
#' @title Title `r 1 + 1`
55
#' @description Description `r 2 + 2`
66
#' @md
7-
foo <- function() {}")[[1]]
8-
7+
foo <- function() NULL
8+
9+
")[[1]]
910
expect_equal(out1$get_value("title"), "Title 2")
1011
expect_equal(out1$get_value("description"), "Description 4")
1112
})
1213

13-
test_that("uses the same env for a block, but not across blocks", {
14+
test_that("can eval fenced code", {
1415
out1 <- roc_proc_text(rd_roclet(), "
15-
#' Title `r foobarxxx123 <- 420` `r foobarxxx123`
16+
17+
#' @title Title
18+
#' @details Details
19+
#' ```{r lorem}
20+
#' 1+1
21+
#' ```
22+
#' @md
23+
foo <- function() NULL
24+
25+
")[[1]]
26+
expect_match(out1$get_value("details"), "2")
27+
})
28+
29+
test_that("use same env within, but not across blocks", {
30+
example <- "
31+
#' Title `r baz <- 420` `r baz`
1632
#'
17-
#' Description `r exists('foobarxxx123', inherits = FALSE)`
33+
#' Description `r exists('baz', inherits = FALSE)`
1834
#' @md
19-
#' @name dummy
20-
NULL
35+
bar <- function() NULL
36+
37+
#' Title
38+
#'
39+
#' Description `r exists('baz', inherits = FALSE)`
40+
#' @md
41+
zap <- function() NULL
42+
"
43+
out1 <- roc_proc_text(rd_roclet(), example)[[1]]
44+
out2 <- roc_proc_text(rd_roclet(), example)[[2]]
45+
expect_equal(out1$get_value("title"), "Title 420")
46+
expect_equal(out1$get_value("description"), "Description TRUE")
47+
expect_equal(out2$get_value("description"), "Description FALSE")
48+
})
2149

22-
#' Title another
50+
test_that("appropriate knit print method for fenced and inline is applied", {
51+
rlang::local_bindings(
52+
knit_print.foo = function(x, inline = FALSE, ...) {
53+
knitr::asis_output(ifelse(inline, "inline", "fenced"))
54+
},
55+
.env = globalenv()
56+
)
57+
out1 <- roc_proc_text(rd_roclet(), "
58+
#' @title Title `r structure('default', class = 'foo')`
59+
#'
60+
#' @details Details
61+
#'
62+
#' ```{r}
63+
#' structure('default', class = 'foo')
64+
#' ```
2365
#'
24-
#' Description `r exists('foobarxxx123', inherits = FALSE)`
2566
#' @md
26-
#' @name dummy2
27-
NULL")
28-
expect_equal(out1$dummy.Rd$get_value("title"), "Title 420 420")
29-
expect_equal(out1$dummy.Rd$get_value("description"), "Description TRUE")
30-
expect_equal(out1$dummy2.Rd$get_value("description"), "Description FALSE")
67+
#' @name bar
68+
NULL
69+
")
70+
expect_match(out1$bar.Rd$get_value("details"), "fenced", fixed = TRUE)
71+
expect_match(out1$bar.Rd$get_value("title"), "inline", fixed = TRUE)
3172
})
3273

3374
test_that("can create markdown markup", {
@@ -40,12 +81,24 @@ test_that("can create markdown markup", {
4081
test_that("can create markdown markup piecewise", {
4182
expect_identical(
4283
markdown(
43-
"Description [`r paste0('https://url]')`](`r paste0('link text')`)"
84+
"Description [`r paste0('https://url')`](`r paste0('link text')`)"
4485
),
45-
"Description \\link{https://url}](link text)"
86+
"Description \\link{https://url}(link text)"
4687
)
4788
})
4889

90+
test_that("can create escaped markdown markup", {
91+
# this workaround is recommended by @yihui
92+
# "proper" escaping for inline knitr tracked in https://github.com/yihui/knitr/issues/1704
93+
out1 <- roc_proc_text(rd_roclet(), "
94+
#' Title
95+
#' Description `r paste0('\\x60', 'bar', '\\x60')`
96+
#' @md
97+
foo <- function() NULL
98+
")[[1]]
99+
expect_match(out1$get_value("title"), "\\code{bar}", fixed = TRUE)
100+
})
101+
49102
test_that("NULL creates no text", {
50103
expect_identical(
51104
markdown("Description --`r NULL`--"),
@@ -89,7 +142,7 @@ test_that("interleaving fences and inline code", {
89142
out1 <- roc_proc_text(rd_roclet(), "
90143
#' Title
91144
#'
92-
#' @details Details `r x <- 10`
145+
#' @details Details `r x <- 10; x`
93146
#'
94147
#' ```{r}
95148
#' y <- x + 10

0 commit comments

Comments
 (0)