Use calc_element() instead of theme subsetting (#365)

thomasp85 · Jul 8, 2024 · 55d054f · 55d054f
1 parent 2d5be47
commit 55d054f
Show file tree

Hide file tree

Showing 4 changed files with 14 additions and 12 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -85,9 +85,11 @@ export(wrap_plots)
 import(cli)
 import(rlang)
 importFrom(ggplot2,aes)
+importFrom(ggplot2,calc_element)
 importFrom(ggplot2,element_blank)
 importFrom(ggplot2,element_grob)
 importFrom(ggplot2,element_line)
+importFrom(ggplot2,element_render)
 importFrom(ggplot2,element_text)
 importFrom(ggplot2,find_panel)
 importFrom(ggplot2,geom_blank)

diff --git a/R/guides.R b/R/guides.R
@@ -48,20 +48,20 @@ collapse_guides <- function(guides) {
 }
 #' @importFrom gtable gtable_width gtable_height gtable gtable_add_grob
 #' @importFrom grid editGrob heightDetails widthDetails valid.just unit.c unit
-#' @importFrom ggplot2 margin element_grob element_blank
+#' @importFrom ggplot2 margin element_grob element_blank calc_element element_render
 guides_build <- function(guides, theme) {
-  legend.spacing <- theme$legend.spacing %||% unit(0.5, "lines")
-  legend.spacing.y <- theme$legend.spacing.y  %||% legend.spacing
-  legend.spacing.x <- theme$legend.spacing.x  %||% legend.spacing
-  legend.box.margin <- theme$legend.box.margin %||% margin()
+  theme$legend.spacing <- calc_element("legend.spacing", theme) %||% unit(0.5, "lines")
+  legend.spacing.y <- calc_element("legend.spacing.y", theme)
+  legend.spacing.x <- calc_element("legend.spacing.x", theme)
+  legend.box.margin <- calc_element("legend.box.margin", theme) %||% margin()
 
   widths <- exec(unit.c, !!!lapply(guides, gtable_width))
   heights <- exec(unit.c, !!!lapply(guides, gtable_height))
 
-  just <- valid.just(theme$legend.box.just)
+  just <- valid.just(calc_element("legend.box.just", theme))
   xjust <- just[1]
   yjust <- just[2]
-  vert <- identical(theme$legend.box, "horizontal")
+  vert <- identical(calc_element("legend.box", theme), "horizontal")
   guides <- lapply(guides, function(g) {
     editGrob(g, vp = viewport(x = xjust, y = yjust, just = c(xjust, yjust),
                               height = if (vert) heightDetails(g) else 1,
@@ -98,7 +98,7 @@ guides_build <- function(guides, theme) {
 
   gtable_add_grob(
     guides,
-    element_grob(theme$legend.box.background %||% element_blank()),
+    element_render(theme, "legend.box.background"),
     t = 1, l = 1, b = -1, r = -1,
     z = -Inf, clip = "off", name = "legend.box.background"
   )
@@ -128,7 +128,7 @@ assemble_guides <- function(guides, theme) {
 
   # Set the justification of the legend box
   # First value is xjust, second value is yjust
-  just <- valid.just(theme$legend.justification)
+  just <- valid.just(calc_element("legend.justification", theme))
   xjust <- just[1]
   yjust <- just[2]
   guides <- grid::editGrob(guides, vp = viewport(x = xjust, y = yjust, just = c(xjust, yjust)))
@@ -158,7 +158,7 @@ attach_guides <- function(table, guides, theme) {
     position <- "right"
   }
 
-  spacing <- theme$legend.box.spacing %||% unit(0.2, 'cm')
+  spacing <- calc_element("legend.box.spacing", theme) %||% unit(0.2, 'cm')
   legend_width  <- gtable_width(guides)
   legend_height <- gtable_height(guides)
   if (position == "left") {

diff --git a/R/plot_patchwork.R b/R/plot_patchwork.R
@@ -323,7 +323,7 @@ plot_table.free_plot <- function(x, guides) {
   table$widths[c(2, ncol(table)-1)] <- gt$widths[c(2, ncol(gt)-1)]
   table$heights[c(2, nrow(table)-1)] <- gt$heights[c(2, nrow(gt)-1)]
   tag <- get_grob(gt, 'tag')
-  tag_pos <- x$theme$plot.tag.position
+  tag_pos <- calc_element("plot.tag.position", x$theme %||% theme_get())
   if (is.null(tag_pos)) tag_pos <- theme_get()$plot.tag.position
   if (!is_zero(tag) && is.character(tag_pos)) {
     table <- switch(

diff --git a/R/wrap_elements.R b/R/wrap_elements.R
@@ -108,7 +108,7 @@ patchGrob.wrapped_patch <- function(x, guides = 'auto') {
     table$widths[c(2, ncol(table)-1)] <- gt$widths[c(2, ncol(gt)-1)]
     table$heights[c(2, nrow(table)-1)] <- gt$heights[c(2, nrow(gt)-1)]
     tag <- get_grob(gt, 'tag')
-    tag_pos <- x$theme$plot.tag.position
+    tag_pos <- calc_element("plot.tag.position", x$theme %||% theme_get())
     if (is.null(tag_pos)) tag_pos <- theme_get()$plot.tag.position
     if (!is.character(tag_pos)) tag_pos <- 'manual'
     table <- switch(