feat: define patch_options to pass layout configuration arguments

Author: Yunuuuu

NAMESPACE

@@ -449,6 +449,7 @@ importFrom(S7,methods_register)
 importFrom(S7,new_object)
 importFrom(S7,prop)
 importFrom(S7,props)
+importFrom(S7,set_props)
 importFrom(S7,super)
 importFrom(cli,cli_abort)
 importFrom(cli,cli_inform)

R/alignpatch-.R

@@ -197,16 +197,8 @@ Patch <- ggproto(
     #' [`standardized gtable`][standardized_gtable] object.
     #'
     #' **Arguments**
-    #' - `theme`: The global [`theme`][ggplot2::theme] of the parent
-    #'   [`alignpatches()`] object.
-    #' - `guides`: Specifies which sides of guide legends should be collected by
-    #'   the parent [`alignpatches()`] object. In most cases, this is the value
-    #'   returned by the subplot's `self$guides()` method. For plots along the
-    #'   border, any guide legends on that side will always be collected if any
-    #'   legends on that side of any subplot are being collected.
-    #' - `tagger`: Either `NULL` (no tagging) or a `LayoutTagger` object that
-    #'   provides a `$tag_table` method (accepting the `gtable` and `theme`)
-    #'   used to add tag.
+    #' - `options`: A [`patch_options`] object that contains various layout
+    #'   options.
     #'
     #' **Value**
     #' A standardized [`gtable`][gtable::gtable] object, or a simple
@@ -216,7 +208,7 @@ Patch <- ggproto(
     #' be a full table-based layout (`gtable`) for more complex arrangements or
     #' a simpler graphical object (`grob`) when only basic plot elements are
     #' involved.
-    gtable = function(self, theme = NULL, guides = NULL, tagger = NULL) {
+    gtable = function(self, options) {
         cli_abort("{.fn gtable} method is not defined")
     },
 

R/alignpatch-alignpatches.R

@@ -145,19 +145,40 @@ S7::method(patch, alignpatches) <- function(x) {
 
 ##############################################################
 # For z in the gtable layout
+# 0L: layout background
+# 1L: background of the plot
+# 2L: plot table
+# 3L: foreground of the panel area
+# 4L: legends
+# 5L: tags
 LAYOUT_BACKGROUND_Z <- 0L
 PLOT_BACKGROUND_Z <- 1L
 PLOT_TABLE_Z <- 2L
 LAYOUT_FOREGROUND_Z <- 3L
 GUIDE_LEGENDS_Z <- 4L
 TAGS_Z <- 5L
 
-# 0L: layout background
-# 1L: background of the plot
-# 2L: plot table
-# 3L: foreground of the panel area
-# 4L: legends
-# 5L: tags
+#' Options passed to the Patch `gtable` method
+#'
+#' This class defines the options that can be passed to the `gtable` method of a
+#' `Patch` object.  It includes:
+#'
+#' - `theme`: The theme to be applied, which can be either `NULL` or a ggplot2
+#'   [theme][ggplot2::theme] object.
+#' - `guides`: The guides for the plot, which can be `NULL` or a character
+#'   vector.
+#' - `tagger`: Either `NULL` (no tagging) or a `LayoutTagger` object that
+#'   provides a `$tag_table` method (accepting the `gtable` and `theme`)
+#'   used to add tag.
+#'
+#' @keywords internal
+patch_options <- S7::new_class("patch_options",
+    properties = list(
+        theme = S7::new_union(NULL, ggplot2::class_theme),
+        guides = S7::new_union(NULL, S7::class_character),
+        tagger = S7::new_union(NULL, S7::new_S3_class("ggalign::LayoutTagger"))
+    )
+)
 
 #' @importFrom ggplot2 ggproto
 #' @noRd
@@ -166,12 +187,12 @@ PatchAlignpatches <- ggproto(
     #' @importFrom gtable gtable gtable_add_grob
     #' @importFrom grid unit
     #' @importFrom ggplot2 wrap_dims calc_element zeroGrob theme_get
-    #' @importFrom S7 prop
-    gtable = function(self, theme = NULL, guides = NULL, tagger = NULL) {
+    #' @importFrom S7 prop prop<- set_props
+    gtable = function(self, options) {
         patches <- lapply(prop(self$plot, "plots"), function(p) {
             out <- patch(p)
             if (!is.null(out) &&
-                !inherits(out, sprintf("%s::Patch", pkg_nm()))) {
+                !inherits(out, "ggalign::Patch")) {
                 cli_abort("{.fn alignpatch} must return a {.cls Patch} object")
             }
             out
@@ -234,7 +255,8 @@ PatchAlignpatches <- ggproto(
         }
 
         # we define the global theme --------------------------
-        if (is.null(theme)) { # No parent theme provided
+        # No parent theme provided
+        if (is.null(theme <- prop(options, "theme"))) {
             top_level <- TRUE
             # by default, we use ggplot2 default theme
             theme <- prop(self$plot, "theme")
@@ -243,9 +265,10 @@ PatchAlignpatches <- ggproto(
             theme <- theme + prop(self$plot, "theme")
         }
         theme <- complete_theme(theme)
+        prop(options, "theme", check = FALSE) <- theme
 
         # by default, we won't collect any guide legends
-        collected <- guides
+        collected <- prop(options, "guides")
         guides <- prop(layout, "guides")
         if (is_string(guides)) {
             guides <- setup_guides(guides)
@@ -268,15 +291,17 @@ PatchAlignpatches <- ggproto(
         # - A single string representing the tag for the entire layout,
         # - NULL, meaning no tagging,
         # - Or a `LayoutTagger` object used to tag each plot individually.
-        tagger <- create_layout_tagger(prop(self$plot, "tags"), tagger)
-        if (!is.null(tagger) && !inherits(tagger, "LayoutTagger")) {
-            # If tagger is not a LayoutTagger, treat it as a single tag for the
-            # whole layout
-            tag <- tagger
-            tagger <- NULL
-        } else {
-            # Otherwise, no single tag for the whole layout
+        tag <- create_layout_tagger(
+            prop(self$plot, "tags"),
+            prop(options, "tagger")
+        )
+        if (is.null(tag) || inherits(tag, "ggalign::LayoutTagger")) {
+            prop(options, "tagger", check = FALSE) <- tag
             tag <- NULL
+        } else {
+            # If tag is a single string, treat it as a single tag for the
+            # whole layout
+            prop(options, "tagger", check = FALSE) <- NULL
         }
 
         # Let each patch to determine whether to collect guides
@@ -299,7 +324,7 @@ PatchAlignpatches <- ggproto(
                 .subset2(guides, i),
                 intersect(border_with_guides, .subset2(borders_list, i))
             )
-            gt <- patch$gtable(theme, g, tagger)
+            gt <- patch$gtable(set_props(options, guides = g))
             components <- patch$decompose_guides(gt, g)
             guides_list[i] <- list(.subset2(components, "guides"))
             gt_list[i] <- list(.subset2(components, "gt"))

R/alignpatch-build.R

@@ -12,7 +12,7 @@ S7::method(ggalign_build, alignpatches) <- function(x) x
 #' @importFrom rlang arg_match0
 #' @importFrom S7 prop
 S7::method(ggalign_gtable, alignpatches) <- function(x) {
-    table <- patch(x)$gtable()
+    table <- patch(x)$gtable(patch_options())
 
     # ensure theme has no missing value
     theme <- complete_theme(prop(x, "theme") %||% theme_get())

R/alignpatch-ggplot2.R

@@ -57,7 +57,7 @@ grid.draw.patch_ggplot <- function(x, recording = TRUE) {
 
 ##################################################
 S7::method(ggalign_gtable, ggplot2::class_ggplot) <- function(x) {
-    patch(x)$gtable()
+    patch(x)$gtable(patch_options())
 }
 
 S7::method(ggalign_build, ggplot2::class_ggplot) <- function(x) x
@@ -80,12 +80,12 @@ S7::method(patch, ggplot2::class_ggplot) <- function(x) {
 #' @importFrom ggplot2 ggplotGrob update_labels complete_theme
 #' @include alignpatch-.R
 PatchGgplot <- ggproto("PatchGgplot", Patch,
-    gtable = function(self, theme = NULL, guides = NULL, tagger = NULL) {
+    gtable = function(self, options) {
         plot <- self$plot
-        if (is.null(theme)) {
+        if (is.null(prop(options, "theme"))) {
             theme <- plot$theme
         } else {
-            theme <- tag_theme(theme) + plot$theme
+            theme <- tag_theme(prop(options, "theme")) + plot$theme
         }
 
         # complete_theme() will ensure elements exist --------
@@ -100,7 +100,9 @@ PatchGgplot <- ggproto("PatchGgplot", Patch,
         # always add strips columns and/or rows
         ans <- add_strips(ans, self$strip_pos)
         ans <- setup_patch_title(ans, plot$ggalign_patch_title, theme = theme)
-        if (!is.null(tagger)) ans <- tagger$tag_table(ans, theme)
+        if (!is.null(prop(options, "tagger"))) {
+            ans <- prop(options, "tagger")$tag_table(ans, theme)
+        }
         ans
     },
     border_sizes = function(self, gt = NULL, free = NULL) {

R/alignpatch-inset.R

@@ -129,8 +129,8 @@ patch.ggalign_inset <- function(x) {
     ggproto(
         "PatchWrapped",
         Parent,
-        gtable = function(self, theme = NULL, guides = NULL, tagger = NULL) {
-            gt <- ggproto_parent(Parent, self)$gtable(theme, guides, tagger)
+        gtable = function(self, options) {
+            gt <- ggproto_parent(Parent, self)$gtable(options)
             # Note: When the gtable represents a facetted plot, the number
             # of rows/columns (heights or widths) will exceed
             #   TABLE_ROWS/COLS.

R/alignpatch-patchwork.R

@@ -69,8 +69,8 @@ PatchPatchworkPatch <- ggproto(
     # `patch` from `patchwork`: patchwork::plot_spacer
     #' @importFrom gtable gtable_add_rows gtable_add_cols
     #' @importFrom ggplot2 find_panel
-    gtable = function(self, theme = NULL, guides = NULL, tagger = NULL) {
-        guides <- if (length(guides)) "collect" else "keep"
+    gtable = function(self, options) {
+        guides <- if (length(prop(options, "guides"))) "collect" else "keep"
         ans <- patchwork::patchGrob(self$plot, guides = guides)
         # add rows and columns for `patch_title()`
         for (border in .TLBR) {
@@ -89,8 +89,10 @@ PatchPatchworkPatch <- ggproto(
                 ans <- gtable_add_cols(ans, unit(0, "mm"), pos = v)
             }
         }
-        if (!is.null(tagger)) {
-            ans <- tagger$tag_table(ans, theme %||% theme_get())
+        if (!is.null(tagger <- prop(options, "tagger"))) {
+            ans <- tagger$tag_table(
+                ans, prop(options, "theme") %||% theme_get()
+            )
         }
         ans
     }

R/alignpatch-tags.R

@@ -180,7 +180,7 @@ create_layout_tagger <- function(tags, parent) {
         )
     }
     ggproto(
-        "LayoutTagger", NULL,
+        "ggalign::LayoutTagger", NULL,
         tags = tags,
         prefix = prefix,
         suffix = suffix,

R/layout-chain-circle-build.R

@@ -315,17 +315,19 @@ S7::method(ggalign_gtable, CircleLayout) <- function(x) {
 S7::method(patch, CircleLayout) <- function(x) {
     build <- ggalign_build(x)
     ggproto(NULL, PatchGgplot,
-        gtable = function(self, theme = NULL, guides = NULL, tagger = NULL) {
+        gtable = function(self, options) {
             # Preserve tag-related theme settings from the original layout
             # theme. These are intentionally not overridden so that
             # `PatchAlignpatches` retains full control over tag appearance and
             # positioning.
-            if (!is.null(theme)) {
+            if (!is.null(theme <- prop(options, "theme"))) {
                 theme <- prop(build, "theme") +
                     (tag_theme(theme) + tag_theme(prop(x, "theme")))
             }
             gt <- ggalign_gtable(build)
-            if (!is.null(tagger)) gt <- tagger$tag_table(gt, theme)
+            if (!is.null(tagger <- prop(options, "tagger"))) {
+                gt <- tagger$tag_table(gt, theme)
+            }
             gt
         }
     )

R/layout-chain-stack-build.R

@@ -9,15 +9,15 @@ S7::method(ggalign_build, StackLayout) <- function(x) {
 S7::method(patch, StackLayout) <- function(x) {
     Parent <- patch(ggalign_build(x))
     ggproto(NULL, Parent,
-        gtable = function(self, theme = NULL, guides = NULL, tagger = NULL) {
+        gtable = function(self, options) {
             # Preserve tag-related theme settings from the original layout
             # theme. These are intentionally not overridden so that `Parent`
             # retains full control over tag appearance and positioning.
-            if (!is.null(theme)) {
+            if (!is.null(theme <- prop(options, "theme"))) {
                 prop(self$plot, "theme") <- prop(self$plot, "theme") +
                     (tag_theme(theme) + tag_theme(prop(x, "theme")))
             }
-            ggproto_parent(Parent, self)$gtable(theme, guides, tagger)
+            ggproto_parent(Parent, self)$gtable(options)
         }
     )
 }