Streamline S7 parts

DESCRIPTION

@@ -93,10 +93,10 @@ Collate:
     'aes-group-order.R'
     'aes-linetype-size-shape.R'
     'aes-position.R'
+    'all-classes.R'
     'compat-plyr.R'
     'utilities.R'
     'aes.R'
-    'all-classes.R'
     'annotation-borders.R'
     'utilities-checks.R'
     'legend-draw.R'

NAMESPACE

@@ -1,23 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method("$","ggplot2::element")
-S3method("$","ggplot2::gg")
-S3method("$","ggplot2::theme")
 S3method("$",ggproto)
 S3method("$",ggproto_parent)
 S3method("$<-","ggplot2::element")
 S3method("$<-","ggplot2::gg")
 S3method("$<-","ggplot2::mapping")
-S3method("[","ggplot2::element")
-S3method("[","ggplot2::gg")
-S3method("[","ggplot2::mapping")
 S3method("[",mapped_discrete)
 S3method("[<-","ggplot2::element")
 S3method("[<-","ggplot2::gg")
 S3method("[<-","ggplot2::mapping")
 S3method("[<-",mapped_discrete)
-S3method("[[","ggplot2::element")
-S3method("[[","ggplot2::gg")
 S3method("[[",ggproto)
 S3method("[[<-","ggplot2::element")
 S3method("[[<-","ggplot2::gg")
@@ -29,7 +21,6 @@ S3method(autolayer,default)
 S3method(autoplot,default)
 S3method(c,mapped_discrete)
 S3method(drawDetails,zeroGrob)
-S3method(element_grob,default)
 S3method(format,ggproto)
 S3method(format,ggproto_method)
 S3method(format,rd_section_aesthetics)
@@ -59,8 +50,6 @@ S3method(fortify,tbl_df)
 S3method(ggplot,"function")
 S3method(ggplot,default)
 S3method(ggplot_add,default)
-S3method(ggplot_build,default)
-S3method(ggplot_gtable,default)
 S3method(grid.draw,absoluteGrob)
 S3method(grobHeight,absoluteGrob)
 S3method(grobHeight,zeroGrob)
@@ -92,10 +81,6 @@ S3method(predictdf,default)
 S3method(predictdf,glm)
 S3method(predictdf,locfit)
 S3method(predictdf,loess)
-S3method(print,"ggplot2::ggplot")
-S3method(print,"ggplot2::mapping")
-S3method(print,"ggplot2::theme")
-S3method(print,element)
 S3method(print,ggplot2_bins)
 S3method(print,ggproto)
 S3method(print,ggproto_method)
@@ -292,7 +277,6 @@ export(autoplot)
 export(benchplot)
 export(binned_scale)
 export(borders)
-export(build_ggplot)
 export(calc_element)
 export(check_device)
 export(class_ggplot)
@@ -321,7 +305,6 @@ export(cut_width)
 export(datetime_scale)
 export(derive)
 export(discrete_scale)
-export(draw_element)
 export(draw_key_abline)
 export(draw_key_blank)
 export(draw_key_boxplot)
@@ -445,7 +428,6 @@ export(ggproto)
 export(ggproto_parent)
 export(ggsave)
 export(ggtitle)
-export(gtable_ggplot)
 export(guide_axis)
 export(guide_axis_logticks)
 export(guide_axis_stack)

R/aes.R

@@ -1,4 +1,4 @@
-#' @include utilities.R compat-plyr.R
+#' @include utilities.R compat-plyr.R all-classes.R
 NULL
 
 #' Construct aesthetic mappings
@@ -131,40 +131,40 @@ new_aesthetic <- function(x, env = globalenv()) {
 }
 
 #' @export
