convert theme to S7

Author: teunbrand

NAMESPACE

@@ -1,8 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("$","ggplot2::theme")
 S3method("$",ggproto)
 S3method("$",ggproto_parent)
-S3method("$",theme)
 S3method("$<-",uneval)
 S3method("+",gg)
 S3method("[",mapped_discrete)
@@ -66,7 +66,6 @@ S3method(ggplot_add,data.frame)
 S3method(ggplot_add,default)
 S3method(ggplot_add,labels)
 S3method(ggplot_add,list)
-S3method(ggplot_add,theme)
 S3method(ggplot_add,uneval)
 S3method(ggplot_build,ggplot)
 S3method(ggplot_build,ggplot_built)

R/plot-construction.R

@@ -133,11 +133,7 @@ ggplot_add.function <- function(object, plot, object_name) {
     "i" = "Did you forget to add parentheses, as in {.fn {object_name}}?"
   ))
 }
-#' @export
-ggplot_add.theme <- function(object, plot, object_name) {
-  plot$theme <- add_theme(plot$theme, object)
-  plot
-}
+
 #' @export
 ggplot_add.Scale <- function(object, plot, object_name) {
   plot$scales$add(object)

R/theme.R

@@ -549,25 +549,39 @@ theme <- function(...,
       el
     })
   }
-  structure(
+  S7::new_object(
     elements,
-    class = c("theme", "gg"),
     complete = complete,
     validate = validate
   )
 }
 
+theme <- S7::new_class(
+  "theme", S7::new_S3_class("gg"),
+  properties = list(
+    complete = S7::class_logical,
+    validate = S7::class_logical
+  ),
+  constructor = theme
+)
+
+S7::method(ggplot_add, theme) <- function(object, plot, object_name, ...) {
+  plot$theme <- add_theme(plot$theme, object)
+  plot
+}
+
 #' @export
 #' @rdname is_tests
-is.theme <- function(x) inherits(x, "theme")
+is.theme <- function(x) S7::S7_inherits(x, theme)
 
 # check whether theme is complete
-is_theme_complete <- function(x) isTRUE(attr(x, "complete", exact = TRUE))
+is_theme_complete <- function(x) {
+  is.theme(x) && isTRUE(x@complete)
+}
 
 # check whether theme should be validated
 is_theme_validate <- function(x) {
-  validate <- attr(x, "validate", exact = TRUE)
-  isTRUE(validate %||% TRUE)
+  !is.theme(x) || isTRUE(x@validate)
 }
 
 check_theme <- function(theme, tree = get_element_tree(), call = caller_env()) {
@@ -604,16 +618,9 @@ complete_theme <- function(theme = NULL, default = theme_get()) {
   }
   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
-  )
+  theme@complete <- TRUE
+  theme@validate <- FALSE
+  theme
 }
 
 # Combine plot defaults with current theme to get complete theme for a plot
@@ -677,13 +684,12 @@ add_theme <- function(t1, t2, t2name, call = caller_env()) {
     }
   )
 
-  # make sure the "complete" attribute is set; this can be missing
-  # when t1 is an empty list
-  attr(t1, "complete") <- is_theme_complete(t1)
+  if (!is.theme(t1) && is.list(t1)) {
+    t1 <- theme(!!!t1)
+  }
 
   # Only validate if both themes should be validated
-  attr(t1, "validate") <-
-    is_theme_validate(t1) && is_theme_validate(t2)
+  t1@validate <- is_theme_validate(t1) && is_theme_validate(t2)
 
   t1
 }
@@ -949,7 +955,7 @@ combine_elements <- function(e1, e2) {
 }
 
 #' @export
-`$.theme` <- function(x, ...) {
+`$.ggplot2::theme` <- function(x, ...) {
   .subset2(x, ...)
 }
 

tests/testthat/test-theme.R

@@ -634,7 +634,7 @@ 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")
+  expect_equal(S7::S7_data(new), S7::S7_data(gray))
 
   # Elements are propagated
   new <- complete_theme(theme(axis.line = element_line("red")), gray)