close yihui/knitr#2331: provide a fenced_block() function to be reuse…

…d in knitr and possibly pandoc/litedown

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: xfun
 Type: Package
 Title: Supporting Functions for Packages Maintained by 'Yihui Xie'
-Version: 0.42.4
+Version: 0.42.5
 Authors@R: c(
   person("Yihui", "Xie", role = c("aut", "cre", "cph"), email = "[email protected]", comment = c(ORCID = "0000-0003-0645-5666")),
   person("Wush", "Wu", role = "ctb"),

NAMESPACE

@@ -42,6 +42,7 @@ export(embed_files)
 export(env_option)
 export(existing_files)
 export(exit_call)
+export(fenced_block)
 export(file_exists)
 export(file_ext)
 export(file_string)
@@ -74,6 +75,7 @@ export(is_windows)
 export(json_vector)
 export(loadable)
 export(magic_path)
+export(make_fence)
 export(mark_dirs)
 export(msg_cat)
 export(n2w)

NEWS.md

@@ -2,6 +2,8 @@
 
 - Added a function `upload_imgur()`, which was adapted from `knitr::imgur_upload()`. The latter will call the former in the future. `xfun::upload_imgur()` allows users to choose whether to use the system command `curl` or the R package **curl** to upload the image. It also has a new argument `include_xml` to specify whether the XML response needs to be included in the returned value.
 
+- Added a function `fenced_block()` to create a fenced block in Markdown (thanks, @cderv, yihui/knitr#2331). The block can be either a code block or a fenced Div.
+
 - Fixed a bug in `xfun::record()` when the argument `verbose = 1` or `2`.
 
 # CHANGES IN xfun VERSION 0.42

R/markdown.R

@@ -107,6 +107,51 @@ escape_math = function(x, token = '') {
   x
 }
 
+#' Create a fenced block in Markdown
+#'
+#' Wrap content with fence delimiters such as backticks (code blocks) or colons
+#' (fenced Div). Optionally the fenced block can have attributes.
+#' @param x A character vector of the block content.
+#' @param attrs A vector of block attributes.
+#' @param fence The fence string, e.g., `:::` or ```` ``` ````. This will be
+#'   generated from the `char` argument by default.
+#' @param char The fence character to be used to generate the fence string by
+#'   default.
+#' @return `fenced_block()` returns a character vector that contains both the
+#'   fences and content.
+#' @export
+#' @examples
+#' # code block with class 'r' and ID 'foo'
+#' xfun::fenced_block('1+1', c('.r', '#foo'))
+#' # fenced Div
+#' xfun::fenced_block('This is a **Div**.', char = ':')
+fenced_block = function(x, attrs = NULL, fence = make_fence(x, char), char = '`') {
+  c('', paste0(fence, block_attr(attrs)), x, fence)
+}
+
+#' @return `make_fence()` returns a character string. If the block content
+#'   contains `N` fence characters (e.g., backticks), use `N + 1` characters as
+#'   the fence.
+#' @rdname fenced_block
+#' @export
+#' @examples
+#' # three backticks by default
+#' xfun::make_fence('1+1')
+#' # needs five backticks for the fences because content has four
+#' xfun::make_fence(c('````r', '1+1', '````'))
+make_fence = function(x, char = '`') {
+  f = strrep(char, 3)
+  while (any(grepl(f, x, fixed = TRUE))) f = paste0(f, char)
+  f
+}
+
+# concatenate block attributes for fenced blocks
+block_attr = function(attrs) {
+  a = paste(attrs, collapse = ' ')
+  if (grepl('[ .]', a)) a = paste0(' {', a, '}')
+  a
+}
+
 #' Embed a file, multiple files, or directory on an HTML page
 #'
 #' For a file, first encode it into base64 data (a character string). Then

tests/test-cran/test-markdown.R

@@ -71,3 +71,22 @@ assert('protect_math() puts inline math expressions in backticks', {
   (protect_math('hi $$\alpha$$ and $$ \alpha$$') %==% 'hi `$$\alpha$$` and $$ \alpha$$')
 })
 
+
+assert('block_attr(x) turns a character vector into Pandoc attributes', {
+  (block_attr(NULL) %==% '')
+  (block_attr('.a') %==% ' {.a}')
+  (block_attr('.a b="11"') %==% ' {.a b="11"}')
+  (block_attr(c('.a', 'b="11"')) %==% ' {.a b="11"}')
+})
+
+assert('make_fence() uses the right number of fence characters', {
+  (make_fence('1+1') %==% '```')
+  (make_fence(c('1+1', '`````')) %==% '``````')
+  (make_fence(':::') %==% '```')
+  (make_fence(':::', ':') %==% '::::')
+})
+
+assert('fenced_block() wraps content inside fences', {
+  (fenced_block('1+1') %==% c('', '```', '1+1', '```'))
+  (fenced_block('1+1', c('.lang', '#id', 'foo="BAR"')) %==% c('', '``` {.lang #id foo="BAR"}', '1+1', '```'))
+})