-# TODO: should convert to proper S7 method once bug in S7 is resolved
-`print.ggplot2::mapping` <- function(x, ...) {
-  cat("Aesthetic mapping: \n")
+local({
+  S7::method(print, class_mapping) <- function(x, ...) {
+    cat("Aesthetic mapping: \n")
 
-  if (length(x) == 0) {
-    cat("<empty>\n")
-  } else {
-    values <- vapply(x, quo_label, character(1))
-    bullets <- paste0("* ", format(paste0("`", names(x), "`")), " -> ", values, "\n")
+    if (length(x) == 0) {
+      cat("<empty>\n")
+    } else {
+      values <- vapply(x, quo_label, character(1))
+      bullets <- paste0("* ", format(paste0("`", names(x), "`")), " -> ", values, "\n")
 
-    cat(bullets, sep = "")
+      cat(bullets, sep = "")
+    }
+
+    invisible(x)
   }
+})
 
-  invisible(x)
-}
+local({
+  S7::method(`[`, class_mapping) <- function(x, i, ...) {
+    class_mapping(`[`(S7::S7_data(x), i, ...))
+  }
+})
 
-# TODO: should convert to proper S7 method once bug in S7 is resolved
 #' @export
-"[.ggplot2::mapping" <- function(x, i, ...) {
-  class_mapping(NextMethod())
+`[[<-.ggplot2::mapping` <- function(x, i, value) {
+  class_mapping(`[[<-`(S7::S7_data(x), i, value))
 }
 
-# If necessary coerce replacements to quosures for compatibility
-#' @export
-"[[<-.ggplot2::mapping" <- function(x, i, value) {
-  class_mapping(NextMethod())
-}
 #' @export
-"$<-.ggplot2::mapping" <- function(x, i, value) {
-  class_mapping(NextMethod())
-}
+`$<-.ggplot2::mapping` <- `[[<-.ggplot2::mapping`
+
 #' @export
-"[<-.ggplot2::mapping" <- function(x, i, value) {
-  class_mapping(NextMethod())
+`[<-.ggplot2::mapping` <- function(x, i, value) {
+  class_mapping(`[<-`(S7::S7_data(x), i, value))
 }
 
 #' Standardise aesthetic names

R/plot-build.R

@@ -25,19 +25,21 @@
 #' The `r link_book("build step section", "internals#sec-ggplotbuild")`
 #' @keywords internal
 #' @export
-build_ggplot <- S7::new_generic("build_ggplot", "plot", fun = function(plot, ...) {
+ggplot_build <- function(plot, ...) {
   env <- try_prop(plot, "plot_env")
   if (!is.null(env)) {
     attach_plot_env(env)
   }
-  S7::S7_dispatch()
-})
+  UseMethod("ggplot_build")
+}
 
-S7::method(build_ggplot, class_ggplot_built) <- function(plot, ...) {
+S7::method(ggplot_build, class_ggplot_built) <- function(plot, ...) {
   plot # This is a no-op
 }
 
-S7::method(build_ggplot, class_ggplot) <- function(plot, ...) {
+# The build_ggplot is a temporary concession to {thematic} after we put in
+# a compatibility PR that uses this function
+build_ggplot <- S7::method(ggplot_build, class_ggplot) <- function(plot, ...) {
   plot <- plot_clone(plot)
   if (length(plot@layers) == 0) {
     plot <- plot + geom_blank()
@@ -136,29 +138,17 @@ S7::method(build_ggplot, class_ggplot) <- function(plot, ...) {
   build
 }
 
-# TODO: the S3 generic should be phased out once S7 is adopted more widely
-#' @rdname build_ggplot
-#' @export
-ggplot_build <- function(plot, ...) {
-  UseMethod("ggplot_build")
-}
-
-#' @export
-ggplot_build.default <- function(plot, ...) {
-  build_ggplot(plot)
-}
-
 #' @export
-#' @rdname build_ggplot
+#' @rdname ggplot_build
 get_layer_data <- function(plot = get_last_plot(), i = 1L) {
   ggplot_build(plot)@data[[i]]
 }
 #' @export
-#' @rdname build_ggplot
+#' @rdname ggplot_build
 layer_data <- get_layer_data
 
 #' @export
-#' @rdname build_ggplot
+#' @rdname ggplot_build
 get_panel_scales <- function(plot = get_last_plot(), i = 1L, j = 1L) {
   b <- ggplot_build(plot)
 
@@ -172,19 +162,19 @@ get_panel_scales <- function(plot = get_last_plot(), i = 1L, j = 1L) {
 }
 
 #' @export
-#' @rdname build_ggplot
+#' @rdname ggplot_build
 layer_scales <- get_panel_scales
 
 #' @export
-#' @rdname build_ggplot
+#' @rdname ggplot_build
 get_layer_grob <- function(plot = get_last_plot(), i = 1L) {
   b <- ggplot_build(plot)
 
   b@plot@layers[[i]]$draw_geom(b@data[[i]], b@layout)
 }
 
 #' @export
-#' @rdname build_ggplot
+#' @rdname ggplot_build
 layer_grob <- get_layer_grob
 
 #' Build a plot with all the usual bits and pieces.
@@ -208,12 +198,12 @@ layer_grob <- get_layer_grob
 #' @keywords internal
 #' @param data plot data generated by [ggplot_build()]
 #' @export
-gtable_ggplot <- S7::new_generic("gtable_ggplot", "data", function(data) {
+ggplot_gtable <- function(data) {
   attach_plot_env(data@plot@plot_env)
-  S7::S7_dispatch()
-})
+  UseMethod("ggplot_gtable")
+}
 
-S7::method(gtable_ggplot, class_ggplot_built) <- function(data) {
+S7::method(ggplot_gtable, class_ggplot_built) <- function(data) {
   plot <- data@plot
   layout <- data@layout
   data <- data@data
@@ -314,18 +304,6 @@ S7::method(gtable_ggplot, class_ggplot_built) <- function(data) {
   plot_table
 }
 
-# TODO: the S3 generic should be phased out once S7 is adopted more widely
-#' @rdname gtable_ggplot
-#' @export
-ggplot_gtable <- function(data) {
-  UseMethod("ggplot_gtable")
-}
-
-#' @export
-ggplot_gtable.default <- function(data) {
-  gtable_ggplot(data)
-}
-
 #' Generate a ggplot2 plot grob.
 #'
 #' @param x ggplot2 object