utility for grabbing props

Author: teunbrand

R/save.R

@@ -245,8 +245,7 @@ get_plot_background <- function(plot, bg = NULL, default = "transparent") {
     return(default)
   }
   bg <- calc_element("plot.background", plot_theme(plot))
-  bg <- if (S7::prop_exists(bg, "fill")) bg@fill else NULL
-  bg %||% "transparent"
+  try_prop(bg, "fill") %||% "transparent"
 }
 
 validate_device <- function(device, filename = NULL, dpi = 300, call = caller_env()) {

R/theme.R

@@ -821,10 +821,7 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE,
   # recursion; we initiate skipping blanks if we encounter an element that
   # doesn't inherit blank.
   skip_blank <- skip_blank ||
-    (!is.null(el_out) &&
-       !isTRUE(S7::S7_inherits(el_out) &&
-               S7::prop_exists(el_out, "inherit.blank") &&
-               el_out@inherit.blank))
+    (!is.null(el_out) && !isTRUE(try_prop(el_out, "inherit.blank")))
 
   parents <- lapply(
     pnames,
@@ -964,8 +961,8 @@ combine_elements <- function(e1, e2) {
 
   # If e2 is element_blank, and e1 inherits blank inherit everything from e2,
   # otherwise ignore e2
-  if (S7::S7_inherits(e2, element_blank)) {
-    if (S7::prop_exists(e1, "inherit.blank") && e1@inherit.blank) {
+  if (is_theme_element(e2, "blank")) {
+    if (isTRUE(try_prop(e1, "inherit.blank"))) {
       return(e2)
     } else {
       return(e1)
@@ -977,12 +974,12 @@ combine_elements <- function(e1, e2) {
   S7::props(e1)[n] <- S7::props(e2)[n]
 
   # Calculate relative sizes
-  if (S7::prop_exists(e1, "size") && is.rel(e1@size)) {
+  if (is.rel(try_prop(e1, "size"))) {
     e1@size <- e2@size * unclass(e1@size)
   }
 
   # Calculate relative linewidth
-  if (S7::prop_exists(e1, "linewidth") && is.rel(e1@linewidth)) {
+  if (is.rel(try_prop(e1, "linewidth"))) {
     e1@linewidth <- e2@linewidth * unclass(e1@linewidth)
   }
 

R/utilities.R

@@ -959,3 +959,13 @@ compute_data_size <- function(data, size, default = 0.9,
   data[[target]] <- res * (default %||% 0.9)
   data
 }
+
+try_prop <- function(object, name, default = NULL) {
+  if (!S7::S7_inherits(object)) {
+    return(default)
+  }
+  if (!S7::prop_exists(object, name)) {
+    return(default)
+  }
+  S7::prop(object, name)
+}

tests/testthat/test-theme.R

@@ -344,13 +344,11 @@ test_that("element tree can be modified", {
 
 test_that("all elements in complete themes have inherit.blank=TRUE", {
   inherit_blanks <- function(theme) {
-    all(vapply(theme, function(el) {
-      if (is_theme_element(el) && S7::prop_exists(el, "inherit.blank")) {
-        el@inherit.blank
-      } else {
-        TRUE
-      }
-    }, logical(1)))
+    all(vapply(
+      theme, try_prop,
+      name = "inherit.blank", default = TRUE,
+      logical(1)
+    ))
   }
   expect_true(inherit_blanks(theme_grey()))
   expect_true(inherit_blanks(theme_bw()))