Merge pull request #4735 from quarto-dev/knitr/verbatim-engine-improv…

…ment

.github/workflows/test-smokes-parallel.yml

@@ -15,6 +15,13 @@ on:
     # only trigger on branches, not on tags
     branches: [main]
 
+concurrency:
+  # Use github.run_id on main branch
+  # Use github.event.pull_request.number on pull requests, so it's unique per pull request
+  # Use github.ref on other branches, so it's unique per branch
+  group: ${{ github.workflow }}-${{ github.ref == 'refs/heads/main' && github.run_id || github.event.pull_request.number || github.ref }}
+  cancel-in-progress: true
+
 jobs:
   jobs-matrix:
     runs-on: ubuntu-latest

news/changelog-1.4.md

@@ -116,6 +116,10 @@
 - Improved detection/exclusion of spurious matplotlib plain text output
 - Correctly exclude `id` fields when converting Colab notebooks to qmd.
 
+## Knitr
+
+- ([#4735](https://github.com/quarto-dev/quarto-cli/pull/4735)): Special `verbatim` and `embed` language engine for knitr's chunk are now better supported, including with special quarto cell option like `echo: fenced`.
+
 ## OJS engine
 
 - Update observablehq's runtime to version 5.6.0.

src/resources/rmd/hooks.R

@@ -7,6 +7,26 @@ merge_list <- function(x, y) {
     x
 }
 
+# inline from knitr:::create_fence() from version 1.38
+# calculate correct number of fences based on content for correct escaping
+create_fence <- function(x, char = "`") {
+  r <- paste0("\n", char, "{3,}")
+  l <- max(if (grepl(r, x)) attr(gregexpr(r, x)[[1]], "match.length"), 3)
+  paste(rep(char, l), collapse = "")
+}
+
+# inline from knitr:::eng2lang() from version 1.38
+# convert some engine names to language names
+eng2lang <- function(x) {
+  d <- c(
+    asy = "cpp", mysql = "sql", node = "javascript", 
+    psql = "sql", rscript = "r", rcpp = "cpp", tikz = "tex"
+  )
+  x <- tolower(x)
+  if (x %in% names(d)) d[x] else x
+}
+
+
 knitr_hooks <- function(format, resourceDir, handledLanguages) {
 
   knit_hooks <- list()
@@ -161,6 +181,10 @@ knitr_hooks <- function(format, resourceDir, handledLanguages) {
 
   # entire chunk
   knit_hooks$chunk <- delegating_hook("chunk", function(x, options) {
+
+    # Do nothing more for some specific chunk content -----
+
+    # Quarto language handler
     if (any(as.logical(lapply(handledLanguages, function(lang) {
       prefix <- paste0("```{", lang, "}")
       startsWith(x, prefix)
@@ -178,6 +202,8 @@ knitr_hooks <- function(format, resourceDir, handledLanguages) {
       return(x)
     }
 
+    # For any other, adding a cell output div -----
+
     # read some options
 
     label <- output_label(options)
@@ -282,7 +308,7 @@ knitr_hooks <- function(format, resourceDir, handledLanguages) {
                      "code-line-numbers",
                      "layout", "layout-nrow", "layout-ncol", "layout-align", "layout-valign", 
                      "output", "include.hidden", "source.hidden", "plot.hidden", "output.hidden")
-    other_opts <- c("eval", "out.width", "yaml.code", "code", "params.src", "original.params.src", 
+    other_opts <- c("eval", "out.width", "yaml.code", "code", "file", "params.src", "original.params.src", 
                     "fenced.echo", "chunk.echo", "lang",
                     "out.width.px", "out.height.px", "indent", "class.source", 
                     "class.output", "class.message", "class.warning", "class.error", "attr.source", 
@@ -325,7 +351,6 @@ knitr_hooks <- function(format, resourceDir, handledLanguages) {
      if (is.character(options[["tbl-cap-location"]])) 
       classes <- c(classes, paste0("tbl-cap-location-", options[["tbl-cap-location"]]))      
 
-
     if (isTRUE(options[["include.hidden"]])) {
       classes <- c(classes, "hidden")
     }
@@ -367,51 +392,46 @@ knitr_hooks <- function(format, resourceDir, handledLanguages) {
     x <- knitr:::hilight_source(x, "markdown", options)
     x <- knitr:::one_string(c('', x))
 
-    # leave verbatim alone
-    if (options[["engine"]] %in% c("verbatim", "embed")) {
-      return(paste0('\n\n````', options[["lang"]] %||% 'default', x, '\n````', '\n\n'))
-    }
-
     class <- options$class.source
     attr <- options$attr.source
-    class <- paste(class, "cell-code")
-    if (isTRUE(options[["source.hidden"]])) {
-      class <- paste(class, "hidden")
-    }
-    if (!identical(format$metadata[["crossref"]], FALSE)) {
-      id <- options[["lst-label"]]
-      if (!is.null(options[["lst-cap"]])) {
-        attr <- paste(attr, paste0('caption="', options[["lst-cap"]], '"'))
+    id <- NULL
+
+    # leave some specific engine alone
+    if (! options[["engine"]] %in% c("verbatim", "embed")) {
+      # Add classes and attributes required for quarto specific features
+      class <- paste(class, "cell-code")
+      if (isTRUE(options[["source.hidden"]])) {
+        class <- paste(class, "hidden")
+      }
+      if (!identical(format$metadata[["crossref"]], FALSE)) {
+        id <- options[["lst-label"]]
+        if (!is.null(options[["lst-cap"]])) {
+          attr <- paste(attr, paste0('caption="', options[["lst-cap"]], '"'))
+        }
+      }
+      if (identical(options[["code-overflow"]], "wrap"))
+        class <- paste(class, "code-overflow-wrap")
+      else if (identical(options[["code-overflow"]], "scroll"))
+        class <- paste(class, "code-overflow-scroll")
+      fold <- options[["code-fold"]]
+      if (!is.null(fold)) {
+        attr <- paste(attr, paste0('code-fold="', tolower(as.character(fold)), '"'))
+      }
+      fold <- options[["code-summary"]]
+      if (!is.null(fold)) {
+        attr <- paste(attr, paste0('code-summary="', as.character(fold), '"'))
+      }
+      lineNumbers <- options[["code-line-numbers"]]
+      if (!is.null(lineNumbers)) {
+        attr <- paste(attr, paste0('code-line-numbers="', tolower(as.character(lineNumbers)), '"'))
       }
-    } else {
-      id = NULL
-    }
-    if (identical(options[["code-overflow"]], "wrap"))
-      class <- paste(class, "code-overflow-wrap")
-    else if (identical(options[["code-overflow"]], "scroll"))
-      class <- paste(class, "code-overflow-scroll")
-    fold <- options[["code-fold"]]
-    if (!is.null(fold)) {
-      attr <- paste(attr, paste0('code-fold="', tolower(as.character(fold)), '"'))
-    }
-    fold <- options[["code-summary"]]
-    if (!is.null(fold)) {
-      attr <- paste(attr, paste0('code-summary="', as.character(fold), '"'))
-    }
-    lineNumbers <- options[["code-line-numbers"]]
-    if (!is.null(lineNumbers)) {
-      attr <- paste(attr, paste0('code-line-numbers="', tolower(as.character(lineNumbers)), '"'))
     }
 
-    lang <- tolower(options$engine)
+    # handles same knitr options
+    lang <- tolower(options$lang %||% eng2lang(options$engine))
+
     if (isTRUE(options[["fenced.echo"]])) {
-      attrs <- block_attr(
-        id = id,
-        lang = NULL,
-        class = trimws(class),
-        attr = attr
-      )
-      ticks <- "````"
+      lang <- NULL
       yamlCode <- lastYamlCode
       if (!is.null(yamlCode)) {
         yamlCode <- Filter(function(line) !grepl("echo:\\s+fenced", line), yamlCode)
@@ -422,15 +442,9 @@ knitr_hooks <- function(format, resourceDir, handledLanguages) {
       } else {
         x <- trimws(x, "left")
       }
-      x <- paste0("\n```{{", options[["original.params.src"]], "}}\n", yamlCode, x, '\n```')
+      ticks <- create_fence(x, "`")
+      x <- paste0("\n", ticks, "{{", options[["original.params.src"]], "}}\n", yamlCode, x, "\n", ticks)
     } else {
-       attrs <- block_attr(
-        id = id,
-        lang = lang,
-        class = trimws(class),
-        attr = attr
-      )
-
       # If requested, preserve the code yaml and emit it into the code blocks
       if (isTRUE(format$render$`produce-source-notebook`)) {
         yamlCode <- lastYamlCode
@@ -442,10 +456,18 @@ knitr_hooks <- function(format, resourceDir, handledLanguages) {
           x <- paste0("\n", yamlCode, x)
         }
       }
-      ticks <- "```"
     }
-
-    paste0('\n\n', ticks, attrs, x, '\n', ticks, '\n\n')   
+
+    ticks <- create_fence(x, "`")
+    attrs <- block_attr(
+      id = id,
+      lang = lang,
+      class = trimws(class),
+      attr = attr
+    )
+
+    paste0("\n\n", ticks, attrs, x, "\n", ticks, "\n\n")
+
   }
   knit_hooks$output <- delegating_output_hook("output", c("stdout"))
   knit_hooks$warning <- delegating_output_hook("warning", c("stderr"))

tests/docs/smoke-all/knitr/embed-verbatim-engine/knitr-embed-verbatim.qmd

@@ -0,0 +1,50 @@
+---
+format: html
+engine: knitr
+_quarto:
+  tests:
+    html:
+      # echo: false has been set and nothing should be including 
+      ensureHtmlElements:
+        - 
+          - "#verbatim div.sourceCode pre code.default"
+          - "#embed div.sourceCode pre code.r"
+          - "#fenced-echo div.sourceCode pre code.markdown"
+        - []
+      ensureFileRegexMatches:
+        - 
+          - "this is code\\.R"
+          - "`{3}\\{verbatim\\}"
+        - []
+    latex: 
+      ensureFileRegexMatches:
+        - 
+          - "\\\\NormalTok\\{Some content\\}"
+          - "\\\\FunctionTok\\{cat\\}"
+          - "(\\\\textasciigrave\\{\\}){3}\\\\{verbatim\\\\}"
+
+---
+
+## Verbatim {#verbatim}
+
+```{verbatim}
+Some content
+```
+
+## Embed {#embed}
+
+```{embed, file = "code.R"}
+```
+
+## Verbatim fenced-echo {#fenced-echo}
+
+````{verbatim}
+#| echo: fenced
+#| lang: markdown
+# Title
+
+```{r}
+1 + 1
+```
+````
+

tests/timing-for-ci.txt

@@ -252,7 +252,7 @@
         17.10 real 15.41 user 1.14 sys
 ./smoke/smoke-all.test.ts -- docs/smoke-all/2023/03/24/3152.qmd
         6.12 real 5.72 user 0.63 sys
-./smoke/smoke-all.test.ts -- docs/smoke-all/2023/03/09/revealjs-knitr-embed-verbatim.qmd
+./smoke/smoke-all.test.ts -- docs/smoke-all/knitr/embed-verbatim-engine/revealjs-knitr-embed-verbatim.qmd
         3.34 real 3.54 user 0.42 sys
 ./smoke/smoke-all.test.ts -- docs/smoke-all/2023/03/17/4867.qmd
         1.70 real 2.14 user 0.14 sys