diff --git a/NAMESPACE b/NAMESPACE index a6ed34d8a..6686da4c0 100644 --- 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 index 3b861b5a5..01197a88b 100644 --- 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 index 58f2c79b4..2ed977f69 100644 --- 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("\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 index 628f88f35..06f862b79 100644 --- 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,17 +397,18 @@ 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) @@ -415,13 +416,27 @@ page_navbar <- function( 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 index 53fcb322e..b94643c70 100644 Binary files a/R/sysdata.rda and b/R/sysdata.rda differ diff --git a/_pkgdown.yml b/_pkgdown.yml index 2a94f58e6..7b6ee3eb2 100644 --- 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 diff --git a/man/fragments/ex-navset_tab.Rmd b/man/fragments/ex-navset_tab.Rmd index 98eda926c..12f3bb572 100644 --- a/man/fragments/ex-navset_tab.Rmd +++ b/man/fragments/ex-navset_tab.Rmd @@ -186,13 +186,17 @@ navset_pill_list( Finally, `page_navbar()` provides full-page navigation container similar to `navset_underline()` but where each `nav_panel()` is treated as a full page of content and the navigation controls appear in a top-level navigation bar. -Note also that the underline styling can be removed via the `underline` argument. +Note that the navbar background and underline styling can be controlled via `navbar_options`. + +`page_navbar()` is complimented by `navset_bar()` which produces a similar layout intended to be used within an app. ```{r page_navbar, fig.width=10} page_navbar( title = "My App", - bg = "#0062cc", - underline = TRUE, + navbar_options = navbar_options( + bg = "#0062cc", + underline = TRUE + ), nav_panel(title = "One", p("First tab content.")), nav_panel(title = "Two", p("Second tab content.")), nav_panel(title = "Three", p("Third tab content")), diff --git a/man/navbar_options.Rd b/man/navbar_options.Rd new file mode 100644 index 000000000..6c4744312 --- /dev/null +++ b/man/navbar_options.Rd @@ -0,0 +1,60 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/navs-legacy.R +\name{navbar_options} +\alias{navbar_options} +\title{Create a set of navbar options} +\usage{ +navbar_options( + ..., + position = c("static-top", "fixed-top", "fixed-bottom"), + bg = NULL, + inverse = "auto", + collapsible = TRUE, + underline = TRUE +) +} +\arguments{ +\item{...}{Additional arguments are ignored. \code{...} is included for future +expansion on \code{navbar_options()}.} + +\item{position}{Determines whether the navbar should be displayed at the top +of the page with normal scrolling behavior (\code{"static-top"}), pinned at +the top (\code{"fixed-top"}), or pinned at the bottom +(\code{"fixed-bottom"}). Note that using \code{"fixed-top"} or +\code{"fixed-bottom"} will cause the navbar to overlay your body content, +unless you add padding, e.g.: \code{tags$style(type="text/css", "body + {padding-top: 70px;}")}} + +\item{bg}{a CSS color to use for the navbar's background color.} + +\item{inverse}{Either \code{TRUE} for a light text color or \code{FALSE} for a dark +text color. If \code{"auto"} (the default), the best contrast to \code{bg} is chosen.} + +\item{collapsible}{\code{TRUE} to automatically collapse the navigation +elements into an expandable menu on mobile devices or narrow window widths.} + +\item{underline}{Whether or not to add underline styling to page or navbar +links when active or focused.} +} +\value{ +Returns a list of navbar options. +} +\description{ +A \code{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 +\code{navbar_options} in \code{\link[=page_navbar]{page_navbar()}} and \code{\link[=navset_bar]{navset_bar()}}. +} +\details{ +\subsection{Changelog}{ + +This function was introduced in \pkg{bslib} v0.9.0, replacing the \code{position}, +\code{bg}, \code{inverse}, \code{collapsible} and \code{underline} arguments of \code{\link[=page_navbar]{page_navbar()}} +and \code{\link[=navset_bar]{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) + +} diff --git a/man/navset.Rd b/man/navset.Rd index 135d71882..1af7e4c10 100644 --- a/man/navset.Rd +++ b/man/navset.Rd @@ -41,13 +41,14 @@ navset_bar( fillable = TRUE, gap = NULL, padding = NULL, - position = c("static-top", "fixed-top", "fixed-bottom"), header = NULL, footer = NULL, - bg = NULL, - inverse = "auto", - collapsible = TRUE, - fluid = TRUE + fluid = TRUE, + navbar_options = NULL, + position = deprecated(), + bg = deprecated(), + inverse = deprecated(), + collapsible = deprecated() ) navset_card_tab( @@ -142,21 +143,20 @@ right. If three, then the first will be used for top, the second will be left and right, and the third will be bottom. If four, then the values will be interpreted as top, right, bottom, and left respectively.} -\item{position}{Determines whether the navbar should be displayed at the top -of the page with normal scrolling behavior (\code{"static-top"}), pinned at -the top (\code{"fixed-top"}), or pinned at the bottom -(\code{"fixed-bottom"}). Note that using \code{"fixed-top"} or -\code{"fixed-bottom"} will cause the navbar to overlay your body content, -unless you add padding, e.g.: \code{tags$style(type="text/css", "body - {padding-top: 70px;}")}} +\item{navbar_options}{Options to control the appearance and behavior of the +navbar. Use \code{\link[=navbar_options]{navbar_options()}} to create the list of options.} + +\item{position}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use +\code{\link[=navbar_options]{navbar_options = navbar_options(position=)}} instead.} -\item{bg}{a CSS color to use for the navbar's background color.} +\item{bg}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use +\code{\link[=navbar_options]{navbar_options = navbar_options(bg=)}} instead.} -\item{inverse}{Either \code{TRUE} for a light text color or \code{FALSE} for a dark -text color. If \code{"auto"} (the default), the best contrast to \code{bg} is chosen.} +\item{inverse}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use +\code{\link[=navbar_options]{navbar_options = navbar_options(inverse=)}} instead.} -\item{collapsible}{\code{TRUE} to automatically collapse the navigation -elements into an expandable menu on mobile devices or narrow window widths.} +\item{collapsible}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use +\code{\link[=navbar_options]{navbar_options = navbar_options(collapsible=)}} instead.} \item{height}{Any valid \link[htmltools:validateCssUnit]{CSS unit} (e.g., \code{height="200px"}). Doesn't apply when a card is made \code{full_screen} @@ -365,12 +365,16 @@ adjacent to, rather than on top of, the tab content panels. Finally, \code{page_navbar()} provides full-page navigation container similar to \code{navset_underline()} but where each \code{nav_panel()} is treated as a full page of content and the navigation controls appear in a top-level navigation bar. -Note also that the underline styling can be removed via the \code{underline} argument. +Note that the navbar background and underline styling can be controlled via \code{navbar_options}. + +\code{page_navbar()} is complimented by \code{navset_bar()} which produces a similar layout intended to be used within an app. \if{html}{\out{
}}\preformatted{page_navbar( title = "My App", - bg = "#0062cc", - underline = TRUE, + navbar_options = navbar_options( + bg = "#0062cc", + underline = TRUE + ), nav_panel(title = "One", p("First tab content.")), nav_panel(title = "Two", p("Second tab content.")), nav_panel(title = "Three", p("Third tab content")), diff --git a/man/page_navbar.Rd b/man/page_navbar.Rd index 38f7714c5..6cf656871 100644 --- a/man/page_navbar.Rd +++ b/man/page_navbar.Rd @@ -14,17 +14,18 @@ page_navbar( 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() ) } \arguments{ @@ -63,14 +64,6 @@ right. If three, then the first will be used for top, the second will be left and right, and the third will be bottom. If four, then the values will be interpreted as top, right, bottom, and left respectively.} -\item{position}{Determines whether the navbar should be displayed at the top -of the page with normal scrolling behavior (\code{"static-top"}), pinned at -the top (\code{"fixed-top"}), or pinned at the bottom -(\code{"fixed-bottom"}). Note that using \code{"fixed-top"} or -\code{"fixed-bottom"} will cause the navbar to overlay your body content, -unless you add padding, e.g.: \code{tags$style(type="text/css", "body - {padding-top: 70px;}")}} - \item{header}{UI element(s) (\link[htmltools:builder]{htmltools::tags}) to display \emph{above} the nav content. For \code{card}-based navsets, these elements are implicitly wrapped in a \code{card_body()}. To control things like \code{padding}, \code{fill}, etc., wrap the @@ -81,16 +74,8 @@ content. For \code{card}-based navsets, these elements are implicitly wrapped in a \code{card_body()}. To control things like \code{padding}, \code{fill}, etc., wrap the elements in an explicit \code{\link[=card_body]{card_body()}}.} -\item{bg}{a CSS color to use for the navbar's background color.} - -\item{inverse}{Either \code{TRUE} for a light text color or \code{FALSE} for a dark -text color. If \code{"auto"} (the default), the best contrast to \code{bg} is chosen.} - -\item{underline}{Whether or not to add underline styling to page links when -active or focused.} - -\item{collapsible}{\code{TRUE} to automatically collapse the navigation -elements into an expandable menu on mobile devices or narrow window widths.} +\item{navbar_options}{Options to control the appearance and behavior of the +navbar. Use \code{\link[=navbar_options]{navbar_options()}} to create the list of options.} \item{fluid}{\code{TRUE} to use fluid layout; \code{FALSE} to use fixed layout.} @@ -104,6 +89,21 @@ host URL of the page is displayed by default).} \item{lang}{ISO 639-1 language code for the HTML page, such as "en" or "ko". This will be used as the lang in the \code{} tag, as in \code{}. The default (NULL) results in an empty string.} + +\item{position}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use +\code{\link[=navbar_options]{navbar_options = navbar_options(position=)}} instead.} + +\item{bg}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use +\code{\link[=navbar_options]{navbar_options = navbar_options(bg=)}} instead.} + +\item{inverse}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use +\code{\link[=navbar_options]{navbar_options = navbar_options(inverse=)}} instead.} + +\item{underline}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use +\code{\link[=navbar_options]{navbar_options = navbar_options(underline=)}} instead.} + +\item{collapsible}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use +\code{\link[=navbar_options]{navbar_options = navbar_options(collapsible=)}} instead.} } \description{ Create a page that contains a top level navigation bar that can be used to diff --git a/tests/testthat/_snaps/navs-legacy.md b/tests/testthat/_snaps/navs-legacy.md new file mode 100644 index 000000000..bab54fe87 --- /dev/null +++ b/tests/testthat/_snaps/navs-legacy.md @@ -0,0 +1,34 @@ +# navbar_options() print method + + Code + navbar_options() + Output + + position: (static-top) + inverse: (auto) + collapsible: (TRUE) + underline: (TRUE) + +--- + + Code + navbar_options(inverse = TRUE, bg = "red") + Output + + position: (static-top) + bg: red + inverse: TRUE + collapsible: (TRUE) + underline: (TRUE) + +--- + + Code + navbar_options(position = "static-top", inverse = FALSE, collapsible = TRUE) + Output + + position: static-top + inverse: FALSE + collapsible: TRUE + underline: (TRUE) + diff --git a/tests/testthat/test-navs-legacy.R b/tests/testthat/test-navs-legacy.R new file mode 100644 index 000000000..4847aac21 --- /dev/null +++ b/tests/testthat/test-navs-legacy.R @@ -0,0 +1,182 @@ +test_that("navbar_options() validates position", { + expect_equal( + navbar_options(position = "fixed-bottom")$position, + "fixed-bottom" + ) + + expect_error(navbar_options(position = "bad")) +}) + +test_that("navbar_options() print method", { + expect_snapshot(navbar_options()) + expect_snapshot(navbar_options(inverse = TRUE, bg = "red")) + expect_snapshot( + navbar_options(position = "static-top", inverse = FALSE, collapsible = TRUE) + ) + + expect_output( + print(navbar_options()), + "" + ) +}) + +test_that("navbar_options() errors if ... swallows unused options", { + expect_error(navbar_options(foo = "bar")) +}) + +test_that("navbar_options_resolve_deprecated() consolidates correctly", { + # TODO-deprecated: Remove when direction options are deprecated with an error + + # deprecation messages are handled through other tests + rlang::local_options(lifecycle_verbosity = "quiet") + + expect_equal( + navbar_options_resolve_deprecated(navbar_options(), bg = "red")$bg, + "red" + ) + + expect_equal( + navbar_options_resolve_deprecated(list(), bg = "red")$bg, + "red" + ) + + expect_warning( + expect_equal( + navbar_options_resolve_deprecated(navbar_options(bg = "blue"), bg = "red")$bg, + "blue" + ) + ) + + expect_warning( + expect_equal( + navbar_options_resolve_deprecated(list(bg = "blue"), bg = "red")$bg, + "blue" + ) + ) + + expect_warning( + expect_null( + navbar_options_resolve_deprecated(navbar_options(bg = NULL), bg = "red")$bg + ) + ) + + expect_warning( + expect_null( + navbar_options_resolve_deprecated(list(bg = NULL), bg = "red")$bg + ) + ) + + expect_equal( + attr(navbar_options(underline = FALSE), "is_default"), + attr(navbar_options_resolve_deprecated(underline = FALSE), "is_default") + ) +}) + +test_that("navset_bar() warns if using deprecated args", { + lifecycle::expect_deprecated( + navset_bar(position = "fixed-top") + ) + lifecycle::expect_deprecated( + navset_bar(bg = "red") + ) + lifecycle::expect_deprecated( + navset_bar(inverse = TRUE) + ) + lifecycle::expect_deprecated( + navset_bar(collapsible = FALSE) + ) +}) + +test_that("navset_bar() warns if `navbar_options()` collide with direct deprecated options", { + rlang::local_options(lifecycle_verbosity = "quiet") + + expect_warning( + navset_bar( + position = "fixed-top", + navbar_options = navbar_options(position = "static-top") + ) + ) + + expect_warning( + navset_bar( + bg = "red", + navbar_options = navbar_options(bg = "blue") + ) + ) + + expect_warning( + navset_bar( + inverse = TRUE, + navbar_options = navbar_options(inverse = FALSE) + ) + ) + + expect_warning( + navset_bar( + collapsible = FALSE, + navbar_options = navbar_options(collapsible = TRUE) + ) + ) +}) + +test_that("navbar_options_resolve_deprecated() prefers user options over deprecated direct options", { + rlang::local_options(lifecycle_verbosity = "quiet") + + expect_warning( + expect_equal( + navbar_options_resolve_deprecated( + position = "fixed-top", + options_user = navbar_options(position = "static-top") + )$position, + "static-top" + ) + ) + + expect_warning( + expect_equal( + navbar_options_resolve_deprecated( + bg = "red", + options_user = navbar_options(bg = "blue") + )$bg, + "blue" + ) + ) + + expect_warning( + expect_equal( + navbar_options_resolve_deprecated( + inverse = TRUE, + options_user = navbar_options(inverse = FALSE) + )$inverse, + FALSE + ) + ) + + expect_warning( + expect_equal( + navbar_options_resolve_deprecated( + collapsible = FALSE, + options_user = navbar_options(collapsible = TRUE) + )$collapsible, + TRUE + ) + ) +}) + +test_that("shiny:navbarPage() is unaffected", { + rlang::local_options(lifecycle_verbosity = "warning") + + expect_silent( + shiny::navbarPage(title = "test") + ) + + expect_silent( + shiny::navbarPage( + title = "test", + bg = "red", + collapsible = TRUE, + inverse = TRUE, + position = "fixed-top" + ) + ) +}) diff --git a/tools/update_gfont_info.R b/tools/update_gfont_info.R index e18b2143f..3e06936fe 100644 --- a/tools/update_gfont_info.R +++ b/tools/update_gfont_info.R @@ -3,5 +3,6 @@ gfont_info <- get_gfont_info(update = TRUE) usethis::use_data( gfont_info, internal = TRUE, - overwrite = TRUE + overwrite = TRUE, + version = 2 )