Skip to content

S7 theme elements #6355

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 24 commits into
base: main
Choose a base branch
from
Open
Changes from all commits
Commits
Show all changes
24 commits
Select commit Hold shift + click to select a range
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 3 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -39,6 +39,7 @@ Imports:
isoband,
lifecycle (> 1.0.1),
rlang (>= 1.1.0),
S7,
scales (>= 1.3.0),
stats,
vctrs (>= 0.6.0),
@@ -175,6 +176,8 @@ Collate:
'grob-dotstack.R'
'grob-null.R'
'grouping.R'
'properties.R'
'margins.R'
'theme-elements.R'
'guide-.R'
'guide-axis.R'
@@ -199,7 +202,6 @@ Collate:
'layer-sf.R'
'layout.R'
'limits.R'
'margins.R'
'performance.R'
'plot-build.R'
'plot-construction.R'
18 changes: 8 additions & 10 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,15 +1,21 @@
# Generated by roxygen2: do not edit by hand

S3method("$","ggplot2::element")
S3method("$",ggproto)
S3method("$",ggproto_parent)
S3method("$",theme)
S3method("$<-","ggplot2::element")
S3method("$<-",uneval)
S3method("+",gg)
S3method("[","ggplot2::element")
S3method("[",mapped_discrete)
S3method("[",uneval)
S3method("[<-","ggplot2::element")
S3method("[<-",mapped_discrete)
S3method("[<-",uneval)
S3method("[[","ggplot2::element")
S3method("[[",ggproto)
S3method("[[<-","ggplot2::element")
S3method("[[<-",uneval)
S3method(.DollarNames,ggproto)
S3method(as.data.frame,mapped_discrete)
@@ -20,12 +26,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")
@@ -95,10 +95,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)
@@ -347,6 +343,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 +763,7 @@ export(xlim)
export(ylab)
export(ylim)
export(zeroGrob)
if (getRversion() < "4.3.0") importFrom("S7", "@")
import(grid)
import(gtable)
import(rlang)
4 changes: 4 additions & 0 deletions R/backports.R
Original file line number Diff line number Diff line change
@@ -15,6 +15,10 @@ if (getRversion() < "3.3") {
backport_unit_methods <- function() {}
}

# enable usage of <S7_object>@name in package code
#' @rawNamespace if (getRversion() < "4.3.0") importFrom("S7", "@")
NULL

on_load(backport_unit_methods())

unitType <- function(x) {
8 changes: 4 additions & 4 deletions R/coord-sf.R
Original file line number Diff line number Diff line change
@@ -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")),
6 changes: 3 additions & 3 deletions R/geom-.R
Original file line number Diff line number Diff line change
@@ -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
2 changes: 1 addition & 1 deletion R/geom-label.R
Original file line number Diff line number Diff line change
@@ -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)
}

1 change: 1 addition & 0 deletions R/guide-.R
Original file line number Diff line number Diff line change
@@ -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
}
2 changes: 1 addition & 1 deletion R/guide-axis-logticks.R
Original file line number Diff line number Diff line change
@@ -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"),
14 changes: 7 additions & 7 deletions R/guide-axis-theta.R
Original file line number Diff line number Diff line change
@@ -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())
}

18 changes: 9 additions & 9 deletions R/guide-axis.R
Original file line number Diff line number Diff line change
@@ -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
}
2 changes: 1 addition & 1 deletion R/guide-custom.R
Original file line number Diff line number Diff line change
@@ -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
10 changes: 7 additions & 3 deletions R/guide-legend.R
Original file line number Diff line number Diff line change
@@ -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
16 changes: 10 additions & 6 deletions R/margins.R
Original file line number Diff line number Diff line change
@@ -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
10 changes: 5 additions & 5 deletions R/plot-build.R
Original file line number Diff line number Diff line change
@@ -348,7 +348,7 @@
return(table)
}
element <- calc_element("plot.tag", theme)
if (inherits(element, "element_blank")) {
if (is_theme_element(element, "blank")) {
return(table)
}

@@ -393,20 +393,20 @@
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")

Check warning on line 401 in R/plot-build.R

Codecov / codecov/patch

R/plot-build.R#L401

Added line #L401 was not covered by tests
}
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")

Check warning on line 409 in R/plot-build.R

Codecov / codecov/patch

R/plot-build.R#L409

Added line #L409 was not covered by tests
}
} else {
x <- unit(position[1], "npc")
Loading
Loading