User-facing tinytheme_get() function + restore plot region after theme

NAMESPACE

@@ -17,6 +17,7 @@ export(tinypairs)
 export(tinyplot)
 export(tinyplot_add)
 export(tinytheme)
+export(tinytheme_get)
 export(tinytheme_list)
 export(tinytheme_register)
 export(tinytheme_unregister)

NEWS.md

@@ -216,6 +216,8 @@ related to plot layering. See "Bug fixes" below.
     so that tiles meet the panel edge, and also rotates the tick labels against
     their respective axes. Colour fills default to the "tealgrn" sequential
     palette. (#677 @grantmcdermott)
+  - New `tinytheme_get()` function returns the name of the currently active
+    theme. (#629 @grantmcdermott)
 - Custom plot types have more control over the surrounding plot machinery, via a
   new `type_hints` mechanism. A type can declare properties about itself---that
   it draws its own axes, needs a secondary right-hand axis, uses proportional
@@ -233,6 +235,12 @@ related to plot layering. See "Bug fixes" below.
 
 ### Bug fixes
 
+- Annotations and layers added after a plot that used an ephemeral `theme`
+  argument are no longer clipped to the wrong region. Only triggered once an
+  intervening annotation changed `xpd` (e.g. `box()`, `mtext()`, or
+  `type_text(xpd = NA)`), since that is what makes base R recompute the
+  clipping rectangle. Thanks to @bastistician for the report.
+  (#629 @grantmcdermott)
 - `type_text()` no longer converts a categorical axis to a numeric one.
   (#730 @grantmcdermott)
 - `type_hline()`, `type_vline()`, and `type_abline()` now respect

R/tinyplot.R

@@ -938,7 +938,10 @@ tinyplot.default = function(
     } else {
       dtheme = theme_default
       otheme = opar[names(dtheme)]
-      on.exit(do.call(tinytheme, otheme), add = TRUE)
+      on.exit({
+        do.call(tinytheme, otheme)
+        restore_plot_region(opar[["mar"]]) # See #629
+      }, add = TRUE)
     }
   }
 
@@ -1283,7 +1286,7 @@ tinyplot.default = function(
     # Read the theme's intended mar. Also build a tpars list from the theme
     # definition so dynmar_side uses theme mgp/tcl/las (which aren't in
     # par() yet since the before.plot.new hook hasn't fired).
-    .tinytheme = get_tpar("tinytheme", default = "default")
+    .tinytheme = tinytheme_get()
     .theme_def = get_theme_def(.tinytheme)
     if (identical(.theme_def, theme_default)) .theme_def = NULL
     .theme_mar = if (!is.null(.theme_def[["mar"]])) .theme_def[["mar"]] else par("mar")

R/tinyplot.data.frame.R

@@ -170,7 +170,7 @@ tinypairs = function (x, by = NULL, labs = FALSE, frames = FALSE, ...) {
   ## language object because `cl` is a matched call, so `cl[["theme"]]` is
   ## unevaluated (e.g. the call `list("dark")`, not a list).
   cex_fct_adj = ifelse(n > 2, 0.66, 0.83) # use same scaling as with faceted plots.
-  active_theme = get_tpar("tinytheme", default = "default")
+  active_theme = tinytheme_get()
   theme_arg = cl[["theme"]]
   if (is.null(theme_arg)) {
     theme_ij = bquote(list(.(active_theme), cex = .(cex_fct_adj)))

R/tinytheme.R

@@ -117,6 +117,8 @@
 #' @return The function returns nothing. It is called for its side effects.
 #' 
 #' @seealso [`tpar`] which does the heavy lifting under the hood;
+#'   [tinytheme_get()] for retrieving the name of the active theme;
+#'   [tinytheme_list()] for listing the names of all available themes;
 #'   [tinytheme_register()] for registering custom named themes.
 #'
 #' @examples
@@ -297,6 +299,47 @@ tinytheme = function(
 }
 
 
+#' @title Get the currently active theme
+#'
+#' @description Returns the name of the [`tinytheme`] that is currently in
+#'   effect. Handy for saving a theme and restoring it later, or for querying
+#'   the active theme programmatically.
+#'
+#' @details A thin convenience wrapper around the `"tinytheme"` entry of
+#'   [`tpar`]. The difference is that it always returns a plain character
+#'   string, including in a session where no theme has been set yet (where
+#'   `tpar("tinytheme")` returns `NULL` rather than `"default"`). Use [`tpar`]
+#'   if you want the full set of underlying theme settings, rather than just
+#'   the name.
+#'
+#'   Note that a theme passed to the `tinyplot(..., theme =)` argument is
+#'   ephemeral: it is reset on exit, so it is only visible to
+#'   `tinytheme_get()` from inside that same call (e.g. via `draw`).
+#'
+#' @returns A character string naming the active theme.
+#'
+#' @seealso [tinytheme], [tinytheme_register], [tpar]
+#'
+#' @examples
+#' # no theme set yet
+#' tinytheme_get()
+#'
+#' # save the current theme, switch, then restore it afterwards
+#' otheme = tinytheme_get()
+#' tinytheme("classic")
+#' tinytheme_get()
+#'
+#' tinyplot(mpg ~ wt, data = mtcars)
+#'
+#' tinytheme(otheme) # back to where we started
+#' tinytheme_get()
+#'
+#' @export
+tinytheme_get = function() {
+  get_tpar("tinytheme", default = "default")
+}
+
+
 
 #
 ## Themes (these are read and set at initial load time)
@@ -771,7 +814,7 @@ get_theme_def = function(name) {
 #'   `tinytheme_list()` returns a named list with character vectors `builtin`
 #'   and `registered`. `tinytheme_unregister()` returns `NULL` (invisibly).
 #'
-#' @seealso [tinytheme()]
+#' @seealso [tinytheme()], [tinytheme_get()]
 #'
 #' @examples
 #' # Register a custom theme based on "float" but with a grid

R/tpar.R

@@ -100,6 +100,7 @@
 #' stages of a `tinyplot` call (and used for internal accounting purposes).
 #' [`tinytheme`] allows users to easily set a group of graphics parameters
 #' in a single function call, according to a variety of predefined themes.
+#' [`tinytheme_get`] returns the name of the currently active theme.
 #'
 #' @examples
 #' # Return a list of existing base and tinyplot graphic params

R/utils.R

@@ -229,6 +229,63 @@ restore_margin_inner = function(ooma, topmar_epsilon = 0.1) {
 }
 
 
+#' Restore the original plot region
+#'
+#' @description A theme applies its margins through the `before.plot.new` hook,
+#'   so they live in the current graphics state but never reach `par()`.
+#'   Rolling an ephemeral theme back therefore leaves `par(plt)` describing a
+#'   different region than the one we just drew into. Base R recomputes the
+#'   device clipping rectangle from `par()`, but only when `xpd` changes, so
+#'   anything added afterwards gets silently truncated to the wrong rectangle
+#'   as soon as some intervening call touches `xpd` (e.g. `box()`, `mtext()`,
+#'   or `type_text(xpd = NA)`). See #629.
+#'
+#'   Fix: put the original (drawn-into) region back, then hand `mar_before`
+#'   back at the next `plot.new()` so the theme's margins don't leak into the
+#'   following plot.
+#'
+#' @param mar_before Pre-theme inner margins (from par("mar"))
+#'
+#' @returns NULL (called for side effect of resetting par("plt"))
+#'
+#' @keywords internal
+restore_plot_region = function(mar_before) {
+  if (is.null(dev.list())) return(invisible(NULL))
+  # read .saved_par_after directly: get_saved_par()'s match.arg() costs more
+  # than everything else here put together
+  dplt = .tinyplot_env[[".saved_par_after"]][["plt"]]
+  if (is.null(dplt) || all(par("plt") == dplt)) return(invisible(NULL))
+  par(plt = dplt)
+  # Arm the reset for the next plot.new(). `dplt` doubles as the sentinel: mar
+  # and plt are derived from each other, so plt still matching on the way out
+  # means nothing else has claimed the margins since.
+  .tinyplot_env[[".mar_pending"]] = list(mar = mar_before, plt = dplt)
+  hks = getHook("before.plot.new")
+  if (!any(vapply(hks, function(h) isTRUE(attr(h, "tinyplot_mar")), logical(1)))) {
+    # first in line, so a theme's own margin hook still has the last word
+    setHook("before.plot.new", mar_reset_hook, action = "prepend")
+  }
+  invisible(NULL)
+}
+
+
+# Installed once by restore_plot_region() and then left registered, so that
+# re-arming is a bare assignment. Every tinyplot_add() layer re-enters
+# restore_plot_region() -- the theme rollback resets `plt` just beforehand --
+# and setHook()/getHook() churn on each of them measurably outweighs leaving
+# an inert closure in place. A no-op unless some plot has armed it.
+mar_reset_hook = structure(
+  function() {
+    pending = .tinyplot_env[[".mar_pending"]]
+    if (is.null(pending)) return(invisible(NULL))
+    .tinyplot_env[[".mar_pending"]] = NULL
+    if (all(par("plt") == pending[["plt"]])) par(mar = pending[["mar"]])
+    invisible(NULL)
+  },
+  tinyplot_mar = TRUE
+)
+
+
 # Convert colour(s) to HCL-like (Luv) coordinates, preserving alpha. Helper for
 # seq_palette(). (Originally lived in type_spineplot.R.)
 #' @importFrom grDevices col2rgb convertColor hcl

altdoc/quarto_website.yml

@@ -74,6 +74,10 @@ website:
           contents:
             - text: tinytheme
               file: man/tinytheme.qmd
+            - text: tinytheme_get
+              file: man/tinytheme_get.qmd
+            - text: tinytheme_list
+              file: man/tinytheme_register.qmd
             - text: tinytheme_register
               file: man/tinytheme_register.qmd
         - section: "Types"

inst/tinytest/test-tinytheme.R

@@ -215,6 +215,15 @@ f = function() {
 }
 expect_snapshot_plot(f, label = "ephemeral_default_theme_add")
 
+# Layers added after an ephemeral theme should not be clipped to the wrong
+# region once an intervening annotation has toggled `xpd` (#629)
+f = function() {
+  plt(0, 0, theme = "classic")
+  plt_add(par("usr")[1], y = 0.3, type = type_text(labels = "foo", xpd = NA, pos = 2))
+  plt_add(type = type_hline(0.3))
+}
+expect_snapshot_plot(f, label = "tinytheme_ephemeral_clip_xpd")
+
 # User mar override respected under dynmar (#587)
 f = function() {
   tinytheme("dynamic", mar = c(5, 5, 5, 5))
@@ -249,3 +258,32 @@ f = function() {
   )
 }
 expect_silent(f())
+
+
+## tinytheme_get() (#629)
+
+# a bare reset reports the default theme
+tinytheme()
+expect_equal(tinytheme_get(), "default")
+
+tinytheme("classic")
+expect_equal(tinytheme_get(), "classic")
+
+# the save/restore idiom the accessor exists for
+otheme = tinytheme_get()
+tinytheme("bw")
+expect_equal(tinytheme_get(), "bw")
+tinytheme(otheme)
+expect_equal(tinytheme_get(), "classic")
+
+# extra tpar overrides don't change the reported theme name
+tinytheme("ipsum", las = 2)
+expect_equal(tinytheme_get(), "ipsum")
+
+# registered themes report their own name
+tinytheme_register("float3", theme = "float", grid = TRUE)
+tinytheme("float3")
+expect_equal(tinytheme_get(), "float3")
+tinytheme_unregister("float3")
+
+tinytheme()