From 395ed9a0332e0803003a36457ca978bc0e40be83 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 26 Oct 2023 15:33:14 +0200
Subject: [PATCH 01/10] guides are named by their hash

---
 R/guides-.R | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/R/guides-.R b/R/guides-.R
index 2117edda62..83bbce4e24 100644
--- a/R/guides-.R
+++ b/R/guides-.R
@@ -434,11 +434,6 @@ Guides <- ggproto(
     # Bundle together guides and their parameters
     pairs <- Map(list, guide = self$guides, params = self$params)
 
-    # If there is only one guide, we can exit early, because nothing to merge
-    if (length(pairs) == 1) {
-      return()
-    }
-
     # The `{order}_{hash}` combination determines groups of guides
     orders <- vapply(self$params, `[[`, 0, "order")
     orders[orders == 0] <- 99
@@ -446,10 +441,16 @@ Guides <- ggproto(
     hashes <- vapply(self$params, `[[`, "", "hash")
     hashes <- paste(orders, hashes, sep = "_")
 
+    # If there is only one guide, we can exit early, because nothing to merge
+    if (length(pairs) == 1) {
+      names(self$guides) <- hashes
+      return()
+    }
+
     # Split by hashes
     indices <- split(seq_along(pairs), hashes)
     indices <- vapply(indices, `[[`, 0L, 1L, USE.NAMES = FALSE) # First index
-    groups  <- unname(split(pairs, hashes))
+    groups  <- split(pairs, hashes)
     lens    <- lengths(groups)
 
     # Merge groups with >1 member

From 460e8a4657a9e900569b0c74195029305bc1c497 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 26 Oct 2023 15:34:09 +0200
Subject: [PATCH 02/10] Pumbing for custom guides

---
 R/guides-.R | 21 ++++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/R/guides-.R b/R/guides-.R
index 83bbce4e24..5d38902c65 100644
--- a/R/guides-.R
+++ b/R/guides-.R
@@ -301,6 +301,19 @@ Guides <- ggproto(
       horizontal = c("center", "top")
     )
 
+    custom <- vapply(self$guides, inherits, logical(1), what = "GuideCustom")
+    n_custom <- sum(custom)
+    if (n_custom > 0) {
+      custom <- guides_list(self$guides[custom])
+      custom$params <- lapply(custom$guides, `[[`, "params")
+      custom$merge()
+      custom <- compact(custom$draw(theme))
+      # We assign the return value for no guides to assembled custom grobs
+      no_guides <- self$assemble(custom, theme)
+    } else {
+      custom <- list()
+    }
+
     # Extract the non-position scales
     scales <- scales$non_position_scales()$scales
     if (length(scales) == 0) {
@@ -326,8 +339,14 @@ Guides <- ggproto(
       return(no_guides)
     }
 
-    # Draw and assemble
+    # Draw
     grobs <- guides$draw(theme)
+
+    # Combine with custom guides
+    grobs <- c(grobs, custom)
+    grobs <- grobs[order(names(grobs))]
+
+    # Assemble guides into guide-box
     guides$assemble(grobs, theme)
   },
 

From df24228c0cdd88e95bbb4793453d9ab57cdce157 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 26 Oct 2023 15:34:30 +0200
Subject: [PATCH 03/10] draft version

---
 R/guide-custom.R | 110 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 110 insertions(+)
 create mode 100644 R/guide-custom.R

diff --git a/R/guide-custom.R b/R/guide-custom.R
new file mode 100644
index 0000000000..53a46a356f
--- /dev/null
+++ b/R/guide-custom.R
@@ -0,0 +1,110 @@
+
+
+
+guide_custom <- function(
+  grob, width = grobWidth(grob), height = grobHeight(grob),
+  title = waiver(), title.position = "top",
+  position = waiver(), order = 0
+) {
+  check_object(grob, is.grob, "a {.cls grob} object")
+  check_object(width, is.unit, "a {.cls unit} object")
+  check_object(height, is.unit, "a {.cls unit} object")
+  if (length(width) != 1) {
+    cli::cli_abort("{.arg width} must be a single {.cls unit}, not a unit vector.")
+  }
+  if (length(height) != 1) {
+    cli::cli_abort("{.arg height} must be a single {.cls unit}, not a unit vector.")
+  }
+
+  new_guide(
+    grob = grob,
+    width = width,
+    height = height,
+    title = title,
+    title.position = title.position,
+    hash = hash(list(title, grob)), # hash is already known
+    position = position,
+    order = order,
+    available_aes = "any",
+    super = GuideCustom
+  )
+}
+
+GuideCustom <- ggproto(
+  "GuideCustom", Guide,
+
+  params = c(Guide$params, list(
+    grob = NULL, width = NULL, height = NULL,
+    title = waiver(),
+    title.position = "top"
+  )),
+
+  hashables = exprs(title, grob),
+
+  elements = list(
+    background  = "legend.background",
+    margin      = "legend.margin",
+    theme.title = "legend.title"
+  ),
+
+  train = function(...) {
+    params
+  },
+
+  transform = function(...) {
+    params
+  },
+
+  override_elements = function(params, elements, theme) {
+    elements$title <- elements$theme.title
+    elements
+  },
+
+  draw = function(self, theme, params = self$params) {
+
+    # Render title
+    elems <- self$setup_elements(params, self$elements, theme)
+    elems <- self$override_elements(params, elems, theme)
+    if (!is.waive(params$title) && !is.null(params$title)) {
+      title <- self$build_title(params$title, elems, params)
+    } else {
+      title <- zeroGrob()
+    }
+    title.position <- params$title.position
+    if (is.zero(title)) {
+      title.position <- "none"
+    }
+
+    width  <- convertWidth(params$width, "cm")
+    height <- convertHeight(params$height, "cm")
+    gt <- gtable(widths = width, heights = height)
+    gt <- gtable_add_grob(gt, params$grob, t = 1, l = 1)
+
+    if (params$title.position == "top") {
+      gt <- gtable_add_rows(gt, elems$margin[1], pos = 0)
+      gt <- gtable_add_rows(gt, unit(height_cm(title), "cm"), pos = 0)
+      gt <- gtable_add_grob(gt, title, t = 1, l = 1, name = "title", clip = "off")
+    } else if (params$title.position == "bottom") {
+      gt <- gtable_add_rows(gt, elems$margin[3], pos = -1)
+      gt <- gtable_add_rows(gt, unit(height_cm(title), "cm"), pos = -1)
+      gt <- gtable_add_grob(gt, title, t = -1, l = 1, name = "title", clip = "off")
+    } else if (params$title.position == "left") {
+      gt <- gtable_add_cols(gt, elems$margin[4], pos = 0)
+      gt <- gtable_add_cols(gt, unit(width_cm(title), "cm"), pos = 0)
+      gt <- gtable_add_grob(gt, title, t = 1, l = 1, name = "title", clip = "off")
+    } else if (params$title.position == "right") {
+      gt <- gtable_add_cols(gt, elems$margin[2], pos = -1)
+      gt <- gtable_add_cols(gt, unit(width_cm(title), "cm"), pos = 0)
+      gt <- gtable_add_grob(gt, title, t = 1, l = -1, name = "title", clip = "off")
+    }
+    gt <- gtable_add_padding(gt, elems$margin)
+
+    background <- element_grob(elems$background)
+    gt <- gtable_add_grob(
+      gt, background,
+      t = 1, l = 1, r = -1, b = -1,
+      z = -Inf, clip = "off"
+    )
+    gt
+  }
+)

From 50d4c329080ffb613b70366e1de10b89df4a6630 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 26 Oct 2023 16:02:21 +0200
Subject: [PATCH 04/10] Document stuff

---
 DESCRIPTION            |  1 +
 NAMESPACE              |  2 ++
 R/guide-custom.R       | 66 +++++++++++++++++++++++++++++++++++------
 man/ggplot2-ggproto.Rd |  3 +-
 man/guide_custom.Rd    | 67 ++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 129 insertions(+), 10 deletions(-)
 create mode 100644 man/guide_custom.Rd

diff --git a/DESCRIPTION b/DESCRIPTION
index 0f931609d9..3399e1fcea 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -178,6 +178,7 @@ Collate:
     'guide-bins.R'
     'guide-colorbar.R'
     'guide-colorsteps.R'
+    'guide-custom.R'
     'layer.R'
     'guide-none.R'
     'guide-old.R'
diff --git a/NAMESPACE b/NAMESPACE
index 717abb2e18..30e9091097 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -214,6 +214,7 @@ export(GuideAxis)
 export(GuideBins)
 export(GuideColourbar)
 export(GuideColoursteps)
+export(GuideCustom)
 export(GuideLegend)
 export(GuideNone)
 export(GuideOld)
@@ -423,6 +424,7 @@ export(guide_colorbar)
 export(guide_colorsteps)
 export(guide_colourbar)
 export(guide_coloursteps)
+export(guide_custom)
 export(guide_gengrob)
 export(guide_geom)
 export(guide_legend)
diff --git a/R/guide-custom.R b/R/guide-custom.R
index 53a46a356f..3ed1e68c92 100644
--- a/R/guide-custom.R
+++ b/R/guide-custom.R
@@ -1,20 +1,61 @@
-
-
-
+#' Custom guides
+#'
+#' This is a special guide that can be used to display any graphical object
+#' (grob) along with the regular guides. This guide has no associated scale.
+#'
+#' @param grob A grob to display.
+#' @param width,height The allocated width and height to display the grob, given
+#'  in [grid::unit()]s.
+#' @param title A character string or expression indicating the title of guide.
+#'   If `NULL` (default), no title is shown.
+#' @param title.position A character string indicating the position of a title.
+#'   One of `"top"` (default), `"bottom"`, `"left"` or `"right"`.
+#' @param margin Margins around the guide. See [margin()] for more details. If
+#'   `NULL` (default), margins are taken from the `legend.margin` theme setting.
+#' @param position Currently not in use.
+#' @inheritParams guide_legend
+#'
+#' @export
+#'
+#' @examples
+#' # A standard plot
+#' p <- ggplot(mpg, aes(displ, hwy)) +
+#'   geom_point()
+#'
+#' # Define a graphical object
+#' circle <- grid::circleGrob()
+#'
+#' # Rendering a grob as a guide
+#' p + guides(custom = guide_custom(circle, title = "My circle"))
+#'
+#' # Controlling the size of the grob defined in relative units
+#' p + guides(custom = guide_custom(
+#'   circle, title = "My circle",
+#'   width = unit(2, "cm"), height = unit(2, "cm"))
+#' )
+#'
+#' # Size of grobs in absolute units is taken directly without the need to
+#' # set these manually
+#' p + guides(custom = guide_custom(
+#'   title = "My circle",
+#'   grob = circleGrob(r = unit(1, "cm"))
+#' ))
 guide_custom <- function(
   grob, width = grobWidth(grob), height = grobHeight(grob),
-  title = waiver(), title.position = "top",
+  title = NULL, title.position = "top", margin = NULL,
   position = waiver(), order = 0
 ) {
   check_object(grob, is.grob, "a {.cls grob} object")
   check_object(width, is.unit, "a {.cls unit} object")
   check_object(height, is.unit, "a {.cls unit} object")
+  check_object(margin, is.margin, "a {.cls margin} object", allow_null = TRUE)
   if (length(width) != 1) {
     cli::cli_abort("{.arg width} must be a single {.cls unit}, not a unit vector.")
   }
   if (length(height) != 1) {
     cli::cli_abort("{.arg height} must be a single {.cls unit}, not a unit vector.")
   }
+  title.position <- arg_match0(title.position, .trbl)
 
   new_guide(
     grob = grob,
@@ -22,6 +63,7 @@ guide_custom <- function(
     height = height,
     title = title,
     title.position = title.position,
+    margin = margin,
     hash = hash(list(title, grob)), # hash is already known
     position = position,
     order = order,
@@ -30,21 +72,26 @@ guide_custom <- function(
   )
 }
 
+#' @rdname ggplot2-ggproto
+#' @format NULL
+#' @usage NULL
+#' @export
 GuideCustom <- ggproto(
   "GuideCustom", Guide,
 
   params = c(Guide$params, list(
     grob = NULL, width = NULL, height = NULL,
-    title = waiver(),
+    margin = NULL,
+    title = NULL,
     title.position = "top"
   )),
 
   hashables = exprs(title, grob),
 
   elements = list(
-    background  = "legend.background",
-    margin      = "legend.margin",
-    theme.title = "legend.title"
+    background   = "legend.background",
+    theme.margin = "legend.margin",
+    theme.title  = "legend.title"
   ),
 
   train = function(...) {
@@ -57,6 +104,7 @@ GuideCustom <- ggproto(
 
   override_elements = function(params, elements, theme) {
     elements$title <- elements$theme.title
+    elements$margin <- params$margin %||% elements$theme.margin
     elements
   },
 
@@ -78,7 +126,7 @@ GuideCustom <- ggproto(
     width  <- convertWidth(params$width, "cm")
     height <- convertHeight(params$height, "cm")
     gt <- gtable(widths = width, heights = height)
-    gt <- gtable_add_grob(gt, params$grob, t = 1, l = 1)
+    gt <- gtable_add_grob(gt, params$grob, t = 1, l = 1, clip = "off")
 
     if (params$title.position == "top") {
       gt <- gtable_add_rows(gt, elems$margin[1], pos = 0)
diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd
index 37a042dd68..951223dc3d 100644
--- a/man/ggplot2-ggproto.Rd
+++ b/man/ggplot2-ggproto.Rd
@@ -14,7 +14,7 @@
 %   R/geom-smooth.R, R/geom-spoke.R, R/geom-text.R, R/geom-tile.R,
 %   R/geom-violin.R, R/geom-vline.R, R/guide-.R, R/guide-axis.R,
 %   R/guide-legend.R, R/guide-bins.R, R/guide-colorbar.R, R/guide-colorsteps.R,
-%   R/guide-none.R, R/guide-old.R, R/layout.R, R/position-.R,
+%   R/guide-custom.R, R/guide-none.R, R/guide-old.R, R/layout.R, R/position-.R,
 %   R/position-dodge.R, R/position-dodge2.R, R/position-identity.R,
 %   R/position-jitter.R, R/position-jitterdodge.R, R/position-nudge.R,
 %   R/position-stack.R, R/scale-.R, R/scale-binned.R, R/scale-continuous.R,
@@ -93,6 +93,7 @@
 \alias{GuideBins}
 \alias{GuideColourbar}
 \alias{GuideColoursteps}
+\alias{GuideCustom}
 \alias{GuideNone}
 \alias{GuideOld}
 \alias{Layout}
diff --git a/man/guide_custom.Rd b/man/guide_custom.Rd
new file mode 100644
index 0000000000..93fe17a199
--- /dev/null
+++ b/man/guide_custom.Rd
@@ -0,0 +1,67 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/guide-custom.R
+\name{guide_custom}
+\alias{guide_custom}
+\title{Custom guides}
+\usage{
+guide_custom(
+  grob,
+  width = grobWidth(grob),
+  height = grobHeight(grob),
+  title = NULL,
+  title.position = "top",
+  margin = NULL,
+  position = waiver(),
+  order = 0
+)
+}
+\arguments{
+\item{grob}{A grob to display.}
+
+\item{width, height}{The allocated width and height to display the grob, given
+in \code{\link[grid:unit]{grid::unit()}}s.}
+
+\item{title}{A character string or expression indicating the title of guide.
+If \code{NULL} (default), no title is shown.}
+
+\item{title.position}{A character string indicating the position of a title.
+One of \code{"top"} (default), \code{"bottom"}, \code{"left"} or \code{"right"}.}
+
+\item{margin}{Margins around the guide. See \code{\link[=margin]{margin()}} for more details. If
+\code{NULL} (default), margins are taken from the \code{legend.margin} theme setting.}
+
+\item{position}{Currently not in use.}
+
+\item{order}{positive integer less than 99 that specifies the order of
+this guide among multiple guides. This controls the order in which
+multiple guides are displayed, not the contents of the guide itself.
+If 0 (default), the order is determined by a secret algorithm.}
+}
+\description{
+This is a special guide that can be used to display any graphical object
+(grob) along with the regular guides. This guide has no associated scale.
+}
+\examples{
+# A standard plot
+p <- ggplot(mpg, aes(displ, hwy)) +
+  geom_point()
+
+# Define a graphical object
+circle <- grid::circleGrob()
+
+# Rendering a grob as a guide
+p + guides(custom = guide_custom(circle, title = "My circle"))
+
+# Controlling the size of the grob defined in relative units
+p + guides(custom = guide_custom(
+  circle, title = "My circle",
+  width = unit(2, "cm"), height = unit(2, "cm"))
+)
+
+# Size of grobs in absolute units is taken directly without the need to
+# set these manually
+p + guides(custom = guide_custom(
+  title = "My circle",
+  grob = circleGrob(r = unit(1, "cm"))
+))
+}

From 02f6626cc8464c5ca8c5e1c456c0a008fe0f76e9 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 26 Oct 2023 16:03:00 +0200
Subject: [PATCH 05/10] Add topic to pkgdown

---
 _pkgdown.yml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/_pkgdown.yml b/_pkgdown.yml
index 7dbedc3062..272039b2c9 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -128,6 +128,7 @@ reference:
   - guide_axis
   - guide_bins
   - guide_coloursteps
+  - guide_custom
   - guide_none
   - guides
   - sec_axis

From 63778b34f5bddff3f2770957f30550eb9e98e7e7 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 26 Oct 2023 16:24:00 +0200
Subject: [PATCH 06/10] prepend grid namespace to example

---
 R/guide-custom.R    | 2 +-
 man/guide_custom.Rd | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/guide-custom.R b/R/guide-custom.R
index 3ed1e68c92..dbb3a61753 100644
--- a/R/guide-custom.R
+++ b/R/guide-custom.R
@@ -38,7 +38,7 @@
 #' # set these manually
 #' p + guides(custom = guide_custom(
 #'   title = "My circle",
-#'   grob = circleGrob(r = unit(1, "cm"))
+#'   grob = grid::circleGrob(r = unit(1, "cm"))
 #' ))
 guide_custom <- function(
   grob, width = grobWidth(grob), height = grobHeight(grob),
diff --git a/man/guide_custom.Rd b/man/guide_custom.Rd
index 93fe17a199..3893dbc2c9 100644
--- a/man/guide_custom.Rd
+++ b/man/guide_custom.Rd
@@ -62,6 +62,6 @@ p + guides(custom = guide_custom(
 # set these manually
 p + guides(custom = guide_custom(
   title = "My circle",
-  grob = circleGrob(r = unit(1, "cm"))
+  grob = grid::circleGrob(r = unit(1, "cm"))
 ))
 }

From bed3afed349102ab8d127cbf444b612739af5e67 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 9 Nov 2023 14:22:09 +0100
Subject: [PATCH 07/10] Adapt to new `Guide$draw()` formals

---
 R/guide-custom.R | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/R/guide-custom.R b/R/guide-custom.R
index dbb3a61753..3ea4fc3ffe 100644
--- a/R/guide-custom.R
+++ b/R/guide-custom.R
@@ -108,7 +108,8 @@ GuideCustom <- ggproto(
     elements
   },
 
-  draw = function(self, theme, params = self$params) {
+  draw = function(self, theme, position = NULL, direction = NULL,
+                  params = self$params) {
 
     # Render title
     elems <- self$setup_elements(params, self$elements, theme)

From b10a901b1330581b19b4f84c22d48f113cbe4587 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 9 Nov 2023 14:22:30 +0100
Subject: [PATCH 08/10] keep custom guides when there are no scales

---
 R/plot-build.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/plot-build.R b/R/plot-build.R
index 10ffaa9ae5..ab6a3aba01 100644
--- a/R/plot-build.R
+++ b/R/plot-build.R
@@ -94,8 +94,8 @@ ggplot_build.ggplot <- function(plot) {
     plot$guides <- plot$guides$build(npscales, plot$layers, plot$labels, data)
     data <- lapply(data, npscales$map_df)
   } else {
-    # Assign empty guides if there are no non-position scales
-    plot$guides <- guides_list()
+    # Only keep custom guides if there are no non-position scales
+    plot$guides <- plot$guides$get_custom()
   }
 
   # Fill in defaults etc.

From 3fe1402a54211e13bcda3d69a1c59c9c04c693e7 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Thu, 9 Nov 2023 14:22:51 +0100
Subject: [PATCH 09/10] sort grobs after drawing

---
 R/guides-.R | 1 +
 1 file changed, 1 insertion(+)

diff --git a/R/guides-.R b/R/guides-.R
index d8167d4763..10fa207349 100644
--- a/R/guides-.R
+++ b/R/guides-.R
@@ -513,6 +513,7 @@ Guides <- ggproto(
     if (length(grobs) < 1) {
       return(zeroGrob())
     }
+    grobs <- grobs[order(names(grobs))]
 
     # Set spacing
     theme$legend.spacing   <- theme$legend.spacing    %||% unit(0.5, "lines")

From e47c75606318282288c2aa108be083289ea83be6 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Mon, 4 Dec 2023 16:46:59 +0100
Subject: [PATCH 10/10] Add news bullet

---
 NEWS.md | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index 359d54ffb9..9a09c4a319 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* New `guide_custom()` function for drawing custom graphical objects (grobs)
+  unrelated to scales in legend positions (#5416).
+
 * Contour functions will not fail when `options("OutDec")` is not `.` (@eliocamp, #5555).
 
 * The `legend.key` theme element is set to inherit from the `panel.background`