Function for completing themes (#5804)

* exported wrapper for `plot_theme()`

* document

* add test

* add news bullet

* Allow for unclassed list themes

* fix failing test

Author: teunbrand

NAMESPACE

@@ -305,6 +305,7 @@ export(borders)
 export(calc_element)
 export(check_device)
 export(combine_vars)
+export(complete_theme)
 export(continuous_scale)
 export(coord_cartesian)
 export(coord_equal)

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* New function `complete_theme()` to replicate how themes are handled during
+  plot building (#5801).
 * Special getter and setter functions have been renamed for consistency, allowing
   for better tab-completion with `get_*`- and `set_*`-prefixes. The old names 
   remain available for backward compatibility (@teunbrand, #5568).

R/theme.R

@@ -560,6 +560,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 = get_theme()) {
   theme <- x$theme

man/complete_theme.Rd

@@ -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", {