Tease apart themes

* Focus +.gg on ggplot2 objects
* Move current theme accessors to new file
* Use explicit environment to manage current theme
* Other doc improvements

Author: hadley

DESCRIPTION

@@ -47,7 +47,7 @@ License: GPL-2 | file LICENSE
 URL: http://ggplot2.tidyverse.org, https://github.com/tidyverse/ggplot2
 BugReports: https://github.com/tidyverse/ggplot2/issues
 LazyData: true
-Collate:
+Collate: 
     'ggproto.r'
     'aaa-.r'
     'aes-calculated.r'
@@ -201,9 +201,10 @@ Collate:
     'stat-unique.r'
     'stat-ydensity.r'
     'summary.r'
-    'theme-defaults.r'
     'theme-elements.r'
     'theme.r'
+    'theme-defaults.r'
+    'theme-current.R'
     'translate-qplot-ggplot.r'
     'translate-qplot-lattice.r'
     'utilities-break.r'

R/plot-construction.r

@@ -1,62 +1,44 @@
-#' Add a new component to a ggplot or theme object.
+#' Add components to a plot
 #'
-#' This operator allows you to add objects to a ggplot or theme object.
+#' \code{+} is the key to constructing sophisticated ggplot2 graphics. It
+#' allows you to start simple, then get more and more complex, checking your
+#' work at each step.
 #'
-#' @section Adding on to a ggplot object:
+#' @section What can you add?:
 #' You can add any of the following types of objects:
 #'
 #' \itemize{
-#'   \item \code{uneval}: replace current aesthetics
-#'   \item \code{layer}: add new layer
-#'   \item \code{theme}: update plot theme
-#'   \item \code{scale}: replace current scale
-#'   \item \code{coord}: override current coordinate system
-#'   \item \code{facet}: override current coordinate faceting
-#'   \item \code{list}: a list of any of the above.
+#'   \item A \code{\link{aes}()} objects replaces the default aesthetics.
+#'   \item A layer created by a \code{geom_} or \code{stat_} function adds
+#'     new layer.
+#'   \item A \code{scale} overrides the existing scale.
+#'   \item A \code{\link{theme}} modifies the current theme.
+#'   \item A \code{coord} overrides current coordinate system.
+#'   \item A \code{facet} specificatio override current faceting.
 #' }
 #'
 #' To replace the current default data frame, you must use \code{\%+\%},
 #' due to S3 method precedence issues.
 #'
-#' @section Adding on to a theme:
-#'
-#' \code{+} and \code{\%+replace\%} can be used to modify elements in themes.
-#'
-#' \code{+} updates the elements of e1 that differ from elements specified (not
-#' NULL) in e2. Thus this operator can be used to incrementally add or modify
-#' attributes of a ggplot theme.
-#'
-#' In contrast, \code{\%+replace\%} replaces the entire element; any element of
-#' a theme not specified in e2 will not be present in the resulting theme (i.e.
-#' NULL). Thus this operator can be used to overwrite an entire theme.
+#' You can also supply a list, in which case each element of the list will
+#' be added in turn.
 #'
 #' @param e1 An object of class \code{\link{ggplot}} or a \code{\link{theme}}.
-#' @param e2 A component, or list of components to add to \code{e1}.
+#' @param e2 A plot component, as described below.
 #' @seealso \code{\link{theme}}
 #' @export
 #' @method + gg
 #' @rdname gg-add
 #' @examples
-#' # Adding on to a plot -----------------------------------------------
-#'
 #' base <- ggplot(mpg, aes(displ, hwy)) + geom_point()
 #' base + geom_smooth()
 #'
 #' # To override the data, you must use %+%
 #' base %+% subset(mpg, fl == "p")
 #'
 #' # Alternatively, you can add multiple components with a list.
-#' # This can be useful to return from a list.
+#' # This can be useful to return from a function.
 #' base + list(subset(mpg, fl == "p"), geom_smooth())
