Strip clipping optional (re: #4125)

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* `theme()` now has a `strip.clip` argument, that can be set to `"off"` to 
+  prevent the clipping of strip text and background borders (@teunbrand, #4118)
+
 * `aes()` now supports the `!!!` operator in its first two arguments
   (#2675). Thanks to @yutannihilation and @teunbrand for draft
   implementations.

R/labeller.r

@@ -498,18 +498,23 @@ build_strip <- function(label_df, labeller, theme, horizontal) {
   ncol <- ncol(labels)
   nrow <- nrow(labels)
 
+  # Decide strip clipping
+  clip <- calc_element("strip.clip", theme)[[1]]
+  clip <- pmatch(clip, c("on", "off", "inherit"), nomatch = 3)
+  clip <- c("on", "off", "inherit")[clip]
+
   if (horizontal) {
     grobs_top <- lapply(labels, element_render, theme = theme,
                         element = "strip.text.x.top", margin_x = TRUE,
                         margin_y = TRUE)
     grobs_top <- assemble_strips(matrix(grobs_top, ncol = ncol, nrow = nrow),
-                                 theme, horizontal, clip = "on")
+                                 theme, horizontal, clip = clip)
 
     grobs_bottom <- lapply(labels, element_render, theme = theme,
                            element = "strip.text.x.bottom", margin_x = TRUE,
                            margin_y = TRUE)
     grobs_bottom <- assemble_strips(matrix(grobs_bottom, ncol = ncol, nrow = nrow),
-                                    theme, horizontal, clip = "on")
+                                    theme, horizontal, clip = clip)
 
     list(
       top = grobs_top,
@@ -520,14 +525,14 @@ build_strip <- function(label_df, labeller, theme, horizontal) {
                          element = "strip.text.y.left", margin_x = TRUE,
                          margin_y = TRUE)
     grobs_left <- assemble_strips(matrix(grobs_left, ncol = ncol, nrow = nrow),
-                                  theme, horizontal, clip = "on")
+                                  theme, horizontal, clip = clip)
 
     grobs_right <- lapply(labels[, rev(seq_len(ncol(labels))), drop = FALSE],
                           element_render, theme = theme,
                           element = "strip.text.y.right", margin_x = TRUE,
                           margin_y = TRUE)
     grobs_right <- assemble_strips(matrix(grobs_right, ncol = ncol, nrow = nrow),
-                                   theme, horizontal, clip = "on")
+                                   theme, horizontal, clip = clip)
 
     list(
       left = grobs_left,

R/theme-defaults.r

@@ -197,6 +197,7 @@ theme_grey <- function(base_size = 11, base_family = "",
     panel.ontop    =     FALSE,
 
     strip.background =   element_rect(fill = "grey85", colour = NA),
+    strip.clip =         "inherit",
     strip.text =         element_text(
                            colour = "grey10",
                            size = rel(0.8),
@@ -484,6 +485,7 @@ theme_void <- function(base_size = 11, base_family = "",
     legend.position =    "right",
     legend.text =        element_text(size = rel(0.8)),
     legend.title =       element_text(hjust = 0),
+    strip.clip =         "inherit",
     strip.text =         element_text(size = rel(0.8)),
     strip.switch.pad.grid = unit(half_line / 2, "pt"),
     strip.switch.pad.wrap = unit(half_line / 2, "pt"),
@@ -609,6 +611,7 @@ theme_test <- function(base_size = 11, base_family = "",
     panel.ontop    =     FALSE,
 
     strip.background =   element_rect(fill = "grey85", colour = "grey20"),
+    strip.clip =         "inherit",
     strip.text =         element_text(
                            colour = "grey10",
                            size = rel(0.8),

R/theme-elements.r

@@ -478,6 +478,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) {
   strip.background    = el_def("element_rect", "rect"),
   strip.background.x  = el_def("element_rect", "strip.background"),
   strip.background.y  = el_def("element_rect", "strip.background"),
+  strip.clip          = el_def("character"),
   strip.text.x        = el_def("element_text", "strip.text"),
   strip.text.x.top    = el_def("element_text", "strip.text.x"),
   strip.text.x.bottom = el_def("element_text", "strip.text.x"),

R/theme.r

@@ -148,6 +148,10 @@
 #' @param strip.placement placement of strip with respect to axes,
 #'    either "inside" or "outside". Only important when axes and strips are
 #'    on the same side of the plot.
+#' @param strip.clip should strip background edges and strip labels be clipped
+#'   to the extend of the strip background? Options are `"on"` to clip, `"off"`
+#'   to disable clipping or `"inherit"` (default) to take the clipping setting
+#'   from the parent viewport.
 #' @param strip.text,strip.text.x,strip.text.y facet labels ([element_text()];
 #'   inherits from  `text`). Horizontal facet labels (`strip.text.x`) & vertical
 #'   facet labels (`strip.text.y`) inherit from `strip.text` or can be specified
@@ -350,6 +354,7 @@ theme <- function(line,
                   strip.background,
                   strip.background.x,
                   strip.background.y,
+                  strip.clip,
                   strip.placement,
                   strip.text,
                   strip.text.x,

tests/testthat/test-facet-strips.r

@@ -162,3 +162,22 @@ test_that("y strip labels are rotated when strips are switched", {
 
   expect_doppelganger("switched facet strips", switched)
 })
+
+test_that("strip clipping can be set from the theme", {
+  labels <- data_frame(var1 = "a")
+
+  strip <- render_strips(
+    labels,
+    labeller = label_value,
+    theme = theme_test() + theme(strip.clip = "on")
+  )
+  expect_equal(strip$x$top[[1]]$layout$clip, "on")
+
+  strip <- render_strips(
+    labels,
+    labeller = label_value,
+    theme = theme_test() + theme(strip.clip = "off")
+  )
+  expect_equal(strip$x$top[[1]]$layout$clip, "off")
+})
+