feat(navbar_options): Match Bootstrap 5 semantics

R/navs-legacy.R

@@ -147,7 +147,7 @@ navset_bar <- function(
     collapsible = collapsible
   )
 
-  navs_bar_(
+  navbar <- navs_bar_(
     ...,
     title = title,
     id = id,
@@ -161,13 +161,15 @@ navset_bar <- function(
     fluid = fluid,
     position = .navbar_options$position,
     bg = .navbar_options$bg,
-    inverse = .navbar_options$inverse,
+    inverse = .navbar_options$type,
     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()
   )
+
+  navbar_options_apply_attribs(navbar, .navbar_options)
 }
 
 #' Create a set of navbar options
@@ -182,19 +184,22 @@ navset_bar <- function(
 #' 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}.
+#' removed in a future version of \pkg{bslib}. Note that the deprecated
+#' `inverse` argument of [page_navbar()] and [navset_bar()] was replaced with
+#' the `type` argument of `navbar_options()`.
 #' 
 #' @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 type Either `"dark"` for a light text color (on a **dark** background)
+#'   or `"light"` for a dark text color (on a **light** background). If `"auto"`
+#'   (the default) and `bg` is provided, 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()`.
+#' @param ... Additional attributes that will be passed directly to the navbar
+#'   container element.
 #' 
 #' @returns Returns a list of navbar options.
 #' 
@@ -203,29 +208,46 @@ navbar_options <- function(
   ...,
   position = c("static-top", "fixed-top", "fixed-bottom"),
   bg = NULL,
-  inverse = "auto",
+  type = c("auto", "light", "dark"),
   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),
+    type = missing(type),
     collapsible = missing(collapsible),
     underline = missing(underline)
   )
-
-  rlang::check_dots_empty()
-
+
   opts <- list(
     position = rlang::arg_match(position),
     bg = bg,
-    inverse = inverse,
+    type = rlang::arg_match(type),
     collapsible = collapsible,
     underline = underline
   )
 
+  dots <- separate_arguments(...)
+  if (length(dots$children) > 0) {
+    abort("All arguments in `...` must be named attributes to be applied to the navbar container.")
+  }
+
+  if ("inverse" %in% names(dots$attribs)) {
+    # Catch muscle-memory for using `inverse`. We didn't officially release
+    # `navbar_options()` with an `inverse` argument, but it's reasonable people
+    # might try to use it and it did exist briefly in dev versions.
+    lifecycle::deprecate_soft(
+      when = "0.9.0",
+      what = "navbar_options(inverse=)",
+      with = "navbar_options(type=)"
+    )
+  }
+  if (length(dots$attribs)) {
+    opts[["attribs"]] <- dots$attribs
+  }
+
   structure(
     opts,
     class = c("bslib_navbar_options", "list"),
@@ -234,6 +256,25 @@ navbar_options <- function(
   )
 }
 
+navbar_options_apply_attribs <- function(navbar, navbar_options = NULL) {
+  if (is.null(navbar_options[["attribs"]])) {
+    return(navbar)
+  }
+
+  attribs <- navbar_options[["attribs"]]
+  navbar[[1]] <- rlang::exec(tagAppendAttributes, navbar[[1]], !!!attribs)
+
+  if ("data-bs-theme" %in% names(attribs)) {
+    # If you're setting this attribute directly, you know more about what you're
+    # doing than we do (we handle it for users via `type`). Also: the call to
+    # tagAppendAttributes ensures that `navbar[[1]]` is a tag object and has the
+    # attribs field.
+    navbar[[1]][["attribs"]][["data-bs-theme"]] <- attribs[["data-bs-theme"]]
+  }
+
+  navbar
+}
+
 navbar_options_resolve_deprecated <- function(
   options_user = list(),
   position = deprecated(),
@@ -260,13 +301,33 @@ navbar_options_resolve_deprecated <- function(
     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
-      ))
+        "The arguments of `%s()` for navbar options (including %s) have been consolidated into a single `navbar_options` argument and ",
+        .fn_caller,
+        paste(sprintf("`%s`", args_deprecated), collapse = ", ")
+      )),
+      details = c(
+        "i" = "See `navbar_options()` for more details.",
+        "!" = if ("inverse" %in% args_deprecated) "Use `type` instead of `inverse` in `navbar_options()`."
+      )
     )
   }
+
+  # Upgrade `inverse` to the new `type` argument of `navbar_options()`
+  if ("inverse" %in% names(options_old)) {
+    inverse <- options_old[["inverse"]]
+    options_old[["inverse"]] <- NULL
+
+    options_old[["type"]] <- 
+      if (is.character(inverse)) {
+        inverse
+      } else if (isTRUE(as.logical(inverse))) {
+        options_old[["type"]] <- "dark"
+      } else if (isFALSE(as.logical(inverse))) {
+        options_old[["type"]] <- "light"
+      } else {
+        abort(paste("Invalid `inverse` value: ", inverse))
+      }
+  }
 
   # Consolidate `navbar_options` (options_user) with the deprecated direct
   # options. We take the direct option if the user option is a default value,
