1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
as_fragment <- function(x, page = page_fluid) {
stopifnot(is.function(page) && "theme" %in% names(formals(page)))
attr(x, "bslib_page") <- page
class(x) <- c("bslib_fragment", class(x))
x
}
as_page <- function(x, theme = bs_theme()) {
class(x) <- c("bslib_page", class(x))
attr(x, "bs_theme") <- theme
x
}
#' Print a bslib page/fragment
#'
#' @param x a bslib page/fragment.
#' @param ... passed along to an underlying print method.
#' @export
#' @keywords internal
#' @rdname html-browse
print.bslib_fragment <- function(x, ...) {
x <- attr(x, "bslib_page")(x)
invisible(print(x, ...))
}
#' Save a bslib page/fragment as HTML
#'
#' @param html a bslib page/fragment.
#' @param ... passed along to an underlying [htmltools::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, ...) {
old_global <- bs_global_get()
bs_global_set(attr(x, "bs_theme", exact = TRUE))
on.exit(bs_global_set(old_global))
if (interactive()) {
x <- htmltools::browsable(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()
}
|
