diff --git a/NEWS.md b/NEWS.md
index 807e9a00fd..3408f12b44 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,12 @@
# ggplot2 (development version)
+* `coord_radial(clip = "on")` clips to the panel area when the graphics device
+ supports clipping paths (@teunbrand, #5952).
+* (internal) Panel clipping responsibility moved from Facet class to Coord
+ class through new `Coord$draw_panel()` method.
+* `theme(strip.clip)` now defaults to `"on"` and is independent of Coord
+ clipping (@teunbrand, 5952).
+* (internal) rearranged the code of `Facet$draw_paensl()` method (@teunbrand).
* Axis labels are now justified across facet panels (@teunbrand, #5820)
* Fixed bug in `stat_function()` so x-axis title now produced automatically
when no data added. (@phispu, #5647).
diff --git a/R/coord-.R b/R/coord-.R
index 6736059fbc..57cf351f92 100644
--- a/R/coord-.R
+++ b/R/coord-.R
@@ -208,6 +208,20 @@ Coord <- ggproto("Coord",
# used as a fudge for CoordFlip and CoordPolar
modify_scales = function(scales_x, scales_y) {
invisible()
+ },
+
+ draw_panel = function(self, panel, params, theme) {
+ fg <- self$render_fg(params, theme)
+ bg <- self$render_bg(params, theme)
+ if (isTRUE(theme$panel.ontop)) {
+ panel <- list2(!!!panel, bg, fg)
+ } else {
+ panel <- list2(bg, !!!panel, fg)
+ }
+ gTree(
+ children = inject(gList(!!!panel)),
+ vp = viewport(clip = self$clip)
+ )
}
)
diff --git a/R/coord-radial.R b/R/coord-radial.R
index c47d55bb56..2f44e1ae4b 100644
--- a/R/coord-radial.R
+++ b/R/coord-radial.R
@@ -409,6 +409,27 @@ CoordRadial <- ggproto("CoordRadial", Coord,
)
},
+
+ draw_panel = function(self, panel, params, theme) {
+ clip_support <- check_device("clippingPaths", "test", maybe = TRUE)
+ if (self$clip == "on" && !isFALSE(clip_support)) {
+ clip_path <- data_frame0(
+ x = c(Inf, Inf, -Inf, -Inf),
+ y = c(Inf, -Inf, -Inf, Inf)
+ )
+ clip_path <- coord_munch(self, clip_path, params, is_closed = TRUE)
+ clip_path <- polygonGrob(clip_path$x, clip_path$y)
+ # Note that clipping path is applied to panel without coord
+ # foreground/background (added in parent method).
+ # These may contain decorations that needn't be clipped
+ panel <- list(gTree(
+ children = inject(gList(!!!panel)),
+ vp = viewport(clip = clip_path)
+ ))
+ }
+ ggproto_parent(Coord, self)$draw_panel(panel, params, theme)
+ },
+
labels = function(self, labels, panel_params) {
# `Layout$resolve_label()` doesn't know to look for theta/r/r.sec guides,
# so we'll handle title propagation here.
diff --git a/R/facet-.R b/R/facet-.R
index 359c19a248..780c8bd184 100644
--- a/R/facet-.R
+++ b/R/facet-.R
@@ -153,8 +153,7 @@ Facet <- ggproto("Facet", NULL,
table <- self$init_gtable(
panels, layout, theme, ranges, params,
- aspect_ratio = aspect_ratio %||% coord$aspect(ranges[[1]]),
- clip = coord$clip
+ aspect_ratio = aspect_ratio %||% coord$aspect(ranges[[1]])
)
table <- self$attach_axes(table, layout, ranges, coord, theme, params)
@@ -198,7 +197,7 @@ Facet <- ggproto("Facet", NULL,
data
},
init_gtable = function(panels, layout, theme, ranges, params,
- aspect_ratio = NULL, clip = "on") {
+ aspect_ratio = NULL) {
# Initialise matrix of panels
dim <- c(max(layout$ROW), max(layout$COL))
@@ -228,7 +227,7 @@ Facet <- ggproto("Facet", NULL,
"layout", table,
widths = widths, heights = heights,
respect = !is.null(aspect_ratio),
- clip = clip, z = matrix(1, dim[1], dim[2])
+ clip = "off", z = matrix(1, dim[1], dim[2])
)
# Set panel names
diff --git a/R/facet-grid-.R b/R/facet-grid-.R
index c51df5c138..a0b6e31931 100644
--- a/R/facet-grid-.R
+++ b/R/facet-grid-.R
@@ -404,13 +404,13 @@ FacetGrid <- ggproto("FacetGrid", Facet,
space <- if (!inside_x & table_has_grob(table, "axis-b")) padding
table <- seam_table(
table, strips$x$bottom, side = "bottom", name = "strip-b",
- shift = shift_x, z = 2, clip = "on", spacing = space
+ shift = shift_x, z = 2, clip = "off", spacing = space
)
} else {
space <- if (!inside_x & table_has_grob(table, "axis-t")) padding
table <- seam_table(
table, strips$x$top, side = "top", name = "strip-t",
- shift = shift_x, z = 2, clip = "on", spacing = space
+ shift = shift_x, z = 2, clip = "off", spacing = space
)
}
@@ -422,13 +422,13 @@ FacetGrid <- ggproto("FacetGrid", Facet,
space <- if (!inside_y & table_has_grob(table, "axis-l")) padding
table <- seam_table(
table, strips$y$left, side = "left", name = "strip-l",
- shift = shift_y, z = 2, clip = "on", spacing = space
+ shift = shift_y, z = 2, clip = "off", spacing = space
)
} else {
space <- if (!inside_y & table_has_grob(table, "axis-r")) padding
table <- seam_table(
table, strips$y$right, side = "right", name = "strip-r",
- shift = shift_y, z = 2, clip = "on", spacing = space
+ shift = shift_y, z = 2, clip = "off", spacing = space
)
}
table
diff --git a/R/facet-null.R b/R/facet-null.R
index bc95141fde..c66f39fa03 100644
--- a/R/facet-null.R
+++ b/R/facet-null.R
@@ -63,11 +63,10 @@ FacetNull <- ggproto("FacetNull", Facet,
grob_widths <- unit.c(grobWidth(axis_v$left), unit(1, "null"), grobWidth(axis_v$right))
grob_heights <- unit.c(grobHeight(axis_h$top), unit(abs(aspect_ratio), "null"), grobHeight(axis_h$bottom))
grob_names <- c("spacer", "axis-l", "spacer", "axis-t", "panel", "axis-b", "spacer", "axis-r", "spacer")
- grob_clip <- c("off", "off", "off", "off", coord$clip, "off", "off", "off", "off")
layout <- gtable_matrix("layout", all,
widths = grob_widths, heights = grob_heights,
- respect = respect, clip = grob_clip,
+ respect = respect, clip = "off",
z = z_matrix
)
layout$layout$name <- grob_names
diff --git a/R/facet-wrap.R b/R/facet-wrap.R
index 93ae19da91..854aacdd80 100644
--- a/R/facet-wrap.R
+++ b/R/facet-wrap.R
@@ -405,7 +405,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
shift <- if (inside) shift[1] else shift[2]
size <- unit(size, "cm")
- table <- weave(table, mat, shift, size, name = prefix, z = 2, clip = "on")
+ table <- weave(table, mat, shift, size, name = prefix, z = 2, clip = "off")
if (!inside) {
axes <- grepl(paste0("axis-", pos), table$layout$name)
diff --git a/R/layout.R b/R/layout.R
index f6e04f9b9c..1b578111b2 100644
--- a/R/layout.R
+++ b/R/layout.R
@@ -80,19 +80,8 @@ Layout <- ggproto("Layout", NULL,
panels <- lapply(seq_along(panels[[1]]), function(i) {
panel <- lapply(panels, `[[`, i)
panel <- c(facet_bg[i], panel, facet_fg[i])
-
- coord_fg <- self$coord$render_fg(self$panel_params[[i]], theme)
- coord_bg <- self$coord$render_bg(self$panel_params[[i]], theme)
- if (isTRUE(theme$panel.ontop)) {
- panel <- c(panel, list(coord_bg), list(coord_fg))
- } else {
- panel <- c(list(coord_bg), panel, list(coord_fg))
- }
-
- ggname(
- paste("panel", i, sep = "-"),
- gTree(children = inject(gList(!!!panel)))
- )
+ panel <- self$coord$draw_panel(panel, self$panel_params[[i]], theme)
+ ggname(paste("panel", i, sep = "-"), panel)
})
plot_table <- self$facet$draw_panels(
panels,
diff --git a/R/theme-defaults.R b/R/theme-defaults.R
index 951f20a01c..9c94e9dce5 100644
--- a/R/theme-defaults.R
+++ b/R/theme-defaults.R
@@ -212,7 +212,7 @@ theme_grey <- function(base_size = 11, base_family = "",
panel.ontop = FALSE,
strip.background = element_rect(fill = "grey85", colour = NA),
- strip.clip = "inherit",
+ strip.clip = "on",
strip.text = element_text(
colour = "grey10",
size = rel(0.8),
@@ -511,7 +511,7 @@ theme_void <- function(base_size = 11, base_family = "",
legend.box.margin = rel(0),
legend.box.spacing = unit(0.2, "cm"),
legend.ticks.length = rel(0.2),
- strip.clip = "inherit",
+ strip.clip = "on",
strip.text = element_text(size = rel(0.8)),
strip.switch.pad.grid = rel(0.5),
strip.switch.pad.wrap = rel(0.5),
@@ -643,7 +643,7 @@ theme_test <- function(base_size = 11, base_family = "",
panel.ontop = FALSE,
strip.background = element_rect(fill = "grey85", colour = "grey20"),
- strip.clip = "inherit",
+ strip.clip = "on",
strip.text = element_text(
colour = "grey10",
size = rel(0.8),
diff --git a/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg b/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg
index 66caee5c07..7c936b4768 100644
--- a/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg
+++ b/tests/testthat/_snaps/facet-/facet-wrap-with-omitted-inner-axis-labels.svg
@@ -108,83 +108,110 @@
-
-
+
+
-
+
+
+6
-
-
+
+
-
-
-6
+
1
-
-
+
+
-
+
8
-
-0
-
-
+
+
-
+
+
+0
-
-
+
+
-
+
4
+
+
+
+
+
+
+
+
+
0
-
-
+
+
-
+
4
+
+
+
+
+
+
+
+
+
1
-
-
+
+
-
+
6
+
+
+
+
+
+
+
+
+
0
diff --git a/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg b/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg
index c3f247ebe5..7d546bcc7e 100644
--- a/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg
+++ b/tests/testthat/_snaps/facet-layout/axes-are-positioned-correctly-in-non-table-layout.svg
@@ -93,24 +93,6 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
@@ -349,15 +331,6 @@
-
-
-
-
-
-
-
-
-
@@ -380,15 +353,6 @@
-
-
-
-
-
-
-
-
-
diff --git a/tests/testthat/test-coord-polar.R b/tests/testthat/test-coord-polar.R
index e9cdcc4813..da49368108 100644
--- a/tests/testthat/test-coord-polar.R
+++ b/tests/testthat/test-coord-polar.R
@@ -158,6 +158,9 @@ test_that("bounding box calculations are sensible", {
# Visual tests ------------------------------------------------------------
+#TODO: Once {vdiffr} supports non-rectangular clipping paths, we should add a
+# test for `coord_radial(clip = "on")`'s ability to clip to the sector
+
test_that("polar coordinates draw correctly", {
theme <- theme_test() +
theme(