Reimplement classes in S7

DESCRIPTION

@@ -39,6 +39,7 @@ Imports:
     isoband,
     lifecycle (> 1.0.1),
     rlang (>= 1.1.0),
+    S7,
     scales (>= 1.4.0),
     stats,
     vctrs (>= 0.6.0),
@@ -93,6 +94,7 @@ Collate:
     'compat-plyr.R'
     'utilities.R'
     'aes.R'
+    'all-classes.R'
     'utilities-checks.R'
     'legend-draw.R'
     'geom-.R'
@@ -175,6 +177,8 @@ Collate:
     'grob-dotstack.R'
     'grob-null.R'
     'grouping.R'
+    'properties.R'
+    'margins.R'
     'theme-elements.R'
     'guide-.R'
     'guide-axis.R'
@@ -199,7 +203,6 @@ Collate:
     'layer-sf.R'
     'layout.R'
     'limits.R'
-    'margins.R'
     'performance.R'
     'plot-build.R'
     'plot-construction.R'

NAMESPACE

@@ -1,31 +1,34 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("$","ggplot2::element")
+S3method("$","ggplot2::gg")
+S3method("$","ggplot2::theme")
 S3method("$",ggproto)
 S3method("$",ggproto_parent)
-S3method("$",theme)
-S3method("$<-",uneval)
-S3method("+",gg)
+S3method("$<-","ggplot2::element")
+S3method("$<-","ggplot2::gg")
+S3method("$<-","ggplot2::mapping")
+S3method("[","ggplot2::element")
+S3method("[","ggplot2::gg")
+S3method("[","ggplot2::mapping")
 S3method("[",mapped_discrete)
-S3method("[",uneval)
+S3method("[<-","ggplot2::element")
+S3method("[<-","ggplot2::gg")
+S3method("[<-","ggplot2::mapping")
 S3method("[<-",mapped_discrete)
-S3method("[<-",uneval)
+S3method("[[","ggplot2::element")
+S3method("[[","ggplot2::gg")
 S3method("[[",ggproto)
-S3method("[[<-",uneval)
+S3method("[[<-","ggplot2::element")
+S3method("[[<-","ggplot2::gg")
+S3method("[[<-","ggplot2::mapping")
 S3method(.DollarNames,ggproto)
 S3method(as.data.frame,mapped_discrete)
-S3method(as.gtable,ggplot)
-S3method(as.gtable,ggplot_built)
 S3method(as.list,ggproto)
 S3method(autolayer,default)
 S3method(autoplot,default)
 S3method(c,mapped_discrete)
 S3method(drawDetails,zeroGrob)
-S3method(element_grob,element_blank)
-S3method(element_grob,element_line)
-S3method(element_grob,element_point)
-S3method(element_grob,element_polygon)
-S3method(element_grob,element_rect)
-S3method(element_grob,element_text)
 S3method(format,ggproto)
 S3method(format,ggproto_method)
 S3method(fortify,"NULL")
@@ -51,30 +54,7 @@ S3method(fortify,sfg)
 S3method(fortify,summary.glht)
 S3method(fortify,tbl)
 S3method(fortify,tbl_df)
-S3method(get_alt_text,ggplot)
-S3method(get_alt_text,ggplot_built)
-S3method(get_alt_text,gtable)
-S3method(ggplot,"function")
-S3method(ggplot,default)
-S3method(ggplot_add,"NULL")
-S3method(ggplot_add,"function")
-S3method(ggplot_add,Coord)
-S3method(ggplot_add,Facet)
-S3method(ggplot_add,Guides)
-S3method(ggplot_add,Layer)
-S3method(ggplot_add,Scale)
-S3method(ggplot_add,by)
-S3method(ggplot_add,data.frame)
-S3method(ggplot_add,default)
-S3method(ggplot_add,labels)
-S3method(ggplot_add,list)
-S3method(ggplot_add,theme)
-S3method(ggplot_add,uneval)
-S3method(ggplot_build,ggplot)
-S3method(ggplot_build,ggplot_built)
-S3method(ggplot_gtable,ggplot_built)
 S3method(grid.draw,absoluteGrob)
-S3method(grid.draw,ggplot)
 S3method(grobHeight,absoluteGrob)
 S3method(grobHeight,zeroGrob)
 S3method(grobWidth,absoluteGrob)
@@ -95,27 +75,22 @@ S3method(limits,character)
 S3method(limits,factor)
 S3method(limits,numeric)
 S3method(makeContext,dotstackGrob)
-S3method(merge_element,default)
-S3method(merge_element,element)
-S3method(merge_element,element_blank)
-S3method(merge_element,margin)
 S3method(pattern_alpha,GridPattern)
 S3method(pattern_alpha,GridTilingPattern)
 S3method(pattern_alpha,default)
 S3method(pattern_alpha,list)
-S3method(plot,ggplot)
 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,ggplot)
 S3method(print,ggplot2_bins)
 S3method(print,ggproto)
 S3method(print,ggproto_method)
 S3method(print,rel)
-S3method(print,theme)
-S3method(print,uneval)
 S3method(scale_type,Date)
 S3method(scale_type,POSIXt)
 S3method(scale_type,character)
@@ -129,7 +104,6 @@ S3method(scale_type,logical)
 S3method(scale_type,numeric)
 S3method(scale_type,ordered)
 S3method(scale_type,sfc)
