Enable margins settings for guide titles

NEWS.md

@@ -327,6 +327,9 @@ up correct aspect ratio, and draws a graticule.
   and it can handle multi-line titles. Minor tweaks were made to `guide_legend()`
   to make sure the two legend functions behave as similarly as possible.
   (@clauswilke, #2397 and #2398)
+
+* The theme elements `legend.title` and `legend.text` now respect the settings of `margin`,
+  `hjust`, and `vjust`. (@clauswilke, #2465, #1502) 
 
 
 ### Other

R/guide-colorbar.r

@@ -324,12 +324,17 @@ guide_gengrob.colorbar <- function(guide, theme) {
   # and to obtain the title fontsize.
   title.theme <- guide$title.theme %||% calc_element("legend.title", theme)
 
+  title.hjust <- guide$title.hjust %||% theme$legend.title.align %||% title.theme$hjust %||% 0
+  title.vjust <- guide$title.vjust %||% title.theme$vjust %||% 0.5
+
   grob.title <- ggname("guide.title",
     element_grob(
       title.theme,
       label = guide$title,
-      hjust = guide$title.hjust %||% theme$legend.title.align %||% 0,
-      vjust = guide$title.vjust %||% 0.5
+      hjust = title.hjust,
+      vjust = title.vjust,
+      margin_x = TRUE,
+      margin_y = TRUE
     )
   )
 
@@ -344,17 +349,48 @@ guide_gengrob.colorbar <- function(guide, theme) {
   hgap <- width_cm(theme$legend.spacing.x  %||% (0.5 * unit(title_fontsize, "pt")))
   vgap <- height_cm(theme$legend.spacing.y %||% (0.5 * unit(title_fontsize, "pt")))
 
-  # label
+  # Labels
+
+  # get the defaults for label justification. The defaults are complicated and depend
+  # on the direction of the legend and on label placement
+  just_defaults <- label_just_defaults.colorbar(guide$direction, label.position)
+  # don't set expressions left-justified
+  if (just_defaults$hjust == 0 && any(is.expression(guide$key$.label))) just_defaults$hjust <- 1
+
+  # get the label theme
   label.theme <- guide$label.theme %||% calc_element("legend.text", theme)
+
+  # We break inheritance for hjust and vjust, because that's more intuitive here; it still allows manual
+  # setting of hjust and vjust if desired. The alternative is to ignore hjust and vjust altogether, which
+  # seems worse
+  if (is.null(guide$label.theme$hjust) && is.null(theme$legend.text$hjust)) label.theme$hjust <- NULL
+  if (is.null(guide$label.theme$vjust) && is.null(theme$legend.text$vjust)) label.theme$vjust <- NULL
+
+  # label.theme in param of guide_legend() > theme$legend.text.align > default
+  hjust <- guide$label.hjust %||% theme$legend.text.align %||% label.theme$hjust %||%
+    just_defaults$hjust
+  vjust <- guide$label.vjust %||% label.theme$vjust %||%
+    just_defaults$vjust
+
   grob.label <- {
     if (!guide$label)
       zeroGrob()
     else {
-      hjust <- x <- guide$label.hjust %||% theme$legend.text.align %||%
-        if (any(is.expression(guide$key$.label))) 1 else switch(guide$direction, horizontal = 0.5, vertical = 0)
-      vjust <- y <- guide$label.vjust %||% 0.5
-      switch(guide$direction, horizontal = {x <- label_pos; y <- vjust}, "vertical" = {x <- hjust; y <- label_pos})
-
+      switch(
+        guide$direction,
+        "horizontal" = {
+          x <- label_pos
+          y <- rep(vjust, length(label_pos))
+          margin_x = FALSE
+          margin_y = TRUE
+        },
+        "vertical" = {
+          x <- rep(hjust, length(label_pos))
+          y <- label_pos
+          margin_x = TRUE
+          margin_y = FALSE
+        }
+      )
       label <- guide$key$.label
 
       # If any of the labels are quoted language objects, convert them
@@ -366,8 +402,16 @@ guide_gengrob.colorbar <- function(guide, theme) {
         })
         label <- do.call(c, label)
       }
-      g <- element_grob(element = label.theme, label = label,
-        x = x, y = y, hjust = hjust, vjust = vjust)
+      g <- element_grob(
+        element = label.theme,
+        label = label,
+        x = x,
+        y = y,
+        hjust = hjust,
+        vjust = vjust,
+        margin_x = margin_x,
+        margin_y = margin_y
+      )
       ggname("guide.label", g)
     }
   }
@@ -484,10 +528,18 @@ guide_gengrob.colorbar <- function(guide, theme) {
   gt <- gtable_add_grob(gt, grob.bar, name = "bar", clip = "off",
     t = 1 + min(vps$bar.row), r = 1 + max(vps$bar.col),
     b = 1 + max(vps$bar.row), l = 1 + min(vps$bar.col))
-  gt <- gtable_add_grob(gt, grob.label, name = "label", clip = "off",
+  gt <- gtable_add_grob(
+    gt,
+    grob.label,
+    name = "label",
+    clip = "off",
     t = 1 + min(vps$label.row), r = 1 + max(vps$label.col),
     b = 1 + max(vps$label.row), l = 1 + min(vps$label.col))
-  gt <- gtable_add_grob(gt, grob.title, name = "title", clip = "off",
+  gt <- gtable_add_grob(
+    gt,
+    justify_grobs(grob.title, hjust = title.hjust, vjust = title.vjust, debug = title.theme$debug),
+    name = "title",
+    clip = "off",
     t = 1 + min(vps$title.row), r = 1 + max(vps$title.col),
     b = 1 + max(vps$title.row), l = 1 + min(vps$title.col))
   gt <- gtable_add_grob(gt, grob.ticks, name = "ticks", clip = "off",
@@ -500,3 +552,25 @@ guide_gengrob.colorbar <- function(guide, theme) {
 #' @export
 #' @rdname guide_colourbar
 guide_colorbar <- guide_colourbar
+
+#' Calculate the default hjust and vjust settings depending on legend
+#' direction and position.
+#'
+#' @noRd
+label_just_defaults.colorbar <- function(direction, position) {
+  if (direction == "horizontal") {
+    switch(
+      position,
+      "top" = list(hjust = 0.5, vjust = 0),
+      list(hjust = 0.5, vjust = 1)
+    )
+  }
+  else {
+    switch(
+      position,
+      "left" = list(hjust = 1, vjust = 0.5),
+      list(hjust = 0, vjust = 0.5)
+    )
+  }
+}
+

R/guide-legend.r

@@ -329,14 +329,17 @@ guide_gengrob.legend <- function(guide, theme) {
   # and to obtain the title fontsize.
   title.theme <- guide$title.theme %||% calc_element("legend.title", theme)
 
+  title.hjust <- guide$title.hjust %||% theme$legend.title.align %||% title.theme$hjust %||% 0
+  title.vjust <- guide$title.vjust %||% title.theme$vjust %||% 0.5
+
   grob.title <- ggname("guide.title",
     element_grob(
       title.theme,
       label = guide$title,
-      hjust = guide$title.hjust %||% theme$legend.title.align %||% 0,
-      vjust = guide$title.vjust %||% 0.5,
-      margin_x = FALSE,
-      margin_y = FALSE
+      hjust = title.hjust,
+      vjust = title.vjust,
+      margin_x = TRUE,
+      margin_y = TRUE
     )
   )
 
@@ -352,16 +355,30 @@ guide_gengrob.legend <- function(guide, theme) {
   vgap <- height_cm(theme$legend.spacing.y %||% (0.5 * unit(title_fontsize, "pt")))
 
   # Labels
+
+  # first get the label theme, we need it below even when there are no labels
+  label.theme <- guide$label.theme %||% calc_element("legend.text", theme)
+
   if (!guide$label || is.null(guide$key$.label)) {
     grob.labels <- rep(list(zeroGrob()), nrow(guide$key))
   } else {
-    label.theme <- guide$label.theme %||% calc_element("legend.text", theme)
+    # get the defaults for label justification. The defaults are complicated and depend
+    # on the direction of the legend and on label placement
+    just_defaults <- label_just_defaults.legend(guide$direction, label.position)
+    # don't set expressions left-justified
+    if (just_defaults$hjust == 0 && any(is.expression(guide$key$.label))) just_defaults$hjust <- 1
+
+    # We break inheritance for hjust and vjust, because that's more intuitive here; it still allows manual
+    # setting of hjust and vjust if desired. The alternative is to ignore hjust and vjust altogether, which
+    # seems worse
+    if (is.null(guide$label.theme$hjust) && is.null(theme$legend.text$hjust)) label.theme$hjust <- NULL
+    if (is.null(guide$label.theme$vjust) && is.null(theme$legend.text$vjust)) label.theme$vjust <- NULL
 
     # label.theme in param of guide_legend() > theme$legend.text.align > default
-    # hjust/vjust in theme$legend.text and label.theme are ignored.
-    hjust <- x <- guide$label.hjust %||% theme$legend.text.align %||%
-      if (any(is.expression(guide$key$.label))) 1 else 0
-    vjust <- y <- guide$label.vjust %||% 0.5
+    hjust <- x <- guide$label.hjust %||% theme$legend.text.align %||% label.theme$hjust %||%
+      just_defaults$hjust
+    vjust <- y <- guide$label.vjust %||% label.theme$vjust %||%
+      just_defaults$vjust
 
     grob.labels <- lapply(guide$key$.label, function(label, ...) {
       g <- element_grob(
@@ -371,8 +388,8 @@ guide_gengrob.legend <- function(guide, theme) {
         y = y,
         hjust = hjust,
         vjust = vjust,
-        margin_x = FALSE,
-        margin_y = FALSE
+        margin_x = TRUE,
+        margin_y = TRUE
       )
       ggname("guide.label", g)
     })
@@ -677,7 +694,7 @@ guide_gengrob.legend <- function(guide, theme) {
   )
   gt <- gtable_add_grob(
     gt,
-    grob.title,
+    justify_grobs(grob.title, hjust = title.hjust, vjust = title.vjust, debug = title.theme$debug),
     name = "title",
     clip = "off",
     t = 1 + min(vps.title.row),
@@ -697,7 +714,7 @@ guide_gengrob.legend <- function(guide, theme) {
   )
   gt <- gtable_add_grob(
     gt,
-    grob.labels,
+    justify_grobs(grob.labels, hjust = hjust, vjust = vjust, debug = label.theme$debug),
     name = paste("label", vps$label.row, vps$label.col, sep = "-"),
     clip = "off",
     t = 1 + vps$label.row,
@@ -708,4 +725,33 @@ guide_gengrob.legend <- function(guide, theme) {
   gt
 }
 
+
+#' Calculate the default hjust and vjust settings depending on legend
+#' direction and position.
+#'
+#' @noRd
+label_just_defaults.legend <- function(direction, position) {
+  if (direction == "horizontal") {
+    switch(
+      position,
+      "top" = list(hjust = 0.5, vjust = 0),
+      "bottom" = list(hjust = 0.5, vjust = 1),
+      "left" = list(hjust = 1, vjust = 0.5),
+      list(hjust = 0, vjust = 0.5)
+    )
+  }
+  else {
+    switch(
+      position,
+      "top" = list(hjust = 0.5, vjust = 0),
+      "bottom" = list(hjust = 0.5, vjust = 1),
+      "left" = list(hjust = 1, vjust = 0.5),
+      list(hjust = 0, vjust = 0.5)
+    )
+
+  }
+
+}
+
+
 globalVariables(c("C", "R", "key.row", "key.col", "label.row", "label.col"))

R/margins.R

@@ -222,3 +222,57 @@ widthDetails.titleGrob <- function(x) {
 heightDetails.titleGrob <- function(x) {
   sum(x$heights)
 }
+
+#' Justifies a grob within a larger drawing area
+#'
+#' `justify_grobs()` can be used to take one or more grobs and draw them justified inside a larger
+#' drawing area, such as the cell in a gtable. It is needed to correctly place [`titleGrob`]s
+#' with margins.
+#'
+#' @param grobs The single grob or list of grobs to justify.
+#' @param x,y x and y location of the reference point relative to which justification
+#'   should be performed. If `NULL`, justification will be done relative to the
+#'   enclosing drawing area (i.e., `x = hjust` and `y = vjust`).
+#' @param hjust,vjust Horizontal and vertical justification of the grob relative to `x` and `y`.
+#' @param debug If `TRUE`, aids visual debugging by drawing a solid
+#'   rectangle behind the complete grob area.
+#'
+#' @noRd
+justify_grobs <- function(grobs, x = NULL, y = NULL, hjust = 0.5, vjust = 0.5, debug = FALSE) {
+  if (!inherits(grobs, "grob")) {
+    if (is.list(grobs)) {
+      return(lapply(grobs, justify_grobs, x, y, hjust, vjust, debug))
+    }
+    else {
+      stop("need individual grob or list of grobs as argument.")
+    }
+  }
+
+  if (inherits(grobs, "zeroGrob")) {
+    return(grobs)
+  }
+
+  x <- x %||% unit(hjust, "npc")
+  y <- y %||% unit(vjust, "npc")
+
+  if (isTRUE(debug)) {
+    children <- gList(
+      rectGrob(gp = gpar(fill = "khaki", col = NA)),
+      grobs
+    )
+  }
+  else {
+    children = gList(grobs)
+  }
+
+  gTree(
+    children = children,
+    vp = viewport(
+      x = x,
+      y = y,
+      width = grobWidth(grobs),
+      height = grobHeight(grobs),
+      just = c(hjust, vjust)
+    )
+  )
+}