Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
8 changed files
with
212 additions
and
40 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,109 @@ | ||
| #' Take a snapshot of an R Markdown document | ||
| #' | ||
| #' This function can handle both static Rmd documents and Rmd documents with | ||
| #' \code{runtime: shiny}. | ||
| #' | ||
| #' @inheritParams appshot | ||
| #' @param doc The path to a Rmd document. | ||
| #' @param delay Time to wait before taking screenshot, in seconds. Sometimes a | ||
| #' longer delay is needed for all assets to display properly. If NULL (the | ||
| #' default), then it will use 0.2 seconds for static Rmd documents, and 3 | ||
| #' seconds for Rmd documents with runtime:shiny. | ||
| #' @param rmd_args A list of additional arguments to pass to either | ||
| #' \code{\link[rmarkdown]{render}} (for static Rmd documents) or | ||
| #' \code{\link[rmarkdown]{run}} (for Rmd documents with runtime:shiny). | ||
| #' | ||
| #' @examples | ||
| #' if (interactive()) { | ||
| #' rmdshot("doc.rmd", "doc.png") | ||
| #' } | ||
| #' | ||
| #' @export | ||
| rmdshot <- function(doc, file = "webshot.png", ..., delay = NULL, rmd_args = list(), | ||
| port = getOption("shiny.port"), envvars = NULL) { | ||
|
|
||
| runtime <- rmarkdown::yaml_front_matter(doc)$runtime | ||
|
|
||
| if (is_shiny(runtime)) { | ||
| if (is.null(delay)) delay <- 3 | ||
|
|
||
| rmdshot_shiny(doc, file, ..., delay = delay, rmd_args = rmd_args, | ||
| port = port, envvars = envvars) | ||
|
|
||
| } else { | ||
| if (is.null(delay)) delay <- 0.2 | ||
|
|
||
| outfile <- tempfile("webshot", fileext = ".html") | ||
| render <- rmarkdown::render | ||
| do.call("render", c(list(doc, output_file = outfile), rmd_args), | ||
| envir = parent.frame()) | ||
| webshot(outfile, file = file, ...) | ||
| } | ||
| } | ||
|
|
||
|
|
||
| rmdshot_shiny <- function(doc, file, ..., rmd_args, port, envvars) { | ||
|
|
||
| pidfile <- normalizePath(tempfile("pid"), winslash = '/', mustWork = FALSE) | ||
| on.exit(unlink(pidfile)) | ||
| port <- available_port(port) | ||
| arg_string <- list_to_arg_string(rmd_args) | ||
| if (nzchar(arg_string)) { | ||
| arg_string <- paste0(", ", arg_string) | ||
| } | ||
| cmd <- shQuote(sprintf( | ||
| "cat(Sys.getpid(), file='%s'); rmarkdown::run('%s', shiny_args=list(port=%d)%s)", | ||
| pidfile, doc, port, arg_string | ||
| )) | ||
|
|
||
| # Run app in background with envvars | ||
| withr::with_envvar( | ||
| envvars, | ||
| system2("R", args = c("--slave", "-e", cmd), wait = FALSE) | ||
| ) | ||
|
|
||
| on.exit({ | ||
| # Kill app on exit | ||
| pid <- readLines(pidfile, warn = FALSE) | ||
| file.remove(pidfile) | ||
| kill_pid(pid) | ||
| }) | ||
|
|
||
| # Wait for app to start | ||
| Sys.sleep(0.5) | ||
|
|
||
| fileout <- webshot(sprintf("http://127.0.0.1:%d/", port), file = file, ...) | ||
|
|
||
| invisible(fileout) | ||
| } | ||
|
|
||
|
|
||
| # Convert a list of args like list(a=1, b="xyz") to a string like 'a=1, b="xyz"' | ||
| list_to_arg_string <- function(x) { | ||
|
|
||
| item_to_arg_string <- function(name, val) { | ||
| if (is.numeric(val)) | ||
| as.character(val) | ||
| else if (is.character(val)) | ||
| paste0('"', val, '"') | ||
| else | ||
| stop("Only know how to handle numbers and strings arguments to rmarkdown::render. ", | ||
| "Don't know how to handle argument `", val, "`.") | ||
| } | ||
|
|
||
| strings <- vapply(seq_along(x), function(n) item_to_arg_string(names(x)[n], x[[n]]), "") | ||
|
|
||
| # Convert to a vector like c("a=1", "b=2") | ||
| strings <- mapply(names(x), strings, | ||
| FUN = function(name, val) paste(name, val, sep ="="), | ||
| USE.NAMES = FALSE | ||
| ) | ||
|
|
||
| paste(strings, collapse = ", ") | ||
| } | ||
|
|
||
|
|
||
| # Borrowed from rmarkdown | ||
| is_shiny <- function (runtime) { | ||
| !is.null(runtime) && grepl("^shiny", runtime) | ||
| } |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.