Support rgl and htmlwidgets in pkgdown

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(is_low_change,default)
 S3method(replay_html,"NULL")
 S3method(replay_html,character)
 S3method(replay_html,error)
@@ -21,4 +22,5 @@ export(evaluate_and_highlight)
 export(highlight)
 export(href_article)
 export(href_topic)
+export(is_low_change)
 import(rlang)

NEWS.md

@@ -1,5 +1,8 @@
 # downlit (development version)
 
+* Changes to better support for HTML widgets and rgl in pkgdown 
+  (@dmurdoch, #78).
+
 # downlit 0.2.1
 
 * When auto-linking `vignette(foo)`, downlit now looks for a vignette named

R/evaluate.R

@@ -11,6 +11,7 @@
 #'   components `path`, `width`, and `height`.
 #' @param env Environment in which to evaluate code; if not supplied,
 #'   defaults to a child of the global environment.
+#' @param output_handler Custom output handler for `evaluate::evaluate`.
 #' @return An string containing HTML.
 #' @inheritParams highlight
 #' @export
@@ -19,10 +20,12 @@
 evaluate_and_highlight <- function(code,
                                    fig_save,
                                    classes = downlit::classes_pandoc(),
-                                   env = NULL) {
+                                   env = NULL,
+                                   output_handler = evaluate::new_output_handler()) {
   env <- env %||% child_env(global_env())
 
-  expr <- evaluate::evaluate(code, child_env(env), new_device = TRUE)
+  expr <- evaluate::evaluate(code, child_env(env), new_device = TRUE,
+                             output_handler = output_handler)
   replay_html(expr, fig_save = fig_save, fig_id = unique_id(), classes = classes)
 }
 
@@ -47,13 +50,20 @@ replay_html.list <- function(x, ...) {
   parts <- merge_low_plot(parts)
 
   pieces <- character(length(parts))
+  dependencies <- list()
   for (i in seq_along(parts)) {
-    pieces[i] <- replay_html(parts[[i]], ...)
+    piece <- replay_html(parts[[i]], ...)
+    dependencies <- c(dependencies, attr(piece, "dependencies"))
+    pieces[i] <- piece
   }
   res <- paste0(pieces, collapse = "")
 
   # convert ansi escapes
   res <- fansi::sgr_to_html(res)
+
+  # get dependencies from htmlwidgets etc.
+  attr(res, "dependencies") <- dependencies
+
   res
 }
 
@@ -150,12 +160,19 @@ unique_id <- function() {
 
 # get MD5 digests of recorded plots so that merge_low_plot works
 digest_plot = function(x, level = 1) {
-  if (!is.list(x) || level >= 3) return(digest::digest(x))
+  if (inherits(x, "otherRecordedplot"))
+    return(x)
+  if (!is.list(x) || level >= 3) return(structure(digest::digest(x),
+                                                  class = "plot_digest"))
   lapply(x, digest_plot, level = level + 1)
 }
 
+is_plot_output = function(x) {
+  evaluate::is.recordedplot(x) || inherits(x, 'otherRecordedplot')
+}
+
 # merge low-level plotting changes
-merge_low_plot = function(x, idx = sapply(x, evaluate::is.recordedplot)) {
+merge_low_plot = function(x, idx = vapply(x, is_plot_output, logical(1L))) {
   idx = which(idx); n = length(idx); m = NULL # store indices that will be removed
   if (n <= 1) return(x)
 
@@ -172,8 +189,18 @@ merge_low_plot = function(x, idx = sapply(x, evaluate::is.recordedplot)) {
   if (is.null(m)) x else x[-m]
 }
 
-# compare two recorded plots
+#' Compare two recorded plots
+#'
+#' @param p1,p2 Plot results
+#'
+#' @return Logical value indicating whether `p2` is a low-level update of `p1`.
+#' @export
 is_low_change = function(p1, p2) {
+  UseMethod("is_low_change")
+}
+
+#' @export
+is_low_change.default = function(p1, p2) {
   p1 = p1[[1]]; p2 = p2[[1]]  # real plot info is in [[1]]
   if ((n2 <- length(p2)) < (n1 <- length(p1))) return(FALSE)  # length must increase
   identical(p1[1:n1], p2[1:n1])

tests/testthat/test-evaluate.R

@@ -14,6 +14,31 @@ test_that("evaluate_and_highlight works", {
     f1 <- function() plot(1)
     f2 <- function() lines(0:2, 0:2)
     cat(evaluate_and_highlight("f1()\nf2()", fig_save = fig_save, env = environment()))
+
+    "Other plots"
+    f3 <- function()
+      structure(3, class = c("fakePlot", "otherRecordedplot"))
+    f4 <- function()
+      structure(4, class = c("fakePlot", "otherRecordedplot"))
+    # Check that we can drop the inclusion of the first one
+    is_low_change.fakePlot <- function(p1, p2) TRUE
+    print.fakePlot <- function(x, ...) {
+      x
+    }
+    replay_html.fakePlot <- function(x, ...) {
+      paste("Text for plot ", unclass(x))
+    }
+    registerS3method("is_low_change", "fakePlot",
+                     is_low_change.fakePlot,
+                     envir = asNamespace("downlit"))
+    registerS3method("replay_html", "fakePlot",
+                     replay_html.fakePlot,
+                     envir = asNamespace("downlit"))
+    registerS3method("print", "fakePlot",
+                     print.fakePlot)
+    cat(evaluate_and_highlight("f3()\nf4()", env = environment(),
+                               fig_save = fig_save,
+                               output_handler = evaluate::new_output_handler(value = print)))
   })
 })
 

tests/testthat/test-evaluate.txt

@@ -26,3 +26,23 @@
 <div class='input'><span class='fu'>f1</span><span class='op'>(</span><span class='op'>)</span>
 </div><div class='input'><span class='fu'>f2</span><span class='op'>(</span><span class='op'>)</span></div><div class='img'><img src='1.png' alt='' width='10' height='10' /></div>
 
+> # Other plots
+> f3 <- (function() structure(3, class = c("fakePlot", "otherRecordedplot")))
+> f4 <- (function() structure(4, class = c("fakePlot", "otherRecordedplot")))
+> is_low_change.fakePlot <- (function(p1, p2) TRUE)
+> print.fakePlot <- (function(x, ...) {
++   x
++ })
+> replay_html.fakePlot <- (function(x, ...) {
++   paste("Text for plot ", unclass(x))
++ })
+> registerS3method("is_low_change", "fakePlot", is_low_change.fakePlot, envir = asNamespace(
++   "downlit"))
+> registerS3method("replay_html", "fakePlot", replay_html.fakePlot, envir = asNamespace(
++   "downlit"))
+> registerS3method("print", "fakePlot", print.fakePlot)
+> cat(evaluate_and_highlight("f3()\nf4()", env = environment(), fig_save = fig_save,
++ output_handler = evaluate::new_output_handler(value = print)))
+<div class='input'><span class='fu'>f3</span><span class='op'>(</span><span class='op'>)</span>
+</div><div class='input'><span class='fu'>f4</span><span class='op'>(</span><span class='op'>)</span></div>Text for plot  4
+