diff --git a/src/resources/rmd/execute.R b/src/resources/rmd/execute.R index 42c2f479469..98ccc440cd0 100644 --- a/src/resources/rmd/execute.R +++ b/src/resources/rmd/execute.R @@ -142,36 +142,51 @@ execute <- function(input, format, tempDir, libDir, dependencies, cwd, params, r df_print = df_print ) - # we need ojs only if markdown has ojs code cells - # inspect code cells for spaces after line breaks - - needs_ojs <- grepl("(\n|^)[[:space:]]*```+\\{ojs[^}]*\\}", markdown) - # FIXME this test isn't failing in shiny mode, but it doesn't look to be - # breaking quarto-shiny-ojs. We should make sure this is right. - if ( - !is_shiny_prerendered(knitr::opts_knit$get("rmarkdown.runtime")) && - needs_ojs - ) { - local({ - # create a hidden environment to store specific objects - .quarto_tools_env <- attach(NULL, name = "tools:quarto") - # source ojs_define() function and save it in the tools environment - source(file.path(resourceDir, "rmd", "ojs_static.R"), local = TRUE) - assign("ojs_define", ojs_define, envir = .quarto_tools_env) - }) + # create a hidden environment to store specific objects + # Beware to use non conflicted name as this will be in second position right after globalenv. + .quarto_tools_env <- attach(NULL, name = "tools:quarto") + .quarto_tools_env$.assignToQuartoToolsEnv <- function(name, value) { + assign(name, value, envir = .quarto_tools_env) + } + .quarto_tools_env$.getFromQuartoToolsEnv <- function(name) { + get0(name, envir = .quarto_tools_env) + } + .quarto_tools_env$.rmFromQuartoToolsEnv <- function(name) { + if (exists(name, envir = .quarto_tools_env)) { + rm(list = c(name), envir = .quarto_tools_env) + } } - env <- globalenv() - env$.QuartoInlineRender <- function(v) { + # special internal function for rendering inline code using Quarto syntax + .assignToQuartoToolsEnv(".QuartoInlineRender", function(v) { # nolint: object_usage_linter, line_length_linter. if (is.null(v)) { "NULL" } else if (inherits(v, "AsIs")) { v } else if (is.character(v)) { - gsub(pattern="(\\[|\\]|[`*_{}()>#+-.!])", x=v, replacement="\\\\\\1") + gsub( + pattern = "(\\[|\\]|[`*_{}()>#+-.!])", + x = v, replacement = "\\\\\\1" + ) } else { v } + }) + + # we need ojs only if markdown has ojs code cells + # inspect code cells for spaces after line breaks + needs_ojs <- grepl("(\n|^)[[:space:]]*```+\\{ojs[^}]*\\}", markdown) + # FIXME this test isn't failing in shiny mode, but it doesn't look to be + # breaking quarto-shiny-ojs. We should make sure this is right. + if ( + !is_shiny_prerendered(knitr::opts_knit$get("rmarkdown.runtime")) && + needs_ojs + ) { + # source ojs_define() function into the tools environment + source( + file = file.path(resourceDir, "rmd", "ojs_static.R"), + local = .quarto_tools_env + ) } render_output <- rmarkdown::render( @@ -180,7 +195,7 @@ execute <- function(input, format, tempDir, libDir, dependencies, cwd, params, r knit_root_dir = knit_root_dir, params = params, run_pandoc = FALSE, - envir = env + envir = globalenv() ) knit_meta <- attr(render_output, "knit_meta") files_dir <- attr(render_output, "files_dir") diff --git a/src/resources/rmd/hooks.R b/src/resources/rmd/hooks.R index 530cbd11b35..a1f5afd53c1 100644 --- a/src/resources/rmd/hooks.R +++ b/src/resources/rmd/hooks.R @@ -165,6 +165,16 @@ knitr_hooks <- function(format, resourceDir, handledLanguages) { } delegating_output_hook = function(type, classes) { delegating_hook(type, function(x, options) { + ### START Knitr hack: + # since knitr 1.49, we can detect if output: asis + # was set by an R function itself (not cell option) + # We save the information for our other processing + # after output hook (i.e after sew method is called) + if (identical(options[["results"]], "asis")) { + .assignToQuartoToolsEnv("cell_options", list(asis_output = TRUE)) # nolint: object_usage_linter, line_length_linter. + } + ### END + if (identical(options[["results"]], "asis") || isTRUE(options[["collapse"]])) { x @@ -182,6 +192,16 @@ knitr_hooks <- function(format, resourceDir, handledLanguages) { # entire chunk knit_hooks$chunk <- delegating_hook("chunk", function(x, options) { + ## START knitr hack: + ## catch knit_asis output from save output hook state + asis_output <- .getFromQuartoToolsEnv("cell_options")$asis_output # nolint: object_usage_linter, line_length_linter. + if (isTRUE(asis_output)) { + options[["results"]] <- "asis" + } + # chunk hook is called last and we can clean the cell storage + on.exit(.rmFromQuartoToolsEnv("cell_options"), add = TRUE) # nolint: object_usage_linter, line_length_linter. + ## END + # Do nothing more for some specific chunk content ----- # Quarto language handler @@ -400,7 +420,7 @@ knitr_hooks <- function(format, resourceDir, handledLanguages) { # if there is a label, additional classes, a forwardAttr, or a cell.cap # then the user is deemed to have implicitly overridden results = "asis" # (as those features don't work w/o an enclosing div) - needCell <- isTRUE(nzchar(label)) || + needCell <- isTRUE(nzchar(label)) || length(classes) > 1 || isTRUE(nzchar(forwardAttr)) || isTRUE(nzchar(cell.cap)) @@ -409,7 +429,8 @@ knitr_hooks <- function(format, resourceDir, handledLanguages) { } else { paste0( options[["indent"]], "::: {", - labelId(label), paste(classes, collapse = " ") ,forwardAttr, "}\n", x, "\n", cell.cap , + labelId(label), paste(classes, collapse = " "), + forwardAttr, "}\n", x, "\n", cell.cap, options[["indent"]], ":::" ) } diff --git a/src/resources/rmd/patch.R b/src/resources/rmd/patch.R index addf5c8af06..fdcd714e848 100644 --- a/src/resources/rmd/patch.R +++ b/src/resources/rmd/patch.R @@ -103,7 +103,7 @@ wrap_asis_output <- function(options, x) { if (identical(options[["html-table-processing"]], "none")) { attrs <- paste(attrs, "html-table-processing=none") } - + # if this is an html table then wrap it further in ```{=html} # (necessary b/c we no longer do this by overriding kable_html, # which is in turn necessary to allow kableExtra to parse @@ -112,9 +112,17 @@ wrap_asis_output <- function(options, x) { !grepl('^