Use S7::method(print) for S7 classes

Author: teunbrand

NAMESPACE

@@ -72,10 +72,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)

R/aes.R

@@ -131,22 +131,22 @@ 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")
-
-  if (length(x) == 0) {
-    cat("<empty>\n")
-  } else {
-    values <- vapply(x, quo_label, character(1))
-    bullets <- paste0("* ", format(paste0("`", names(x), "`")), " -> ", values, "\n")
+local({
+  S7::method(print, class_mapping) <- function(x, ...) {
+    cat("Aesthetic mapping: \n")
 
-    cat(bullets, sep = "")
-  }
+    if (length(x) == 0) {
+      cat("<empty>\n")
+    } else {
+      values <- vapply(x, quo_label, character(1))
+      bullets <- paste0("* ", format(paste0("`", names(x), "`")), " -> ", values, "\n")
 
-  invisible(x)
-}
+      cat(bullets, sep = "")
+    }
 
+    invisible(x)
+  }
+})
 
 local({
   S7::method(`[`, class_mapping) <- function(x, i, ...) {

R/plot.R

@@ -179,10 +179,8 @@ is.ggplot <- function(x) {
 #' @param ... other arguments not used by this method
 #' @keywords hplot
 #' @return Invisibly returns the original plot.
-#' @export
-#' @method print ggplot2::ggplot
 #' @name print.ggplot
-#' @aliases print.ggplot2::ggplot plot.ggplot2::ggplot
+#' @aliases plot.ggplot
 #' @examples
 #' colours <- c("class", "drv", "fl")
 #'
@@ -196,38 +194,38 @@ is.ggplot <- function(x) {
 #'   print(ggplot(mpg, aes(displ, hwy, colour = .data[[colour]])) +
 #'           geom_point())
 #' }
-# TODO: should convert to proper S7 method once bug in S7 is resolved
-`print.ggplot2::ggplot` <- function(x, newpage = is.null(vp), vp = NULL, ...) {
-  set_last_plot(x)
-  if (newpage) grid.newpage()
-
-  # Record dependency on 'ggplot2' on the display list
-  # (AFTER grid.newpage())
-  grDevices::recordGraphics(
-    requireNamespace("ggplot2", quietly = TRUE),
-    list(),
-    getNamespace("ggplot2")
-  )
+local({
+  S7::method(print, class_ggplot) <- S7::method(plot, class_ggplot) <-
+    function(x, newpage = is.null(vp), vp = NULL, ...) {
+      set_last_plot(x)
+      if (newpage) grid.newpage()
 
-  data <- ggplot_build(x)
+      # Record dependency on 'ggplot2' on the display list
+      # (AFTER grid.newpage())
+      grDevices::recordGraphics(
+        requireNamespace("ggplot2", quietly = TRUE),
+        list(),
+        getNamespace("ggplot2")
+      )
 
-  gtable <- ggplot_gtable(data)
-  if (is.null(vp)) {
-    grid.draw(gtable)
-  } else {
-    if (is.character(vp)) seekViewport(vp) else pushViewport(vp)
-    grid.draw(gtable)
-    upViewport()
-  }
+      data <- ggplot_build(x)
 
-  if (isTRUE(getOption("BrailleR.VI")) && rlang::is_installed("BrailleR")) {
-    print(asNamespace("BrailleR")$VI(x))
-  }
+      gtable <- ggplot_gtable(data)
+      if (is.null(vp)) {
+        grid.draw(gtable)
+      } else {
+        if (is.character(vp)) seekViewport(vp) else pushViewport(vp)
+        grid.draw(gtable)
+        upViewport()
+      }
 
-  invisible(x)
-}
+      if (isTRUE(getOption("BrailleR.VI")) && rlang::is_installed("BrailleR")) {
+        print(asNamespace("BrailleR")$VI(x))
+      }
 
-S7::method(plot, class_ggplot) <- `print.ggplot2::ggplot`
+      invisible(x)
+    }
+})
 
 # The following extractors and subassignment operators are for a smooth
 # transition and should be deprecated in the release cycle after 4.0.0

R/theme-elements.R

@@ -354,8 +354,11 @@ element_geom <- S7::new_class(
   fill = NULL, colour = NULL
 )
 
-#' @export
-print.element <- function(x, ...) utils::str(x)
+local({
+  S7::method(print, element) <- function(x, ...) {
+    utils::str(x)
+  }
+})
 
 #' @export
 #' @param type For testing elements: the type of element to expect. One of

R/theme.R

@@ -1054,7 +1054,7 @@ local({
   S7::method(`$`, class_theme) <- function(x, ...) {
     .subset2(x, ...)
   }
+  S7::method(print, class_theme) <- function(x, ...) {
+    utils::str(x)
+  }
 })
-
-#' @export
-`print.ggplot2::theme` <- function(x, ...) utils::str(x)