diff --git a/DESCRIPTION b/DESCRIPTION index 22f4670da0..218c8a88bd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -181,6 +181,7 @@ Collate: 'guide-colorsteps.R' 'layer.R' 'guide-none.R' + 'guide-old.R' 'guides-.R' 'guides-grid.R' 'hexbin.R' diff --git a/NAMESPACE b/NAMESPACE index 41676e5022..eb67c79182 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index fb27331f34..7a9eb66130 100644 --- a/NEWS.md +++ b/NEWS.md @@ -27,6 +27,13 @@ in ggproto. The axes and legends now inherit from a 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 objects, so that diff --git a/R/guide-old.R b/R/guide-old.R new file mode 100644 index 0000000000..735dc96f21 --- /dev/null +++ b/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) + } +) + diff --git a/R/guides-.R b/R/guides-.R index 7ab099aef7..f8273d07e6 100644 --- a/R/guides-.R +++ b/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}") } diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index 69939d4a82..a74d8877e8 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -4,17 +4,17 @@ % R/geom-raster.R, R/annotation-raster.R, R/axis-secondary.R, R/coord-.R, % R/coord-cartesian-.R, R/coord-fixed.R, R/coord-flip.R, R/coord-map.R, % R/coord-polar.R, R/coord-quickmap.R, R/coord-transform.R, R/facet-.R, -% R/facet-grid-.R, R/facet-null.R, R/facet-wrap.R, R/stat-.R, -% R/geom-abline.R, R/geom-rect.R, R/geom-bar.R, R/geom-blank.R, -% R/geom-boxplot.R, R/geom-col.R, R/geom-path.R, R/geom-contour.R, -% R/geom-crossbar.R, R/geom-segment.R, R/geom-curve.R, R/geom-ribbon.R, -% R/geom-density.R, R/geom-density2d.R, R/geom-dotplot.R, R/geom-errorbar.R, -% R/geom-errorbarh.R, R/geom-function.R, R/geom-hex.R, R/geom-hline.R, -% R/geom-label.R, R/geom-linerange.R, R/geom-point.R, R/geom-pointrange.R, -% R/geom-quantile.R, R/geom-rug.R, 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/layout.R, R/position-.R, +% R/facet-grid-.R, R/facet-null.R, R/facet-wrap.R, R/stat-.R, R/geom-abline.R, +% R/geom-rect.R, R/geom-bar.R, R/geom-blank.R, R/geom-boxplot.R, R/geom-col.R, +% R/geom-path.R, R/geom-contour.R, R/geom-crossbar.R, R/geom-segment.R, +% R/geom-curve.R, R/geom-ribbon.R, R/geom-density.R, R/geom-density2d.R, +% R/geom-dotplot.R, R/geom-errorbar.R, R/geom-errorbarh.R, R/geom-function.R, +% R/geom-hex.R, R/geom-hline.R, R/geom-label.R, R/geom-linerange.R, +% R/geom-point.R, R/geom-pointrange.R, R/geom-quantile.R, R/geom-rug.R, +% 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/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, @@ -94,6 +94,7 @@ \alias{GuideColourbar} \alias{GuideColoursteps} \alias{GuideNone} +\alias{GuideOld} \alias{Layout} \alias{Position} \alias{PositionDodge} diff --git a/man/old_guide.Rd b/man/old_guide.Rd new file mode 100644 index 0000000000..3b2a36d5ff --- /dev/null +++ b/man/old_guide.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guide-old.R +\name{old_guide} +\alias{old_guide} +\alias{guide_train} +\alias{guide_merge} +\alias{guide_geom} +\alias{guide_transform} +\alias{guide_gengrob} +\title{The previous S3 guide system} +\usage{ +guide_train(guide, scale, aesthetic = NULL) + +guide_merge(guide, new_guide) + +guide_geom(guide, layers, default_mapping = NULL) + +guide_transform(guide, coord, panel_params) + +guide_gengrob(guide, theme) + +old_guide(guide) +} +\arguments{ +\item{guide}{An old guide object} +} +\description{ +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 \code{GuideOld} ggproto class. +} +\keyword{internal} diff --git a/tests/testthat/_snaps/guides.md b/tests/testthat/_snaps/guides.md index f088f31f7d..6fb109ecbd 100644 --- a/tests/testthat/_snaps/guides.md +++ b/tests/testthat/_snaps/guides.md @@ -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. + diff --git a/tests/testthat/_snaps/guides/old-s3-guide-drawing-a-circle.svg b/tests/testthat/_snaps/guides/old-s3-guide-drawing-a-circle.svg new file mode 100644 index 0000000000..35af42a85f --- /dev/null +++ b/tests/testthat/_snaps/guides/old-s3-guide-drawing-a-circle.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +10 +15 +20 +25 +30 +35 + + + + + + + +mpg +old S3 guide drawing a circle + + diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 4a3f7ed64d..4ef7174f99 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -770,3 +770,56 @@ test_that("guides() errors if unnamed guides are provided", { "The 2nd guide is unnamed" ) }) + +test_that("old S3 guides can be implemented", { + + my_env <- env() + my_env$guide_circle <- function() { + structure( + list(available_aes = c("x", "y"), position = "bottom"), + class = c("guide", "circle") + ) + } + + registerS3method( + "guide_train", "circle", + function(guide, ...) guide, + envir = my_env + ) + registerS3method( + "guide_transform", "circle", + function(guide, ...) guide, + envir = my_env + ) + registerS3method( + "guide_merge", "circle", + function(guide, ...) guide, + envir = my_env + ) + registerS3method( + "guide_geom", "circle", + function(guide, ...) guide, + envir = my_env + ) + registerS3method( + "guide_gengrob", "circle", + function(guide, ...) { + absoluteGrob( + gList(circleGrob()), + height = unit(1, "cm"), width = unit(1, "cm") + ) + }, + envir = my_env + ) + + withr::local_environment(my_env) + + expect_snapshot_warning( + expect_doppelganger( + "old S3 guide drawing a circle", + ggplot(mtcars, aes(disp, mpg)) + + geom_point() + + guides(x = "circle") + ) + ) +})