diff --git a/R/navbar_options.R b/R/navbar_options.R index b2aa494be..2832ca75e 100644 --- a/R/navbar_options.R +++ b/R/navbar_options.R @@ -53,8 +53,12 @@ navbar_options <- function( underline = underline ) - attrs <- rlang::dots_list(...) - if ("inverse" %in% names(attrs)) { + 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 release # `navbar_options()` with an `inverse`, but it's reasonable people might try # to use it and it did exist briefly in dev versions. @@ -64,8 +68,8 @@ navbar_options <- function( with = "navbar_options(type=)" ) } - if (length(attrs)) { - opts[["attrs"]] <- attrs + if (length(dots$attribs)) { + opts[["attribs"]] <- dots$attribs } structure( @@ -76,20 +80,20 @@ navbar_options <- function( ) } -navbar_options_apply_attrs <- function(navbar, navbar_options = NULL) { - if (is.null(navbar_options[["attrs"]])) { +navbar_options_apply_attribs <- function(navbar, navbar_options = NULL) { + if (is.null(navbar_options[["attribs"]])) { return(navbar) } - attrs <- navbar_options[["attrs"]] - navbar[[1]] <- rlang::exec(tagAppendAttributes, navbar[[1]], !!!attrs) + attribs <- navbar_options[["attribs"]] + navbar[[1]] <- rlang::exec(tagAppendAttributes, navbar[[1]], !!!attribs) - if ("data-bs-theme" %in% names(attrs)) { + 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"]] <- attrs[["data-bs-theme"]] + navbar[[1]][["attribs"]][["data-bs-theme"]] <- attribs[["data-bs-theme"]] } navbar @@ -184,10 +188,10 @@ navbar_options_resolve_deprecated <- function( ) } - attrs <- options_user$attrs %||% list() - options_user$attrs <- NULL + attribs <- options_user$attrs %||% list() + options_user$attribs <- NULL - rlang::exec(navbar_options, !!!options_user, !!!attrs) + rlang::exec(navbar_options, !!!options_user, !!!attribs) } #' @export diff --git a/R/navs-legacy.R b/R/navs-legacy.R index 1c80967d9..7dc892837 100644 --- a/R/navs-legacy.R +++ b/R/navs-legacy.R @@ -169,7 +169,7 @@ navset_bar <- function( theme = bs_theme() ) - navbar_options_apply_attrs(navbar, .navbar_options) + navbar_options_apply_attribs(navbar, .navbar_options) } diff --git a/R/page.R b/R/page.R index 323450318..c398ee932 100644 --- a/R/page.R +++ b/R/page.R @@ -466,7 +466,7 @@ page_navbar <- function( fluid = fluid, theme = theme ) - navbar <- navbar_options_apply_attrs(navbar, .navbar_options) + navbar <- navbar_options_apply_attribs(navbar, .navbar_options) page_func( title = infer_window_title(title, window_title), diff --git a/tests/testthat/test-navbar_options.R b/tests/testthat/test-navbar_options.R index 082854748..206e3e426 100644 --- a/tests/testthat/test-navbar_options.R +++ b/tests/testthat/test-navbar_options.R @@ -20,8 +20,12 @@ test_that("navbar_options() print method", { ) }) -test_that("navbar_options() adds ... to `attrs`", { - expect_equal(navbar_options(foo = "bar")$attrs, list(foo = "bar")) +test_that("navbar_options() adds named args from ... to `attribs`", { + expect_equal(navbar_options(foo = "bar")$attribs, list(foo = "bar")) +}) + +test_that("navbar_options() throws for unnamed args in ...", { + expect_error(navbar_options("foo", "bar")) }) test_that("navbar_options() warns `inverse` is used instead of `type`", {