From 2eb2648b9102957c9ee62a35dfed088c2f950c40 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Fri, 18 Apr 2025 15:54:56 -0400 Subject: [PATCH 1/7] Support htmlwidgets in litedown. --- R/knitr-methods.R | 1 + R/litedown.R | 37 +++++++++++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+) create mode 100644 R/litedown.R diff --git a/R/knitr-methods.R b/R/knitr-methods.R index 7196b99..cd3376e 100644 --- a/R/knitr-methods.R +++ b/R/knitr-methods.R @@ -1,5 +1,6 @@ .onLoad <- function(...) { s3_register("knitr::knit_print", "htmlwidget") + s3_register("xfun::record_print", "htmlwidget") register_upgrade_message("shiny", "1.1", error = TRUE) } diff --git a/R/litedown.R b/R/litedown.R new file mode 100644 index 0000000..f7b3d1a --- /dev/null +++ b/R/litedown.R @@ -0,0 +1,37 @@ +record_print.htmlwidget <- function(x, ...) { + saveopt <- options(knitr.in.progress = TRUE) + on.exit(options(saveopt)) + + # Build knitr options from litedown options + options <- as.list(litedown::reactor()) + if (!is.null(options$fig.dim)) { + options$fig.width <- options$fig.dim[1] + options$fig.height <- options$fig.dim[2] + } + if (is.null(options$out.width.px)) + options$out.width.px <- options$fig.width*84 + if (is.null(options$out.height.px)) + options$out.height.px <- options$fig.height*84 + + html <- toHTML(x, standalone = FALSE, knitrOptions = options) + output <- knitr::knit_print(html, options = options, ...) + meta <- attr(output, "knit_meta") + meta <- htmltools::resolveDependencies(meta) + css <- js <- character() + for (i in seq_along(meta)) { + dep <- meta[[i]] + if (!is.null(dep$stylesheet)) { + css <- c(css, file.path(dep$src$file, dep$stylesheet)) + } + if (!is.null(dep$script)) { + js <- c(js, file.path(dep$src$file, dep$script)) + } + if (!is.null(dep$meta) || !is.null(dep$head)) + browser() + } + meta <- getOption("litedown.html.meta") + meta$css <- unique(c(meta$css, css)) + meta$js <- unique(c(meta$js, js)) + options(litedown.html.meta = meta) + xfun::new_record(output, "asis") +} From 861e924fb1145f3d32b77ab510d954287cc1591b Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Sat, 19 Apr 2025 09:39:49 -0400 Subject: [PATCH 2/7] Use reactor() options instead of R options. --- R/litedown.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/litedown.R b/R/litedown.R index f7b3d1a..bda674f 100644 --- a/R/litedown.R +++ b/R/litedown.R @@ -29,9 +29,9 @@ record_print.htmlwidget <- function(x, ...) { if (!is.null(dep$meta) || !is.null(dep$head)) browser() } - meta <- getOption("litedown.html.meta") + meta <- litedown::reactor("meta") meta$css <- unique(c(meta$css, css)) meta$js <- unique(c(meta$js, js)) - options(litedown.html.meta = meta) + litedown::reactor(meta = meta) xfun::new_record(output, "asis") } From 936ae56ab39fb5dc323b4d6f9ae392973406bb74 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Sat, 19 Apr 2025 11:05:39 -0400 Subject: [PATCH 3/7] Include `meta` and `head` entries. --- R/litedown.R | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/R/litedown.R b/R/litedown.R index bda674f..90def01 100644 --- a/R/litedown.R +++ b/R/litedown.R @@ -17,21 +17,30 @@ record_print.htmlwidget <- function(x, ...) { output <- knitr::knit_print(html, options = options, ...) meta <- attr(output, "knit_meta") meta <- htmltools::resolveDependencies(meta) - css <- js <- character() + head <- css <- js <- character() + metatag <- list() for (i in seq_along(meta)) { dep <- meta[[i]] - if (!is.null(dep$stylesheet)) { + if (!is.null(dep$stylesheet)) css <- c(css, file.path(dep$src$file, dep$stylesheet)) - } - if (!is.null(dep$script)) { + if (!is.null(dep$script)) js <- c(js, file.path(dep$src$file, dep$script)) - } - if (!is.null(dep$meta) || !is.null(dep$head)) - browser() + if (!is.null(dep$meta)) + metatag <- c(metatag, list(dep$meta)) + if (!is.null(dep$head)) + head <- c(head, dep$head) } + metatag <- unlist(lapply(metatag, function(x) + paste0(""))) + head <- c(head, metatag) meta <- litedown::reactor("meta") - meta$css <- unique(c(meta$css, css)) - meta$js <- unique(c(meta$js, js)) + if (length(css)) + meta$css <- unique(c(meta$css, css)) + if (length(js)) + meta$js <- unique(c(meta$js, js)) + if (length(head)) + meta$"header-includes" <- c(meta$"header-includes", head) litedown::reactor(meta = meta) xfun::new_record(output, "asis") } From e99cbd587362e0f56014207d200295dffde92102 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Sun, 20 Apr 2025 09:54:00 -0400 Subject: [PATCH 4/7] Allow dpi and fig.retina to be specified as chunk options. --- R/litedown.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/litedown.R b/R/litedown.R index 90def01..40bb846 100644 --- a/R/litedown.R +++ b/R/litedown.R @@ -8,10 +8,14 @@ record_print.htmlwidget <- function(x, ...) { options$fig.width <- options$fig.dim[1] options$fig.height <- options$fig.dim[2] } + if (is.null(options$dpi)) + options$dpi <- 84 + if (is.null(options$fig.retina)) + options$fig.retina <- 1 if (is.null(options$out.width.px)) - options$out.width.px <- options$fig.width*84 + options$out.width.px <- with(options, fig.width*dpi/fig.retina) if (is.null(options$out.height.px)) - options$out.height.px <- options$fig.height*84 + options$out.height.px <- with(options, fig.height*dpi/fig.retina) html <- toHTML(x, standalone = FALSE, knitrOptions = options) output <- knitr::knit_print(html, options = options, ...) From 64c5242f7e6c9f7387b0a2302e98a3824bb7f481 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Sun, 20 Apr 2025 13:06:49 -0400 Subject: [PATCH 5/7] Support snapshots in litedown --- DESCRIPTION | 5 +- NAMESPACE | 1 + R/litedown.R | 120 ++++++++++++++++++++++--------------- man/htmlwidgets-package.Rd | 8 +++ 4 files changed, 85 insertions(+), 49 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6e714fe..f568ff2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -11,6 +11,7 @@ Authors@R: c( comment = c(ORCID = "0000-0002-4958-2844")), person("Kenton", "Russell", role = c("aut", "cph")), person("Ellis", "Hughes", role = "ctb"), + person("Duncan", "Murdoch", role = "ctb"), person("Posit Software, PBC", role = c("cph", "fnd")) ) Description: A framework for creating HTML widgets that render in various @@ -27,10 +28,10 @@ Imports: rmarkdown, yaml Suggests: - testthat + testthat, litedown (>= 0.7.1), webshot2, xfun Enhances: shiny (>= 1.1) VignetteBuilder: knitr Encoding: UTF-8 -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.2 diff --git a/NAMESPACE b/NAMESPACE index 160e645..3e34d67 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,4 +20,5 @@ export(sizingPolicy) import(htmltools) importFrom(utils,browseURL) importFrom(utils,file.edit) +importFrom(utils,file_test) importFrom(utils,packageVersion) diff --git a/R/litedown.R b/R/litedown.R index 40bb846..7271275 100644 --- a/R/litedown.R +++ b/R/litedown.R @@ -1,50 +1,76 @@ -record_print.htmlwidget <- function(x, ...) { - saveopt <- options(knitr.in.progress = TRUE) - on.exit(options(saveopt)) +#' @importFrom utils file_test +record_print.htmlwidget <- local({ + fignum <- 0L - # Build knitr options from litedown options - options <- as.list(litedown::reactor()) - if (!is.null(options$fig.dim)) { - options$fig.width <- options$fig.dim[1] - options$fig.height <- options$fig.dim[2] - } - if (is.null(options$dpi)) - options$dpi <- 84 - if (is.null(options$fig.retina)) - options$fig.retina <- 1 - if (is.null(options$out.width.px)) - options$out.width.px <- with(options, fig.width*dpi/fig.retina) - if (is.null(options$out.height.px)) - options$out.height.px <- with(options, fig.height*dpi/fig.retina) + function(x, ...) { + saveopt <- options(knitr.in.progress = TRUE) + on.exit(options(saveopt)) + + # Build knitr options from litedown options + options <- as.list(litedown::reactor()) + if (!is.null(options$fig.dim)) { + options$fig.width <- options$fig.dim[1] + options$fig.height <- options$fig.dim[2] + } + if (is.null(options$dpi)) + options$dpi <- 84 + if (is.null(options$fig.retina)) + options$fig.retina <- 1 + if (is.null(options$out.width.px)) + options$out.width.px <- with(options, fig.width*dpi/fig.retina) + if (is.null(options$out.height.px)) + options$out.height.px <- with(options, fig.height*dpi/fig.retina) - html <- toHTML(x, standalone = FALSE, knitrOptions = options) - output <- knitr::knit_print(html, options = options, ...) - meta <- attr(output, "knit_meta") - meta <- htmltools::resolveDependencies(meta) - head <- css <- js <- character() - metatag <- list() - for (i in seq_along(meta)) { - dep <- meta[[i]] - if (!is.null(dep$stylesheet)) - css <- c(css, file.path(dep$src$file, dep$stylesheet)) - if (!is.null(dep$script)) - js <- c(js, file.path(dep$src$file, dep$script)) - if (!is.null(dep$meta)) - metatag <- c(metatag, list(dep$meta)) - if (!is.null(dep$head)) - head <- c(head, dep$head) + doSnapshot <- litedown::get_context("format") != "html" + if (doSnapshot && requireNamespace("webshot2")) { + f1 <- tempfile(fileext = ".html") + fignum <<- fignum + 1L + f2 <- file.path(options$fig.path, sprintf("%s-%d.png", options$label, fignum)) + if (!file_test("-d", dirname(f2))) + dir.create(dirname(f2), recursive = TRUE) + saveWidget(x, f1, knitrOptions = options) + do.call(webshot2::webshot, + c(list(url = f1, file = f2, quiet = TRUE, + vwidth = options$out.width.px, + vheight = options$out.width.px), + options$screenshot.opts)) + alt <- options$fig.alt + if (is.null(alt)) + alt <- options$fig.cap + if (is.null(alt)) + alt <- "" + xfun::new_record(sprintf("![%s](%s)", alt, f2), "asis") + } else { + html <- toHTML(x, standalone = FALSE, knitrOptions = options) + output <- knitr::knit_print(html, options = options) + meta <- attr(output, "knit_meta") + meta <- resolveDependencies(meta) + head <- css <- js <- character() + metatag <- list() + for (i in seq_along(meta)) { + dep <- meta[[i]] + if (!is.null(dep$stylesheet)) + css <- c(css, file.path(dep$src$file, dep$stylesheet)) + if (!is.null(dep$script)) + js <- c(js, file.path(dep$src$file, dep$script)) + if (!is.null(dep$meta)) + metatag <- c(metatag, list(dep$meta)) + if (!is.null(dep$head)) + head <- c(head, dep$head) + } + metatag <- unlist(lapply(metatag, function(x) + paste0(""))) + head <- c(head, metatag) + meta <- litedown::reactor("meta") + if (length(css)) + meta$css <- unique(c(meta$css, css)) + if (length(js)) + meta$js <- unique(c(meta$js, js)) + if (length(head)) + meta$"header-includes" <- c(meta$"header-includes", head) + litedown::reactor(meta = meta) + xfun::new_record(output, "asis") + } } - metatag <- unlist(lapply(metatag, function(x) - paste0(""))) - head <- c(head, metatag) - meta <- litedown::reactor("meta") - if (length(css)) - meta$css <- unique(c(meta$css, css)) - if (length(js)) - meta$js <- unique(c(meta$js, js)) - if (length(head)) - meta$"header-includes" <- c(meta$"header-includes", head) - litedown::reactor(meta = meta) - xfun::new_record(output, "asis") -} +}) diff --git a/man/htmlwidgets-package.Rd b/man/htmlwidgets-package.Rd index 11f891a..2cd5a7f 100644 --- a/man/htmlwidgets-package.Rd +++ b/man/htmlwidgets-package.Rd @@ -28,6 +28,14 @@ vignette("develop_advanced", package = "htmlwidgets") Source code for the package is available on GitHub: \url{https://github.com/ramnathv/htmlwidgets} +} +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/ramnathv/htmlwidgets} + \item Report bugs at \url{https://github.com/ramnathv/htmlwidgets/issues} +} + } \author{ Ramnath Vaidyanathan, Joe Cheng, JJ Allaire, and Yihui Xie From d82016b140d50e4299442f38641994ae659e9ba5 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Mon, 21 Apr 2025 06:33:50 -0400 Subject: [PATCH 6/7] Add litedown remote. --- DESCRIPTION | 2 ++ 1 file changed, 2 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index f568ff2..e095864 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,3 +35,5 @@ VignetteBuilder: knitr Encoding: UTF-8 RoxygenNote: 7.3.2 +Remotes: + dmurdoch/litedown@htmlwidgets From 284b082bd6e938ef98ea85010bf97490554cb0e0 Mon Sep 17 00:00:00 2001 From: Duncan Murdoch Date: Tue, 22 Apr 2025 11:22:41 -0400 Subject: [PATCH 7/7] Allow href dependencies. --- R/litedown.R | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/R/litedown.R b/R/litedown.R index 7271275..494b754 100644 --- a/R/litedown.R +++ b/R/litedown.R @@ -49,10 +49,17 @@ record_print.htmlwidget <- local({ metatag <- list() for (i in seq_along(meta)) { dep <- meta[[i]] + src <- dep$src$file + if (is.null(src)) + src <- dep$src$href + if (is.null(src)) { + warning("dependency '", dep$name, "' has neither `file` nor `href` source, so will be ignored.") + next + } if (!is.null(dep$stylesheet)) - css <- c(css, file.path(dep$src$file, dep$stylesheet)) + css <- c(css, file.path(src, dep$stylesheet)) if (!is.null(dep$script)) - js <- c(js, file.path(dep$src$file, dep$script)) + js <- c(js, file.path(src, dep$script)) if (!is.null(dep$meta)) metatag <- c(metatag, list(dep$meta)) if (!is.null(dep$head))