Inheritance of theme-based aesthetics

R/geom-.R

@@ -133,7 +133,7 @@ Geom <- ggproto("Geom",
     # Fill in missing aesthetics with their defaults
     missing_aes <- setdiff(names(default_aes), names(data))
     default_aes <- default_aes[missing_aes]
-    themed_defaults <- eval_from_theme(default_aes, theme)
+    themed_defaults <- eval_from_theme(default_aes, theme, class(self))
     default_aes[names(themed_defaults)] <- themed_defaults
 
     # Mark staged/scaled defaults as modifier (#6135)
@@ -243,13 +243,33 @@ Geom <- ggproto("Geom",
 #' @rdname is_tests
 is.geom <- function(x) inherits(x, "Geom")
 
-eval_from_theme <- function(aesthetics, theme) {
+eval_from_theme <- function(aesthetics, theme, class = NULL) {
   themed <- is_themed_aes(aesthetics)
   if (!any(themed)) {
     return(aesthetics)
   }
-  settings <- calc_element("geom", theme) %||% .default_geom_element
-  lapply(aesthetics[themed], eval_tidy, data = settings)
+
+  element <- calc_element("geom", theme) %||% .default_geom_element
+  class <- setdiff(class, c("Geom", "ggproto", "gg"))
+
+  if (length(class) > 0) {
+
+    # CamelCase to dot.case
+    class <- gsub("([A-Za-z])([A-Z])([a-z])", "\\1.\\2\\3", class)
+    class <- gsub("([a-z])([A-Z])", "\\1.\\2", class)
+    class <- to_lower_ascii(class)
+
+    class <- class[class %in% names(theme)]
+
+    # Inherit up to parent geom class
+    if (length(class) > 0) {
+      for (cls in rev(class)) {
+        element <- combine_elements(theme[[cls]], element)
+      }
+    }
+  }
+
+  lapply(aesthetics[themed], eval_tidy, data = element)
 }
 
 #' Graphical units

R/theme.R

@@ -565,8 +565,11 @@ validate_theme <- function(theme, tree = get_element_tree(), call = caller_env()
   if (!is_theme_validate(theme)) {
     return()
   }
+  elnames <- names(theme)
+  elnames[startsWith(elnames, "geom.")] <- "geom"
+
   mapply(
-    validate_element, theme, names(theme),
+    validate_element, theme, elnames,
     MoreArgs = list(element_tree = tree, call = call)
   )
 }
@@ -630,7 +633,10 @@ plot_theme <- function(x, default = get_theme()) {
   validate_theme(theme)
 
   # Remove elements that are not registered
-  theme[setdiff(names(theme), names(get_element_tree()))] <- NULL
+  # We accept unregistered `geom.*` elements
+  remove <- setdiff(names(theme), names(get_element_tree()))
+  remove <- remove[!startsWith(remove, "geom.")]
+  theme[remove] <- NULL
   theme
 }
 

tests/testthat/test-theme.R

@@ -673,6 +673,26 @@ test_that("margin_part() mechanics work as expected", {
   expect_equal(as.numeric(test), c(5.5, 5.5, 11, 5.5))
 })
 
+test_that("geom elements are inherited correctly", {
+
+  GeomFoo <- ggproto("GeomFoo", GeomPoint)
+  GeomBar <- ggproto("GeomBar", GeomFoo)
+
+  p <- ggplot(data.frame(x = 1), aes(x, x)) +
+    stat_identity(geom = GeomBar) +
+    theme(
+      geom = element_geom(pointshape = 15),
+      geom.point = element_geom(borderwidth = 2, ink = "blue"),
+      geom.foo = element_geom(pointsize = 2),
+      geom.bar = element_geom(ink = "red")
+    )
+  p <- layer_data(p)
+  expect_equal(p$shape, 15)
+  expect_equal(p$stroke, 2)
+  expect_equal(p$size, 2)
+  expect_equal(p$colour, "red")
+})
+
 # Visual tests ------------------------------------------------------------
 
 test_that("aspect ratio is honored", {