Refactor guide styling

DESCRIPTION

@@ -173,6 +173,7 @@ Collate:
     'grob-dotstack.R'
     'grob-null.R'
     'grouping.R'
+    'theme-elements.R'
     'guide-.R'
     'guide-axis.R'
     'guide-axis-logticks.R'
@@ -265,7 +266,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.
+
 * The `legend.key` theme element is set to inherit from the `panel.background`
   theme element. The default themes no longer set the `legend.key` element.
   This causes a visual change with the default `theme_gray()` (#5549).

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,
@@ -274,6 +279,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

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-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) {