diff --git a/.Rbuildignore b/.Rbuildignore index c53116051..c76aff6c8 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -17,6 +17,7 @@ inst/lib/bsw3/.npmignore ^_pkgdown\.yml$ ^vignettes$ +^srcts$ ^node_modules$ ^package\.json$ ^tsconfig\.json$ diff --git a/.gitignore b/.gitignore index a297bec2c..eb2ccb0b5 100644 --- a/.gitignore +++ b/.gitignore @@ -17,3 +17,11 @@ inst/doc inst/yarn.lock inst/rmarkdown/templates/*/skeleton/skeleton.html + +vignettes/navbar-global +vignettes/navbar-global-fillable +vignettes/navbar-local-scroll +vignettes/navbar-local-fill +vignettes/page-scroll +vignettes/page-fill +vignettes/page-fill-double diff --git a/DESCRIPTION b/DESCRIPTION index 99424402d..1fd43415f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -71,6 +71,7 @@ Collate: 'precompiled.R' 'print.R' 'shiny-devmode.R' + 'sidebar.R' 'staticimports.R' 'utils-shiny.R' 'utils-tags.R' @@ -85,6 +86,7 @@ Config/Needs/routine: renv Config/Needs/website: brio, + crosstalk, dplyr, DT, glue, diff --git a/NAMESPACE b/NAMESPACE index 4d6bc01d1..bb4e1038a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -56,6 +56,7 @@ export(card_body_fill) export(card_footer) export(card_header) export(card_image) +export(card_sidebar) export(card_title) export(font_collection) export(font_face) @@ -64,6 +65,7 @@ export(font_link) export(is.card_item) export(is_bs_theme) export(layout_column_wrap) +export(layout_sidebar) export(nav) export(nav_append) export(nav_content) @@ -92,6 +94,9 @@ export(precompiled_css_path) export(run_with_themer) export(showcase_left_center) export(showcase_top_right) +export(sidebar) +export(sidebar_close) +export(sidebar_open) export(theme_bootswatch) export(theme_version) export(value_box) diff --git a/NEWS.md b/NEWS.md index 9508c360e..2ff0e8202 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,11 +2,19 @@ ## Potentially breaking changes +* `page_fill()` now produces a `` tag with `display:flex` (instead of `display:block`). It also no longer fills the windows height on mobile (i.e., narrow screens) by default. If this breaks existing behavior, consider using `shiny::fillPage(theme = bslib::bs_theme(), ...)` instead of `page_fill()`. (#479) +* `page_navbar()` (and consequently `shiny::navbarPage()`) no longer implicitly wrap `header` and `footer` in an additional `shiny::fluidRow()` container for Bootstrap 5+ (i.e., `theme = bs_theme()`). Similarly, `navs_bar()` no longer does this (for any version of Bootstrap). If this breaks existing behavior, consider wrapping the `header` and `footer` value(s) with `shiny::fluidRow()`). (#479) * Defaults for the following Bootstrap 5 Sass variables were changed to `null`: `$accordion-button-active-bg`, `$accordion-button-active-color`, and `$accordion-icon-active-color`. To restore the old behavior, do `bs_add_variables(theme, "accordion-button-active-bg" = "tint-color($component-active-bg, 90%)", "accordion-button-active-color" = "shade-color($primary, 10%)", "accordion-icon-active-color" = "$accordion-button-active-color", .where = "declarations")`. (#475) ## New features -* Adds a new `accordion()` component API. See `help(accordion)` for details. (#475) +* Added a `sidebar()` API for creating sidebar layouts in various contexts. See [the article](https://rstudio.github.io/bslib/articles/sidebars.html) to learn more. (#479) +* Adds a new `accordion()` API. See `help(accordion)` for examples and details. Note also `accordion()` is designed to [work well inside a `sidebar()`](https://rstudio.github.io/bslib/articles/sidebars.html#accordions). (#475) +* `page_navbar()`, `navs_tab_card()`, and ` navs_pill_card()` gain a `sidebar` argument for putting a `sidebar()` on every page/tab/pill. (#479) +* `page_navbar()` gains a `fillable` argument to make the content of particular page(s) fit the window/card. (#479) +* `page_fill()` is now considered a `fillable` container, meaning that `fill` items like `card()`, `layout_column_wrap()`, and `layout_sidebar()` now grow/shrink to fit the window's height when they appear as a direct child of `page_fill()`. (#479) +* `page_navbar()` and `page_fill()` gain `fill_mobile` arguments to control whether the page should grow/shrink to fit the viewport on mobile. (#479) + # bslib 0.4.2 diff --git a/R/accordion.R b/R/accordion.R index 80aec670e..9ac87bbaa 100644 --- a/R/accordion.R +++ b/R/accordion.R @@ -150,8 +150,9 @@ accordion_panel <- function(title, ..., value = title, icon = NULL) { div( class = "accordion-item", "data-value" = value, + # Use a instead of

so that it doesn't get included in rmd/pkgdown/qmd TOC # TODO: can we provide a way to put more stuff in the header? Like maybe some right-aligned controls? - h2(class = "accordion-header", btn), + span(class = "accordion-header h2", btn), div( id = id, class = "accordion-collapse collapse", diff --git a/R/bs-theme.R b/R/bs-theme.R index 08dbf86e4..1605a4ab9 100644 --- a/R/bs-theme.R +++ b/R/bs-theme.R @@ -276,8 +276,10 @@ bootstrap_bundle <- function(version) { !!!rule_bundles(c( system_file("components", "accordion.scss", package = "bslib"), system_file("components", "card.scss", package = "bslib"), - system_file("components", "value_box.scss", package = "bslib"), - system_file("components", "layout_column_wrap.scss", package = "bslib") + system_file("components", "fill.scss", package = "bslib"), + system_file("components", "layout_column_wrap.scss", package = "bslib"), + system_file("components", "sidebar.scss", package = "bslib"), + system_file("components", "value_box.scss", package = "bslib") )) ), four = sass_bundle( diff --git a/R/card.R b/R/card.R index 70fc85ccb..ea84b26ee 100644 --- a/R/card.R +++ b/R/card.R @@ -210,6 +210,18 @@ card_footer <- function(..., class = NULL) { ) } +#' @describeIn card_body A [card_body_fill()] with a [layout_sidebar()] inside +#' of it. All arguments to this function are passed along to +#' [layout_sidebar()]. +#' @inheritParams layout_sidebar +#' @export +card_sidebar <- function(sidebar = sidebar(), ..., border = FALSE) { + card_body_fill( + class = "p-0", + layout_sidebar(sidebar = sidebar, ..., border = border) + ) +} + #' @describeIn card_body Include static (i.e., pre-generated) images. #' @param file a file path pointing an image. The image will be base64 encoded #' and provided to the `src` attribute of the ``. Alternatively, you may diff --git a/R/navs-legacy.R b/R/navs-legacy.R index 3c956be60..617171dc5 100644 --- a/R/navs-legacy.R +++ b/R/navs-legacy.R @@ -104,17 +104,48 @@ navs_hidden <- function(..., id = NULL, selected = NULL, #' @inheritParams shiny::navbarPage +#' @param sidebar A [sidebar()] component to display on every [nav()] page. +#' @param fillable Whether or not to allow `fill` items to grow/shrink to fit +#' the browser window. If `TRUE`, all [nav()] pages are `fillable`. A +#' character vector, matching the `value` of [nav()]s to be filled, may also +#' be provided. Note that, if a `sidebar` is provided, `fillable` makes the +#' main content portion fillable. #' @param bg a CSS color to use for the navbar's background color. #' @param inverse Either `TRUE` for a light text color or `FALSE` for a dark #' text color. If `"auto"` (the default), the best contrast to `bg` is chosen. #' @export #' @rdname navs navs_bar <- function(..., title = NULL, id = NULL, selected = NULL, + sidebar = NULL, fillable = FALSE, # TODO: add sticky-top as well? position = c("static-top", "fixed-top", "fixed-bottom"), header = NULL, footer = NULL, bg = NULL, inverse = "auto", collapsible = TRUE, fluid = TRUE) { + navs_bar_( + ..., title = title, id = id, selected = selected, + sidebar = sidebar, fillable = fillable, + position = position, + header = header, footer = footer, + bg = bg, inverse = inverse, + collapsible = collapsible, fluid = fluid, + # theme is only used to determine whether legacy style markup should be used + # (and, at least at the moment, we don't need legacy markup for this exported function) + theme = bs_theme() + ) +} + +# This internal version of navs_bar() exists so both it and page_navbar() +# (and thus shiny::navbarPage()) can use it. And in the page_navbar() case, +# we can use addition theme information as an indication of whether we need +# to handle backwards compatibility +navs_bar_ <- function(..., title = NULL, id = NULL, selected = NULL, + sidebar = NULL, fillable = FALSE, + position = c("static-top", "fixed-top", "fixed-bottom"), + header = NULL, footer = NULL, + bg = NULL, inverse = "auto", + collapsible = TRUE, fluid = TRUE, + theme = NULL) { if (identical(inverse, "auto")) { inverse <- TRUE @@ -127,9 +158,11 @@ navs_bar <- function(..., title = NULL, id = NULL, selected = NULL, navbar <- navbarPage_( title = title, ..., id = id, selected = selected, + sidebar = sidebar, fillable = fillable, position = match.arg(position), header = header, footer = footer, collapsible = collapsible, - inverse = inverse, fluid = fluid + inverse = inverse, fluid = fluid, + theme = theme ) if (!is.null(bg)) { @@ -153,15 +186,15 @@ navbarPage_ <- function(title, ..., id = NULL, selected = NULL, + sidebar = NULL, + fillable = FALSE, position = c("static-top", "fixed-top", "fixed-bottom"), header = NULL, footer = NULL, inverse = FALSE, collapsible = FALSE, fluid = TRUE, - theme = NULL, - windowTitle = title, - lang = NULL) { + theme = NULL) { # alias title so we can avoid conflicts w/ title in withTags pageTitle <- title @@ -230,13 +263,53 @@ navbarPage_ <- function(title, allTags() } - # build the main tab content div - contentDiv <- div(class = containerClass) - if (!is.null(header)) - contentDiv <- tagAppendChild(contentDiv, div(class = "row", header)) - contentDiv <- tagAppendChild(contentDiv, tabset$content) - if (!is.null(footer)) - contentDiv <- tagAppendChild(contentDiv, div(class = "row", footer)) + # If fillable is truthy, give the relevant .tab-content > .tab-pane containers + # the potential to fill + tabset$content <- makeTabsFillable(tabset$content, fillable, navbar = TRUE) + + # For backwards compatibility reasons, wrap header & footer in a .row + # container if we're not using BS5+. I'm not entirely sure what the motivation + # was for it in the 1st place, but now that, with BS5, .row adds + # `display:flex` and makes children `width:100%`, which is surprising and + # confusing from a user perspective + isLegacy <- as.numeric(theme_version(theme) %||% 3) < 5 + if (!is.null(header) && isLegacy) { + header <- div(class = "row", header) + } + if (!is.null(footer) && isLegacy) { + footer <- div(class = "row", footer) + } + + contents <- dropNulls(list(header, tabset$content, footer)) + + if (is.null(sidebar)) { + + contentDiv <- div(class = containerClass, !!!contents) + + # If fillable is truthy, the .container also needs to be fillable + if (!isFALSE(fillable)) { + contentDiv <- bindFillRole(contentDiv, container = TRUE, item = TRUE) + } + + } else { + + contentDiv <- div( + # In the fluid case, the sidebar layout should be flush (i.e., + # the .container-fluid class adds padding that we don't want) + class = if (!fluid) "container", + layout_sidebar( + fillable = !isFALSE(fillable), + border_radius = FALSE, + border = !fluid, + sidebar, contents + ) + ) + + # Always have the sidebar layout fill its parent (in this case + # fillable controls whether the _main_ content portion is fillable) + contentDiv <- bindFillRole(contentDiv, container = TRUE, item = TRUE) + + } # *Don't* wrap in bootstrapPage() (shiny::navbarPage()) does that part tagList( diff --git a/R/navs.R b/R/navs.R index 270b8bf6b..a6440f587 100644 --- a/R/navs.R +++ b/R/navs.R @@ -5,8 +5,8 @@ #' provided, other nav items are automatically right aligned. #' @rdname navs navs_tab_card <- function(..., id = NULL, selected = NULL, title = NULL, - header = NULL, footer = NULL, height = NULL, - full_screen = FALSE, wrapper = card_body) { + sidebar = NULL, header = NULL, footer = NULL, + height = NULL, full_screen = FALSE, wrapper = card_body) { items <- collect_nav_items(..., wrapper = wrapper) @@ -14,11 +14,11 @@ navs_tab_card <- function(..., id = NULL, selected = NULL, title = NULL, !!!items, id = id, selected = selected, header = header, footer = footer ) + tabQ <- tagQuery(tabs) + # https://getbootstrap.com/docs/5.0/components/card/#navigation - nav <- tagQuery(tabs)$ - find(".nav")$ - addClass("card-header-tabs")$ - selectedTags() + nav <- tabQ$children(".nav")$addClass("card-header-tabs")$selectedTags()[[1]] + content <- tabQ$children(".tab-content")$selectedTags()[[1]] card( height = height, @@ -28,7 +28,7 @@ navs_tab_card <- function(..., id = NULL, selected = NULL, title = NULL, } else { card_header(nav) }, - navs_card_body(tabs) + navs_card_body(content, sidebar) ) } @@ -36,8 +36,8 @@ navs_tab_card <- function(..., id = NULL, selected = NULL, title = NULL, #' @param placement placement of the nav items relative to the content. #' @rdname navs navs_pill_card <- function(..., id = NULL, selected = NULL, title = NULL, - header = NULL, footer = NULL, height = NULL, - placement = c("above", "below"), + sidebar = NULL, header = NULL, footer = NULL, + height = NULL, placement = c("above", "below"), full_screen = FALSE, wrapper = card_body) { items <- collect_nav_items(..., wrapper = wrapper) @@ -49,10 +49,11 @@ navs_pill_card <- function(..., id = NULL, selected = NULL, title = NULL, above <- match.arg(placement) == "above" - nav <- tagQuery(pills)$ - find(".nav")$ - addClass(if (above) "card-header-pills")$ - selectedTags() + pillQ <- tagQuery(pills) + + # https://getbootstrap.com/docs/5.0/components/card/#navigation + nav <- pillQ$children(".nav")$addClass(if (above) "card-header-pills")$selectedTags()[[1]] + content <- pillQ$children(".tab-content")$selectedTags()[[1]] nav_args <- if (!is.null(title)) { list(class = "bslib-navs-card-title", tags$span(title), nav) @@ -64,7 +65,7 @@ navs_pill_card <- function(..., id = NULL, selected = NULL, title = NULL, height = height, full_screen = full_screen, if (above) card_header(!!!nav_args), - navs_card_body(pills), + navs_card_body(content, sidebar), if (!above) card_footer(!!!nav_args) ) } @@ -87,16 +88,46 @@ collect_nav_items <- function(..., wrapper) { lapply(items, nav_to_card_item) } -navs_card_body <- function(tabs) { +# Always give tab contents the potential to fill since that's akin to the +# normal card() API (i.e. the card() is a fill container) and users have +# option to make the contents fill via card_body(fill = TRUE) and/or card_body_fill() +navs_card_body <- function(content, sidebar) { + content <- makeTabsFillable(content, fillable = TRUE) + if (!is.null(sidebar)) { + content <- card_sidebar(sidebar, content, fillable = TRUE, border = FALSE) + } + as.card_item(content) +} - tabs <- bindFillRole(tabs, .cssSelector = ".tab-content", container = TRUE, item = TRUE) - tabs <- bindFillRole(tabs, .cssSelector = ".tab-content > *", container = TRUE, item = TRUE) - content <- tagQuery(tabs)$find(".tab-content")$selectedTags() +# Given a .tab-content container, mark each relevant .tab-pane as a +# fill container/item. +makeTabsFillable <- function(content, fillable = FALSE, navbar = FALSE) { + if (!inherits(content, "shiny.tag") || !tagQuery(content)$hasClass("tab-content")) { + abort("Expected `content` to be a tag with a tab-content class") + } - if (length(content) > 1) { - stop("Found more than 1 .tab-content CSS class. Please use another name for your CSS classes.") + if (isFALSE(fillable)) { + return(content) } - as.card_item(content[[1]]) + # Even if only one .tab-pane wants fillable behavior, the .tab-content + # must to be a fillable container. + content <- bindFillRole(content, container = TRUE, item = TRUE) + + tagQuery(content)$ + find(".tab-pane")$ + each(function(x, i) { + + if (isTRUE(fillable) || isTRUE(tagGetAttribute(x, "data-value") %in% fillable)) { + x <- tagAppendAttributes( + # Remove the margin between nav and content (for page_navbr()) + style = css("--bslib-navbar-margin" = if (navbar) 0), + bindFillRole(x, container = TRUE, item = TRUE) + ) + } + + x + })$ + allTags() } diff --git a/R/page.R b/R/page.R index 78ff9b64d..146c1bfe8 100644 --- a/R/page.R +++ b/R/page.R @@ -39,12 +39,34 @@ page_fixed <- function(..., title = NULL, theme = bs_theme(), lang = NULL) { #' @rdname page #' @inheritParams shiny::fillPage +#' @param fill_mobile Whether or not the page should fill the viewport's +#' height on mobile devices (i.e., narrow windows). #' @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) +page_fill <- function(..., padding = 0, fill_mobile = FALSE, title = NULL, theme = bs_theme(), lang = NULL) { + page( + title = title, + theme = theme, + lang = lang, + tags$head(tags$style(HTML("html { height: 100%; }"))), + bindFillRole( + tags$body( + class = "bslib-page-fill", + style = css( + padding = validateCssPadding(padding), + "--bslib-page-fill-mobile-height" = if (fill_mobile) "100%" else "auto" + ), + ... + ), + container = TRUE + ) + ) +} + +validateCssPadding <- function(padding = NULL) { + paste( + vapply(padding, validateCssUnit, character(1)), + collapse = " " ) } @@ -52,11 +74,14 @@ page_fill <- function(..., padding = 0, title = NULL, #' @inheritParams navs_bar #' @inheritParams bs_page #' @seealso [shiny::navbarPage()] +#' @param fill_mobile Whether or not `fillable` pages should fill the viewport's +#' height on mobile devices (i.e., narrow windows). #' @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, + sidebar = NULL, fillable = FALSE, fill_mobile = FALSE, position = c("static-top", "fixed-top", "fixed-bottom"), header = NULL, footer = NULL, bg = NULL, inverse = "auto", @@ -75,19 +100,64 @@ page_navbar <- function(..., title = NULL, id = NULL, selected = NULL, } } - page( + if (!is.null(sidebar) && !inherits(sidebar, "sidebar")) { + abort("`sidebar` argument must contain a `bslib::sidebar()` component.") + } + + # If a sidebar is provided, we want the layout_sidebar(fill = TRUE) component + # (which is a sibling of the