close yihui#1885: export output hooks from render_*() functions to ho…

…oks_*() functions (yihui#1889)

NAMESPACE

@@ -53,6 +53,15 @@ export(hook_pngquant)
 export(hook_purl)
 export(hook_r2swf)
 export(hook_scianimator)
+export(hooks_asciidoc)
+export(hooks_html)
+export(hooks_jekyll)
+export(hooks_latex)
+export(hooks_listings)
+export(hooks_markdown)
+export(hooks_rst)
+export(hooks_sweave)
+export(hooks_textile)
 export(image_uri)
 export(imgur_upload)
 export(include_app)

NEWS.md

@@ -2,6 +2,8 @@
 
 ## NEW FEATURES
 
+- Added `knitr::hooks_*()` functions to get a list of output hooks for a specific format. Previously, these hooks only exist inside the `knitr::render_*()` functions, and users do not have direct access to them. Now they can be accessed directly, e.g., via `knitr::hooks_markdown()` to get a list of output hooks for R Markdown documents. You can also set the output hooks individually, e.g., `knitr::knit_hooks$set(knitr::hooks_markdown()['source'])` only sets the _source_ ouput hook. See more on output hooks at https://yihui.org/knitr/hooks/#output-hooks and https://bookdown.org/yihui/rmarkdown-cookbook/output-hooks.html (thanks, @cderv, #1889).
+
 - Added an argument `lib.loc` to `knitr::write_bib()`.
 
 ## BUG FIXES

R/hooks-asciidoc.R

@@ -17,6 +17,12 @@ hook_plot_asciidoc = function(x, options) {
 render_asciidoc = function() {
   set_html_dev()
   opts_knit$set(out.format = 'asciidoc')
+  knit_hooks$set(hooks_asciidoc())
+}
+
+#' @rdname output_hooks
+#' @export
+hooks_asciidoc = function() {
   hook.source = function(x, options) {
     x = one_string(c(hilight_source(x, 'asciidoc', options), ''))
     sprintf('\n[source,%s]\n----\n%s----\n', tolower(options$engine), x)
@@ -31,7 +37,7 @@ render_asciidoc = function() {
     sprintf('\n[CAUTION]\n====\n.Error\n%s\n====\n', gsub('^.*Error: ', '', x))
   }
   hook.output = function(x, options) sprintf('\n----\n%s----\n', x)
-  knit_hooks$set(
+  list(
     source = hook.source, output = hook.output, message = hook.message,
     warning = hook.warning, error = hook.error, plot = hook_plot_asciidoc
   )

R/hooks-html.R

@@ -233,8 +233,16 @@ hook_r2swf = function(x, options) {
 render_html = function() {
   set_html_dev()
   opts_knit$set(out.format = 'html')
+  h = opts_knit$get('header')
+  if (!nzchar(h['highlight'])) set_header(highlight = .header.hi.html)
+  knit_hooks$set(hooks_html())
+}
+
+#' @rdname output_hooks
+#' @export
+hooks_html = function() {
   # use div with different classes
-  html.hook = function(name) {
+  hook = function(name) {
     force(name)
     function(x, options) {
       x = if (name == 'source') {
@@ -244,14 +252,12 @@ render_html = function() {
       sprintf('<div class="%s"><pre class="knitr %s">%s</pre></div>\n', name, tolower(options$engine), x)
     }
   }
-  h = opts_knit$get('header')
-  if (!nzchar(h['highlight'])) set_header(highlight = .header.hi.html)
-  z = list()
-  for (i in c('source', 'warning', 'message', 'error'))
-    z[[i]] = html.hook(i)
-  knit_hooks$set(z)
-  knit_hooks$set(inline = function(x) {
-    sprintf(if (inherits(x, 'AsIs')) '%s' else '<code class="knitr inline">%s</code>',
-            .inline.hook(format_sci(x, 'html')))
-  }, output = html.hook('output'), plot = hook_plot_html, chunk = .chunk.hook.html)
+  list(
+    source = hook('source'), output = hook('output'), warning = hook('warning'),
+    message = hook('message'), error = hook('error'), plot = hook_plot_html,
+    chunk = .chunk.hook.html, inline = function(x) sprintf(
+      if (inherits(x, 'AsIs')) '%s' else '<code class="knitr inline">%s</code>',
+      .inline.hook(format_sci(x, 'html'))
+    )
+  )
 }

R/hooks-latex.R

@@ -231,44 +231,74 @@ hook_plot_tex = function(x, options) {
   }
 }
 
-#' Set output hooks for different output formats
+#' Set or get output hooks for different output formats
 #'
-#' These functions set built-in output hooks for LaTeX, HTML, Markdown,
-#' reStructuredText, AsciiDoc and Textile.
+#' The \code{render_*()} functions set built-in output hooks for LaTeX, HTML,
+#' Markdown, reStructuredText, AsciiDoc, and Textile. The \code{hooks_*()}
+#' functions return a list of the output hooks for the corresponding format.
 #'
-#' There are three variants of markdown documents: ordinary markdown
-#' (\code{render_markdown(strict = TRUE)}), extended markdown (e.g. GitHub
-#' Flavored Markdown and pandoc; \code{render_markdown(strict = FALSE)}), and
-#' Jekyll (a blogging system on GitHub; \code{render_jekyll()}). For LaTeX
-#' output, there are three variants as well: \pkg{knitr}'s default style
-#' (\code{render_latex()}; use the LaTeX \pkg{framed} package), Sweave style
-#' (\code{render_sweave()}; use \file{Sweave.sty}) and listings style
-#' (\code{render_listings()}; use LaTeX \pkg{listings} package). Default HTML
-#' output hooks are set by \code{render_html()}; \code{render_rst()} and
-#' \code{render_asciidoc()} are for reStructuredText and AsciiDoc respectively.
+#' There are three variants of Markdown documents: ordinary Markdown
+#' (\code{render_markdown(strict = TRUE)}, which calls
+#' \code{hooks_markdown(strict = TRUE)}), extended Markdown (e.g., GitHub
+#' Flavored Markdown and Pandoc; \code{render_markdown(strict = FALSE)}, which
+#' calls \code{hooks_markdown(strict = FALSE)}), and Jekyll (a blogging system
+#' on GitHub; \code{render_jekyll()}, which calls \code{hooks_jekyll()}).
 #'
-#' These functions can be used before \code{knit()} or in the first chunk of the
-#' input document (ideally this chunk has options \code{include = FALSE} and
-#' \code{cache = FALSE}) so that all the following chunks will be formatted as
-#' expected.
+#' For LaTeX output, there are three variants: \pkg{knitr}'s default style
+#' (\code{render_latex()}, which calls \code{hooks_latex()} and uses the LaTeX
+#' \pkg{framed} package), Sweave style (\code{render_sweave()}, which calls
+#' \code{hooks_sweave()} and uses \file{Sweave.sty}), and listings style
+#' (\code{render_listings()}, which calls \code{hooks_listings()} and uses LaTeX
+#' \pkg{listings} package).
+#'
+#' Default HTML output hooks are set by \code{render_html()} (which calls
+#' \code{hooks_html()}); \code{render_rst()} (which calls \code{hooks_rst()}) is
+#' for reStructuredText; \code{render_textile()} (which calls
+#' \code{hooks_textile()}) is for Textile, and \code{render_asciidoc()} (which
+#' calls \code{hooks_asciidoc()}) is AsciiDoc.
+#'
+#' The \code{render_*()} functions can be used before \code{knit()} or in the
+#' first chunk of the input document (ideally this chunk has options
+#' \code{include = FALSE} and \code{cache = FALSE}) so that all the following
+#' chunks will be formatted as expected.
+#'
+#' You can also use \code{\link{knit_hooks}} to set the format's hooks with the
+#' \code{hooks_*()} functions; see references for more info on further
+#' customizing output hooks.
 #'
-#' You can use \code{\link{knit_hooks}} to further customize output hooks; see
-#' references.
 #' @rdname output_hooks
-#' @return \code{NULL}; corresponding hooks are set as a side effect
+#' @return \code{NULL} for \code{render_*} functions; corresponding hooks are
+#'   set as a side effect. A list of output hooks for \code{hooks_*()}
+#'   functions.
 #' @export
-#' @references See output hooks in \url{https://yihui.org/knitr/hooks/}.
+#' @references See output hooks in \url{https://yihui.org/knitr/hooks/}, and
+#'   some examples in
+#'   \url{https://bookdown.org/yihui/rmarkdown-cookbook/output-hooks.html}
 #'
 #'   Jekyll and Liquid:
-#'   \url{https://github.com/jekyll/jekyll/wiki/Liquid-Extensions};
-#'   prettify.js: \url{http://code.google.com/p/google-code-prettify/}
+#'   \url{https://github.com/jekyll/jekyll/wiki/Liquid-Extensions}; prettify.js:
+#'   \url{http://code.google.com/p/google-code-prettify/}
+#' @examples
+#' # below is pretty much what knitr::render_markdown() does:
+#' knitr::knit_hooks$set(knitr::hooks_markdown())
+#'
+#' # you can retrieve a subset of the hooks and set them, e.g.,
+#' knitr::knit_hooks$set(knitr::hooks_markdown()["source"])
+#'
+#' knitr::knit_hooks$restore()
 render_latex = function() {
   opts_chunk$set(out.width = '\\maxwidth', dev = 'pdf')
   opts_knit$set(out.format = 'latex')
   h = opts_knit$get('header')
   if (!nzchar(h['framed'])) set_header(framed = .header.framed)
   if (!nzchar(h['highlight'])) set_header(highlight = .header.hi.tex)
-  knit_hooks$set(
+  knit_hooks$set(hooks_latex())
+}
+
+#' @rdname output_hooks
+#' @export
+hooks_latex = function() {
+  list(
     source = function(x, options) {
       x = hilight_source(x, 'latex', options)
       if (options$highlight) {
@@ -295,39 +325,54 @@ render_latex = function() {
     }
   )
 }
+
 #' @rdname output_hooks
 #' @export
 render_sweave = function() {
   opts_chunk$set(highlight = FALSE, comment = NA, prompt = TRUE) # mimic Sweave settings
   opts_knit$set(out.format = 'sweave')
   test_latex_pkg('Sweave', file.path(R.home('share'), 'texmf', 'tex', 'latex', 'Sweave.sty'))
   set_header(framed = '', highlight = '\\usepackage{Sweave}')
+  knit_hooks$set(hooks_sweave())
+}
+
+#' @param envirs Names of LaTeX environments for code input, output, and chunk.
+#' @rdname output_hooks
+#' @export
+hooks_sweave = function(envirs = c('Sinput', 'Soutput', 'Schunk')) {
   # wrap source code in the Sinput environment, output in Soutput
-  hook.i = function(x, options)
-    one_string(c('\\begin{Sinput}', hilight_source(x, 'sweave', options), '\\end{Sinput}', ''))
+  hook.i = function(x, options) one_string(c(
+    sprintf('\\begin{%s}', envirs[1]), hilight_source(x, 'sweave', options),
+    sprintf('\\end{%s}', envirs[1]), ''
+  ))
   hook.s = function(x, options) {
     if (output_asis(x, options)) return(x)
-    paste0('\\begin{Soutput}\n', x, '\\end{Soutput}\n')
+    sprintf('\\begin{%s}\n%s\\end{%s}\n', envirs[2], x, envirs[2])
   }
   hook.c = function(x, options) {
     if (output_asis(x, options)) return(x)
-    paste0('\\begin{Schunk}\n', x, '\\end{Schunk}')
+    sprintf('\\begin{%s}\n%s\\end{%s}', envirs[3], x, envirs[3])
   }
-  knit_hooks$set(source = hook.i, output = hook.s, warning = hook.s,
-                 message = hook.s, error = hook.s, inline = .inline.hook.tex,
-                 plot = hook_plot_tex, chunk = hook.c)
+  list(
+    source = hook.i, output = hook.s, warning = hook.s, message = hook.s,
+    error = hook.s, plot = hook_plot_tex, inline = .inline.hook.tex, chunk = hook.c
+  )
 }
+
 #' @rdname output_hooks
 #' @export
 render_listings = function() {
-  render_sweave()
-  opts_chunk$set(prompt = FALSE)
+  opts_chunk$set(highlight = FALSE, comment = NA, prompt = FALSE) # mimic Sweave settings
   opts_knit$set(out.format = 'listings')
   test_latex_pkg('Sweavel', system.file('misc', 'Sweavel.sty', package = 'knitr'))
   set_header(framed = '', highlight = '\\usepackage{Sweavel}')
-  invisible(NULL)
+  knit_hooks$set(hooks_listings())
 }
 
+#' @rdname output_hooks
+#' @export
+hooks_listings = hooks_sweave
+
 # may add textile, and many other markup languages
 
 #' Some potentially useful document hooks

R/hooks-md.R

@@ -140,6 +140,12 @@ block_attr = function(attr, class = NULL, lang = NULL) {
 render_markdown = function(strict = FALSE, fence_char = '`') {
   set_html_dev()
   opts_knit$set(out.format = 'markdown')
+  knit_hooks$set(hooks_markdown(strict, fence_char))
+}
+
+#' @rdname output_hooks
+#' @export
+hooks_markdown = function(strict = FALSE, fence_char = '`') {
   fence = paste(rep(fence_char, 3), collapse = '')
   # four spaces lead to <pre></pre>
   hook.t = function(x, options, attr = NULL, class = NULL) {
@@ -170,10 +176,7 @@ render_markdown = function(strict = FALSE, fence_char = '`') {
     attrs = block_attr(options$attr.source, options$class.source, language)
     paste0('\n\n', fence, attrs, '\n', x, fence, '\n\n')
   }
-  hooks = list()
-  for (i in c('output', 'warning', 'error', 'message')) hooks[[i]] = hook.o(i)
-  knit_hooks$set(hooks)
-  knit_hooks$set(
+  list(
     source = function(x, options) {
       x = hilight_source(x, 'markdown', options)
       (if (strict) hook.t else hook.r)(one_string(c(x, '')), options)
@@ -193,9 +196,12 @@ render_markdown = function(strict = FALSE, fence_char = '`') {
       }
       if (is.null(s <- options$indent)) return(x)
       line_prompt(x, prompt = s, continue = s)
-    }
+    },
+    output = hook.o('output'), warning = hook.o('warning'),
+    error = hook.o('error'), message = hook.o('message')
   )
 }
+
 #' @param highlight Which code highlighting engine to use: if \code{pygments},
 #'   the Liquid syntax is used (default approach Jekyll); if \code{prettify},
 #'   the output is prepared for the JavaScript library \file{prettify.js}; if
@@ -206,9 +212,16 @@ render_markdown = function(strict = FALSE, fence_char = '`') {
 #' @rdname output_hooks
 #' @export
 render_jekyll = function(highlight = c('pygments', 'prettify', 'none'), extra = '') {
-  hi = match.arg(highlight)
   render_markdown(TRUE)
-  if (hi == 'none') return()
+  knit_hooks$set(hooks_jekyll(highlight = highlight, extra = extra))
+}
+
+#' @rdname output_hooks
+#' @export
+hooks_jekyll = function(highlight = c('pygments', 'prettify', 'none'), extra = '') {
+  hook.m = hooks_markdown(TRUE)
+  hi = match.arg(highlight)
+  if (hi == 'none') return(hook.m)
   switch(hi, pygments = {
     hook.r = function(x, options) {
       paste0(
@@ -230,8 +243,11 @@ render_jekyll = function(highlight = c('pygments', 'prettify', 'none'), extra =
       '\n\n<pre><code>', escape_html(x), '</code></pre>\n\n'
     )
   })
-  knit_hooks$set(source = function(x, options) {
+  source = function(x, options) {
     x = one_string(hilight_source(x, 'markdown', options))
     hook.r(x, options)
-  }, output = hook.t, warning = hook.t, error = hook.t, message = hook.t)
+  }
+  merge_list(hook.m, list(
+    source = source, output = hook.t, warning = hook.t, message = hook.t, error = hook.t
+  ))
 }

R/hooks-rst.R

@@ -22,20 +22,27 @@ hook_plot_rst = function(x, options) {
 #' @export
 render_rst = function(strict = FALSE) {
   set_html_dev()
+  knit_hooks$set(hooks_rst(strict))
+}
+
+#' @rdname output_hooks
+#' @export
+hooks_rst = function(strict = FALSE) {
   hook.s = function(x, options) {
     one_string(c('\n\n::\n', indent_block(x), ''))
   }
   hook.t = function(x, options) {
     make_directive('sourcecode', tolower(options$engine), '', content = x)
   }
   hook.i = function(x) .inline.hook(format_sci(x, 'rst'))
-  knit_hooks$set(
+  list(
     source = function(x, options) {
       x = one_string(c(hilight_source(x, 'rst', options), ''))
       (if (strict) hook.s else hook.t)(x, options)
     },
     warning = hook.s, error = hook.s, message = hook.s,
-    output = hook.s, inline = hook.i, plot = hook_plot_rst)
+    output = hook.s, inline = hook.i, plot = hook_plot_rst
+  )
 }
 
 # Insert a reStructuredText directive for sphinx

R/hooks-textile.R

@@ -22,7 +22,13 @@ hook_plot_textile = function(x, options) {
 render_textile = function() {
   set_html_dev()
   opts_knit$set(out.format = 'textile')
-  textile.hook = function(name) {
+  knit_hooks$set(hooks_textile())
+}
+
+#' @rdname output_hooks
+#' @export
+hooks_textile = function() {
+  hook = function(name) {
     force(name)
     function(x, options) {
       if (name == 'source') x = c(hilight_source(x, 'textile', options), '')
@@ -31,12 +37,9 @@ render_textile = function() {
               tolower(options$engine), name, options$label, x)
     }
   }
-  hook.inline = function(x) .inline.hook(format_sci(x, 'html'))
-  z = list()
-  for (i in c('source', 'warning', 'message', 'error'))
-    z[[i]] = textile.hook(i)
-  knit_hooks$set(z)
-  knit_hooks$set(
-    inline = hook.inline, output = textile.hook('output'), plot = hook_plot_textile
+  list(
+    source = hook('source'), output = hook('output'), warning = hook('warning'),
+    message = hook('message'), error = hook('error'), plot = hook_plot_textile,
+    inline = function(x) .inline.hook(format_sci(x, 'html'))
   )
 }