Inheritance of theme-based aesthetics

R/annotation-logticks.R

@@ -229,7 +229,7 @@ GeomLogticks <- ggproto("GeomLogticks", Geom,
   },
 
   default_aes = aes(
-    colour = from_theme(ink),
+    colour = from_theme(colour %||% ink),
     linewidth = from_theme(linewidth),
     linetype = from_theme(linetype),
     alpha = 1

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)
@@ -242,13 +242,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/geom-abline.R

@@ -147,7 +147,7 @@ GeomAbline <- ggproto("GeomAbline", Geom,
   },
 
   default_aes = aes(
-    colour = from_theme(ink),
+    colour = from_theme(colour %||% ink),
     linewidth = from_theme(linewidth),
     linetype = from_theme(linetype),
     alpha = NA

R/geom-boxplot.R

@@ -395,8 +395,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
   draw_key = draw_key_boxplot,
 
   default_aes = aes(
-    weight = 1, colour = from_theme(col_mix(ink, paper, 0.2)),
-    fill = from_theme(paper), size = from_theme(pointsize),
+    weight = 1, colour = from_theme(colour %||% col_mix(ink, paper, 0.2)),
+    fill = from_theme(fill %||% paper), size = from_theme(pointsize),
     alpha = NA, shape = from_theme(pointshape), linetype = from_theme(bordertype),
     linewidth = from_theme(borderwidth),
     width = 0.9

R/geom-contour.R

@@ -124,13 +124,7 @@ geom_contour_filled <- function(mapping = NULL, data = NULL,
 #' @export
 #' @include geom-path.R
 GeomContour <- ggproto("GeomContour", GeomPath,
-  default_aes = aes(
-    weight = 1,
-    colour = from_theme(accent),
-    linewidth = from_theme(linewidth),
-    linetype = from_theme(linetype),
-    alpha = NA
-  )
+  default_aes = aes(weight = 1, !!!GeomPath$default_aes)
 )
 
 #' @rdname ggplot2-ggproto

R/geom-crossbar.R

@@ -79,8 +79,8 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,
   },
 
   default_aes = aes(
-    colour = from_theme(ink),
-    fill = NA,
+    colour = from_theme(colour %||% ink),
+    fill = from_theme(fill %||% NA),
     linewidth = from_theme(borderwidth),
     linetype = from_theme(bordertype),
     alpha = NA

R/geom-curve.R

@@ -41,13 +41,6 @@ geom_curve <- function(mapping = NULL, data = NULL,
 #' @export
 GeomCurve <- ggproto("GeomCurve", GeomSegment,
 
-  default_aes = aes(
-    colour = from_theme(ink),
-    linewidth = from_theme(linewidth),
-    linetype = from_theme(linetype),
-    alpha = NA
-  ),
-
   draw_panel = function(data, panel_params, coord, curvature = 0.5, angle = 90,
                         ncp = 5, arrow = NULL, arrow.fill = NULL, lineend = "butt", na.rm = FALSE) {
 

R/geom-density.R

@@ -92,8 +92,12 @@ geom_density <- function(mapping = NULL, data = NULL,
 #' @export
 #' @include geom-ribbon.R
 GeomDensity <- ggproto("GeomDensity", GeomArea,
-  default_aes = defaults(
-    aes(fill = NA, weight = 1, colour = from_theme(ink), alpha = NA),
-    GeomArea$default_aes
+  default_aes = aes(
+    colour = from_theme(colour %||% ink),
+    fill   = from_theme(fill %||% NA),
+    weight = 1,
+    alpha  = NA,
+    linewidth = from_theme(borderwidth),
+    linetype  = from_theme(bordertype)
   )
 )

R/geom-density2d.R

@@ -107,7 +107,7 @@ geom_density2d <- geom_density_2d
 #' @export
 GeomDensity2d <- ggproto("GeomDensity2d", GeomPath,
   default_aes = aes(
-    colour = from_theme(accent),
+    colour = from_theme(colour %||% accent),
     linewidth = from_theme(linewidth),
     linetype = from_theme(linetype),
     alpha = NA

R/geom-dotplot.R

@@ -189,8 +189,8 @@ GeomDotplot <- ggproto("GeomDotplot", Geom,
   non_missing_aes = c("size", "shape"),
 
   default_aes = aes(
-    colour = from_theme(ink),
-    fill = from_theme(ink),
+    colour = from_theme(colour %||% ink),
+    fill = from_theme(fill %||% ink),
     alpha = NA,
     stroke = from_theme(borderwidth * 2),
     linetype = from_theme(linetype),

R/geom-errorbar.R

@@ -59,7 +59,7 @@ geom_errorbarh <- function(mapping = NULL, data = NULL,
 GeomErrorbar <- ggproto("GeomErrorbar", Geom,
 
   default_aes = aes(
-    colour = from_theme(ink),
+    colour = from_theme(colour %||% ink),
     linewidth = from_theme(linewidth),
     linetype = from_theme(linetype),
     width = 0.9,

R/geom-hex.R

@@ -107,8 +107,8 @@ GeomHex <- ggproto("GeomHex", Geom,
   required_aes = c("x", "y"),
 
   default_aes = aes(
-    colour = NA,
-    fill = from_theme(col_mix(ink, paper)),
+    colour = from_theme(colour %||% NA),
+    fill = from_theme(fill %||% col_mix(ink, paper)),
     linewidth = from_theme(borderwidth),
     linetype = from_theme(bordertype),
     alpha = NA

R/geom-hline.R

@@ -57,7 +57,7 @@ GeomHline <- ggproto("GeomHline", Geom,
   },
 
   default_aes = aes(
-    colour = from_theme(ink),
+    colour = from_theme(colour %||% ink),
     linewidth = from_theme(linewidth),
     linetype = from_theme(linetype),
     alpha = NA

R/geom-label.R

@@ -62,7 +62,8 @@ GeomLabel <- ggproto("GeomLabel", Geom,
   required_aes = c("x", "y", "label"),
 
   default_aes = aes(
-    colour = from_theme(ink), fill = from_theme(paper),
+    colour = from_theme(colour %||% ink),
+    fill = from_theme(fill %||% paper),
     family = from_theme(family),
     size = from_theme(fontsize),
     angle = 0,

R/geom-linerange.R

@@ -91,12 +91,7 @@ geom_linerange <- function(mapping = NULL, data = NULL,
 #' @export
 GeomLinerange <- ggproto("GeomLinerange", Geom,
 
-  default_aes = aes(
-    colour = from_theme(ink),
-    linewidth = from_theme(linewidth),
-    linetype = from_theme(linetype),
-    alpha = NA
-  ),
+  default_aes = GeomPath$default_aes,
 
   draw_key = draw_key_linerange,
 

R/geom-point.R

@@ -143,8 +143,11 @@ GeomPoint <- ggproto("GeomPoint", Geom,
   non_missing_aes = c("size", "shape", "colour"),
   default_aes = aes(
     shape = from_theme(pointshape),
-    colour = from_theme(ink), size = from_theme(pointsize), fill = NA,
-    alpha = NA, stroke = from_theme(borderwidth)
+    colour = from_theme(colour %||% ink),
+    fill = from_theme(fill %||% NA),
+    size = from_theme(pointsize),
+    alpha = NA,
+    stroke = from_theme(borderwidth)
   ),
 
   draw_panel = function(self, data, panel_params, coord, na.rm = FALSE) {

R/geom-pointrange.R

@@ -31,9 +31,9 @@ geom_pointrange <- function(mapping = NULL, data = NULL,
 #' @export
 GeomPointrange <- ggproto("GeomPointrange", Geom,
   default_aes = aes(
-    colour = from_theme(ink), size = from_theme(pointsize / 3),
+    colour = from_theme(colour %||% ink), size = from_theme(pointsize / 3),
     linewidth = from_theme(linewidth), linetype = from_theme(linetype),
-    shape = from_theme(pointshape), fill = NA, alpha = NA,
+    shape = from_theme(pointshape), fill = from_theme(fill %||% NA), alpha = NA,
     stroke = from_theme(borderwidth * 2)
   ),
 

R/geom-polygon.R

@@ -176,8 +176,8 @@ GeomPolygon <- ggproto("GeomPolygon", Geom,
   },
 
   default_aes = aes(
-    colour = NA,
-    fill = from_theme(col_mix(ink, paper, 0.2)),
+    colour = from_theme(colour %||% NA),
+    fill = from_theme(fill %||% col_mix(ink, paper, 0.2)),
     linewidth = from_theme(borderwidth),
     linetype = from_theme(bordertype),
     alpha = NA, subgroup = NULL

R/geom-quantile.R

@@ -65,8 +65,8 @@ geom_quantile <- function(mapping = NULL, data = NULL,
 #' @export
 #' @include geom-path.R
 GeomQuantile <- ggproto("GeomQuantile", GeomPath,
-  default_aes = defaults(
-    aes(weight = 1, colour = from_theme(accent)),
+  default_aes = aes(!!!defaults(
+    aes(weight = 1, colour = from_theme(colour %||% accent)),
     GeomPath$default_aes
-  )
+  ))
 )

R/geom-raster.R

@@ -44,7 +44,10 @@ geom_raster <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomRaster <- ggproto("GeomRaster", Geom,
-  default_aes = aes(fill = from_theme(col_mix(ink, paper, 0.2)), alpha = NA),
+  default_aes = aes(
+    fill = from_theme(fill %||% col_mix(ink, paper, 0.2)),
+    alpha = NA
+  ),
   non_missing_aes = c("fill", "xmin", "xmax", "ymin", "ymax"),
   required_aes = c("x", "y"),
 

R/geom-rect.R

@@ -29,7 +29,8 @@ geom_rect <- function(mapping = NULL, data = NULL,
 #' @export
 GeomRect <- ggproto("GeomRect", Geom,
   default_aes = aes(
-    colour = NA, fill = from_theme(col_mix(ink, paper, 0.35)),
+    colour = from_theme(colour %||% NA),
+    fill = from_theme(fill %||% col_mix(ink, paper, 0.35)),
     linewidth = from_theme(borderwidth), linetype = from_theme(bordertype),
     alpha = NA
   ),

R/geom-ribbon.R

@@ -96,12 +96,14 @@ geom_ribbon <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 GeomRibbon <- ggproto("GeomRibbon", Geom,
+
   default_aes = aes(
-    colour = NA,
-    fill = from_theme(col_mix(ink, paper, 0.2)),
+    colour = from_theme(colour %||% NA),
+    fill = from_theme(fill %||% col_mix(ink, paper, 0.2)),
     linewidth = from_theme(borderwidth),
     linetype = from_theme(bordertype),
-    alpha = NA),
+    alpha = NA
+  ),
 
   required_aes = c("x|y", "ymin|xmin", "ymax|xmax"),
 
@@ -320,14 +322,6 @@ geom_area <- function(mapping = NULL, data = NULL, stat = "align",
 #' @export
 GeomArea <- ggproto("GeomArea", GeomRibbon,
 
-  default_aes = aes(
-    colour = NA,
-    fill = from_theme(col_mix(ink, paper, 0.2)),
-    linewidth = from_theme(borderwidth),
-    linetype = from_theme(bordertype),
-    alpha = NA
-  ),
-
   required_aes = c("x", "y"),
 
   setup_params = function(data, params) {

R/geom-rug.R

@@ -153,12 +153,7 @@ GeomRug <- ggproto("GeomRug", Geom,
     gTree(children = inject(gList(!!!rugs)))
   },
 
-  default_aes = aes(
-    colour = from_theme(ink),
-    linewidth = from_theme(linewidth),
-    linetype = from_theme(linetype),
-    alpha = NA
-  ),
+  default_aes = GeomPath$default_aes,
 
   draw_key = draw_key_path,
 

R/geom-segment.R

@@ -105,12 +105,7 @@ GeomSegment <- ggproto("GeomSegment", Geom,
   required_aes = c("x", "y", "xend|yend"),
   non_missing_aes = c("linetype", "linewidth"),
 
-  default_aes = aes(
-    colour = from_theme(ink),
-    linewidth = from_theme(linewidth),
-    linetype = from_theme(linetype),
-    alpha = NA
-  ),
+  default_aes = GeomPath$default_aes,
 
   draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL,
                         lineend = "butt", linejoin = "round", na.rm = FALSE) {

R/geom-sf.R

@@ -171,8 +171,8 @@ GeomSf <- ggproto("GeomSf", Geom,
     other_default <- modify_list(
       GeomPolygon$default_aes,
       aes(
-        fill   = from_theme(col_mix(ink, paper, 0.9)),
-        colour = from_theme(col_mix(ink, paper, 0.35)),
+        fill   = from_theme(fill %||% col_mix(ink, paper, 0.9)),
+        colour = from_theme(colour %||% col_mix(ink, paper, 0.35)),
         linewidth = from_theme(0.4 * borderwidth)
       )
     )

R/geom-smooth.R

@@ -169,8 +169,8 @@ GeomSmooth <- ggproto("GeomSmooth", Geom,
   optional_aes = c("ymin", "ymax"),
 
   default_aes = aes(
-    colour = from_theme(accent),
-    fill = from_theme(col_mix(ink, paper, 0.6)),
+    colour = from_theme(colour %||% accent),
+    fill = from_theme(fill %||% col_mix(ink, paper, 0.6)),
     linewidth = from_theme(2 * linewidth),
     linetype = from_theme(linetype),
     weight = 1, alpha = 0.4

R/geom-text.R

@@ -190,7 +190,7 @@ GeomText <- ggproto("GeomText", Geom,
   non_missing_aes = "angle",
 
   default_aes = aes(
-    colour = from_theme(ink),
+    colour = from_theme(colour %||% ink),
     family = from_theme(family),
     size = from_theme(fontsize),
     angle = 0, hjust = 0.5,

R/geom-tile.R

@@ -130,8 +130,8 @@ GeomTile <- ggproto("GeomTile", GeomRect,
   },
 
   default_aes = aes(
-    fill = from_theme(col_mix(ink, paper, 0.2)),
-    colour = NA,
+    fill = from_theme(fill %||% col_mix(ink, paper, 0.2)),
+    colour = from_theme(colour %||% NA),
     linewidth = from_theme(0.4 * borderwidth),
     linetype = from_theme(bordertype),
     alpha = NA, width = 1, height = 1

R/geom-violin.R

@@ -230,8 +230,8 @@ GeomViolin <- ggproto("GeomViolin", Geom,
 
   default_aes = aes(
     weight = 1,
-    colour = from_theme(col_mix(ink, paper, 0.2)),
-    fill = from_theme(paper),
+    colour = from_theme(colour %||% col_mix(ink, paper, 0.2)),
+    fill = from_theme(fill %||% paper),
     linewidth = from_theme(borderwidth),
     linetype = from_theme(bordertype),
     alpha = NA,