Add output_format_dependency() (#2462)

This new function allows to modify output format from within a document's chunk

Co-authored-by: Christophe Dervieux <christophe.dervieux@gmail.com>

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: rmarkdown
 Title: Dynamic Documents for R
-Version: 2.23.2
+Version: 2.23.3
 Authors@R: c(
  person("JJ", "Allaire", , "jj@posit.co", role = "aut"),
  person("Yihui", "Xie", , "xie@yihui.name", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-0645-5666")),

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(knit_print,grouped_df)
+S3method(knit_print,output_format_dependency)
 S3method(knit_print,rowwise_df)
 S3method(knit_print,tbl_sql)
 S3method(prepare_evaluate_output,default)
@@ -57,6 +58,7 @@ export(navbar_html)
 export(navbar_links_html)
 export(odt_document)
 export(output_format)
+export(output_format_dependency)
 export(output_metadata)
 export(paged_table)
 export(pandoc_available)

NEWS.md

@@ -3,6 +3,8 @@ rmarkdown 2.24
 
 - Fixed `file_scope` being lost when extending output formats that considers the `file_scope` using `output_format()`. Merge behavior is to apply overlay `file_scope` function onto the result of `base_format`'s `file_scope` function. This implies that `file_scope` gains second argument which receives the returned values of the base `file_scope` (thanks, @atusy, #2488).
 
+- Added `output_format_dependency()` which allows extending output format from within chunks (thanks, @atusy, #2462)
+
 rmarkdown 2.23
 ================================================================================
 

R/output_format.R

@@ -831,3 +831,63 @@ citeproc_required <- function(yaml_front_matter,
  length(grep("^bibliography:\\s*$", input_lines)) > 0
  )
 }
+
+#' Define an R Markdown's output format dependency
+#'
+#' Define the dependency such as and pre/post-processors dynamically from
+#' within chunks. This function shares some arguments with
+#' \code{\link{output_format}}, but lacks the others because dependency
+#' is resolved after \code{post_knit} and before \code{pre_processor}.
+#'
+#' @param name A dependency name. If some dependencies share the same name,
+#' then only the first one will be attached.
+#' @inheritParams output_format
+#' @return An list of arguments with the "rmd_dependency" class.
+#' @examples
+#' # Add lua filters from within a chunk
+#' output_format_dependency("lua_filter", pre_processor = function(...) {
+#' pandoc_lua_filter_args(c("example1.lua", "example2.lua"))
+#' })
+#'
+#' @export
+output_format_dependency <- function(name,
+ pandoc = list(),
+ pre_processor = NULL,
+ post_processor = NULL,
+ file_scope = NULL,
+ on_exit = NULL) {
+ # Some arguments are NULL
+ # to ensure inheriting the values from the base output format
+ structure(list(name = name,
+ knitr = NULL, # must be NULL because merge happens after knit
+ pandoc = pandoc,
+ pre_processor = pre_processor,
+ keep_md = NULL,
+ clean_supporting = NULL,
+ post_processor = post_processor,
+ file_scope = file_scope,
+ on_exit = on_exit),
+ class = "output_format_dependency")
+}
+
+#' @export
+knit_print.output_format_dependency <- function(x, ...) {
+ knitr::asis_output(list(), meta = list(x))
+}
+
+merge_output_format_dependency <- function(fmt, dep) {
+ dep$name <- NULL # remove to be consistent with arguments of output_format
+ dep$base_format <- fmt
+ do.call(output_format, dep)
+}
+
+merge_output_format_dependencies <- function(fmt, deps) {
+ skip <- c()
+ for (d in deps) {
+ if (inherits(d, "output_format_dependency") && !isTRUE(skip[d$name])) {
+ skip[d$name] <- TRUE
+ fmt <- merge_output_format_dependency(fmt, d)
+ }
+ }
+ fmt
+}

R/render.R

@@ -840,6 +840,9 @@ render <- function(input,
 
  perf_timer_start("pre-processor")
 
+ if (has_dependencies(knit_meta, "output_format_dependency")) {
+ output_format <- merge_output_format_dependencies(output_format, knit_meta)
+ }
  # call any pre_processor
  if (!is.null(output_format$pre_processor)) {
  extra_args <- output_format$pre_processor(front_matter,

tests/testthat/test-output_format.R

@@ -106,3 +106,64 @@ test_that("default output_format is guessed from output file extension", {
  expect_equal(output_format_string_from_ext("test.any"), "html_document")
  expect_equal(output_format_string_from_ext(NULL), "html_document")
 })
+
+test_that("output format dependency has no effect on merge if it is empty", {
+ fmt <- html_document_base()
+ dep <- output_format_dependency("empty")
+ merged <- merge_output_format_dependencies(fmt, list(dep))
+ testthat::expect_named(merged, names(fmt))
+ fmt$on_exit <- merged$on_exit
+ expect_identical(fmt, merged)
+})
+
+test_that("output format dependencies can be merged", {
+ empty_format <- output_format(
+ knitr = NULL, pandoc = NULL, keep_md = NULL, clean_supporting = NULL,
+ pre_processor = NULL, post_processor = NULL,
+ file_scope = NULL, on_exit = NULL
+ )
+
+ f1 <- function(...) cat("d1")
+ f2 <- function(...) cat("d2")
+ d1 <- output_format_dependency(
+ name = "d1",
+ pandoc = list(to = "html", lua_filters = "d1.lua"),
+ pre_processor = f1,
+ post_processor = f1,
+ file_scope = f1,
+ on_exit = f1
+ )
+ d2 <- output_format_dependency(
+ name = "d2",
+ pandoc = list(to = "markdown", lua_filters = "d2.lua"),
+ pre_processor = f2,
+ post_processor = f2,
+ file_scope = f2,
+ on_exit = f2
+ )
+
+ m1 <- merge_output_format_dependencies(empty_format, list(d1, d2))
+ m2 <- merge_output_format_dependencies(empty_format, list(d1, d2, d2))
+ expect_identical(
+ m1$pandoc, list(to = "markdown", lua_filters = c("d1.lua", "d2.lua"))
+ )
+ expect_equal(m1, m2)
+
+ expect_cat <- function(obj, expected) {
+ expect_identical(capture.output(obj), expected)
+ }
+ expect_cat(invisible(m1$pre_processor()), "d1d2")
+ expect_cat(m1$post_processor(output_file = "example"), "d2d1")
+ expect_cat(m1$file_scope(), "d1d2")
+ expect_cat(m1$on_exit(), "d1d2")
+})
+
+test_that("output format dependencies are merged once per name", {
+ fmt <- html_document_base()
+ d1 <- output_format_dependency("d1", pandoc = list(lua_filters = "d1.lua"))
+ d2 <- output_format_dependency("d2", pandoc = list(lua_filters = "d2.lua"))
+ expect_equal(
+ merge_output_format_dependencies(fmt, list(d1, d2)),
+ merge_output_format_dependencies(fmt, list(d1, d1, d2, d1, d2))
+ )
+})