@@ -285,7 +346,7 @@ navbar_options_resolve_deprecated <- function(
     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)      
+      ignored <- c(ignored, if (opt == "type") "inverse" else opt)      
     }
   }
 
@@ -303,7 +364,10 @@ navbar_options_resolve_deprecated <- function(
     )
   }
 
-  rlang::exec(navbar_options, !!!options_user)
+  attribs <- options_user$attrs %||% list()
+  options_user$attribs <- NULL
+
+  rlang::exec(navbar_options, !!!options_user, !!!attribs)
 }
 
 #' @export
@@ -319,6 +383,9 @@ print.bslib_navbar_options <- function(x, ...) {
   is_default <- attr(x, "is_default") %||% list()
   for (opt in fields) {
     value <- x[[opt]] %||% "NULL"
+    if (inherits(value, "list")) {
+      value <- paste(names(value), collapse = ", ")
+    }
     if (isTRUE(is_default[[opt]])) {
       if (identical(value, "NULL")) { 
         # Skip printing default NULL values
@@ -332,6 +399,7 @@ print.bslib_navbar_options <- function(x, ...) {
   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
@@ -347,17 +415,23 @@ navs_bar_ <- function(..., title = NULL, id = NULL, selected = NULL,
                       theme = NULL) {
 
   if (identical(inverse, "auto")) {
-    inverse <- TRUE
-    if (identical(theme_preset_info(theme)$name, "shiny")) {
-      inverse <- FALSE
+    if (is.null(theme) || theme_version(theme) < 5) {
+      inverse <- TRUE
     }
     if (!is.null(bg)) {
       bg <- htmltools::parseCssColors(bg)
-      bg_contrast <- bs_get_contrast(bs_theme("navbar-bg" = bg), "navbar-bg")
-      inverse <- col2rgb(bg_contrast)[1,] > 127.5
+      bg_contrast <- get_color_contrast(bg)
+      inverse <- bg_contrast == "#FFFFFF"
     }
   }
 
+  navbar_color_mode <- switch(
+    as.character(inverse),
+    "TRUE" = "dark",
+    "FALSE" = "light",
+    inverse
+  )
+
   navbar <- navbarPage_(
     title = title, ..., id = id, selected = selected,
     sidebar = sidebar, fillable = fillable,
@@ -368,12 +442,12 @@ navs_bar_ <- function(..., title = NULL, id = NULL, selected = NULL,
     theme = theme
   )
 
-  if (!is.null(bg)) {
-    # navbarPage_() returns a tagList() of the nav and content
-    navbar[[1]] <- tagAppendAttributes(
-      navbar[[1]], style = css(background_color = paste(bg, "!important"))
-    )
-  }
+  # navbarPage_() returns a tagList() of the nav and content
+  navbar[[1]] <- tagAppendAttributes(
+    navbar[[1]], 
+    style = if (!is.null(bg)) css(background_color = paste(bg, "!important")),
+    "data-bs-theme" = navbar_color_mode
+  )
 
   as_fragment(navbar, page = page)
 }
@@ -408,7 +482,7 @@ navbarPage_ <- function(title,
   position <- match.arg(position)
   if (!is.null(position))
     navbarClass <- paste0(navbarClass, " navbar-", position)
-  if (inverse)
+  if (isTRUE(inverse))
     navbarClass <- paste(navbarClass, "navbar-inverse")
 
   if (!is.null(id))

R/page.R

@@ -447,31 +447,34 @@ page_navbar <- function(
     function(...) page_fillable(..., fillable_mobile = fillable_mobile, padding = 0, gap = 0)
   }
 
+  navbar <- navs_bar_(
+    ...,
+    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$type,
+    underline = .navbar_options$underline,
+    collapsible = .navbar_options$collapsible,
+    fluid = fluid,
+    theme = theme
+  )
+  navbar <- navbar_options_apply_attribs(navbar, .navbar_options)
+
   page_func(
     title = infer_window_title(title, window_title),
     theme = theme,
     lang = lang,
     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,
-      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
-    )
+    navbar
   )
 }
 

tests/testthat/_snaps/navs-legacy.md

@@ -5,30 +5,30 @@
     Output
       <bslib_navbar_options>
          position: (static-top)
-          inverse: (auto)
+             type: (auto)
       collapsible: (TRUE)
         underline: (TRUE)
 
 ---
 
     Code
-      navbar_options(inverse = TRUE, bg = "red")
+      navbar_options(type = "dark", bg = "red")
     Output
       <bslib_navbar_options>
          position: (static-top)
                bg: red
-          inverse: TRUE
+             type: dark
       collapsible: (TRUE)
         underline: (TRUE)
 
 ---
 
     Code
-      navbar_options(position = "static-top", inverse = FALSE, collapsible = TRUE)
+      navbar_options(position = "static-top", type = "auto", collapsible = TRUE)
     Output
       <bslib_navbar_options>
          position: static-top
-          inverse: FALSE
+             type: auto
       collapsible: TRUE
         underline: (TRUE)