Another attempt at fixing issues with pandoc's raw attribute usage in…

… htmlPreserve() (#308)

Co-authored-by: Barret Schloerke <[email protected]>
Co-authored-by: cpsievert <[email protected]>

NEWS.md

@@ -2,7 +2,7 @@
 
 ## Breaking changes
 
-* Closed #305: `htmlPreserve()` no longer uses inline code blocks for Pandoc's raw attribute feature (i.e., when `options(htmltools.preserve.raw = TRUE)`. As a result, rmarkdown no longer adds an addition `<p>` tag around 'literal' HTML. (#306)
+* Closed #305: `htmlPreserve()` no longer uses _inline_ code blocks for Pandoc's raw attribute feature when used inside a _non_-inline knitr/rmarkdown code chunk, and as a result, in this case, an additional `<p>` tag is no longer wrapped around the HTML content. (#306)
 
 ## Bug fixes
 

R/tags.R

@@ -1482,22 +1482,41 @@ as.tags.html_dependency <- function(x, ...) {
 #'
 #' @export
 htmlPreserve <- function(x) {
+  html_preserve(x, inline = "auto")
+}
+
+html_preserve <- function(x, inline = "auto") {
   x <- paste(x, collapse = "\n")
+
   # Do nothing for empty string
   if (!nzchar(x)) {
     return(x)
   }
+
   # rmarkdown sets this option to TRUE to leverage various benefits
   # that come with preserving HTML via pandoc 2.0's raw attribute feature
   # https://github.com/rstudio/rmarkdown/pull/1965#issuecomment-734804176
   if (!getOption("htmltools.preserve.raw", FALSE)) {
     return(sprintf("<!--html_preserve-->%s<!--/html_preserve-->", x))
   }
-  # Always use the block (not inline) form since the latter wraps x in
-  # a <p> tag, which can have unfortunate consequences, most notably
+
+  # With no other context, the presence of line break(s) determines whether a
+  # block or inline code chunk is used for pandoc's raw attributes (the inline
+  # version may add an additional <p> tag around the HTML (which can be
+  # problematic, for instance, when embedding shiny inside flexdashboard)
+  # Thankfully knitr::knit_print() can tell us whether we're inside a inline
+  # code which is why this is here essentially just for non-knit usage
   # https://github.com/rstudio/flexdashboard/issues/379
   # https://github.com/rstudio/rmarkdown/issues/2259#issuecomment-995996958
-  sprintf("\n```{=html}\n%s\n```\n", x)
+  if (identical(inline, "auto")) {
+    inline <- grepl(x, "\n", fixed = TRUE)
+  }
+
+  if (inline) {
+    sprintf("`%s`{=html}", x)
+  } else {
+    sprintf("\n```{=html}\n%s\n```\n", x)
+  }
 }
 
 # Temporarily set x in env to value, evaluate expr, and
@@ -1664,11 +1683,12 @@ restorePreserveChunks <- function(strval, chunks) {
 #' @name knitr_methods
 #' @param x Object to knit_print
 #' @param ... Additional knit_print arguments
+#' @param inline Whether or not the code chunk is inline.
 NULL
 
 #' @rdname knitr_methods
 #' @export
-knit_print.shiny.tag <- function(x, ...) {
+knit_print.shiny.tag <- function(x, ..., inline = FALSE) {
   x <- tagify(x)
   output <- surroundSingletons(x)
   deps <- resolveDependencies(findDependencies(x, tagify = FALSE), resolvePackageDir = FALSE)
@@ -1681,15 +1701,15 @@ knit_print.shiny.tag <- function(x, ...) {
   meta <- c(meta, deps)
 
   knitr::asis_output(
-    htmlPreserve(format(content$ui, indent=FALSE)),
+    html_preserve(format(content$ui, indent=FALSE), inline),
     meta = meta)
 }
 
 #' @rdname knitr_methods
 #' @export
-knit_print.html <- function(x, ...) {
+knit_print.html <- function(x, ..., inline = FALSE) {
   deps <- resolveDependencies(findDependencies(x, tagify = FALSE))
-  knitr::asis_output(htmlPreserve(as.character(x)),
+  knitr::asis_output(html_preserve(as.character(x), inline),
     meta = if (length(deps)) list(deps))
 }