Make evaluation more reproducible (#1351)

And suppress various cli capabilities that you don't want inside docs

Fixes #1349

NEWS.md

@@ -1,5 +1,10 @@
 # roxygen2 (development version)
 
+* Code evaluated in inline markdown code chunks and `@eval`/`@evalRd`/
+  `@evalNamespace` is now evaluated in an environment designed to be more
+  reproducible and to suppress output that won't work in Rd (e.g. turning
+  off colour and unicode support in cli) (#1351).
+
 # roxygen2 7.2.0
 
 ## New features

R/markdown.R

@@ -96,7 +96,6 @@ eval_code_nodes <- function(nodes) {
   # This should only happen in our test cases
   if (is.null(evalenv)) evalenv <- new.env(parent = baseenv())
 
-  withr::local_options(width = 80)
   map_chr(nodes, eval_code_node, env = evalenv)
 }
 
@@ -111,9 +110,7 @@ eval_code_node <- function(node, env) {
     # write knitr markup for fenced code
     text <- paste0("```", xml_attr(node, "info"), "\n", xml_text(node), "```\n")
   }
-  old_opts <- purrr::exec(opts_chunk$set, knitr_chunk_defaults)
-  withr::defer(purrr::exec(opts_chunk$set, old_opts))
-  knit(text = text, quiet = TRUE, envir = env)
+  roxy_knit(text, env, knitr_chunk_defaults)
 }
 
 knitr_chunk_defaults <- list(

R/rd-eval.R

@@ -0,0 +1,26 @@
+roxy_eval <- function(expr, env) {
+  local_reproducible_output()
+  eval(expr, env)
+}
+
+roxy_knit <- function(text, envir, options) {
+  old_opts <- purrr::exec(opts_chunk$set, options)
+  withr::defer(purrr::exec(opts_chunk$set, old_opts))
+
+  local_reproducible_output()
+  knit(text = text, quiet = TRUE, envir = envir)
+}
+
+# Simplified from testthat::local_reproducible_output
+local_reproducible_output <- function(.envir = parent.frame()) {
+  withr::local_options(
+    crayon.enabled = FALSE,
+    cli.unicode = FALSE,
+    cli.dynamic = FALSE,
+    rlang_interactive = FALSE,
+    width = 80,
+    .local_envir = .envir
+  )
+  withr::local_envvar(RSTUDIO = NA, .local_envir = .envir)
+  withr::local_collate("C", .local_envir = .envir)
+}

R/rd-raw.R

@@ -18,7 +18,7 @@ format.rd_section_rawRd <- function(x, ...) {
 
 roxy_tag_eval <- function(tag, env = new.env(parent = baseenv())) {
   tryCatch({
-    out <- eval(tag$val, envir = env)
+    out <- roxy_eval(tag$val, env)
 
     if (!is.character(out)) {
       warn_roxy_tag(tag, "must evaluate to a character vector")