feat!: Introduce navbar_options() (#1141)

* chore: code style * feat!(navbar_options): Introduce `navbar_options()`, deprecate navbar-related options in `navset_bar()` * feat: Add `underline` to `navbar_options()` * feat!(page_navbar): Use `navbar_options()` * docs: Move `navbar_options()` to its own docs page * chore(page_navbar): Move deprecated arguments to the end * docs: Update navset examples * feat: Prevent deprecation warnings from `shiny::navbarPage()` * refactor: simplify navbar_options() * chore: use version 2 for internal data * feat: Make `underline = TRUE` the default * refactor: consolidate deprecation warning into single message * tests: update snapshots * docs: Add news item * docs: Add a note about `navset_bar()` in the examples page Fixes #552 * chore: add todo note to remember to remove code when fully deprecated * chore: Include `...` for future expansion * refactor: Use attributes on `navbar_options()` to track source * chore: Apply changes from review * chore: edit wording in comment * feat: resolved navbar options equivalent to `navbar_options()` * chore: Error if `...` includes unused options
rstudio · Dec 2, 2024 · 74a138c · 74a138c
1 parent a6fda93
commit 74a138c
Show file tree

Hide file tree

Showing 13 changed files with 604 additions and 86 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -9,6 +9,7 @@ S3method(is_fillable_container,default)
 S3method(is_fillable_container,htmlwidget)
 S3method(print,bslib_breakpoints)
 S3method(print,bslib_fragment)
+S3method(print,bslib_navbar_options)
 S3method(print,bslib_page)
 S3method(print,bslib_showcase_layout)
 S3method(print,bslib_value_box_theme)
@@ -105,6 +106,7 @@ export(nav_remove)
 export(nav_select)
 export(nav_show)
 export(nav_spacer)
+export(navbar_options)
 export(navs_bar)
 export(navs_hidden)
 export(navs_pill)

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,13 @@
 # bslib (development version)
 
+## Breaking changes
+
+* The navbar-related style options of `page_navbar()` and `navset_bar()` have been consolidated into a single `navbar_options` argument that pairs with a new `navbar_options()` helper. Using the direct `position`, `bg`, `inverse`, `collapsible`, and `underline` arguments will continue to work with a deprecation message. (#1141)
+
+   Related to the above change, `navset_bar()` now defaults to using `underline = TRUE` so that both `page_navbar()` and `navset_bar()` use the same set of default `navbar_options()`.
+
+## Improvements and bug fixes
+
 * `navset_card_pills()`, `navset_card_underline()`, `navset_card_tabs()` fixed to now respect header/footer arguments (@tanho63, #1024) 
 
 * Fixed a bug in `bs_themer()` (and `bs_theme_preview()`) that caused it to stop applying changes if a Sass variable was `NULL`. (@meztez, #1112)

diff --git a/R/navs-legacy.R b/R/navs-legacy.R
@@ -105,36 +105,233 @@ navset_hidden <- function(..., id = NULL, selected = NULL,
 #'   character vector, matching the `value` of [nav_panel()]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.
+#' @param navbar_options Options to control the appearance and behavior of the
+#'   navbar. Use [navbar_options()] to create the list of options.
+#' @param position `r lifecycle::badge("deprecated")` Please use 
+#'   [`navbar_options = navbar_options(position=)`][navbar_options] instead.
+#' @param collapsible `r lifecycle::badge("deprecated")` Please use 
+#'   [`navbar_options = navbar_options(collapsible=)`][navbar_options] instead.
+#' @param bg `r lifecycle::badge("deprecated")` Please use 
+#'   [`navbar_options = navbar_options(bg=)`][navbar_options] instead.
+#' @param inverse `r lifecycle::badge("deprecated")` Please use 
+#'   [`navbar_options = navbar_options(inverse=)`][navbar_options] instead.
+#' 
 #' @export
 #' @rdname navset
-navset_bar <- function(..., title = NULL, id = NULL, selected = NULL,
-                     sidebar = NULL, fillable = TRUE,
-                     gap = NULL, padding = NULL,
-                     # 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) {
+navset_bar <- function(
+  ...,
+  title = NULL,
+  id = NULL,
+  selected = NULL,
+  sidebar = NULL,
+  fillable = TRUE,
+  gap = NULL,
+  padding = NULL,
+  header = NULL,
+  footer = NULL,
+  fluid = TRUE,
+  navbar_options = NULL,
+  position = deprecated(),
+  bg = deprecated(),
+  inverse = deprecated(),
+  collapsible = deprecated()
+) {
   padding <- validateCssPadding(padding)
   gap <- validateCssUnit(gap)
 
-  navs_bar_(
-    ..., title = title, id = id, selected = selected,
-    sidebar = sidebar, fillable = fillable,
-    gap = gap, padding = padding,
+  .navbar_options <- navbar_options_resolve_deprecated(
+    options_user = navbar_options,
     position = position,
-    header = header, footer = footer,
-    bg = bg, inverse = inverse,
-    collapsible = collapsible, fluid = fluid,
+    bg = bg,
+    inverse = inverse,
+    collapsible = collapsible
+  )
+
+  navs_bar_(
+    ...,
+    title = title,
+    id = id,
+    selected = selected,
+    sidebar = sidebar,
+    fillable = fillable,
+    gap = gap,
+    padding = padding,
+    header = header,
+    footer = footer,
+    fluid = fluid,
+    position = .navbar_options$position,
+    bg = .navbar_options$bg,
+    inverse = .navbar_options$inverse,
+    collapsible = .navbar_options$collapsible,
+    underline = .navbar_options$underline,
     # 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()
   )
 }
 
+#' Create a set of navbar options
+#' 
+#' A `navbar_options()` object captures options specific to the appearance and
+#' behavior of the navbar, independent from the content displayed on the page.
+#' This helper should be used to create the list of options expected by
+#' `navbar_options` in [page_navbar()] and [navset_bar()].
+#' 
+#' ## Changelog
+#' 
+#' This function was introduced in \pkg{bslib} v0.9.0, replacing the `position`,
+#' `bg`, `inverse`, `collapsible` and `underline` arguments of [page_navbar()]
+#' and [navset_bar()]. Those arguments are deprecated with a warning and will be
+#' removed in a future version of \pkg{bslib}.
+#' 
+#' @examples
+#' navbar_options(position = "static-top", bg = "#2e9f7d", underline = FALSE)
+#' 
+#' @inheritParams shiny::navbarPage
+#' @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.
+#' @param underline Whether or not to add underline styling to page or navbar
+#'   links when active or focused.
+#' @param ... Additional arguments are ignored. `...` is included for future
+#'   expansion on `navbar_options()`.
+#' 
+#' @returns Returns a list of navbar options.
+#' 
+#' @export
+navbar_options <- function(
+  ...,
+  position = c("static-top", "fixed-top", "fixed-bottom"),
+  bg = NULL,
+  inverse = "auto",
+  collapsible = TRUE,
+  underline = TRUE
+) {
+  # Track user-provided arguments for print method and deprecation warnings
+  is_default <- list(
+    position = missing(position),
+    bg = missing(bg),
+    inverse = missing(inverse),
+    collapsible = missing(collapsible),
+    underline = missing(underline)
+  )
+
+  rlang::check_dots_empty()
+
+  opts <- list(
+    position = rlang::arg_match(position),
+    bg = bg,
+    inverse = inverse,
+    collapsible = collapsible,
+    underline = underline
+  )
+
+  structure(
+    opts,
+    class = c("bslib_navbar_options", "list"),
+    is_default = is_default,
+    waldo_opts = list(ignore_attr = TRUE)
+  )
+}
+
+navbar_options_resolve_deprecated <- function(
+  options_user = list(),
+  position = deprecated(),
+  bg = deprecated(),
+  inverse = deprecated(),
+  collapsible = deprecated(),
+  underline = deprecated(),
+  .fn_caller = "navset_bar",
+  .warn_deprecated = TRUE
+) {
+  options_old <- list(
+    position = if (lifecycle::is_present(position)) position,
+    bg = if (lifecycle::is_present(bg)) bg,
+    inverse = if (lifecycle::is_present(inverse)) inverse,
+    collapsible = if (lifecycle::is_present(collapsible)) collapsible,
+    underline = if (lifecycle::is_present(underline)) underline
+  )
+  options_old <- dropNulls(options_old)
+
+  args_deprecated <- names(options_old)
+
+  if (.warn_deprecated && length(args_deprecated)) {
+    # TODO-deprecated: (2024-12) Elevate deprecation to an error
+    lifecycle::deprecate_warn(
+      "0.9.0",
+      I(sprintf(
+        "The %s argument%s of `%s()` have been consolidated into a single `navbar_options` argument and ",
+        paste(sprintf("`%s`", args_deprecated), collapse = ", "),
+        if (length(args_deprecated) > 1) "s" else "",
+        .fn_caller
+      ))
+    )
+  }
+
+  # Consolidate `navbar_options` (options_user) with the deprecated direct
+  # options. We take the direct option if the user option is a default value,
+  # warning if otherwise ignored.
+  # TODO-deprecated: Remove this and warning when direct options are hard-deprecated  
+  is_default <- attr(options_user, "is_default") %||% list()
+  keep_user_values <- vapply(
+    names(options_user),
+    function(x) !isTRUE(is_default[[x]]),
+    logical(1)
+  )
+  options_user <- options_user[keep_user_values]
+
+  ignored <- c()
+  for (opt in names(options_old)) {
+    if (!opt %in% names(options_user)) {
+      options_user[[opt]] <- options_old[[opt]]
+    } else if (!identical(options_old[[opt]], options_user[[opt]])) {
+      ignored <- c(ignored, opt)      
+    }
+  }
+
+  if (length(ignored) > 0) {
+    rlang::warn(
+      c(
+        sprintf(
+          "`%s` %s provided twice: once directly and once in `navbar_options`.",
+          paste(ignored, collapse = "`, `"),
+          if (length(ignored) == 1) "was" else "were"
+        ),
+        "The deprecated direct option(s) will be ignored and the values from `navbar_options` will be used."
+      ),
+      call = rlang::caller_call()
+    )
+  }
+
+  rlang::exec(navbar_options, !!!options_user)
+}
+
+#' @export
+print.bslib_navbar_options <- function(x, ...) {
+  cat("<bslib_navbar_options>\n")
+
+  if (length(x) == 0) {
+    return(invisible(x))
+  }
+
+  fields <- names(x)
+  opt_w <- max(nchar(fields))
+  is_default <- attr(x, "is_default") %||% list()
+  for (opt in fields) {
+    value <- x[[opt]] %||% "NULL"
+    if (isTRUE(is_default[[opt]])) {
+      if (identical(value, "NULL")) { 
+        # Skip printing default NULL values
+        next
+      }
+      value <- sprintf("(%s)", value)
+    }
+    cat(sprintf("%*s", opt_w, opt), ": ", value, "\n", sep = "")
+  }
+
+  invisible(x)
+}
+
 # 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

diff --git a/R/page.R b/R/page.R
@@ -333,8 +333,8 @@ maybe_page_sidebar <- function(x) {
 #'
 #' @param fillable_mobile Whether or not `fillable` pages should fill the viewport's
 #'   height on mobile devices (i.e., narrow windows).
-#' @param underline Whether or not to add underline styling to page links when
-#'   active or focused.
+#' @param underline `r lifecycle::badge("deprecated")` Please use 
+#'   [`navbar_options = navbar_options(underline=)`][navbar_options] instead.
 #' @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).
@@ -397,31 +397,46 @@ page_navbar <- function(
   fillable_mobile = FALSE,
   gap = NULL,
   padding = NULL,
-  position = c("static-top", "fixed-top", "fixed-bottom"),
   header = NULL,
   footer = NULL,
-  bg = NULL,
-  inverse = "auto",
-  underline = TRUE,
-  collapsible = TRUE,
+  navbar_options = NULL,
   fluid = TRUE,
   theme = bs_theme(),
   window_title = NA,
-  lang = NULL
+  lang = NULL,
+  position = deprecated(),
+  bg = deprecated(),
+  inverse = deprecated(),
+  underline = deprecated(),
+  collapsible = deprecated()
 ) {
 
   sidebar <- maybe_page_sidebar(sidebar)
 
   padding <- validateCssPadding(padding)
   gap <- validateCssUnit(gap)
 
+  # Change behavior when called by Shiny
+  # TODO: Coordinate with next bslib version bump in Shiny to use the new interface
+  was_called_by_shiny <- 
+    isNamespaceLoaded("shiny") && 
+    identical(rlang::caller_fn(), shiny::navbarPage)
+
+  .navbar_options <- navbar_options_resolve_deprecated(
+    options_user = navbar_options,
+    position = position,
+    bg = bg,
+    inverse = inverse,
+    collapsible = collapsible,
+    underline = underline,
+    .fn_caller = "page_navbar",
+    .warn_deprecated = !was_called_by_shiny
+  )
+
   # Default to fillable = F when this is called from shiny::navbarPage()
   # TODO: update shiny::navbarPage() to set fillable = FALSE and get rid of this hack
-  if (missing(fillable)) {
-    isNavbarPage <- isNamespaceLoaded("shiny") && identical(rlang::caller_fn(), shiny::navbarPage)
-    if (isNavbarPage) {
-      fillable <- FALSE
-    }
+  if (missing(fillable) && was_called_by_shiny) {
+    fillable <- FALSE
   }
 
   # If a sidebar is provided, we want the layout_sidebar(fill = TRUE) component
@@ -439,13 +454,23 @@ page_navbar <- function(
     class = "bslib-page-navbar",
     class = if (!is.null(sidebar)) "has-page-sidebar",
     navs_bar_(
-      ..., title = title, id = id, selected = selected,
-      sidebar = sidebar, fillable = fillable,
-      gap = gap, padding = padding,
-      position = match.arg(position), header = header,
-      footer = footer, bg = bg, inverse = inverse,
-      underline = underline, collapsible = collapsible,
-      fluid = fluid, theme = theme
+      ...,
+      title = title,
+      id = id,
+      selected = selected,
+      sidebar = sidebar,
+      fillable = fillable,
+      gap = gap,
+      padding = padding,
+      header = header,
+      footer = footer,
+      position = .navbar_options$position,
+      bg = .navbar_options$bg,
+      inverse = .navbar_options$inverse,
+      underline = .navbar_options$underline,
+      collapsible = .navbar_options$collapsible,
+      fluid = fluid,
+      theme = theme
     )
   )
 }

diff --git a/R/sysdata.rda b/R/sysdata.rda
diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -134,6 +134,7 @@ reference:
     - navset
     - nav-items
     - nav_select
+    - navbar_options
 - subtitle: Sidebar layout
   desc: >
     Place input controls or additional context in a sidebar next to the main