rstudio · cpsievert · Oct 11, 2023 · Oct 5, 2023 · Oct 5, 2023 · Oct 6, 2023
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -32,7 +32,7 @@ Imports:
     base64enc,
     cachem,
     grDevices,
-    htmltools (>= 0.5.4.9000),
+    htmltools (>= 0.5.6.9001),
     jquerylib (>= 0.1.3),
     jsonlite,
     lifecycle,

diff --git a/NAMESPACE b/NAMESPACE
@@ -9,6 +9,8 @@ S3method(print,bslib_fragment)
 S3method(print,bslib_page)
 S3method(print,bslib_showcase_layout)
 S3method(print,bslib_value_box_theme)
+S3method(save_html,bslib_fragment)
+S3method(save_html,bslib_page)
 export(accordion)
 export(accordion_panel)
 export(accordion_panel_close)

diff --git a/NEWS.md b/NEWS.md
@@ -36,6 +36,8 @@
 
 * Improved the style and appearance of the button to enter full screen in `card()`s and `value_box()`es to better adapt to Bootstrap's dark mode. (#780)
 
+* `htmltools::save_html()` now works as expected when applied directly to components (e.g., `card()`, etc) and pages with a non-default theme. (#823, #815)
+
 * `layout_sidebar()` received a new design. The button to collapse and expand the sidebar now appears at the top edge of the sidebar, and we now use the [arrow-bar-left](https://icons.getbootstrap.com/icons/arrow-bar-left/) icon instead of [chevron-left](https://icons.getbootstrap.com/icons/chevron-left/). On mobile devices, the sidebar now fills the `layout_sidebar()` area as an overlay, rather than expanding from above the main content area. **Note** the `max_mobile_height` argument of `sidebar()` determines the maximum height of the sidebar area on mobile, but it now only applies when `open = "always"`. (#798)
 
 * `layout_sidebar()` now uses an `<aside>` element for the sidebar's container and a `<header>` element for the sidebar title. The classes of each element remain the same, but the semantic meaning of the elements is now better reflected in the HTML markup. (#580)

diff --git a/R/print.R b/R/print.R
@@ -11,10 +11,10 @@ as_page <- function(x, theme = bs_theme()) {
   x
 }
 
-#' Make HTML browsable by default
+#' Print a bslib page/fragment
 #'
-#' @param x a [tag()] object.
-#' @param ... passed along to an underlying print method
+#' @param x a bslib page/fragment.
+#' @param ... passed along to an underlying print method.
 #' @export
 #' @keywords internal
 #' @rdname html-browse
@@ -23,6 +23,18 @@ print.bslib_fragment <- function(x, ...) {
   invisible(print(x, ...))
 }
 
+#' Save a bslib page/fragment as HTML
+#'
+#' @param x a bslib page/fragment.
+#' @param ... passed along to an underlying [save_html()] method.
+#' @export
+#' @keywords internal
+#' @rdname save-html
+save_html.bslib_fragment <- function(html, file, ...) {
+  html <- attr(html, "bslib_page")(html)
+  save_html(html, file, ...)
+}
+
 #' @rdname html-browse
 #' @export
 print.bslib_page <- function(x, ...) {
@@ -36,3 +48,13 @@ print.bslib_page <- function(x, ...) {
 
   invisible(NextMethod())
 }
+
+#' @rdname save-html
+#' @export
+save_html.bslib_page <- function(html, file, ...) {
+  old_theme <- bs_global_get()
+  bs_global_set(attr(html, "bs_theme", exact = TRUE))
+  on.exit(bs_global_set(old_theme), add = TRUE)
+
+  NextMethod()
+}
diff --git a/man/html-browse.Rd b/man/html-browse.Rd
diff --git a/man/save-html.Rd b/man/save-html.Rd
diff --git a/tests/testthat/_snaps/page/card.html b/tests/testthat/_snaps/page/card.html
@@ -0,0 +1,28 @@
+<!DOCTYPE html>
+<html lang="en">
+<head>
+<meta charset="utf-8"/>
+<style>body{background-color:white;}</style>
+<script src="lib/jquery/jquery-3.6.0.min.js"></script>
+<meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no" />
+<link href="lib/bootstrap/bootstrap.min.css" rel="stylesheet" />
+<script src="lib/bootstrap/bootstrap.bundle.min.js"></script>
+<script src="lib/bslib-component-js/components.min.js"></script>
+<script src="lib/bslib-component-js/web-components.min.js" type="module"></script>
+<link href="lib/bslib-component-css/components.css" rel="stylesheet" />
+<script src="lib/bs3compat/transition.js"></script>
+<script src="lib/bs3compat/tabs.js"></script>
+<script src="lib/bs3compat/bs3compat.js"></script>
+<link href="lib/htmltools-fill/fill.css" rel="stylesheet" />
+<script src="lib/bslib-tag-require/tag-require.js"></script>
+
+</head>
+<body>
+<div class="container-fluid">
+  <div class="card bslib-card bslib-mb-spacing html-fill-item html-fill-container" data-bslib-card-init data-require-bs-caller="card()" data-require-bs-version="5">
+    <div class="card-body bslib-gap-spacing html-fill-item html-fill-container" style="margin-top:auto;margin-bottom:auto;flex:1 1 auto;">A simple card</div>
+    <script data-bslib-card-init>bslib.Card.initializeAllCards();</script>
+  </div>
+</div>
+</body>
+</html>
diff --git a/tests/testthat/_snaps/page/modern-page.html b/tests/testthat/_snaps/page/modern-page.html
@@ -0,0 +1,16 @@
+<!DOCTYPE html>
+<html lang="en">
+<head>
+<meta charset="utf-8"/>
+<style>body{background-color:white;}</style>
+<script src="lib/jquery/jquery-3.6.0.min.js"></script>
+<meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no" />
+<link href="lib/bootstrap/bootstrap.min.css" rel="stylesheet" />
+<script src="lib/bootstrap/bootstrap.bundle.min.js"></script>
+<script src="lib/bslib-component-js/components.min.js"></script>
+<script src="lib/bslib-component-js/web-components.min.js" type="module"></script>
+<link href="lib/bslib-component-css/bslib-component-css.min.css" rel="stylesheet" />
+
+</head>
+<body>A simple page without bs3compat dependencies</body>
+</html>
diff --git a/tests/testthat/test-page.R b/tests/testthat/test-page.R
@@ -78,3 +78,26 @@ test_that("page_sidebar()", {
   )
 
 })
+
+test_that("save_html() works on components and pages with a custom theme", {
+  withr::local_options(list(htmltools.dir.version = FALSE))
+
+  withr::with_tempdir({
+    save_html(
+      card("A simple card"),
+      "card.html"
+    )
+    expect_snapshot_file("card.html")
+  })
+
+  withr::with_tempdir({
+    save_html(
+      page(
+        theme = bs_remove(bs_theme(), "bs3compat"),
+        "A simple page without bs3compat dependencies"
+      ),
+      "modern-page.html"
+    )
+    expect_snapshot_file("modern-page.html")
+  })
+})