WIP: Register default scales via themes

DESCRIPTION

@@ -254,6 +254,6 @@ Collate:
     'zxx.r'
     'zzz.r'
 VignetteBuilder: knitr
-RoxygenNote: 7.0.2
+RoxygenNote: 7.1.0
 Roxygen: list(markdown = TRUE)
 Encoding: UTF-8

NAMESPACE

@@ -107,6 +107,7 @@ S3method(makeContext,dotstackGrob)
 S3method(merge_element,default)
 S3method(merge_element,element)
 S3method(merge_element,element_blank)
+S3method(merge_element,list)
 S3method(plot,ggplot)
 S3method(predictdf,default)
 S3method(predictdf,glm)

R/layer.r

@@ -223,8 +223,7 @@ Layer <- ggproto("Layer", NULL,
     if (!is.null(self$geom_params$group)) {
       aesthetics[["group"]] <- self$aes_params$group
     }
-
-    scales_add_defaults(plot$scales, data, aesthetics, plot$plot_env)
+    scales_add_defaults(plot$scales, data, aesthetics, plot$plot_env, plot$theme)
 
     # Evaluate aesthetics
     env <- child_env(baseenv(), stage = stage)
@@ -320,7 +319,7 @@ Layer <- ggproto("Layer", NULL,
     stat_data <- new_data_frame(compact(stat_data))
 
     # Add any new scales, if needed
-    scales_add_defaults(plot$scales, data, new, plot$plot_env)
+    scales_add_defaults(plot$scales, data, new, plot$plot_env, plot$theme)
     # Transform the values, if the scale say it's ok
     # (see stat_spoke for one exception)
     if (self$stat$retransform) {

R/plot-build.r

@@ -43,6 +43,8 @@ ggplot_build.ggplot <- function(plot) {
     }
     out
   }
+  ## Build full theme combining supplied elements and current defaults
+  plot$theme <- plot_theme(plot)
 
   # Allow all layers to make any final adjustments based
   # on raw input data and plot info
@@ -163,7 +165,7 @@ ggplot_gtable.ggplot_built <- function(data) {
   plot <- data$plot
   layout <- data$layout
   data <- data$data
-  theme <- plot_theme(plot)
+  theme <- plot$theme
 
   geom_grobs <- Map(function(l, d) l$draw_geom(d, layout), plot$layers, data)
   layout$setup_panel_guides(plot$guides, plot$layers, plot$mapping)

R/scale-type.R

@@ -1,4 +1,4 @@
-find_scale <- function(aes, x, env = parent.frame()) {
+find_scale <- function(aes, x, env = parent.frame(), theme = NULL) {
   # Inf is ambiguous; it can be used either with continuous scales or with
   # discrete scales, so just skip in the hope that we will have a better guess
   # with the other layers
@@ -8,11 +8,17 @@ find_scale <- function(aes, x, env = parent.frame()) {
 
   type <- scale_type(x)
   candidates <- paste("scale", aes, type, sep = "_")
-
   for (scale in candidates) {
+    ## First try lookup in theme (if supplied)
+    default_scales <- calc_element("default.scales", theme)
+    scale <- default_scales[[name]]
+    if (!is.null(scale) && isTRUE(mode(scale) == mode)) {
+      return(scale)
+    }
     scale_f <- find_global(scale, env, mode = "function")
-    if (!is.null(scale_f))
+    if (!is.null(scale_f)) {
       return(scale_f())
+    }
   }
 
   # Failure to find a scale is not an error because some "aesthetics" don't

R/scales-.r

@@ -88,7 +88,7 @@ scales_transform_df <- function(scales, df) {
 
 # @param aesthetics A list of aesthetic-variable mappings. The name of each
 #   item is the aesthetic, and the value of each item is the variable in data.
-scales_add_defaults <- function(scales, data, aesthetics, env) {
+scales_add_defaults <- function(scales, data, aesthetics, env, theme) {
   if (is.null(aesthetics)) return()
   names(aesthetics) <- unlist(lapply(names(aesthetics), aes_to_scale))
 
@@ -100,7 +100,7 @@ scales_add_defaults <- function(scales, data, aesthetics, env) {
   datacols <- compact(datacols)
 
   for (aes in names(datacols)) {
-    scales$add(find_scale(aes, datacols[[aes]], env))
+    scales$add(find_scale(aes, datacols[[aes]], env, theme))
   }
 
 }

R/theme-elements.r

@@ -480,6 +480,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) {
   strip.placement.y   = el_def("character", "strip.placement"),
   strip.switch.pad.grid = el_def("unit"),
   strip.switch.pad.wrap = el_def("unit"),
+  default.scales      = el_def("list"),
 
   plot.background     = el_def("element_rect", "rect"),
   plot.title          = el_def("element_text", "title"),

R/theme.r

@@ -356,6 +356,7 @@ theme <- function(line,
                   strip.text.y,
                   strip.switch.pad.grid,
                   strip.switch.pad.wrap,
+                  default.scales,
                   ...,
                   complete = FALSE,
                   validate = TRUE
@@ -643,6 +644,14 @@ merge_element.element <- function(new, old) {
   new
 }
 
+#' @rdname merge_element
+#' @export
+merge_element.list <- function(new, old) {
+  overlap <- intersect(names(new), names(old))
+  old <- old[setdiff(names(old), overlap)]
+  append(old, new)
+}
+
 #' Combine the properties of two elements
 #'
 #' @param e1 An element object