More page constructors (#320)

* Add page_navbar(); rename bs_page() to page()

* Put all page constructor on the same Rd page

* Better title/window_title handling

* Don't add special title handling in page() (do that in shiny instead)

* Add some snapshots tests for page_navbar()

* Fix the ritual build

* Document (GitHub Actions)

* No warning should be thrown

* Skip snapshots on R < 3.6

Co-authored-by: cpsievert <[email protected]>

NAMESPACE

@@ -25,7 +25,6 @@ export(bs_global_get)
 export(bs_global_set)
 export(bs_global_theme)
 export(bs_global_theme_update)
-export(bs_page)
 export(bs_remove)
 export(bs_retrieve)
 export(bs_theme)
@@ -61,8 +60,11 @@ export(navs_hidden)
 export(navs_pill)
 export(navs_pill_list)
 export(navs_tab)
+export(page)
+export(page_fill)
 export(page_fixed)
 export(page_fluid)
+export(page_navbar)
 export(precompiled_css_path)
 export(run_with_themer)
 export(theme_bootswatch)

R/navs-legacy.R

@@ -168,13 +168,13 @@ navs_bar <- function(..., title = NULL, id = NULL, selected = NULL,
   )
 
   if (!is.null(bg)) {
-    navbar <- tagAppendAttributes(
-      navbar, .cssSelector = ".navbar",
-      style = css(background_color = paste(bg, "!important"))
+    # navbarPage_() returns a tagList() of the nav and content
+    navbar[[1]] <- tagAppendAttributes(
+      navbar[[1]], style = css(background_color = paste(bg, "!important"))
     )
   }
 
-  as_fragment(navbar, page = bs_page)
+  as_fragment(navbar, page = page)
 }
 
 

R/page.R

@@ -4,40 +4,101 @@
 
 #' Create a Bootstrap page
 #'
-#' Alias for [shiny::bootstrapPage()] with `theme` defaulting to bslib's
-#' recommended version Bootstrap.
+#' These functions are small wrappers around shiny's page constructors (i.e., [shiny::fluidPage()], [shiny::navbarPage()], etc) that differ in two ways:
+#'  * The `theme` parameter defaults bslib's recommended version of Bootstrap (for new projects).
+#'  * The return value is rendered as an static HTML page when printed interactively at the console.
 #'
-#' @export
 #' @inheritParams shiny::bootstrapPage
-bs_page <- function(..., title = NULL, theme = bs_theme(), lang = NULL) {
+#' @seealso [shiny::bootstrapPage()]
+#' @export
+page <- function(..., title = NULL, theme = bs_theme(), lang = NULL) {
   as_page(
     shiny::bootstrapPage(..., title = title, theme = theme, lang = lang)
   )
 }
 
-
-#' Create a page with fluid layout
-#'
-#' Alias for [shiny::fluidPage()] with `theme` defaulting to bslib's recommended
-#' version Bootstrap.
-#'
-#' @export
+#' @rdname page
 #' @inheritParams shiny::fluidPage
+#' @seealso [shiny::fluidPage()]
+#' @export
 page_fluid <- function(..., title = NULL, theme = bs_theme(), lang = NULL) {
   as_page(
     shiny::fluidPage(..., title = title, theme = theme, lang = lang)
   )
 }
 
-#' Create a page with fluid layout
-#'
-#' Alias for [shiny::fixedPage()] with `theme` defaulting to bslib's recommended
-#' version Bootstrap.
-#'
-#' @export
+#' @rdname page
 #' @inheritParams shiny::fixedPage
+#' @seealso [shiny::fixedPage()]
+#' @export
 page_fixed <- function(..., title = NULL, theme = bs_theme(), lang = NULL) {
   as_page(
     shiny::fixedPage(..., title = title, theme = theme, lang = lang)
   )
 }
+
+#' @rdname page
+#' @inheritParams shiny::fillPage
+#' @seealso [shiny::fillPage()]
+#' @export
+page_fill <- function(..., padding = 0, title = NULL,
+                      theme = bs_theme(), lang = NULL) {
+  as_page(
+    shiny::fillPage(..., padding = padding, title = title, theme = theme, lang = lang)
+  )
+}
+
+#' @rdname page
+#' @inheritParams navs_bar
+#' @inheritParams bs_page
+#' @seealso [shiny::navbarPage()]
+#' @param window_title the browser window title. The default value, `NA`, means
+#'   to use any character strings that appear in `title` (if none are found, the
+#'   host URL of the page is displayed by default).
+#' @export
+page_navbar <- function(..., title = NULL, id = NULL, selected = NULL,
+                        position = c("static-top", "fixed-top", "fixed-bottom"),
+                        header = NULL, footer = NULL,
+                        bg = NULL, inverse = "auto",
+                        collapsible = TRUE, fluid = TRUE,
+                        theme =  bs_theme(),
+                        window_title = NA,
+                        lang = NULL) {
+
+  # https://github.com/rstudio/shiny/issues/2310
+  if (!is.null(title) && isTRUE(is.na(window_title))) {
+    window_title <- unlist(find_characters(title))
+    if (is.null(window_title)) {
+      warning("Unable to infer a `window_title` default from `title`. Consider providing a character string to `window_title`.")
+    } else {
+      window_title <- paste(window_title, collapse = " ")
+    }
+  }
+
+  page(
+    title = window_title,
+    theme = theme,
+    lang = lang,
+    navs_bar(
+      ..., title = title, id = id, selected = selected,
+      position = match.arg(position), header = header,
+      footer = footer, bg = bg, inverse = inverse,
+      collapsible = collapsible, fluid = fluid
+    )
+  )
+}
+
+#> unlist(find_characters(div(h1("foo"), h2("bar"))))
+#> [1] "foo" "bar"
+find_characters <- function(x) {
+  if (is.character(x)) {
+    return(x)
+  }
+  if (inherits(x, "shiny.tag")) {
+    return(lapply(x$children, find_characters))
+  }
+  if (is.list(x)) {
+    return(lapply(x, find_characters))
+  }
+  NULL
+}

_pkgdown.yml

@@ -68,9 +68,7 @@ reference:
     - nav_select
 - title: Create a Bootstrap page
   contents:
-    - page_fluid
-    - page_fixed
-    - bs_page
+    - page
 - title: Dynamic theming
   description: |
     Create dynamically themable HTML widgets.