automatically screenshotting HTML widgets and Shiny apps (not yet sup…

…ported by webshot) when the output format is not HTML

NAMESPACE

@@ -9,6 +9,7 @@ S3method(process_tangle,inline)
 S3method(wrap,character)
 S3method(wrap,default)
 S3method(wrap,error)
+S3method(wrap,html_screenshot)
 S3method(wrap,knit_asis)
 S3method(wrap,knit_image_paths)
 S3method(wrap,list)

R/output.R

@@ -550,6 +550,19 @@ wrap.knit_image_paths = function(x, options = opts_chunk$get(), inline = FALSE)
   })), collapse = '')
 }
 
+#' @export
+wrap.html_screenshot = function(x, options = opts_chunk$get(), inline = FALSE) {
+  ext = x$extension
+  hook_plot = knit_hooks$get('plot')
+  in_base_dir({
+    i = 1
+    while(file.exists(f <- fig_path(ext, options, i))) i = i + 1
+    dir.create(dirname(f), recursive = TRUE, showWarning = FALSE)
+    writeBin(x$image, f, useBytes = TRUE)
+    hook_plot(f, options)
+  })
+}
+
 #' A custom printing function
 #'
 #' The S3 generic function \code{knit_print} is the default printing function in
@@ -585,7 +598,11 @@ wrap.knit_image_paths = function(x, options = opts_chunk$get(), inline = FALSE)
 #' # after you defined the above method, data frames will be printed as tables in knitr,
 #' # which is different with the default print() behavior
 knit_print = function(x, ...) {
-  UseMethod('knit_print', x)
+  if (need_screenshot(x)) {
+    html_screenshot(x)
+  } else {
+    UseMethod('knit_print')
+  }
 }
 
 #" the default print method is just print()/show()

R/plot.R

@@ -354,3 +354,45 @@ include_graphics = function(path, auto_pdf = TRUE) {
   }
   structure(path, class = c('knit_image_paths', 'knit_asis'))
 }
+
+need_screenshot = function(x) {
+  fmt = pandoc_to()
+  # not R Markdown v2, always screenshot htmlwidgets and shiny apps
+  if (length(fmt) == 0) return(inherits(x, c('htmlwidget', 'shiny.appobj')))
+  html_format = fmt %in% c('html', 'html5', 'revealjs', 's5', 'slideous', 'slidy')
+  (inherits(x, 'htmlwidget') && !html_format) ||
+    (inherits(x, 'shiny.appobj') && !(html_format && runtime_shiny()))
+}
+
+runtime_shiny = function() {
+  identical(opts_knit$get('rmarkdown.runtime'), 'shiny')
+}
+
+html_screenshot = function(x, options = opts_current$get(), ...) {
+  i1 = inherits(x, 'htmlwidget')
+  i2 = inherits(x, 'shiny.appobj')
+  if (!(i1 || i2))
+    stop('Screenshotting for the class ', class(x)[1], ' is not supported.')
+  ext = switch(options$dev, pdf = '.pdf', jpeg = '.jpeg', '.png')
+  wargs = options$webshot.args %n% list()
+  if (is.null(wargs$vwidth)) wargs$vwidth = options$out.width.px
+  if (is.null(wargs$vheight)) wargs$vheight = options$out.height.px
+  if (is.null(wargs$delay)) wargs$delay = if (i1) 1 else 3
+  d = tempfile()
+  dir.create(d); on.exit(unlink(d, recursive = TRUE), add = TRUE)
+  f = in_dir(d, {
+    if (i1) {
+      f1 = tempfile('widget', '.', '.html')
+      htmlwidgets::saveWidget(x, f1, FALSE, knitrOptions = options)
+      f2 = tempfile('webshot', '.', ext)
+      do.call(webshot::webshot, c(list(f1, f2), wargs))
+      normalizePath(f2)
+    } else if (i2) {
+      f = tempfile('webshot', '.', ext)
+      do.call(webshot::appshot, c(list(x, f), wargs))
+      normalizePath(f)
+    }
+  })
+  res = readBin(f, 'raw', file.info(f)[, 'size'])
+  structure(list(image = res, extension = ext), class = 'html_screenshot')
+}