From d801bd2faa5c92af5b03065cb4a926547efa517f Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 14 Oct 2025 08:42:36 +0200 Subject: [PATCH 1/6] as.list for theme elements --- R/theme-elements.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/theme-elements.R b/R/theme-elements.R index 3f69eacfb3..59c4f2aa20 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -408,6 +408,13 @@ local({ # deprecate_soft0("4.1.0", I("`[[i]]`"), I("`S7::prop(, i)`")) `[[`(S7::props(x), i) } + S7::method(as.list, element) <- function(x, ...) { + S7::convert(x, S7::class_list) + } + S7::method(convert, list(from = element, to = S7::class_list)) <- + function(from, to, ...) { + S7::props(from) + } }) # Element setter methods From d2f363d7e1c6abbbded8016e6977304d0b39e54d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 14 Oct 2025 08:55:53 +0200 Subject: [PATCH 2/6] move methods --- R/all-classes.R | 15 +++++++++++++++ R/plot.R | 13 ------------- 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/R/all-classes.R b/R/all-classes.R index 9f0f0ad44c..12dcce746e 100644 --- a/R/all-classes.R +++ b/R/all-classes.R @@ -408,3 +408,18 @@ class_ggplot_built <- S7::new_class( ) } ) + +# Methods ----------------------------------------------------------------- + +#' @importFrom S7 convert +# S7 currently attaches the S3 method to the calling environment which gives `ggplot2:::as.list` +# Wrap in `local()` to provide a temp environment which throws away the attachment +local({ + S7::method(convert, list(from = class_ggplot, to = S7::class_list)) <- + function(from, to) { + S7::props(from) + } + + S7::method(as.list, class_gg) <- + function(x, ...) convert(x, S7::class_list) +}) diff --git a/R/plot.R b/R/plot.R index 1b84a1e1b2..ea6966289e 100644 --- a/R/plot.R +++ b/R/plot.R @@ -267,16 +267,3 @@ local({ #' @export `[[<-.ggplot2::gg` <- `$<-.ggplot2::gg` - -#' @importFrom S7 convert -# S7 currently attaches the S3 method to the calling environment which gives `ggplot2:::as.list` -# Wrap in `local()` to provide a temp environment which throws away the attachment -local({ - S7::method(convert, list(from = class_ggplot, to = S7::class_list)) <- - function(from, to) { - S7::props(from) - } - - S7::method(as.list, class_ggplot) <- - function(x, ...) convert(x, S7::class_list) -}) From c4ccfdb8303af3c8aedd895a00e1a68852850df3 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 14 Oct 2025 08:56:19 +0200 Subject: [PATCH 3/6] as.list/convert for other classes --- R/all-classes.R | 29 +++++++++++++++++++++++------ 1 file changed, 23 insertions(+), 6 deletions(-) diff --git a/R/all-classes.R b/R/all-classes.R index 12dcce746e..86f953c545 100644 --- a/R/all-classes.R +++ b/R/all-classes.R @@ -415,11 +415,28 @@ class_ggplot_built <- S7::new_class( # S7 currently attaches the S3 method to the calling environment which gives `ggplot2:::as.list` # Wrap in `local()` to provide a temp environment which throws away the attachment local({ - S7::method(convert, list(from = class_ggplot, to = S7::class_list)) <- - function(from, to) { - S7::props(from) - } - S7::method(as.list, class_gg) <- - function(x, ...) convert(x, S7::class_list) + S7::method( + convert, + list( + from = class_ggplot | class_ggplot_built, + to = S7::class_list + ) + ) <- function(from, to, ...) { + S7::props(from) + } + + S7::method( + convert, + list( + from = class_mapping | class_theme | class_labels, + to = S7::class_list + ) + ) <- function(from, to, ...) { + S7::S7_data(from) + } + + S7::method(as.list, class_gg) <- function(x, ...) convert(x, S7::class_list) }) + + From e233764176871d6f12bf455a966f9e6dde55c648 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 14 Oct 2025 10:29:44 +0200 Subject: [PATCH 4/6] reformat --- R/all-classes.R | 37 ++++++++++++++++++------------------- 1 file changed, 18 insertions(+), 19 deletions(-) diff --git a/R/all-classes.R b/R/all-classes.R index 86f953c545..e6c95fa77b 100644 --- a/R/all-classes.R +++ b/R/all-classes.R @@ -415,28 +415,27 @@ class_ggplot_built <- S7::new_class( # S7 currently attaches the S3 method to the calling environment which gives `ggplot2:::as.list` # Wrap in `local()` to provide a temp environment which throws away the attachment local({ + list_classes <- class_mapping | class_theme | class_labels + prop_classes <- class_ggplot | class_ggplot_built - S7::method( - convert, - list( - from = class_ggplot | class_ggplot_built, - to = S7::class_list - ) - ) <- function(from, to, ...) { - S7::props(from) - } + S7::method(convert, list(from = prop_classes, to = S7::class_list)) <- + function(from, to, ...) S7::props(from) - S7::method( - convert, - list( - from = class_mapping | class_theme | class_labels, - to = S7::class_list - ) - ) <- function(from, to, ...) { - S7::S7_data(from) - } + S7::method(convert, list(from = list_classes, to = S7::class_list)) <- + function(from, to, ...) S7::S7_data(from) + + # We're not using union classes here because of S7#510 + S7::method(as.list, class_gg) <- + S7::method(as.list, class_mapping) <- + S7::method(as.list, class_theme) <- + S7::method(as.list, class_labels) <- + function(x, ...) convert(x, S7::class_list) + + S7::method(convert, list(from = S7::class_list, to = prop_classes)) <- + function(from, to, ...) inject(to(!!!from)) - S7::method(as.list, class_gg) <- function(x, ...) convert(x, S7::class_list) + S7::method(convert, list(from = S7::class_list, to = list_classes)) <- + function(from, to, ...) to(from) }) From 56a4c5a7f5d09ad392dab1839a80842b3f488812 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 15 Oct 2025 10:30:12 +0200 Subject: [PATCH 5/6] list to theme element conversion --- R/theme-elements.R | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/R/theme-elements.R b/R/theme-elements.R index 59c4f2aa20..a2e0498651 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -412,9 +412,25 @@ local({ S7::convert(x, S7::class_list) } S7::method(convert, list(from = element, to = S7::class_list)) <- - function(from, to, ...) { - S7::props(from) + function(from, to, ...) S7::props(from) + S7::method( + convert, + list( + from = S7::class_list, + to = element_geom | element_line | element_point | + element_polygon | element_rect | element_text | element_blank + ) + ) <- function(from, to, ...) { + extra <- setdiff(names(from), fn_fmls_names(to)) + if (length(extra) > 0) { + cli::cli_warn( + "Unknown {cli::qty(extra)} argument{?s} to {.fn {to@name}}: \\ + {.and {.arg {extra}}}." + ) + from <- from[setdiff(names(from), extra)] } + inject(to(!!!from)) + } }) # Element setter methods From e114c4ba9fcabf7f8f789d40f3dabcfce1b6a859 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 15 Oct 2025 10:51:17 +0200 Subject: [PATCH 6/6] add tests --- tests/testthat/_snaps/theme.md | 4 ++++ tests/testthat/test-theme.R | 16 ++++++++++++++++ tests/testthat/test-utilities.R | 21 +++++++++++++++++++++ 3 files changed, 41 insertions(+) diff --git a/tests/testthat/_snaps/theme.md b/tests/testthat/_snaps/theme.md index 180e0563a1..8026a22228 100644 --- a/tests/testthat/_snaps/theme.md +++ b/tests/testthat/_snaps/theme.md @@ -153,3 +153,7 @@ [23] "axis.line.r" "complete" [25] "validate" +# theme element conversion to lists works + + Unknown arguments to `element_text()`: `italic`, `fontweight`, and `fontwidth`. + diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index 3f3fb9eeb9..8145e2323f 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -791,6 +791,22 @@ test_that("theme elements are covered in `theme_sub_*()` functions", { expect_snapshot(extra_elements) }) +test_that("theme element conversion to lists works", { + + x <- element_rect(colour = "red") + expect_type(x <- as.list(x), "list") + expect_s7_class(convert(x, element_rect), element_rect) + + # For now, element_text doesn't round-trip. + # Once fontwidth/fontweight/italic are implemented, it should round-trip again + x <- as.list(element_text(colour = "red")) + expect_snapshot_warning( + convert(x, element_text) + ) + x <- x[setdiff(names(x), c("fontwidth", "fontweight", "italic"))] + expect_silent(convert(x, element_text)) +}) + # Visual tests ------------------------------------------------------------ test_that("element_polygon() can render a grob", { diff --git a/tests/testthat/test-utilities.R b/tests/testthat/test-utilities.R index 4768bbf3da..c6e24cf702 100644 --- a/tests/testthat/test-utilities.R +++ b/tests/testthat/test-utilities.R @@ -218,3 +218,24 @@ test_that("summary method gives a nice summary", { expect_snapshot(summary(p)) }) + +test_that("list conversion works for ggplot classes", { + # Test list-based class round-trips + x <- aes(x = 10, y = foo) + expect_type(x <- as.list(x), "list") + expect_s7_class(x <- convert(x, class_mapping), class_mapping) + + # Mapping should still be able to evaluate + expect_equal( + eval_aesthetics(x, data = data.frame(foo = "A")), + list(x = 10, y = "A") + ) + + # Test property-based class round-trips + x <- ggplot() + expect_type(x <- as.list(x), "list") + expect_s7_class(x <- convert(x, class_ggplot), class_ggplot) + + # Plot should still be buildable + expect_s3_class(ggplotGrob(x), "gtable") +})