Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Function for completing themes #5804

Merged
merged 7 commits into from
May 20, 2024
Merged
Show file tree
Hide file tree
Changes from 6 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -304,6 +304,7 @@ export(borders)
export(calc_element)
export(check_device)
export(combine_vars)
export(complete_theme)
export(continuous_scale)
export(coord_cartesian)
export(coord_equal)
Expand Down
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@

# ggplot2 (development version)

* New function `complete_theme()` to replicate how themes are handled during
plot building (#5801).
* `coord_map()` and `coord_polar()` throw informative warnings when used
with the guide system (#5707).
* When passing a function to `stat_contour(breaks)`, that function is used to
Expand Down
36 changes: 36 additions & 0 deletions R/theme.R
Original file line number Diff line number Diff line change
Expand Up @@ -553,6 +553,42 @@ validate_theme <- function(theme, tree = get_element_tree(), call = caller_env()
)
}

#' Complete a theme
#'
#' This function takes a theme and completes it so that it can be used
#' downstream to render theme elements. Missing elements are filled in and
#' every item is validated to the specifications of the element tree.
#'
#' @param theme An incomplete [theme][theme()] object to complete, or `NULL`
#' to complete the default theme.
#' @param default A complete [theme][theme()] to fill in missing pieces.
#' Defaults to the global theme settings.
#'
#' @keywords internal
#' @return A [theme][theme()] object.
#' @export
#'
#' @examples
#' my_theme <- theme(line = element_line(colour = "red"))
#' complete_theme(my_theme)
complete_theme <- function(theme = NULL, default = theme_get()) {
if (!is_bare_list(theme)) {
check_object(theme, is.theme, "a {.cls theme} object", allow_null = TRUE)
}
check_object(default, is.theme, "a {.cls theme} object")
theme <- plot_theme(list(theme = theme), default = default)

# Using `theme(!!!theme)` drops `NULL` entries, so strip most attributes and
# construct a new theme
attributes(theme) <- list(names = attr(theme, "names"))
structure(
theme,
class = c("theme", "gg"),
complete = TRUE, # This theme is complete and has no missing elements
validate = FALSE # Settings have already been validated
)
}

# Combine plot defaults with current theme to get complete theme for a plot
plot_theme <- function(x, default = theme_get()) {
theme <- x$theme
Expand Down
28 changes: 28 additions & 0 deletions man/complete_theme.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

24 changes: 24 additions & 0 deletions tests/testthat/test-theme.R
Original file line number Diff line number Diff line change
Expand Up @@ -583,6 +583,30 @@ test_that("Minor tick length supports biparental inheritance", {
)
})

test_that("complete_theme completes a theme", {
# `NULL` should match default
gray <- theme_gray()
new <- complete_theme(NULL, default = gray)
expect_equal(new, gray, ignore_attr = "validate")

# Elements are propagated
new <- complete_theme(theme(axis.line = element_line("red")), gray)
expect_equal(new$axis.line$colour, "red")

# Missing elements are filled in if default theme is incomplete
new <- complete_theme(default = theme())
expect_s3_class(new$axis.line, "element_blank")

# Registered elements are included
register_theme_elements(
test = element_text(),
element_tree = list(test = el_def("element_text", "text"))
)
new <- complete_theme(default = gray)
expect_s3_class(new$test, "element_text")
reset_theme_settings()
})

# Visual tests ------------------------------------------------------------

test_that("aspect ratio is honored", {
Expand Down