Adding Layout slot to ggplot object

R/layout.R

@@ -6,21 +6,17 @@
 # This includes managing the parameters for the facet and the coord
 # so that we don't modify the ggproto object in place.
 
-#' create_layout
-#'
-#' This S3 method is called within `ggplot_build.ggplot` method and
-#' allows package developers to have control over how the Layout object
-#' is made by exporting their own `create_layout` method for their subclassed
-#' ggplot object.
-#'
-#' @param plot plotting object
-#' @return Layout ggproto object
-#' @export
-create_layout <- function(plot) UseMethod("create_layout", plot)
-
-#' @export
-create_layout.ggplot <- function(plot) {
-  ggproto(NULL, Layout, facet = plot$facet, coord = plot$coordinates)
+create_layout <- function(facet, coord, layout = NULL) {
+  layout <- layout %||% Layout
+  if (!inherits(layout, "Layout"))
+    cli::cli_abort(
+      c(
+        "issue with ggproto layout",
+        "i" = "The supplied ggproto should inherit from {.cls Layout}",
+        "x" = "not {.cl {class(layout)}"
+      )
+    )
+  ggproto(NULL, layout, facet = facet, coord = coord)
 }
 
 #' @rdname ggplot2-ggproto

R/plot-build.R

@@ -46,7 +46,7 @@ ggplot_build.ggplot <- function(plot) {
 
   # Initialise panels, add extra data for margins & missing faceting
   # variables, and add on a PANEL variable to data
-  layout <- create_layout(plot)
+  layout <- create_layout(plot$facet, plot$coordinates, plot$layout)
   data <- layout$setup(data, plot$data, plot$plot_env)
 
   # Compute aesthetics to produce data with generalised variable names

R/plot.R

@@ -127,7 +127,8 @@ ggplot.default <- function(data = NULL, mapping = aes(), ...,
     theme = list(),
     coordinates = coord_cartesian(default = TRUE),
     facet = facet_null(),
-    plot_env = environment
+    plot_env = environment,
+    layout = Layout
   ), class = c("gg", "ggplot"))
 
   p$labels <- make_labels(mapping)

tests/testthat/test-facet-layout.R

@@ -4,7 +4,7 @@ c <- data_frame(b = 3)
 empty <- data_frame()
 
 panel_layout <- function(facet, data) {
-  layout <- ggproto(NULL, Layout, facet = facet, coord = CoordCartesian)
+  layout <- create_layout(facet = facet, coord = CoordCartesian)
   layout$setup(data)
   layout$layout
 }

tests/testthat/test-facet-map.R

@@ -4,7 +4,7 @@ df_b <- unique(df["b"])
 df_c <- unique(data_frame(c = 1))
 
 panel_map_one <- function(facet, data, plot_data = data) {
-  layout <- ggproto(NULL, Layout, facet = facet, coord = CoordCartesian)
+  layout <- create_layout(facet = facet, coord = CoordCartesian)
   layout$setup(list(data), plot_data)[[1]]
 }