Old S3 guide wrapper (#5319)

* S3 guide necromancy

* Wrap old guide system in ggproto

* Validate old guides

* Add test for old S3 guides

* Add NEWS bullet

Author: teunbrand

DESCRIPTION

@@ -181,6 +181,7 @@ Collate:
     'guide-colorsteps.R'
     'layer.R'
     'guide-none.R'
+    'guide-old.R'
     'guides-.R'
     'guides-grid.R'
     'hexbin.R'

NAMESPACE

@@ -75,6 +75,11 @@ S3method(grobWidth,absoluteGrob)
 S3method(grobWidth,zeroGrob)
 S3method(grobX,absoluteGrob)
 S3method(grobY,absoluteGrob)
+S3method(guide_gengrob,default)
+S3method(guide_geom,default)
+S3method(guide_merge,default)
+S3method(guide_train,default)
+S3method(guide_transform,default)
 S3method(heightDetails,titleGrob)
 S3method(heightDetails,zeroGrob)
 S3method(interleave,default)
@@ -211,6 +216,7 @@ export(GuideColourbar)
 export(GuideColoursteps)
 export(GuideLegend)
 export(GuideNone)
+export(GuideOld)
 export(Layout)
 export(Position)
 export(PositionDodge)
@@ -416,8 +422,13 @@ export(guide_colorbar)
 export(guide_colorsteps)
 export(guide_colourbar)
 export(guide_coloursteps)
+export(guide_gengrob)
+export(guide_geom)
 export(guide_legend)
+export(guide_merge)
 export(guide_none)
+export(guide_train)
+export(guide_transform)
 export(guides)
 export(has_flipped_aes)
 export(is.Coord)
@@ -451,6 +462,7 @@ export(mean_se)
 export(median_hilow)
 export(merge_element)
 export(new_guide)
+export(old_guide)
 export(panel_cols)
 export(panel_rows)
 export(position_dodge)

NEWS.md

@@ -27,6 +27,13 @@
   in ggproto. The axes and legends now inherit from a <Guide> class, which makes
   them extensible in the same manner as geoms, stats, facets and coords 
   (#3329, @teunbrand). In addition, the following changes were made:
+    * A fallback for old S3 guides is encapsulated in the `GuideOld` ggproto
+      class, which mostly just calls the old S3 generics.
+    * While the S3 guide generics are still in place, the S3 methods for 
+      `guide_train()`, `guide_merge()`, `guide_geom()`, `guide_transform()`,
+      `guide_gengrob()` have been superseded by the respective ggproto methods.
+      In practise, this will mean that `NextMethod()` or sub-classing ggplot2's
+      guides with the S3 system will no longer work.
     * Styling theme parts of the guide now inherit from the plot's theme 
       (#2728). 
     * Styling non-theme parts of the guides accept <element> objects, so that

R/guide-old.R

@@ -0,0 +1,119 @@
+
+#' The previous S3 guide system
+#'
+#' The guide system has been overhauled to use the ggproto infrastructure to
+#' accommodate guide extensions with the same flexibility as layers, scales and
+#' other ggplot2 objects. In rewriting, the old S3 system has become defunct,
+#' meaning that the previous methods for guides have been superseded by ggproto
+#' methods. As a fallback option, the generics, but not the methods, that the
+#' previous S3 system used are encapsulated in the `GuideOld` ggproto class.
+#'
+#' @param guide An old guide object
+#' @keywords internal
+#' @name old_guide
+
+#' @export
+#' @rdname old_guide
+guide_train <- function(guide, scale, aesthetic = NULL) {
+  UseMethod("guide_train")
+}
+
+#' @export
+guide_train.default <- function(guide, ...) {
+  cli::cli_abort(c(
+    "{.cls Guide} classes have been rewritten as {.cls ggproto} classes.",
+    "The old S3 guide methods have been superseded."
+  ))
+}
+
+#' @export
+#' @rdname old_guide
+guide_merge <- function(guide, new_guide) {
+  UseMethod("guide_merge")
+}
+
+#' @export
+guide_merge.default <- guide_train.default
+
+#' @export
+#' @rdname old_guide
+guide_geom <- function(guide, layers, default_mapping = NULL) {
+  UseMethod("guide_geom")
+}
+
+#' @export
+guide_geom.default <- guide_train.default
+
+#' @export
+#' @rdname old_guide
+guide_transform <- function(guide, coord, panel_params) {
+  UseMethod("guide_transform")
+}
+
+#' @export
+guide_transform.default <- guide_train.default
+
+#' @export
+#' @rdname old_guide
+guide_gengrob <- function(guide, theme) {
+  UseMethod("guide_gengrob")
+}
+
+#' @export
+guide_gengrob.default <- guide_train.default
+
+#' @export
+#' @rdname old_guide
+old_guide <- function(guide) {
+  deprecate_warn0(
+    when = "3.5.0",
+    what = I("The S3 guide system"),
+    details = c(
+      i = "It has been replaced by a ggproto system that can be extended."
+    )
+  )
+
+  ggproto(
+    NULL, GuideOld,
+    params = guide,
+    available_aes = guide$available_aes %||% NULL
+  )
+}
+
+#' @rdname ggplot2-ggproto
+#' @format NULL
+#' @usage NULL
+#' @export
+GuideOld <- ggproto(
+  "GuideOld", Guide,
+
+  train = function(self, params, scale, aesthetic = NULL,
+                   title = NULL, direction = NULL) {
+    params <- guide_train(params, scale, aesthetic)
+    params$title <- params$title %|W|% title
+    params$direction <- params$direction %||% direction
+    params
+  },
+
+  merge = function(self, params, new_guide, new_params) {
+    guide_merge(params, new_params)
+  },
+
+  transform = function(self, params, coord, panel_params, ...) {
+    guide_transform(params, coord, panel_params)
+  },
+
+  get_layer_key = function(params, layers) {
+    guide_geom(params, layers, default_mapping = NULL)
+  },
+
+  draw = function(self, theme, params) {
+    params$title.position <- params$title.position %||% switch(
+      params$direction %||% "placeholder",
+      vertical = "top", horizontal = "left",
+      NULL
+    )
+    guide_gengrob(params, theme)
+  }
+)
+

R/guides-.R

@@ -635,8 +635,10 @@ validate_guide <- function(guide) {
     }
   }
   if (inherits(guide, "Guide")) {
-    guide
-  } else {
-    cli::cli_abort("Unknown guide: {guide}")
+    return(guide)
+  }
+  if (inherits(guide, "guide") && is.list(guide)) {
+    return(old_guide(guide))
   }
+  cli::cli_abort("Unknown guide: {guide}")
 }

man/ggplot2-ggproto.Rd

@@ -80,3 +80,8 @@
     The `guide` argument in `scale_*()` cannot be `FALSE`. This was deprecated in ggplot2 3.3.4.
     i Please use "none" instead.
 
+# old S3 guides can be implemented
+
+    The S3 guide system was deprecated in ggplot2 3.5.0.
+    i It has been replaced by a ggproto system that can be extended.
+