-#'
-#' # Adding on to a theme ----------------------------------------------
-#'
-#' # Compare these results of adding theme objects to other theme objects
-#' add_el <- theme_grey() + theme(text = element_text(family = "Times"))
-#' rep_el <- theme_grey() %+replace% theme(text = element_text(family = "Times"))
-#'
-#' add_el$text
-#' rep_el$text
 "+.gg" <- function(e1, e2) {
   # Get the name of what was passed in as e2, and pass along so that it
   # can be displayed in error messages

R/theme-current.R

@@ -0,0 +1,116 @@
+#' @include theme-defaults.r
+#' @include theme-elements.r
+theme_env <- new.env(parent = emptyenv())
+theme_env$current <- theme_gray()
+
+#' Get, set and update themes
+#'
+#' Use \code{theme_get} to get the current theme, and \code{theme_set} to
+#' completely override it. \code{theme_update} and \code{theme_replace} are
+#' shorthands for changing individual elements in the current theme.
+#'
+#' @section Adding on to a theme:
+#'
+#' \code{+} and \code{\%+replace\%} can be used to modify elements in themes.
+#'
+#' \code{+} updates the elements of e1 that differ from elements specified (not
+#' NULL) in e2. Thus this operator can be used to incrementally add or modify
+#' attributes of a ggplot theme.
+#'
+#' In contrast, \code{\%+replace\%} replaces the entire element; any element of
+#' a theme not specified in e2 will not be present in the resulting theme (i.e.
+#' NULL). Thus this operator can be used to overwrite an entire theme.
+#'
+#' \code{theme_update} uses the \code{+} operator, so that any unspecified
+#' values in the theme element will default to the values they are set in the
+#' theme. \code{theme_replace} uses \code{\%+replace\%} tocompletely replace
+#' the element, so any unspecified values will overwrite the current value in
+#' the theme with \code{NULL}s.
+#'
+#' @param ... named list of theme settings
+#' @param e1,e2 Theme and element to combine
+#' @seealso \code{\link{+.gg}}
+#' @export
+#' @examples
+#' p <- ggplot(mtcars, aes(mpg, wt)) +
+#'   geom_point()
+#' p
+#' old <- theme_set(theme_bw())
+#' p
+#' theme_set(old)
+#' p
+#'
+#' #theme_replace NULLs out the fill attribute of panel.background,
+#' #resulting in a white background:
+#' theme_get()$panel.background
+#' old <- theme_replace(panel.background = element_rect(colour = "pink"))
+#' theme_get()$panel.background
+#' p
+#' theme_set(old)
+#'
+#' #theme_update only changes the colour attribute, leaving the others intact:
+#' old <- theme_update(panel.background = element_rect(colour = "pink"))
+#' theme_get()$panel.background
+#' p
+#' theme_set(old)
+#'
+#' theme_get()
+#'
+#'
+#' ggplot(mtcars, aes(mpg, wt)) +
+#'   geom_point(aes(color = mpg)) +
+#'   theme(legend.position = c(0.95, 0.95),
+#'         legend.justification = c(1, 1))
+#' last_plot() +
+#'  theme(legend.background = element_rect(fill = "white", colour = "white", size = 3))
+#'
+#' # Adding on to a theme ----------------------------------------------
+#'
+#' # Compare these results of adding theme objects to other theme objects
+#' add_el <- theme_grey() + theme(text = element_text(family = "Times"))
+#' rep_el <- theme_grey() %+replace% theme(text = element_text(family = "Times"))
+#'
+#' add_el$text
+#' rep_el$text
+theme_get <- function() {
+  theme_env$current
+}
+
+#' @rdname theme_get
+#' @param new new theme (a list of theme elements)
+#' @export
+theme_set <- function(new) {
+  missing <- setdiff(names(theme_gray()), names(new))
+  if (length(missing) > 0) {
+    warning("New theme missing the following elements: ",
+      paste(missing, collapse = ", "), call. = FALSE)
+  }
+
+  old <- theme_env$current
+  theme_env$current <- new
+  invisible(old)
+}
+
+#' @rdname theme_get
+#' @export
+theme_update <- function(...) {
+  theme_set(theme_get() + theme(...))
+}
+
+#' @rdname theme_get
+#' @export
+theme_replace <- function(...) {
+  theme_set(theme_get() %+replace% theme(...))
+}
+
+#' @rdname theme_get
+#' @export
+"%+replace%" <- function(e1, e2) {
+  if (!is.theme(e1) || !is.theme(e2)) {
+    stop("%+replace% requires two theme objects", call. = FALSE)
+  }
+
+  # Can't use modifyList here since it works recursively and drops NULLs
+  e1[names(e2)] <- e2
+  e1
+}

R/theme-defaults.r

@@ -57,6 +57,7 @@
 #' @name ggtheme
 NULL
 
+#' @include theme.r
 #' @export
 #' @rdname ggtheme
 theme_grey <- function(base_size = 11, base_family = "") {

R/theme.r

@@ -1,68 +1,3 @@
-#' Get, set and update themes.
-#'
-#' Use \code{theme_get} to get the current theme, and \code{theme_set} to
-#' completely override it. \code{theme_update} and \code{theme_replace} are
-#' shorthands for changing individual elements in the current theme.
-#' \code{theme_update} uses the \code{+} operator, so that any unspecified
-#' values in the theme element will default to the values they are set in the
-#' theme. \code{theme_replace} will completely replace the element, so any
-#' unspecified values will overwrite the current value in the theme with \code{NULL}s.
-#'
-#'
-#' @param ... named list of theme settings
-#' @seealso \code{\link{\%+replace\%}} and \code{\link{+.gg}}
-#' @export
-#' @examples
-#' p <- ggplot(mtcars, aes(mpg, wt)) +
-#'   geom_point()
-#' p
-#' old <- theme_set(theme_bw())
-#' p
-#' theme_set(old)
-#' p
-#'
-#' #theme_replace NULLs out the fill attribute of panel.background,
-#' #resulting in a white background:
-#' theme_get()$panel.background
-#' old <- theme_replace(panel.background = element_rect(colour = "pink"))
-#' theme_get()$panel.background
-#' p
-#' theme_set(old)
-#'
-#' #theme_update only changes the colour attribute, leaving the others intact:
-#' old <- theme_update(panel.background = element_rect(colour = "pink"))
-#' theme_get()$panel.background
-#' p
-#' theme_set(old)
-#'
-#' theme_get()
-#'
-#'
-#' ggplot(mtcars, aes(mpg, wt)) +
-#'   geom_point(aes(color = mpg)) +
-#'   theme(legend.position = c(0.95, 0.95),
-#'         legend.justification = c(1, 1))
-#' last_plot() +
-#'  theme(legend.background = element_rect(fill = "white", colour = "white", size = 3))
-#'
-theme_update <- function(...) {
-  theme_set(theme_get() + theme(...))
-}
-
-#' @rdname theme_update
-#' @export
-theme_replace <- function(...) {
-  theme_set(theme_get() %+replace% theme(...))
-}
-
-#' Reports whether x is a theme object
-#' @param x An object to test
-#' @export
-is.theme <- function(x) inherits(x, "theme")
-
-#' @export
-print.theme <- function(x, ...) utils::str(x)
-
 #' Set theme elements
 #'
 #' Theme elements can inherit properties from other theme elements.
@@ -441,61 +376,16 @@ plot_theme <- function(x) {
   defaults(x$theme, theme_get())
 }
 
-
-.theme <- (function() {
-  theme <- theme_gray()
-
-  list(
-    get = function() theme,
-    set = function(new) {
-      missing <- setdiff(names(theme_gray()), names(new))
-      if (length(missing) > 0) {
-        warning("New theme missing the following elements: ",
-          paste(missing, collapse = ", "), call. = FALSE)
-      }
-
-      old <- theme
-      theme <<- new
-      invisible(old)
-    }
-  )
-})()
-
-
-#' @rdname theme_update
-#' @export
-theme_get <- .theme$get
-#' @rdname theme_update
-#' @param new new theme (a list of theme elements)
-#' @export
-theme_set <- .theme$set
-
-
-#' @rdname gg-add
-#' @export
-"%+replace%" <- function(e1, e2) {
-  if (!is.theme(e1) || !is.theme(e2)) {
-    stop("%+replace% requires two theme objects", call. = FALSE)
-  }
-
-  # Can't use modifyList here since it works recursively and drops NULLs
-  e1[names(e2)] <- e2
-  e1
-}
-
-
 #' Modify properties of an element in a theme object
 #'
 #' @param t1 A theme object
 #' @param t2 A theme object that is to be added to \code{t1}
 #' @param t2name A name of the t2 object. This is used for printing
 #'   informative error messages.
-#'
-#' @seealso +.gg
-#'
+#' @keywords internal
 add_theme <- function(t1, t2, t2name) {
   if (!is.theme(t2)) {
-    stop("Don't know how to add ", t2name, " to a theme object",
+    stop("Don't know how to add RHS to a theme object",
       call. = FALSE)
   }
 
@@ -586,6 +476,8 @@ update_theme <- function(oldtheme, newtheme) {
 #' @param element The name of the theme element to calculate
 #' @param theme A theme object (like theme_grey())
 #' @param verbose If TRUE, print out which elements this one inherits from
+#' @keywords internal
+#' @export
 #' @examples
 #' t <- theme_grey()
 #' calc_element('text', t)
@@ -599,8 +491,6 @@ update_theme <- function(oldtheme, newtheme) {
 #' t$axis.text.x
 #' t$axis.text
 #' t$text
-#'
-#' @export
 calc_element <- function(element, theme, verbose = FALSE) {
   if (verbose) message(element, " --> ", appendLF = FALSE)
 
@@ -670,3 +560,11 @@ combine_elements <- function(e1, e2) {
 
   e1
 }
+
+#' Reports whether x is a theme object
+#' @param x An object to test
+#' @export
+is.theme <- function(x) inherits(x, "theme")
+
+#' @export
+print.theme <- function(x, ...) utils::str(x)