diff --git a/DESCRIPTION b/DESCRIPTION index 1deed8f79e..9e9bf500ce 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ggplot2 Title: Create Elegant Data Visualisations Using the Grammar of Graphics -Version: 3.5.2.9001 +Version: 3.5.2.9002 Authors@R: c( person("Hadley", "Wickham", , "hadley@posit.co", role = "aut", comment = c(ORCID = "0000-0003-4757-117X")), diff --git a/NAMESPACE b/NAMESPACE index 5893c8bb5a..284d21da05 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -295,11 +295,26 @@ export(borders) export(build_ggplot) export(calc_element) export(check_device) +export(class_S3_gg) +export(class_coord) +export(class_derive) +export(class_facet) +export(class_gg) export(class_ggplot) export(class_ggplot_built) +export(class_ggproto) +export(class_guide) +export(class_guides) export(class_labels) +export(class_layer) +export(class_layout) export(class_mapping) +export(class_rel) +export(class_scale) +export(class_scales_list) export(class_theme) +export(class_waiver) +export(class_zero_grob) export(combine_vars) export(complete_theme) export(continuous_scale) diff --git a/R/all-classes.R b/R/all-classes.R index 23fb806578..23fe36cd78 100644 --- a/R/all-classes.R +++ b/R/all-classes.R @@ -1,27 +1,203 @@ -# S3 classes -------------------------------------------------------------- +# Docs ------------------------------------------------------------- -# Meta classes: -# TODO: These should be replaced once R 4.3.0 is the minimum version as `+` -# dispatch should work as intended. -class_gg <- S7::new_class("gg", abstract = TRUE) -class_S3_gg <- S7::new_S3_class("gg") +#' Class definitions +#' +#' The S7 object oriented programming system requires class definitions. +#' Here, we provide definitions of classes that are home to ggplot2. +#' +#' @section S7 classes: +#' +#' A general advice the S7 package gives is to name class definition objects +#' the same as the class name, which then becomes the constructor for the class. +#' The classes listed below deviate from that advice for historical reasons, +#' because some constructors like `ggplot()` are also S3 generics with methods. +#' The have the `class_`-prefix to indicate their role. +#' +#' * [`class_ggplot`] is an S7 class used for objects generated by [ggplot()]. +#' * [`class_ggplot_built`] is an S7 class used for objects generated by +#' [ggplot_build()]. +#' * [`class_mapping`] is an S7 class used for objects generated by [aes()]. +#' * [`class_theme`] is an S7 class used for objects generated by [theme()]. +#' * [`class_labels`] is an S7 class used for objects generated by [labs()]. +#' +#' @section Theme elements: +#' +#' The theme elements follow the advice of the S7 package that the class names +#' are also the class definitions and constructors. +#' +#' * [`element`] is an abstract S7 class used to invoke similar behaviour among +#' theme element objects. +#' * [`element_blank`] is an S7 class for not drawing theme elements. +#' * [`element_rect`] is an S7 class for drawing rectangles. +#' * [`element_line`] is an S7 class for drawing lines. +#' * [`element_text`] is an S7 class for rendering text. +#' * [`element_polygon`] is an S7 class for drawing polygons. +#' * [`element_point`] is an S7 class for drawing points. +#' * [`element_geom`] is an S7 class holding geom defaults. +#' * [`margin`] is an S7 class for declaring margins. +#' +#' @section ggproto classes: +#' +#' The ggproto classes are S3 classes of the type environment that form the +#' backbone of most systems in ggplot2 and are in particular crucial to the +#' extension system. +#' +#' @section S3 classes: +#' +#' Some simple classes remain S3, primarily because they aren't meant to be +#' recycled into new classes. +#' +#' @name class_definitions +#' @keywords internal +NULL + +#' @rdname class_definitions +#' @section S7 classes: +#' * `class_gg` is an abstract S7 class to used invoke similar behaviour among +#' ggplot objects. +#' @export +#' @format NULL +#' @usage NULL +class_gg <- S7::new_class("gg", abstract = TRUE) + +# ggproto classes --------------------------------------------------------- -# Proper S3 classes we need awareness for +#' @rdname class_definitions +#' @section ggproto classes: +#' * `class_ggproto` is an S3 class used for the objects generated by +#' [ggproto()] which are of the type environment. +#' @export +#' @format NULL +#' @usage NULL class_ggproto <- S7::new_S3_class("ggproto") -class_gtable <- S7::new_S3_class("gtable") -# The important ggproto classes that we treat as S3 classes in S7 even though -# they are their own thing. -class_scale <- S7::new_S3_class("Scale") +# We don't own this class, so we don't export or describe it +class_gtable <- S7::new_S3_class("gtable") + +#' @rdname class_definitions +#' @section ggproto classes: +#' * `class_scale` is a subclass of `class_ggproto` and is more described in +#' the [Scale] documentation. +#' @export +#' @format NULL +#' @usage NULL +class_scale <- S7::new_S3_class("Scale") + +#' @rdname class_definitions +#' @section ggproto classes: +#' * `class_guides` is a subclass of `class_ggproto` and is considered an +#' internal class. +#' @export +#' @format NULL +#' @usage NULL class_guides <- S7::new_S3_class("Guides") + +#' @rdname class_definitions +#' @section ggproto classes: +#' * `class_guide` is a subclass of `class_ggproto` and is more described in the +#' [Guide] documentation. +#' @export +#' @format NULL +#' @usage NULL +class_guide <- S7::new_S3_class("Guide") + +#' @rdname class_definitions +#' @section ggproto classes: +#' * `class_coord` is a subclass of `class_ggproto` and is more described in the +#' [Coord] documentation. +#' @export +#' @format NULL +#' @usage NULL class_coord <- S7::new_S3_class("Coord") + + +#' @rdname class_definitions +#' @section ggproto classes: +#' * `class_facet` is a subclass of `class_ggproto` and is more described in the +#' [Facet] documentation. +#' @export +#' @format NULL +#' @usage NULL class_facet <- S7::new_S3_class("Facet") + +#' @rdname class_definitions +#' @section ggproto classes: +#' * `class_layer` is a subclass of `class_ggproto` and is used for the objects +#' generated by [layer()]. The class itself is considered internal and is +#' described in more detail in the [Layer] documentation. +#' @export +#' @format NULL +#' @usage NULL class_layer <- S7::new_S3_class("Layer") + +#' @rdname class_definitions +#' @section ggproto classes: +#' * `class_layout` is a subclass of `class_ggproto` and is considered an +#' internal class. It is described in more detail in the [Layout] +#' documentation. +#' @export +#' @format NULL +#' @usage NULL class_layout <- S7::new_S3_class("Layout") + +#' @rdname class_definitions +#' @section ggproto classes: +#' * `class_scales_list` is a subclass of `class_ggproto` and is considered an +#' internal class. +#' @export +#' @format NULL +#' @usage NULL class_scales_list <- S7::new_S3_class("ScalesList") +# S3 classes -------------------------------------------------------------- + +#' @rdname class_definitions +#' @section S3 classes: +#' * `r lifecycle::badge("superseded")` `class_S3_gg` is a temporary S3 class +#' until R 4.3.0 is the minimum supported version. It is exported and +#' listed here for completeness, but its use is heavily discouraged. It +#' is superseded by `class_gg`. +#' @export +#' @format NULL +#' @usage NULL +class_S3_gg <- S7::new_S3_class("gg") + +#' @rdname class_definitions +#' @section S3 classes: +#' * `class_rel` is an S3 class used in [element] properties. +#' @export +#' @format NULL +#' @usage NULL +class_rel <- S7::new_S3_class("rel") + +#' @rdname class_definitions +#' @section S3 classes: +#' * `class_zero_grob` is an S3 class used to indicate empty drawings. +#' @export +#' @format NULL +#' @usage NULL +class_zero_grob <- S7::new_S3_class("zeroGrob") + +#' @rdname class_definitions +#' @section S3 classes: +#' * `class_waiver` is an S3 sentinel value class used in various places. +#' @export +#' @format NULL +#' @usage NULL +class_waiver <- S7::new_S3_class("waiver") + +#' @rdname class_definitions +#' @section S3 classes: +#' * `class_derive` is an S3 sentinel value class used primarily in [sec_axis()]. +#' @export +#' @format NULL +#' @usage NULL +class_derive <- S7::new_S3_class("derive") + # User facing classes ----------------------------------------------------- +## Theme ------------------------------------------------------------------- + #' The theme class #' #' The theme class holds information on how non-data elements of the plot @@ -29,6 +205,7 @@ class_scales_list <- S7::new_S3_class("ScalesList") #' is through the [`theme()`] function. #' #' @param elements A named list containing theme elements. +#' @param ... Reserved for future expansion. #' @param complete A boolean value stating whether a theme is complete. #' @param validate A boolean value stating whether a theme should still be #' validated. @@ -41,7 +218,8 @@ class_theme <- S7::new_class( complete = S7::class_logical, validate = S7::class_logical ), - constructor = function(elements, complete, validate) { + constructor = function(elements, ..., complete, validate) { + warn_dots_empty() S7::new_object( elements, complete = complete, @@ -50,6 +228,8 @@ class_theme <- S7::new_class( } ) +## Labels ------------------------------------------------------------------ + #' The labels class #' #' The labels class holds a list with label information to display as titles @@ -57,12 +237,20 @@ class_theme <- S7::new_class( #' class is to use the [`labs()`] function. #' #' @param labels A named list. +#' @param ... Reserved for future expansion. +#' +#' @details +#' All members of `labels` are expected to be named and names should be unique. +#' #' #' @keywords internal #' @export class_labels <- S7::new_class( "labels", parent = class_S3_gg, - constructor = function(labels) S7::new_object(labels), + constructor = function(labels, ...) { + warn_dots_empty() + S7::new_object(labels) + }, validator = function(self) { if (!is.list(self)) { return("labels must be a list.") @@ -79,6 +267,8 @@ class_labels <- S7::new_class( } ) +## Mapping ----------------------------------------------------------------- + #' The mapping class #' #' The mapping class holds a list of quoted expressions @@ -86,13 +276,15 @@ class_labels <- S7::new_class( #' constructed using the [`aes()`] function. #' #' @param x A list of quosures and constants. +#' @param ... Reserved for future expansion. #' @param env An environment for symbols that are not quosures or constants. #' #' @keywords internal #' @export class_mapping <- S7::new_class( "mapping", parent = class_S3_gg, - constructor = function(x, env = globalenv()) { + constructor = function(x, ..., env = globalenv()) { + warn_dots_empty() check_object(x, is.list, "a {.cls list}") x <- lapply(x, new_aesthetic, env = env) x <- S7::new_object(x) @@ -101,12 +293,15 @@ class_mapping <- S7::new_class( } ) +## ggplot ------------------------------------------------------------------ + #' The ggplot class #' #' The ggplot class collects the needed information to render a plot. #' This class can be constructed using the [`ggplot()`] function. #' #' @param data A property containing any data coerced by [`fortify()`]. +#' @param ... Reserved for future expansion. #' @param layers A list of layer instances created by [`layer()`]. #' @param scales A ScalesList ggproto object. #' @param guides A Guides ggproto object created by [`guides()`]. @@ -140,12 +335,22 @@ class_ggplot <- S7::new_class( meta = S7::class_list, plot_env = S7::class_environment ), - constructor = function(data = waiver(), layers = list(), scales = NULL, - guides = NULL, mapping = aes(), theme = NULL, - coordinates = coord_cartesian(default = TRUE), - facet = facet_null(), layout = NULL, - labels = labs(), meta = list(), - plot_env = parent.frame()) { + constructor = function( + data = waiver(), + ..., + layers = list(), + scales = NULL, + guides = NULL, + mapping = aes(), + theme = NULL, + coordinates = coord_cartesian(default = TRUE), + facet = facet_null(), + layout = NULL, + labels = labs(), + meta = list(), + plot_env = parent.frame() + ) { + warn_dots_empty() S7::new_object( S7::S7_object(), data = data, @@ -164,6 +369,8 @@ class_ggplot <- S7::new_class( } ) +## Built ggplot ------------------------------------------------------------ + #' The ggplot built class #' #' The ggplot built class is an intermediate class and represents a processed @@ -172,6 +379,7 @@ class_ggplot <- S7::new_class( #' instantiated directly. The class can be rendered to a gtable object by #' calling the [`ggplot_gtable()`] function on a ggplot built class object. #' +#' @param ... Reserved for future expansion. #' @param data A list of plain data frames; one for each layer. #' @param layout A Layout ggproto object. #' @param plot A completed ggplot class object. @@ -185,7 +393,8 @@ class_ggplot_built <- S7::new_class( layout = class_layout, plot = class_ggplot ), - constructor = function(data = NULL, layout = NULL, plot = NULL) { + constructor = function(..., data = NULL, layout = NULL, plot = NULL) { + warn_dots_empty() if (is.null(data) || is.null(layout) || is.null(plot)) { cli::cli_abort( "The {.cls ggplot_built} class should be constructed by {.fn ggplot_build}." @@ -193,7 +402,9 @@ class_ggplot_built <- S7::new_class( } S7::new_object( S7::S7_object(), - data = data, layout = layout, plot = plot + data = data, + layout = layout, + plot = plot ) } ) diff --git a/R/margins.R b/R/margins.R index 15a27520a1..af52156d5d 100644 --- a/R/margins.R +++ b/R/margins.R @@ -7,7 +7,8 @@ #' @export 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") { + constructor = function(t = 0, r = 0, b = 0, l = 0, unit = "pt", ...) { + warn_dots_empty() lens <- c(length(t), length(r), length(b), length(l)) if (any(lens != 1)) { incorrect <- c("t", "r", "b", "l")[lens != 1] @@ -41,7 +42,7 @@ margin_part <- function(t = NA, r = NA, b = NA, l = NA, unit = "pt") { #' @rdname element #' @export margin_auto <- function(t = 0, r = t, b = t, l = r, unit = "pt") { - margin(t = t, r = r, b = b, l = l, unit) + margin(t = t, r = r, b = b, l = l, unit = unit) } as_margin <- function(x, x_arg = caller_arg(x), call = caller_env()) { diff --git a/R/theme-elements.R b/R/theme-elements.R index 09f8c96a13..be246c1dfe 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -33,6 +33,8 @@ #' a blank element among its parents will cause this element to be blank as #' well. If `FALSE` any blank parent element will be ignored when #' calculating final element state. +#' @param ... Reserved for future expansion. +#' #' @return An object of class `element`, `rel`, or `margin`. #' @details #' The `element_polygon()` and `element_point()` functions are not rendered @@ -137,7 +139,8 @@ element_rect <- S7::new_class( "inherit.blank")], constructor = function(fill = NULL, colour = NULL, linewidth = NULL, linetype = NULL, color = NULL, linejoin = NULL, - inherit.blank = FALSE, size = deprecated()){ + inherit.blank = FALSE, size = deprecated(), ...){ + warn_dots_empty() if (lifecycle::is_present(size)) { deprecate_warn0("3.4.0", "element_rect(size)", "element_rect(linewidth)") linewidth <- size @@ -171,7 +174,8 @@ element_line <- S7::new_class( constructor = function(colour = NULL, linewidth = NULL, linetype = NULL, lineend = NULL, color = NULL, linejoin = NULL, arrow = NULL, arrow.fill = NULL, - inherit.blank = FALSE, size = deprecated()) { + inherit.blank = FALSE, size = deprecated(), ...) { + warn_dots_empty() if (lifecycle::is_present(size)) { deprecate_warn0("3.4.0", "element_line(size)", "element_line(linewidth)") linewidth <- size @@ -225,7 +229,8 @@ element_text <- S7::new_class( constructor = function(family = NULL, face = NULL, colour = NULL, size = NULL, hjust = NULL, vjust = NULL, angle = NULL, lineheight = NULL, color = NULL, margin = NULL, - debug = NULL, inherit.blank = FALSE) { + debug = NULL, inherit.blank = FALSE, ...) { + warn_dots_empty() n <- max( length(family), length(face), length(colour), length(size), length(hjust), length(vjust), length(angle), length(lineheight) @@ -269,7 +274,8 @@ element_polygon <- S7::new_class( )], constructor = function(fill = NULL, colour = NULL, linewidth = NULL, linetype = NULL, color = NULL, linejoin = NULL, - inherit.blank = FALSE) { + inherit.blank = FALSE, ...) { + warn_dots_empty() colour <- color %||% colour S7::new_object( S7::S7_object(), @@ -290,7 +296,8 @@ element_point <- S7::new_class( c("linewidth" = "stroke") ), constructor = function(colour = NULL, shape = NULL, size = NULL, fill = NULL, - stroke = NULL, color = NULL, inherit.blank = FALSE) { + stroke = NULL, color = NULL, inherit.blank = FALSE, ...) { + warn_dots_empty() S7::new_object( S7::S7_object(), colour = color %||% colour, fill = fill, shape = shape, size = size, @@ -327,8 +334,9 @@ element_geom <- S7::new_class( linetype = NULL, bordertype = NULL, family = NULL, fontsize = NULL, pointsize = NULL, pointshape = NULL, - colour = NULL, color = NULL, fill = NULL) { - + colour = NULL, color = NULL, fill = NULL, + ...) { + warn_dots_empty() if (!is.null(fontsize)) { fontsize <- fontsize / .pt } diff --git a/R/utilities.R b/R/utilities.R index ec375b723e..348430fd12 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -850,6 +850,16 @@ warn_dots_used <- function(env = caller_env(), call = caller_env()) { ) } +warn_dots_empty <- function(env = caller_env(), call = caller_env()) { + check_dots_empty( + env = env, call = call, + error = function(cnd) { + msg <- gsub("\n", "\f", cnd_message(cnd)) + cli::cli_warn(msg, call = call) + } + ) +} + # TODO: Replace me if rlang/#1730 gets implemented # Similar to `rlang::check_installed()` but returns boolean and misses # features such as versions, comparisons and using {pak}. diff --git a/man/class_definitions.Rd b/man/class_definitions.Rd new file mode 100644 index 0000000000..3b638cf6d9 --- /dev/null +++ b/man/class_definitions.Rd @@ -0,0 +1,169 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/all-classes.R +\docType{data} +\name{class_definitions} +\alias{class_definitions} +\alias{class_gg} +\alias{class_ggproto} +\alias{class_scale} +\alias{class_guides} +\alias{class_guide} +\alias{class_coord} +\alias{class_facet} +\alias{class_layer} +\alias{class_layout} +\alias{class_scales_list} +\alias{class_S3_gg} +\alias{class_rel} +\alias{class_zero_grob} +\alias{class_waiver} +\alias{class_derive} +\title{Class definitions} +\description{ +The S7 object oriented programming system requires class definitions. +Here, we provide definitions of classes that are home to ggplot2. +} +\section{S7 classes}{ + + +A general advice the S7 package gives is to name class definition objects +the same as the class name, which then becomes the constructor for the class. +The classes listed below deviate from that advice for historical reasons, +because some constructors like \code{ggplot()} are also S3 generics with methods. +The have the \code{class_}-prefix to indicate their role. +\itemize{ +\item \code{\link{class_ggplot}} is an S7 class used for objects generated by \code{\link[=ggplot]{ggplot()}}. +\item \code{\link{class_ggplot_built}} is an S7 class used for objects generated by +\code{\link[=ggplot_build]{ggplot_build()}}. +\item \code{\link{class_mapping}} is an S7 class used for objects generated by \code{\link[=aes]{aes()}}. +\item \code{\link{class_theme}} is an S7 class used for objects generated by \code{\link[=theme]{theme()}}. +\item \code{\link{class_labels}} is an S7 class used for objects generated by \code{\link[=labs]{labs()}}. +} + + +\itemize{ +\item \code{class_gg} is an abstract S7 class to used invoke similar behaviour among +ggplot objects. +} +} + +\section{Theme elements}{ + + +The theme elements follow the advice of the S7 package that the class names +are also the class definitions and constructors. +\itemize{ +\item \code{\link{element}} is an abstract S7 class used to invoke similar behaviour among +theme element objects. +\item \code{\link{element_blank}} is an S7 class for not drawing theme elements. +\item \code{\link{element_rect}} is an S7 class for drawing rectangles. +\item \code{\link{element_line}} is an S7 class for drawing lines. +\item \code{\link{element_text}} is an S7 class for rendering text. +\item \code{\link{element_polygon}} is an S7 class for drawing polygons. +\item \code{\link{element_point}} is an S7 class for drawing points. +\item \code{\link{element_geom}} is an S7 class holding geom defaults. +\item \code{\link{margin}} is an S7 class for declaring margins. +} +} + +\section{ggproto classes}{ + + +The ggproto classes are S3 classes of the type environment that form the +backbone of most systems in ggplot2 and are in particular crucial to the +extension system. + + +\itemize{ +\item \code{class_ggproto} is an S3 class used for the objects generated by +\code{\link[=ggproto]{ggproto()}} which are of the type environment. +} + + +\itemize{ +\item \code{class_scale} is a subclass of \code{class_ggproto} and is more described in +the \link{Scale} documentation. +} + + +\itemize{ +\item \code{class_guides} is a subclass of \code{class_ggproto} and is considered an +internal class. +} + + +\itemize{ +\item \code{class_guide} is a subclass of \code{class_ggproto} and is more described in the +\link{Guide} documentation. +} + + +\itemize{ +\item \code{class_coord} is a subclass of \code{class_ggproto} and is more described in the +\link{Coord} documentation. +} + + +\itemize{ +\item \code{class_facet} is a subclass of \code{class_ggproto} and is more described in the +\link{Facet} documentation. +} + + +\itemize{ +\item \code{class_layer} is a subclass of \code{class_ggproto} and is used for the objects +generated by \code{\link[=layer]{layer()}}. The class itself is considered internal and is +described in more detail in the \link{Layer} documentation. +} + + +\itemize{ +\item \code{class_layout} is a subclass of \code{class_ggproto} and is considered an +internal class. It is described in more detail in the \link{Layout} +documentation. +} + + +\itemize{ +\item \code{class_scales_list} is a subclass of \code{class_ggproto} and is considered an +internal class. +} +} + +\section{S3 classes}{ + + +Some simple classes remain S3, primarily because they aren't meant to be +recycled into new classes. + + +\itemize{ +\item \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} \code{class_S3_gg} is a temporary S3 class +until R 4.3.0 is the minimum supported version. It is exported and +listed here for completeness, but its use is heavily discouraged. It +is superseded by \code{class_gg}. +} + + +\itemize{ +\item \code{class_rel} is an S3 class used in \link{element} properties. +} + + +\itemize{ +\item \code{class_zero_grob} is an S3 class used to indicate empty drawings. +} + + +\itemize{ +\item \code{class_waiver} is an S3 sentinel value class used in various places. +} + + +\itemize{ +\item \code{class_derive} is an S3 sentinel value class used primarily in \code{\link[=sec_axis]{sec_axis()}}. +} +} + +\keyword{datasets} +\keyword{internal} diff --git a/man/class_ggplot.Rd b/man/class_ggplot.Rd index 05b4f3e0df..13e7de84c1 100644 --- a/man/class_ggplot.Rd +++ b/man/class_ggplot.Rd @@ -6,6 +6,7 @@ \usage{ class_ggplot( data = waiver(), + ..., layers = list(), scales = NULL, guides = NULL, @@ -22,6 +23,8 @@ class_ggplot( \arguments{ \item{data}{A property containing any data coerced by \code{\link[=fortify]{fortify()}}.} +\item{...}{Reserved for future expansion.} + \item{layers}{A list of layer instances created by \code{\link[=layer]{layer()}}.} \item{scales}{A ScalesList ggproto object.} diff --git a/man/class_ggplot_built.Rd b/man/class_ggplot_built.Rd index 4e87451998..a52e45a0be 100644 --- a/man/class_ggplot_built.Rd +++ b/man/class_ggplot_built.Rd @@ -4,9 +4,11 @@ \alias{class_ggplot_built} \title{The ggplot built class} \usage{ -class_ggplot_built(data = NULL, layout = NULL, plot = NULL) +class_ggplot_built(..., data = NULL, layout = NULL, plot = NULL) } \arguments{ +\item{...}{Reserved for future expansion.} + \item{data}{A list of plain data frames; one for each layer.} \item{layout}{A Layout ggproto object.} diff --git a/man/class_labels.Rd b/man/class_labels.Rd index 57788e666d..9c94e05f13 100644 --- a/man/class_labels.Rd +++ b/man/class_labels.Rd @@ -4,14 +4,19 @@ \alias{class_labels} \title{The labels class} \usage{ -class_labels(labels) +class_labels(labels, ...) } \arguments{ \item{labels}{A named list.} + +\item{...}{Reserved for future expansion.} } \description{ The labels class holds a list with label information to display as titles of plot components. The preferred way to construct an object of the labels class is to use the \code{\link[=labs]{labs()}} function. } +\details{ +All members of \code{labels} are expected to be named and names should be unique. +} \keyword{internal} diff --git a/man/class_mapping.Rd b/man/class_mapping.Rd index 63f75456d3..715174a092 100644 --- a/man/class_mapping.Rd +++ b/man/class_mapping.Rd @@ -4,11 +4,13 @@ \alias{class_mapping} \title{The mapping class} \usage{ -class_mapping(x, env = globalenv()) +class_mapping(x, ..., env = globalenv()) } \arguments{ \item{x}{A list of quosures and constants.} +\item{...}{Reserved for future expansion.} + \item{env}{An environment for symbols that are not quosures or constants.} } \description{ diff --git a/man/class_theme.Rd b/man/class_theme.Rd index ab3a03ef1d..e5c5db2d75 100644 --- a/man/class_theme.Rd +++ b/man/class_theme.Rd @@ -4,11 +4,13 @@ \alias{class_theme} \title{The theme class} \usage{ -class_theme(elements, complete, validate) +class_theme(elements, ..., complete, validate) } \arguments{ \item{elements}{A named list containing theme elements.} +\item{...}{Reserved for future expansion.} + \item{complete}{A boolean value stating whether a theme is complete.} \item{validate}{A boolean value stating whether a theme should still be diff --git a/man/continuous_scale.Rd b/man/continuous_scale.Rd index 76d7492ba6..f834d6cd00 100644 --- a/man/continuous_scale.Rd +++ b/man/continuous_scale.Rd @@ -17,7 +17,7 @@ continuous_scale( rescaler = rescale, oob = censor, expand = waiver(), - na.value = NA_real_, + na.value = NA, transform = "identity", trans = deprecated(), guide = "legend", diff --git a/man/element.Rd b/man/element.Rd index 8411711999..a1a528921d 100644 --- a/man/element.Rd +++ b/man/element.Rd @@ -15,7 +15,7 @@ \alias{rel} \title{Theme elements} \usage{ -margin(t = 0, r = 0, b = 0, l = 0, unit = "pt") +margin(t = 0, r = 0, b = 0, l = 0, unit = "pt", ...) margin_part(t = NA, r = NA, b = NA, l = NA, unit = "pt") @@ -33,7 +33,8 @@ element_rect( color = NULL, linejoin = NULL, inherit.blank = FALSE, - size = deprecated() + size = deprecated(), + ... ) element_line( @@ -46,7 +47,8 @@ element_line( arrow = NULL, arrow.fill = NULL, inherit.blank = FALSE, - size = deprecated() + size = deprecated(), + ... ) element_text( @@ -61,7 +63,8 @@ element_text( color = NULL, margin = NULL, debug = NULL, - inherit.blank = FALSE + inherit.blank = FALSE, + ... ) element_polygon( @@ -71,7 +74,8 @@ element_polygon( linetype = NULL, color = NULL, linejoin = NULL, - inherit.blank = FALSE + inherit.blank = FALSE, + ... ) element_point( @@ -81,7 +85,8 @@ element_point( fill = NULL, stroke = NULL, color = NULL, - inherit.blank = FALSE + inherit.blank = FALSE, + ... ) element_geom( @@ -98,7 +103,8 @@ element_geom( pointshape = NULL, colour = NULL, color = NULL, - fill = NULL + fill = NULL, + ... ) rel(x) @@ -109,6 +115,8 @@ rel(x) \item{unit}{Default units of dimensions. Defaults to "pt" so it can be most easily scaled with the text.} +\item{...}{Reserved for future expansion.} + \item{fill}{Fill colour. \code{fill_alpha()} can be used to set the transparency of the fill.} diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index af5a304cdb..889304ce64 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -146,7 +146,7 @@ test_that("calculating theme element inheritance works", { # Check that inheritance from derived class works element_dummyrect <- S7::new_class( "element_dummyrect", parent = element_rect, - properties = c(element_rect@properties, list(dummy = S7::class_any)) + properties = list(dummy = S7::class_any) ) e <- calc_element(