S7 elements

DESCRIPTION

@@ -177,6 +177,8 @@ Collate:
     'grob-dotstack.R'
     'grob-null.R'
     'grouping.R'
+    'properties.R'
+    'margins.R'
     'theme-elements.R'
     'guide-.R'
     'guide-axis.R'
@@ -201,7 +203,6 @@ Collate:
     'layer-sf.R'
     'layout.R'
     'limits.R'
-    'margins.R'
     'performance.R'
     'plot-build.R'
     'plot-construction.R'

NAMESPACE

@@ -1,19 +1,25 @@
 # 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")
 S3method("[[<-","ggplot2::mapping")
 S3method(.DollarNames,ggproto)
@@ -23,12 +29,6 @@ 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")
@@ -75,10 +75,6 @@ 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)
@@ -330,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)

R/coord-sf.R

@@ -334,13 +334,13 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
 
     # we don't draw the graticules if the major panel grid is
     # turned off
-    if (inherits(el, "element_blank")) {
+    if (is_theme_element(el, "blank")) {
       grobs <- list(element_render(theme, "panel.background"))
     } else {
       line_gp <- gg_par(
-        col = el$colour,
-        lwd = el$linewidth,
-        lty = el$linetype
+        col = el@colour,
+        lwd = el@linewidth,
+        lty = el@linetype
       )
       grobs <- c(
         list(element_render(theme, "panel.background")),

R/geom-.R

@@ -245,7 +245,7 @@ eval_from_theme <- function(aesthetics, theme, class = NULL) {
     return(aesthetics)
   }
 
-  element <- calc_element("geom", theme) %||% .default_geom_element
+  el <- calc_element("geom", theme) %||% .default_geom_element
   class <- setdiff(class, c("Geom", "ggproto", "gg"))
 
   if (length(class) > 0) {
@@ -260,12 +260,12 @@ eval_from_theme <- function(aesthetics, theme, class = NULL) {
     # Inherit up to parent geom class
     if (length(class) > 0) {
       for (cls in rev(class)) {
-        element <- combine_elements(theme[[cls]], element)
+        el <- combine_elements(theme[[cls]], el)
       }
     }
   }
 
-  lapply(aesthetics[themed], eval_tidy, data = element)
+  lapply(aesthetics[themed], eval_tidy, data = S7::props(el))
 }
 
 #' Graphical units

R/geom-label.R

@@ -88,7 +88,7 @@ GeomLabel <- ggproto("GeomLabel", Geom,
     data <- coord$transform(data, panel_params)
     data$vjust <- compute_just(data$vjust, data$y, data$x, data$angle)
     data$hjust <- compute_just(data$hjust, data$x, data$y, data$angle)
-    if (!is_margin("margin")) {
+    if (!is_margin(label.padding)) {
       label.padding <- rep(label.padding, length.out = 4)
     }
 

R/guide-.R

@@ -376,6 +376,7 @@ Guide <- ggproto(
   # Renders tickmarks
   build_ticks = function(key, elements, params, position = params$position,
                          length = elements$ticks_length) {
+    force(length)
     if (!is_theme_element(elements)) {
       elements <- elements$ticks
     }

R/guide-axis-logticks.R

@@ -119,7 +119,7 @@ guide_axis_logticks <- function(
     allow_null = TRUE
   )
   check_bool(expanded)
-  check_inherits(short.theme, c("element_blank", "element_line"))
+  check_inherits(short.theme, c("ggplot2::element_blank", "ggplot2::element_line"))
 
   new_guide(
     available_aes  = c("x", "y"),

R/guide-axis-theta.R

@@ -154,7 +154,7 @@ GuideAxisTheta <- ggproto(
     }
 
     offset <- max(unit(0, "pt"), elements$major_length, elements$minor_length)
-    elements$offset <- offset + max(elements$text$margin %||% unit(0, "pt"))
+    elements$offset <- offset + max(elements$text@margin %||% unit(0, "pt"))
     elements
   },
 
@@ -184,7 +184,7 @@ GuideAxisTheta <- ggproto(
 
   build_labels = function(key, elements, params) {
 
-    if (inherits(elements$text, "element_blank")) {
+    if (is_theme_element(elements$text, "blank")) {
       return(zeroGrob())
     }
 
@@ -198,7 +198,7 @@ GuideAxisTheta <- ggproto(
 
     # Resolve text angle
     if (is.waiver(params$angle) || is.null(params$angle)) {
-      angle <- elements$text$angle
+      angle <- elements$text@angle
     } else {
       angle <- flip_text_angle(params$angle - rad2deg(key$theta))
     }
@@ -268,20 +268,20 @@ GuideAxisTheta <- ggproto(
     key <- params$key
     key <- vec_slice(key, !is.na(key$.label) & nzchar(key$.label))
     labels <- validate_labels(key$.label)
-    if (length(labels) == 0 || inherits(elements$text, "element_blank")) {
+    if (length(labels) == 0 || is_theme_element(elements$text, "blank")) {
       return(list(offset = offset))
     }
 
     # Resolve text angle
     if (is.waiver(params$angle %||% waiver())) {
-      angle <- elements$text$angle
+      angle <- elements$text@angle
     } else {
       angle <- flip_text_angle(params$angle - rad2deg(key$theta))
     }
     angle <- key$theta + deg2rad(angle)
 
     # Set margin
-    margin <- rep(max(elements$text$margin), length.out = 4)
+    margin <- rep(max(elements$text@margin), length.out = 4)
 
     # Measure size of each individual label
     single_labels <- lapply(labels, function(lab) {
@@ -365,7 +365,7 @@ GuideAxisTheta <- ggproto(
 
 theta_tickmarks <- function(key, element, length, offset = NULL) {
   n_breaks <- nrow(key)
-  if (n_breaks < 1 || inherits(element, "element_blank")) {
+  if (n_breaks < 1 || is_theme_element(element, "blank")) {
     return(zeroGrob())
   }
 

R/guide-axis.R

@@ -259,10 +259,10 @@ GuideAxis <- ggproto(
   override_elements = function(params, elements, theme) {
     elements$text <-
       label_angle_heuristic(elements$text, params$position, params$angle)
-    if (inherits(elements$ticks, "element_blank")) {
+    if (is_theme_element(elements$ticks, "blank")) {
       elements$major_length <- unit(0, "cm")
     }
-    if (inherits(elements$minor, "element_blank") || isFALSE(params$minor.ticks)) {
+    if (is_theme_element(elements$minor, "blank") || isFALSE(params$minor.ticks)) {
       elements$minor_length <- unit(0, "cm")
     }
     return(elements)
@@ -379,7 +379,7 @@ GuideAxis <- ggproto(
     # Ticks
     major_cm <- convertUnit(elements$major_length, "cm", valueOnly = TRUE)
     range <- range(0, major_cm)
-    if (params$minor.ticks && !inherits(elements$minor, "element_blank")) {
+    if (params$minor.ticks && !is_theme_element(elements$minor, "blank")) {
       minor_cm <- convertUnit(elements$minor_length, "cm", valueOnly = TRUE)
       range <- range(range, minor_cm)
     }
@@ -450,13 +450,13 @@ GuideAxis <- ggproto(
     # rather than dimensions of this axis alone.
     if (has_labels && params$position %in% c("left", "right")) {
       where <- layout$l[-c(1, length(layout$l))]
-      just <- with(elements$text, rotate_just(angle, hjust, vjust))$hjust %||% 0.5
+      just <- with(S7::props(elements$text), rotate_just(angle, hjust, vjust))$hjust %||% 0.5
       gt <- gtable_add_cols(gt, unit(just, "null"), pos = min(where) - 1)
       gt <- gtable_add_cols(gt, unit(1 - just, "null"), pos = max(where) + 1)
     }
     if (has_labels && params$position %in% c("top", "bottom")) {
       where <- layout$t[-c(1, length(layout$t))]
-      just <- with(elements$text, rotate_just(angle, hjust, vjust))$vjust %||% 0.5
+      just <- with(S7::props(elements$text), rotate_just(angle, hjust, vjust))$vjust %||% 0.5
       gt <- gtable_add_rows(gt, unit(1 - just, "null"), pos = min(where) - 1)
       gt <- gtable_add_rows(gt, unit(just, "null"), pos = max(where) + 1)
     }
@@ -590,7 +590,7 @@ axis_label_priority_between <- function(x, y) {
 #'   overridden from the user- or theme-supplied element.
 #' @noRd
 label_angle_heuristic <- function(element, position, angle) {
-  if (!inherits(element, "element_text")
+  if (!is_theme_element(element, "text")
       || is.null(position)
       || is.null(angle %|W|% NULL)) {
     return(element)
@@ -612,8 +612,8 @@ label_angle_heuristic <- function(element, position, angle) {
   hjust <- switch(position, left = cosine, right = 1 - cosine, top = 1 - sine, sine)
   vjust <- switch(position, left = 1 - sine, right = sine, top = 1 - cosine, cosine)
 
-  element$angle <- angle %||% element$angle
-  element$hjust <- hjust %||% element$hjust
-  element$vjust <- vjust %||% element$vjust
+  element@angle <- angle %||% element@angle
+  element@hjust <- hjust %||% element@hjust
+  element@vjust <- vjust %||% element@vjust
   element
 }

R/guide-custom.R

@@ -113,7 +113,7 @@ GuideCustom <- ggproto(
 
     gt <- self$add_title(
       gt, title, title_position,
-      with(elems$title, rotate_just(angle, hjust, vjust))
+      with(S7::props(elems$title), rotate_just(angle, hjust, vjust))
     )
 
     # Add padding and background

R/guide-legend.R

@@ -325,7 +325,7 @@ GuideLegend <- ggproto(
     # Resolve title. The trick here is to override the main text element, so
     # that any settings declared in `legend.title` will be honoured but we have
     # custom defaults for the guide.
-    margin <- calc_element("text", theme)$margin
+    margin <- calc_element("text", theme)@margin
     title <- theme(text = element_text(
       hjust = 0, vjust = 0.5,
       margin = position_margin(title_position, margin, gap)
@@ -573,7 +573,7 @@ GuideLegend <- ggproto(
 
     gt <- self$add_title(
       gt, grobs$title, elements$title_position,
-      with(elements$title, rotate_just(angle, hjust, vjust))
+      with(S7::props(elements$title), rotate_just(angle, hjust, vjust))
     )
 
     gt <- gtable_add_padding(gt, unit(elements$padding, "cm"))
@@ -690,13 +690,17 @@ keep_key_data <- function(key, data, aes, show) {
 
 position_margin <- function(position, margin = NULL, gap = unit(0, "pt")) {
   margin <- margin %||% margin()
-  switch(
+  margin <- switch(
     position,
     top    = replace(margin, 3, margin[3] + gap),
     bottom = replace(margin, 1, margin[1] + gap),
     left   = replace(margin, 2, margin[2] + gap),
     right  = replace(margin, 4, margin[4] + gap)
   )
+  # We have to manually reconstitute the class because the 'simpleUnit' class
+  # might be dropped by the replacement operation.
+  class(margin) <- c("ggplot2::margin", class(margin), "S7_object")
+  margin
 }
 
 # Function implementing backward compatibility with the old way of specifying

R/margins.R

@@ -1,17 +1,21 @@
+#' @include properties.R
+
 #' @param t,r,b,l Dimensions of each margin. (To remember order, think trouble).
 #' @param unit Default units of dimensions. Defaults to "pt" so it
 #'   can be most easily scaled with the text.
 #' @rdname element
 #' @export
-margin <- function(t = 0, r = 0, b = 0, l = 0, unit = "pt") {
-  u <- unit(c(t, r, b, l), unit)
-  class(u) <- c("margin", class(u))
-  u
-}
+margin <- S7::new_class(
+  "margin", parent = S7::new_S3_class(c("simpleUnit", "unit", "unit_v2")),
+  constructor = function(t = 0, r = 0, b = 0, l = 0, unit = "pt") {
+    u <- unit(c(t, r, b, l), unit)
+    S7::new_object(u)
+  }
+)
 
 #' @export
 #' @rdname is_tests
-is_margin <- function(x) inherits(x, "margin")
+is_margin <- function(x) S7::S7_inherits(x, margin)
 is.margin <- function(x) lifecycle::deprecate_stop("3.5.2", "is.margin()", "is_margin()")
 
 #' @rdname element

R/plot-build.R

@@ -337,7 +337,7 @@ table_add_tag <- function(table, label, theme) {
     return(table)
   }
   element <- calc_element("plot.tag", theme)
-  if (inherits(element, "element_blank")) {
+  if (is_theme_element(element, "blank")) {
     return(table)
   }
 
@@ -382,20 +382,20 @@ table_add_tag <- function(table, label, theme) {
   if (location %in% c("plot", "panel")) {
     if (!is.numeric(position)) {
       if (right || left) {
-        x <- (1 - element$hjust) * width
+        x <- (1 - element@hjust) * width
         if (right) {
           x <- unit(1, "npc") - x
         }
       } else {
-        x <- unit(element$hjust, "npc")
+        x <- unit(element@hjust, "npc")
       }
       if (top || bottom) {
-        y <- (1 - element$vjust) * height
+        y <- (1 - element@vjust) * height
         if (top) {
           y <- unit(1, "npc") - y
         }
       } else {
-        y <- unit(element$vjust, "npc")
+        y <- unit(element@vjust, "npc")
       }
     } else {
       x <- unit(position[1], "npc")

R/plot-construction.R

@@ -96,7 +96,7 @@ add_ggplot <- function(p, object, objectname) {
 #' Add custom objects to ggplot
 #'
 #' This generic allows you to add your own methods for adding custom objects to
-#' a ggplot with [+.gg].
+#' a ggplot with [+.gg][add_gg].
 #'
 #' @param object An object to add to the plot
 #' @param plot The ggplot object to add `object` to
@@ -115,7 +115,9 @@ add_ggplot <- function(p, object, objectname) {
 #' @keywords internal
 #' @export
 #' @examples
-#' S7::method(ggplot_add, list(S7::new_S3_class("element_text"), class_ggplot)) <-
+#' # making a new method for the generic
+#' # in this example, we enable adding text elements
+#' S7::method(ggplot_add, list(element_text, class_ggplot)) <-
 #'   function(object, plot, ...) {
 #'     plot + theme(text = object)
 #'   }
@@ -126,7 +128,6 @@ add_ggplot <- function(p, object, objectname) {
 #'   element_text(colour = "red")
 #'
 #' # clean-up
-#' rm("element_text", envir = ggplot_add@methods)
 ggplot_add <- S7::new_generic("ggplot_add", c("object", "plot"))
 
 S7::method(ggplot_add, list(S7::class_any, class_ggplot)) <-