Add function for registering of new theme elements. (#3678)

* Add functions specifically for registering of new theme elements. Fixes #3677

* remove element tree from theme.

* minor fixes

* add one more regression test

Author: clauswilke

NAMESPACE

@@ -374,6 +374,7 @@ export(geom_text)
 export(geom_tile)
 export(geom_violin)
 export(geom_vline)
+export(get_element_tree)
 export(gg_dep)
 export(ggplot)
 export(ggplotGrob)
@@ -444,10 +445,12 @@ export(quickplot)
 export(quo)
 export(quo_name)
 export(quos)
+export(register_theme_elements)
 export(rel)
 export(remove_missing)
 export(render_axes)
 export(render_strips)
+export(reset_theme_settings)
 export(resolution)
 export(scale_alpha)
 export(scale_alpha_continuous)

NEWS.md

@@ -35,9 +35,9 @@
 * `Geom` now gains a `setup_params()` method in line with the other ggproto
   classes (@thomasp85, #3509)
 
-* Themes can now modify the theme element tree, via the
-  `element_tree` argument. This allows extension packages to add functionality that
-  alters the element tree (@clauswilke, #2540).
+* The newly added function `register_theme_elements()` now allows developers
+  of extension packages to define their own new theme elements and place them
+  into the ggplot2 element tree (@clauswilke, #2540).
 
 * `element_text()` now issues a warning when vectorized arguments are provided, as in
   `colour = c("red", "green", "blue")`. Such use is discouraged and not officially supported

R/theme-current.R

@@ -72,14 +72,6 @@ theme_get <- function() {
 #' @param new new theme (a list of theme elements)
 #' @export
 theme_set <- function(new) {
-  missing <- setdiff(names(ggplot_global$theme_grey), names(new))
-  if (length(missing) > 0) {
-    warn(glue(
-      "New theme missing the following elements: ",
-      glue_collapse(missing, ", ", last = " and ")
-    ))
-  }
-
   old <- ggplot_global$theme_current
   ggplot_global$theme_current <- new
   invisible(old)
@@ -107,16 +99,11 @@ theme_replace <- function(...) {
   # Can't use modifyList here since it works recursively and drops NULLs
   e1[names(e2)] <- e2
 
-  # Merge element trees if provided
-  attr(e1, "element_tree") <- defaults(
-    attr(e2, "element_tree", exact = TRUE),
-    attr(e1, "element_tree", exact = TRUE)
-  )
-
   # comment by @clauswilke:
   # `complete` and `validate` are currently ignored,
   # which means they are taken from e1. Is this correct?
   # I'm not sure how `%+replace%` should handle them.
 
   e1
 }
+

R/theme-defaults.r

@@ -651,9 +651,13 @@ theme_test <- function(base_size = 11, base_family = "",
 }
 
 theme_all_null <- function() {
-  # set all elements in the element tree to NULL
+  # Set all elements in the element tree to NULL.
+
+  # We read from `.element_tree` instead of `ggplot_global$element_tree`
+  # because we don't want to change our results just because a user
+  # has defined new theme elements.
   elements <- sapply(
-    names(ggplot_global$element_tree),
+    names(.element_tree),
     function(x) NULL,
     simplify = FALSE, USE.NAMES = TRUE
   )

R/theme-elements.r

@@ -266,23 +266,23 @@ element_grob.element_line <- function(element, x = 0:1, y = 0:1,
   )
 }
 
-
-
-#' Define new elements for a theme's element tree
+#' Define and register new theme elements
 #'
-#' Each theme has an element tree that defines which theme elements inherit
-#' theme parameters from which other elements. The function `el_def()` can be used
-#' to define new or modified elements for this tree.
+#' The underlying structure of a ggplot2 theme is defined via the element tree, which
+#' specifies for each theme element what type it should have and whether it inherits from
+#' a parent element. In some use cases, it may be necessary to modify or extend this
+#' element tree and provide default settings for newly defined theme elements.
 #'
-#' @param class The name of the element class. Examples are "element_line" or
-#'  "element_text" or "unit", or one of the two reserved keywords "character" or
-#'  "margin". The reserved keyword "character" implies a character
-#'  or numeric vector, not a class called "character". The keyword
-#'  "margin" implies a unit vector of length 4, as created by [margin()].
-#' @param inherit A vector of strings, naming the elements that this
-#'  element inherits from.
-#' @param description An optional character vector providing a description
-#'  for the element.
+#' The function `register_theme_elements()` provides the option to globally register new
+#' theme elements with ggplot2. In general, for each new theme element both an element
+#' definition and a corresponding entry in the element tree should be provided. See
+#' examples for details. For extension package that use this functionality, it is
+#' recommended to call `register_theme_elements()` from the `.onLoad()` function.
+#' @param ... Element specifications
+#' @param element_tree Addition of or modification to the element tree, which specifies the
+#'   inheritance relationship of the theme elements. The element tree must be provided as
+#'   a list of named element definitions created with el_def().
+#' @param complete If `TRUE` (the default), elements are set to inherit from blank elements.
 #' @examples
 #' # define a new coord that includes a panel annotation
 #' coord_annotate <- function(label = "panel annotation") {
@@ -297,9 +297,8 @@ element_grob.element_line <- function(element, x = 0:1, y = 0:1,
 #'   )
 #' }
 #'
-#' # update the default theme by adding a new `panel.annotation`
-#' # theme element
-#' old <- theme_update(
+#' # register a new theme element `panel.annotation`
+#' register_theme_elements(
 #'   panel.annotation = element_text(color = "blue", hjust = 0.95, vjust = 0.05),
 #'   element_tree = list(panel.annotation = el_def("element_text", "text"))
 #' )
@@ -309,18 +308,74 @@ element_grob.element_line <- function(element, x = 0:1, y = 0:1,
 #'   geom_point() +
 #'   coord_annotate("annotation in blue")
 #'
-#' # revert to original default theme
-#' theme_set(old)
+#' # revert to original ggplot2 settings
+#' reset_theme_settings()
+#' @keywords internal
+#' @export
+register_theme_elements <- function(..., element_tree = NULL, complete = TRUE) {
+  old <- ggplot_global$theme_default
+  t <- theme(..., complete = complete)
+  ggplot_global$theme_default <- ggplot_global$theme_default %+replace% t
+
+  # Merge element trees
+  ggplot_global$element_tree <- defaults(element_tree, ggplot_global$element_tree)
+
+  invisible(old)
+}
+
+#' @rdname register_theme_elements
+#' @details
+#' The function `reset_theme_settings()` restores the default element tree, discards
+#' all new element definitions, and (unless turned off) resets the currently active
+#' theme to the default.
+#' @param reset_current If `TRUE` (the default), the currently active theme is
+#'   reset to the default theme.
+#' @keywords internal
+#' @export
+reset_theme_settings <- function(reset_current = TRUE) {
+  ggplot_global$element_tree <- .element_tree
+
+  # reset the underlying fallback default theme
+  ggplot_global$theme_default <- theme_grey()
+
+  if (isTRUE(reset_current)) {
+    # reset the currently active theme
+    ggplot_global$theme_current <- ggplot_global$theme_default
+  }
+}
+
+#' @rdname register_theme_elements
+#' @details
+#' The function `get_element_tree()` returns the currently active element tree.
+#' @keywords internal
+#' @export
+get_element_tree <- function() {
+  ggplot_global$element_tree
+}
+
+#' @rdname register_theme_elements
+#' @details
+#' The function `el_def()` is used to define new or modified element types and
+#' element inheritance relationships for the element tree.
+#' @param class The name of the element class. Examples are "element_line" or
+#'  "element_text" or "unit", or one of the two reserved keywords "character" or
+#'  "margin". The reserved keyword "character" implies a character
+#'  or numeric vector, not a class called "character". The keyword
+#'  "margin" implies a unit vector of length 4, as created by [margin()].
+#' @param inherit A vector of strings, naming the elements that this
+#'  element inherits from.
+#' @param description An optional character vector providing a description
+#'  for the element.
 #' @keywords internal
 #' @export
 el_def <- function(class = NULL, inherit = NULL, description = NULL) {
   list(class = class, inherit = inherit, description = description)
 }
 
 
-# This data structure represents the theme elements and the inheritance
-# among them. (In the future, .element_tree should be removed in favor
-# of direct assignment to ggplot_global$element_tree, see below.)
+# This data structure represents the default theme elements and the inheritance
+# among them. It should not be read from directly, since users may modify the
+# current element tree stored in ggplot_global$element_tree
 .element_tree <- list(
   line                = el_def("element_line"),
   rect                = el_def("element_rect"),
@@ -424,8 +479,6 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) {
   aspect.ratio        = el_def("character")
 )
 
-ggplot_global$element_tree <- .element_tree
-
 # Check that an element object has the proper class
 #
 # Given an element object and the name of the element, this function

R/theme.r

@@ -156,19 +156,14 @@
 #' @param strip.switch.pad.wrap space between strips and axes when strips are
 #'   switched (`unit`)
 #'
-#' @param ... additional element specifications not part of base ggplot2. If
-#'   supplied `validate` needs to be set to `FALSE`.
+#' @param ... additional element specifications not part of base ggplot2. In general,
+#'   these should also be defined in the `element tree` argument.
 #' @param complete set this to `TRUE` if this is a complete theme, such as
 #'   the one returned by [theme_grey()]. Complete themes behave
 #'   differently when added to a ggplot object. Also, when setting
 #'   `complete = TRUE` all elements will be set to inherit from blank
 #'   elements.
 #' @param validate `TRUE` to run `validate_element()`, `FALSE` to bypass checks.
-#' @param element_tree optional addition or modification to the element tree,
-#'   which specifies the inheritance relationship of the theme elements. The element
-#'   tree should be provided as a list of named element definitions created with
-#'   [`el_def()`]. See [`el_def()`] for more details.
-#'
 #' @seealso
 #'   [+.gg()] and [%+replace%],
 #'   [element_blank()], [element_line()],
@@ -362,10 +357,9 @@ theme <- function(line,
                   strip.switch.pad.wrap,
                   ...,
                   complete = FALSE,
-                  validate = TRUE,
-                  element_tree = NULL
+                  validate = TRUE
                   ) {
-  elements <- find_args(..., complete = NULL, validate = NULL, element_tree = NULL)
+  elements <- find_args(..., complete = NULL, validate = NULL)
 
   if (!is.null(elements$axis.ticks.margin)) {
     warn("`axis.ticks.margin` is deprecated. Please set `margin` property of `axis.text` instead")
@@ -405,8 +399,7 @@ theme <- function(line,
     elements,
     class = c("theme", "gg"),
     complete = complete,
-    validate = validate,
-    element_tree = element_tree
+    validate = validate
   )
 }
 
@@ -422,24 +415,6 @@ is_theme_validate <- function(x) {
     isTRUE(validate)
 }
 
-# obtain the full element tree from a theme,
-# substituting the defaults if needed
-complete_element_tree <- function(theme) {
-  element_tree <- attr(theme, "element_tree", exact = TRUE)
-
-  # we fill in the element tree first from the current default theme,
-  # and then from the internal element tree if necessary
-  # this makes it easy for extension packages to provide modified
-  # default element trees
-  defaults(
-    defaults(
-      element_tree,
-      attr(theme_get(), "element_tree", exact = TRUE)
-    ),
-    ggplot_global$element_tree
-  )
-}
-
 # Combine plot defaults with current theme to get complete theme for a plot
 plot_theme <- function(x, default = theme_get()) {
   theme <- x$theme
@@ -455,15 +430,15 @@ plot_theme <- function(x, default = theme_get()) {
     theme <- default + theme
   }
 
-  # complete the element tree and save back to the theme
-  element_tree <- complete_element_tree(theme)
-  attr(theme, "element_tree") <- element_tree
+  # if we're still missing elements relative to fallback default, fill in those
+  missing <- setdiff(names(ggplot_global$theme_default), names(theme))
+  theme[missing] <- ggplot_global$theme_default[missing]
 
   # Check that all elements have the correct class (element_text, unit, etc)
   if (is_theme_validate(theme)) {
     mapply(
       validate_element, theme, names(theme),
-      MoreArgs = list(element_tree = element_tree)
+      MoreArgs = list(element_tree = get_element_tree())
     )
   }
 
@@ -504,12 +479,6 @@ add_theme <- function(t1, t2, t2name) {
   attr(t1, "validate") <-
     is_theme_validate(t1) && is_theme_validate(t2)
 
-  # Merge element trees if provided
-  attr(t1, "element_tree") <- defaults(
-    attr(t2, "element_tree", exact = TRUE),
-    attr(t1, "element_tree", exact = TRUE)
-  )
-
   t1
 }
 
@@ -552,13 +521,8 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE) {
     }
   }
 
-  # Obtain the element tree and check that the element is in it
-  # If not, try to retrieve the complete element tree. This is
-  # needed for backwards compatibility and certain unit tests.
-  element_tree <- attr(theme, "element_tree", exact = TRUE)
-  if (!element %in% names(element_tree)) {
-    element_tree <- complete_element_tree(theme)
-  }
+  # Obtain the element tree
+  element_tree <- get_element_tree()
 
   # If the element is defined (and not just inherited), check that
   # it is of the class specified in element_tree
@@ -580,8 +544,8 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE) {
       return(el_out) # no null properties, return element as is
     }
 
-    # if we have null properties, try to fill in from theme_grey()
-    el_out <- combine_elements(el_out, ggplot_global$theme_grey[[element]])
+    # if we have null properties, try to fill in from ggplot_global$theme_default
+    el_out <- combine_elements(el_out, ggplot_global$theme_default[[element]])
     nullprops <- vapply(el_out, is.null, logical(1))
     if (!any(nullprops)) {
       return(el_out) # no null properties remaining, return element

R/zzz.r

@@ -33,10 +33,12 @@ pathGrob <- NULL
 
   .zeroGrob <<- grob(cl = "zeroGrob", name = "NULL")
 
-  # create default theme, store for later use, and set as current theme
-  ggplot_global$theme_all_null <- theme_all_null() # required by theme_grey()
-  ggplot_global$theme_grey <- theme_grey()
-  ggplot_global$theme_current <- ggplot_global$theme_grey
+  # create the global variables holding all the theme settings
+  ggplot_global$theme_all_null <- theme_all_null() # cache all null theme, required by theme_grey()
+  ggplot_global$theme_current <- NULL  # the current theme applied to plots if none is specified
+  ggplot_global$theme_default <- NULL  # the underlying fallback default theme
+  ggplot_global$element_tree <- NULL   # the current element tree for themes
+  reset_theme_settings() # sets the preceding three global variables to their actual defaults
 
   # Used by rbind_dfs
   date <- Sys.Date()