Refactor tutorial knitr hooks and set them in the tutorial format (#599)

NAMESPACE

@@ -67,7 +67,6 @@ export(tutorial_html_dependency)
 export(tutorial_options)
 export(tutorial_package_dependencies)
 import(curl)
-import(rmarkdown)
 import(shiny)
 importFrom(evaluate,evaluate)
 importFrom(htmltools,HTML)

NEWS.md

@@ -57,6 +57,7 @@ learnr (development version)
 
 ## Bug fixes
 
+* learnr's knitr hooks are now included by default in the `learnr::tutorial` R Markdown format. They are also registered for any tutorials run by `run_tutorial()`. [thanks @czucca, #599](https://github.com/rstudio/learnr/pull/599)
 * Support the updated Bootstrap 4+ popover `dispose` method name, previously `destroy`. ([#560](https://github.com/rstudio/learnr/pull/560))
 * Properly enforce time limits and measure exercise execution times that exceed 60 seconds ([#366](https://github.com/rstudio/learnr/pull/366), [#368](https://github.com/rstudio/learnr/pull/368))
 * Fixed unexpected behavior for `question_is_correct.learnr_text()` where `trim = FALSE`. Comparisons will now happen with the original input value, not the `HTML()` formatted answer value. ([#376](https://github.com/rstudio/learnr/pull/376))

R/knitr-hooks.R

@@ -13,12 +13,7 @@ detect_installed_knitr_hooks <- function() {
   is.function(tutorial_knit_hook)
 }
 
-install_knitr_hooks <- function() {
-  # set global tutorial option which we can use as a basis for hooks
-  # (this is so we don't collide with hooks set by the user or
-  # by other packages or Rmd output formats)
-  knitr::opts_chunk$set(tutorial = TRUE)
-
+tutorial_knitr_options <- function() {
   # helper to check for runtime: shiny_prerendered being active
   is_shiny_prerendered_active <- function() {
     identical(knitr::opts_knit$get("rmarkdown.runtime"),"shiny_prerendered")
@@ -186,7 +181,7 @@ install_knitr_hooks <- function() {
   }
 
   # hook to turn off evaluation/highlighting for exercise related chunks
-  knitr::opts_hooks$set(tutorial = function(options) {
+  tutorial_opts_hook <-  function(options) {
 
     # check for chunk type
     exercise_chunk <- is_exercise_chunk(options)
@@ -285,10 +280,10 @@ install_knitr_hooks <- function() {
 
     # return modified options
     options
-  })
+  }
 
   # hook to amend output for exercise related chunks
-  knitr::knit_hooks$set(tutorial = function(before, options, envir) {
+  tutorial_knit_hook <- function(before, options, envir) {
 
     # helper to produce an exercise wrapper div w/ the specified class
     exercise_wrapper_div <- function(suffix = NULL, extra_html = NULL) {
@@ -465,7 +460,24 @@ install_knitr_hooks <- function() {
       }
 
     }
-  })
+  }
+
+  list(
+    # learnr uses `tutorial` for options and hooks, and we also globally set the
+    # chunk option `tutorial = TRUE`. This allows the learnr tutorial hooks to
+    # visit every chunk without colliding with hooks or options set by other
+    # packages or Rmd formats.
+    opts_chunk = list(tutorial = TRUE),
+    opts_hooks = list(tutorial = tutorial_opts_hook),
+    knit_hooks = list(tutorial = tutorial_knit_hook)
+  )
+}
+
+install_knitr_hooks <- function() {
+  knit_opts <- tutorial_knitr_options()
+  knitr::opts_chunk$set(tutorial = knit_opts$opts_chunk$tutorial)
+  knitr::opts_hooks$set(tutorial = knit_opts$opts_hooks$tutorial)
+  knitr::knit_hooks$set(tutorial = knit_opts$knit_hooks$tutorial)
 }
 
 remove_knitr_hooks <- function() {

R/learnr-package.R

@@ -0,0 +1,34 @@
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+#' @importFrom evaluate evaluate
+#' @importFrom htmltools attachDependencies
+#' @importFrom htmltools div
+#' @importFrom htmltools HTML
+#' @importFrom htmltools htmlDependency
+#' @importFrom htmltools tags
+#' @importFrom htmlwidgets createWidget
+#' @importFrom jsonlite base64_dec
+#' @importFrom jsonlite base64_enc
+#' @importFrom knitr all_labels
+#' @importFrom knitr knit_hooks
+#' @importFrom knitr knit_meta_add
+#' @importFrom knitr opts_chunk
+#' @importFrom knitr opts_hooks
+#' @importFrom knitr opts_knit
+#' @importFrom knitr spin
+#' @importFrom markdown markdownExtensions
+#' @importFrom markdown markdownToHTML
+#' @importFrom rprojroot find_root
+#' @importFrom rprojroot is_r_package
+#' @importFrom shiny invalidateLater
+#' @importFrom shiny isolate
+#' @importFrom shiny observe
+#' @importFrom shiny observeEvent
+#' @importFrom shiny reactive
+#' @importFrom shiny reactiveValues
+#' @importFrom shiny req
+#' @importFrom withr with_envvar
+## usethis namespace: end
+NULL

R/run.R

@@ -84,6 +84,12 @@ run_tutorial <- function(name = NULL, package = NULL, shiny_args = NULL) {
       )
     })
 
+  # ensure hooks are available for a tutorial and clean up after run_tutorial()
+  if (!detect_installed_knitr_hooks()) {
+    withr::defer(remove_knitr_hooks())
+  }
+  install_knitr_hooks()
+
   # run within tutorial wd
   withr::with_dir(tutorial_path, {
     if (!identical(Sys.getenv("SHINY_PORT", ""), "")) {

R/tutorial-format.R

@@ -62,13 +62,13 @@ tutorial <- function(fig_width = 6.5,
   args <- c(args, "--section-divs")
 
   # template
-  args <- c(args, "--template", pandoc_path_arg(
+  args <- c(args, "--template", rmarkdown::pandoc_path_arg(
     system.file("rmarkdown/templates/tutorial/resources/tutorial-format.htm",
                 package = "learnr")
   ))
 
   # content includes
-  args <- c(args, includes_to_pandoc_args(includes))
+  args <- c(args, rmarkdown::includes_to_pandoc_args(includes))
 
   # pagedtables
   if (identical(df_print, "paged")) {
@@ -94,7 +94,7 @@ tutorial <- function(fig_width = 6.5,
 
   # additional css
   for (css_file in css)
-    args <- c(args, "--css", pandoc_path_arg(css_file))
+    args <- c(args, "--css", rmarkdown::pandoc_path_arg(css_file))
 
   # resolve theme (ammend base stylesheet for "rstudio" theme
   stylesheets <- "tutorial-format.css"
@@ -123,16 +123,19 @@ tutorial <- function(fig_width = 6.5,
 
   # additional pandoc variables
   jsbool <- function(value) ifelse(value, "true", "false")
-  args <- c(args, pandoc_variable_arg("progressive", jsbool(progressive)))
-  args <- c(args, pandoc_variable_arg("allow-skip", jsbool(allow_skip)))
+  args <- c(args, rmarkdown::pandoc_variable_arg("progressive", jsbool(progressive)))
+  args <- c(args, rmarkdown::pandoc_variable_arg("allow-skip", jsbool(allow_skip)))
 
   # knitr and pandoc options
-  knitr_options <- knitr_options_html(fig_width, fig_height, fig_retina, keep_md = FALSE , dev)
-  pandoc_options <- pandoc_options(to = "html4",
+  knitr_options <- rmarkdown::knitr_options_html(fig_width, fig_height, fig_retina, keep_md = FALSE , dev)
+  pandoc_options <- rmarkdown::pandoc_options(to = "html4",
     from = rmarkdown::from_rmarkdown(fig_caption, md_extensions),
     args = args,
     ext = ".html")
 
+  tutorial_opts <- tutorial_knitr_options()
+  knitr_options <- utils::modifyList(knitr_options, tutorial_opts)
+
   # set 1000 as the default maximum number of rows in paged tables
   knitr_options$opts_chunk$max.print <- 1000
 

R/learnr.R → R/zzz.R

@@ -1,3 +1,15 @@
+
+# install knitr hooks when package is attached to search path
+.onAttach <- function(libname, pkgname) {
+  install_knitr_hooks()
+  initialize_tutorial()
+}
+
+# remove knitr hooks when package is detached from search path
+.onDetach <- function(libpath) {
+  remove_knitr_hooks()
+}
+
 .onLoad <- function(libname, pkgname) {
   register_default_event_handlers()