-S3method(summary,ggplot)
 S3method(vec_cast,character.mapped_discrete)
 S3method(vec_cast,double.mapped_discrete)
 S3method(vec_cast,factor.mapped_discrete)
@@ -308,6 +282,11 @@ export(binned_scale)
 export(borders)
 export(calc_element)
 export(check_device)
+export(class_ggplot)
+export(class_ggplot_built)
+export(class_labels)
+export(class_mapping)
+export(class_theme)
 export(combine_vars)
 export(complete_theme)
 export(continuous_scale)
@@ -347,6 +326,7 @@ export(draw_key_vline)
 export(draw_key_vpath)
 export(dup_axis)
 export(el_def)
+export(element)
 export(element_blank)
 export(element_geom)
 export(element_grob)
@@ -766,6 +746,7 @@ export(xlim)
 export(ylab)
 export(ylim)
 export(zeroGrob)
+if (getRversion() < "4.3.0") importFrom("S7", "@")
 import(grid)
 import(gtable)
 import(rlang)

R/aes.R

@@ -46,8 +46,8 @@ NULL
 #' 'AsIs' variables.
 #'
 #' @family aesthetics documentation
-#' @return A list with class `uneval`. Components of the list are either
-#'   quosures or constants.
+#' @return An S7 object representing a list with class `mapping`. Components of
+#'   the list are either quosures or constants.
 #' @export
 #' @examples
 #' aes(x = mpg, y = wt)
@@ -105,13 +105,12 @@ aes <- function(x, y, ...) {
     inject(aes(!!!args))
   })
 
-  aes <- new_aes(args, env = parent.frame())
-  rename_aes(aes)
+  class_mapping(rename_aes(args), env = parent.frame())
 }
 
 #' @export
 #' @rdname is_tests
-is_mapping <- function(x) inherits(x, "uneval")
+is_mapping <- function(x) S7::S7_inherits(x, class_mapping)
 
 # Wrap symbolic objects in quosures but pull out constants out of
 # quosures for backward-compatibility
@@ -130,14 +129,10 @@ new_aesthetic <- function(x, env = globalenv()) {
 
   x
 }
-new_aes <- function(x, env = globalenv()) {
-  check_object(x, is.list, "a {.cls list}")
-  x <- lapply(x, new_aesthetic, env = env)
-  structure(x, class = "uneval")
-}
 
 #' @export
-print.uneval <- function(x, ...) {
+# TODO: should convert to proper S7 method once bug in S7 is resolved
+`print.ggplot2::mapping` <- function(x, ...) {
   cat("Aesthetic mapping: \n")
 
   if (length(x) == 0) {
@@ -152,26 +147,24 @@ print.uneval <- function(x, ...) {
   invisible(x)
 }
 
+# TODO: should convert to proper S7 method once bug in S7 is resolved
 #' @export
-"[.uneval" <- function(x, i, ...) {
-  new_aes(NextMethod())
+"[.ggplot2::mapping" <- function(x, i, ...) {
+  class_mapping(NextMethod())
 }
 
 # If necessary coerce replacements to quosures for compatibility
 #' @export
-"[[<-.uneval" <- function(x, i, value) {
-  new_aes(NextMethod())
+"[[<-.ggplot2::mapping" <- function(x, i, value) {
+  class_mapping(NextMethod())
 }
 #' @export
-"$<-.uneval" <- function(x, i, value) {
-  # Can't use NextMethod() because of a bug in R 3.1
-  x <- unclass(x)
-  x[[i]] <- value
-  new_aes(x)
+"$<-.ggplot2::mapping" <- function(x, i, value) {
+  class_mapping(NextMethod())
 }
 #' @export
-"[<-.uneval" <- function(x, i, value) {
-  new_aes(NextMethod())
+"[<-.ggplot2::mapping" <- function(x, i, value) {
+  class_mapping(NextMethod())
 }
 
 #' Standardise aesthetic names
@@ -212,8 +205,7 @@ substitute_aes <- function(x, fun = standardise_aes_symbols, ...) {
   x <- lapply(x, function(aesthetic) {
     as_quosure(fun(quo_get_expr(aesthetic), ...), env = environment(aesthetic))
   })
-  class(x) <- "uneval"
-  x
+  class_mapping(x)
 }
 # x is a quoted expression from inside aes()
 standardise_aes_symbols <- function(x) {
@@ -311,7 +303,7 @@ aes_ <- function(x, y, ...) {
     }
   }
   mapping <- lapply(mapping, as_quosure_aes)
-  structure(rename_aes(mapping), class = "uneval")
+  class_mapping(rename_aes(mapping))
 }
 
 #' @rdname aes_
@@ -337,7 +329,7 @@ aes_string <- function(x, y, ...) {
     new_aesthetic(x, env = caller_env)
   })
 
-  structure(rename_aes(mapping), class = "uneval")
+  class_mapping(rename_aes(mapping))
 }
 
 #' @export
@@ -358,10 +350,9 @@ aes_all <- function(vars) {
 
   # Quosure the symbols in the empty environment because they can only
   # refer to the data mask
-  structure(
-    lapply(vars, function(x) new_quosure(as.name(x), emptyenv())),
-    class = c("unlabelled_uneval", "uneval")
-  )
+  x <- class_mapping(lapply(vars, function(x) new_quosure(as.name(x), emptyenv())))
+  class(x) <- union("unlabelled", class(x))
+  x
 }
 
 #' Automatic aesthetic mapping