Refactor guide styling (#5554)

* add more legend theme settings

* remove elements as part of guide construction

* add `theme` as required guide parameter

* bequeath axes with `theme` argument

* wire `theme` into legends

* impart `theme` upon colourbars

* entrust bins guide with `theme`

* replacement utility

* redocument

* small tweaks

* backward compatibility mechanism

* add news bullet

* update tests

* Separate colourbar/coloursteps constructors

* themes have default `legend.key.spacing`

* doc fixes

* add `theme` to stacked axis

* There is no need for `justify_grobs()`

* update `replace_null()`

* fix examples

* adapt to latest changes

* rename argument

* Fix typo

* no need to use `justify_grobs()`

Author: teunbrand

DESCRIPTION

@@ -175,6 +175,7 @@ Collate:
     'grob-dotstack.R'
     'grob-null.R'
     'grouping.R'
+    'theme-elements.R'
     'guide-.R'
     'guide-axis.R'
     'guide-axis-logticks.R'
@@ -269,7 +270,6 @@ Collate:
     'stat-ydensity.R'
     'summarise-plot.R'
     'summary.R'
-    'theme-elements.R'
     'theme.R'
     'theme-defaults.R'
     'theme-current.R'

NEWS.md

@@ -1,5 +1,12 @@
 # ggplot2 (development version)
 
+* `guide_*()` functions get a new `theme` argument to style individual guides.
+  The `theme()` function has gained additional arguments for styling guides:
+  `legend.key.spacing{.x/.y}`, `legend.frame`, `legend.axis.line`, 
+  `legend.ticks`, `legend.ticks.length`, `legend.text.position` and 
+  `legend.title.position`. Previous style arguments in the `guide_*()` functions 
+  have been soft-deprecated.
+  
 * When legend titles are larger than the legend, title justification extends
   to the placement of keys and labels (#1903).
 

R/guide-.R

@@ -1,3 +1,6 @@
+#' @include theme-elements.R
+NULL
+
 #' Guide constructor
 #'
 #' A constructor function for guides, which performs some standard compatibility
@@ -25,13 +28,8 @@ new_guide <- function(..., available_aes = "any", super) {
   params <- intersect(names(args), param_names)
   params <- defaults(args[params], super$params)
 
-  # Set elements
-  elems_names <- names(super$elements)
-  elems  <- intersect(names(args), elems_names)
-  elems  <- defaults(args[elems], super$elements)
-
   # Warn about extra arguments
-  extra_args <- setdiff(names(args), union(param_names, elems_names))
+  extra_args <- setdiff(names(args), param_names)
   if (length(extra_args) > 0) {
     cli::cli_warn(paste0(
       "Ignoring unknown {cli::qty(extra_args)} argument{?s} to ",
@@ -50,14 +48,20 @@ new_guide <- function(..., available_aes = "any", super) {
     ))
   }
 
+  # Validate theme settings
+  if (!is.null(params$theme)) {
+    check_object(params$theme, is.theme, what = "a {.cls theme} object")
+    validate_theme(params$theme)
+    params$direction <- params$direction %||% params$theme$legend.direction
+  }
+
   # Ensure 'order' is length 1 integer
   params$order <- vec_cast(params$order, 0L, x_arg = "order", call = pf)
   vec_assert(params$order, 0L, size = 1L, arg = "order", call = pf)
 
   ggproto(
     NULL, super,
-    params   = params,
-    elements = elems,
+    params = params,
     available_aes = available_aes
   )
 }
@@ -162,6 +166,7 @@ Guide <- ggproto(
   #  `GuidesList` class.
   params = list(
     title     = waiver(),
+    theme     = NULL,
     name      = character(),
     position  = waiver(),
     direction = NULL,
@@ -275,6 +280,7 @@ Guide <- ggproto(
   # Converts the `elements` field to proper elements to be accepted by
   # `element_grob()`. String-interpolates aesthetic/position dependent elements.
   setup_elements = function(params, elements, theme) {
+    theme <- add_theme(theme, params$theme)
     is_char  <- vapply(elements, is.character, logical(1))
     elements[is_char] <- lapply(elements[is_char], calc_element, theme = theme)
     elements
@@ -294,8 +300,7 @@ Guide <- ggproto(
     key <- params$key
 
     # Setup parameters and theme
-    params$position  <- params$position  %||% position
-    params$direction <- params$direction %||% direction
+    params <- replace_null(params, position = position, direction = direction)
     params <- self$setup_params(params)
     elems  <- self$setup_elements(params, self$elements, theme)
     elems  <- self$override_elements(params, elems, theme)

R/guide-axis-logticks.R

@@ -72,6 +72,7 @@ guide_axis_logticks <- function(
   short_theme = element_line(),
   expanded = TRUE,
   cap = "none",
+  theme = NULL,
   ...
 ) {
   if (is.logical(cap)) {
@@ -108,6 +109,7 @@ guide_axis_logticks <- function(
     cap   = cap,
     minor.ticks = TRUE,
     short_theme = short_theme,
+    theme = theme,
     ...,
     super = GuideAxisLogticks
   )

R/guide-axis-stack.R

@@ -29,7 +29,7 @@ NULL
 #'
 #' # A normal axis first, then a capped axis
 #' p + guides(x = guide_axis_stack("axis", guide_axis(cap = "both")))
-guide_axis_stack <- function(first = "axis", ..., title = waiver(),
+guide_axis_stack <- function(first = "axis", ..., title = waiver(), theme = NULL,
                              spacing = NULL, order = 0, position = waiver()) {
 
   check_object(spacing, is.unit, "{.cls unit}", allow_null = TRUE)
@@ -63,6 +63,7 @@ guide_axis_stack <- function(first = "axis", ..., title = waiver(),
 
   new_guide(
     title = title,
+    theme = theme,
     guides = axes,
     guide_params = params,
     available_aes = c("x", "y", "theta", "r"),
@@ -88,6 +89,7 @@ GuideAxisStack <- ggproto(
     # Standard guide stuff
     name      = "stacked_axis",
     title     = waiver(),
+    theme     = NULL,
     angle     = waiver(),
     hash      = character(),
     position  = waiver(),
@@ -142,6 +144,7 @@ GuideAxisStack <- ggproto(
 
   draw = function(self, theme, position = NULL, direction = NULL,
                   params = self$params) {
+    theme <- add_theme(theme, params$theme)
 
     position  <- params$position  %||% position
     direction <- params$direction %||% direction

R/guide-axis-theta.R

@@ -23,7 +23,7 @@ NULL
 #'
 #' # The `angle` argument can be used to set relative angles
 #' p + guides(theta = guide_axis_theta(angle = 0))
-guide_axis_theta <- function(title = waiver(), angle = waiver(),
+guide_axis_theta <- function(title = waiver(), theme = NULL, angle = waiver(),
                              minor.ticks = FALSE, cap = "none", order = 0,
                              position = waiver()) {
 

R/guide-axis.R

@@ -46,9 +46,9 @@
 #'
 #' # can also be used to add a duplicate guide
 #' p + guides(x = guide_axis(n.dodge = 2), y.sec = guide_axis())
-guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = waiver(),
-                       n.dodge = 1, minor.ticks = FALSE, cap = "none",
-                       order = 0, position = waiver()) {
+guide_axis <- function(title = waiver(), theme = NULL, check.overlap = FALSE,
+                       angle = waiver(), n.dodge = 1, minor.ticks = FALSE,
+                       cap = "none", order = 0, position = waiver()) {
   check_bool(minor.ticks)
   if (is.logical(cap)) {
     check_bool(cap)
@@ -58,6 +58,7 @@ guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = waiver()
 
   new_guide(
     title = title,
+    theme = theme,
 
     # customisations
     check.overlap = check.overlap,
@@ -86,6 +87,7 @@ GuideAxis <- ggproto(
 
   params = list(
     title     = waiver(),
+    theme     = NULL,
     name      = "axis",
     hash      = character(),
     position  = waiver(),
@@ -225,17 +227,14 @@ GuideAxis <- ggproto(
   },
 
   setup_elements = function(params, elements, theme) {
-    axis_elem <- c("line", "text", "ticks", "minor", "major_length", "minor_length")
-    is_char  <- vapply(elements[axis_elem], is.character, logical(1))
-    axis_elem <- axis_elem[is_char]
-    elements[axis_elem] <- lapply(
-      paste(
-        unlist(elements[axis_elem]),
-        params$aes, params$position, sep = "."
-      ),
-      calc_element, theme = theme
+    is_char <- vapply(elements, is.character, logical(1))
+    suffix <- paste(params$aes, params$position, sep = ".")
+    elements[is_char] <- vapply(
+      elements[is_char],
+      function(x) paste(x, suffix, sep = "."),
+      character(1)
     )
-    elements
+    Guide$setup_elements(params, elements, theme)
   },
 
   override_elements = function(params, elements, theme) {