diff --git a/R/theme.R b/R/theme.R index 984087a61e..9c0d5aa5ca 100644 --- a/R/theme.R +++ b/R/theme.R @@ -467,8 +467,29 @@ theme <- function(..., strip.switch.pad.wrap, complete = FALSE, validate = TRUE) { + elements <- find_args(..., complete = NULL, validate = NULL) + elements <- fix_theme_deprecations(elements) + elements <- validate_theme_palettes(elements) + # If complete theme set all non-blank elements to inherit from blanks + if (complete) { + elements <- lapply(elements, function(el) { + if (is.theme_element(el) && !inherits(el, "element_blank")) { + el$inherit.blank <- TRUE + } + el + }) + } + structure( + elements, + class = c("theme", "gg"), + complete = complete, + validate = validate + ) +} + +fix_theme_deprecations <- function(elements) { if (is.unit(elements$legend.margin) && !is.margin(elements$legend.margin)) { cli::cli_warn(c( "{.var legend.margin} must be specified using {.fn margin}", @@ -511,22 +532,46 @@ theme <- function(..., elements$legend.position.inside <- elements$legend.position elements$legend.position <- "inside" } + elements +} - # If complete theme set all non-blank elements to inherit from blanks - if (complete) { - elements <- lapply(elements, function(el) { - if (is.theme_element(el) && !inherits(el, "element_blank")) { - el$inherit.blank <- TRUE - } - el - }) +validate_theme_palettes <- function(elements) { + + pals <- c("palette.colour.discrete", "palette.colour.continuous", + "palette.fill.discrete", "palette.fill.continuous", + "palette.color.discrete", "palette.color.continuous") + if (!any(pals %in% names(elements))) { + return(elements) } - structure( + + # Standardise spelling + elements <- replace_null( elements, - class = c("theme", "gg"), - complete = complete, - validate = validate + palette.colour.discrete = elements$palette.color.discrete, + palette.colour.continuous = elements$palette.color.continuous ) + elements$palette.color.discrete <- NULL + elements$palette.color.continuous <- NULL + + # Check for incompatible options + pals <- c("palette.colour.discrete", "palette.colour.continuous", + "palette.fill.discrete", "palette.fill.continuous") + opts <- c("ggplot2.discrete.colour", "ggplot2.continuous.colour", + "ggplot2.discrete.fill", "ggplot2.continuous.fill") + index <- which(pals %in% names(elements)) + + for (i in index) { + if (is.null(getOption(opts[i]))) { + next + } + cli::cli_warn(c( + "The {.code options('{opts[i]}')} setting is incompatible with the \\ + {.arg {pals[i]}} theme setting.", + i = "You can set {.code options({opts[i]} = NULL)}." + )) + } + + elements } #' @export diff --git a/tests/testthat/_snaps/theme.md b/tests/testthat/_snaps/theme.md index 005e1b2abd..0218bbef51 100644 --- a/tests/testthat/_snaps/theme.md +++ b/tests/testthat/_snaps/theme.md @@ -98,3 +98,8 @@ The `aspect.ratio` theme element must be a object. +# theme() warns about conflicting palette options + + The `options('ggplot2.discrete.colour')` setting is incompatible with the `palette.colour.discrete` theme setting. + i You can set `options(ggplot2.discrete.colour = NULL)`. + diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index 151f34cf96..11f356b4f7 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -706,6 +706,16 @@ test_that("margin_part() mechanics work as expected", { expect_equal(as.numeric(test), c(5.5, 5.5, 11, 5.5)) }) +test_that("theme() warns about conflicting palette options", { + expect_silent( + theme(palette.colour.discrete = c("dodgerblue", "orange")) + ) + local_options(ggplot2.discrete.colour = c("red", "purple")) + expect_snapshot_warning( + theme(palette.colour.discrete = c("dodgerblue", "orange")) + ) +}) + test_that("geom elements are inherited correctly", { GeomFoo <- ggproto("GeomFoo", GeomPoint)