Make save_html() an S3 generic method (#411)

Co-authored-by: cpsievert <[email protected]>
rstudio · Oct 6, 2023 · 2a26d1f · 2a26d1f
1 parent 6dddb58
commit 2a26d1f
Show file tree

Hide file tree

Showing 6 changed files with 44 additions and 15 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: htmltools
 Title: Tools for HTML
-Version: 0.5.6.9000
+Version: 0.5.6.9001
 Authors@R: c(
     person("Joe", "Cheng", , "[email protected]", role = "aut"),
     person("Carson", "Sievert", , "[email protected]", role = c("aut", "cre"),

diff --git a/NAMESPACE b/NAMESPACE
@@ -30,6 +30,7 @@ S3method(print,shiny.tag)
 S3method(print,shiny.tag.env)
 S3method(print,shiny.tag.list)
 S3method(print,shiny.tag.query)
+S3method(save_html,default)
 S3method(str,shiny.tag.env)
 export("htmlDependencies<-")
 export(HTML)

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,9 @@
 # htmltools (development version)
 
+## New Features
+
+* `save_html()` is now an S3 generic, allowing for more customization over how certain classes are saved to an HTML file. (#411)
+
 ## Improvements
 
 * Fill items no longer set `overflow: auto` or `width: 100%` by default. (#401)

diff --git a/R/html_print.R b/R/html_print.R
@@ -59,18 +59,27 @@ html_print <- function(html, background = "white", viewer = getOption("viewer",
 
 #' Save an HTML object to a file
 #'
-#' Save the specified HTML object to a file, copying all of it's
-#' dependencies to the directory specified via `libdir`.
+#' An S3 generic method for saving an HTML-like object to a file. The default
+#' method copies dependency files to the directory specified via `libdir`.
 #'
-#' @param html HTML content to print
-#' @param background Background color for web page
+#' @param html HTML content to print.
 #' @param file File path or connection. If a file path containing a
 #'   sub-directory, the sub-directory must already exist.
-#' @param libdir Directory to copy dependencies to
-#' @param lang Value of the `<html>` `lang` attribute
+#' @param ... Further arguments passed to other methods.
 #'
 #' @export
-save_html <- function(html, file, background = "white", libdir = "lib", lang = "en") {
+save_html <- function(html, file, ...) {
+  UseMethod("save_html")
+}
+
+#' @rdname save_html
+#' @param background Background color for web page.
+#' @param libdir Directory to copy dependencies to.
+#' @param lang Value of the `<html>` `lang` attribute.
+#' @export
+save_html.default <- function(html, file, background = "white", libdir = "lib", lang = "en", ...) {
+  rlang::check_dots_empty()
+
   force(html)
   force(background)
   force(libdir)

diff --git a/man/save_html.Rd b/man/save_html.Rd
diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R
@@ -99,3 +99,13 @@ test_that("save_html() can write to a file connection", {
     grepl("<h2>Howdy</h2>", paste(readLines(f), collapse = " "))
   )
 })
+
+test_that("save_html.default() throws when undefined arguments are provided", {
+  expect_error(
+    save_html(div(), tempfile(), foo = "bar")
+  )
+
+  expect_error(
+    save_html(div(), tempfile(), background = "white", libdir = "lib", lang = "en", "bar")
+  )
+})