Better detection of new guide system

R/guide_stringlegend.R

@@ -111,7 +111,7 @@ guide_stringlegend <- function(
 #' @method guide_train stringlegend
 #' @noRd
 guide_train.stringlegend <- function(guide, scale, aesthetic) {
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     return(NextMethod())
   }
   legend <- guide_legend()
@@ -122,7 +122,7 @@ guide_train.stringlegend <- function(guide, scale, aesthetic) {
 #' @method guide_geom stringlegend
 #' @noRd
 guide_geom.stringlegend <- function(guide, layers, ...) {
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     return(NextMethod())
   }
   legend <- guide_legend()

R/strip_vanilla.R

@@ -149,7 +149,7 @@ Strip <- ggproto(
     aes <- if (position %in% c("top", "bottom")) "x" else "y"
     labels <- mapply(function(label, elem) {
       grob <- element_grob(elem, label, margin_x = TRUE, margin_y = TRUE)
-      if (utils::packageVersion("ggplot2") <= "3.4.2") {
+      if (!new_guide_system) {
         if (!inherits(grob, c("titleGrob", "zeroGrob"))) {
           grob <- add_margins(
             gList(grob), grobHeight(grob), grobWidth(grob),
@@ -167,7 +167,7 @@ Strip <- ggproto(
     }
 
     if (aes == "x") {
-      if (utils::packageVersion("ggplot2") <= "3.4.2") {
+      if (!new_guide_system) {
         height <- lapply(labels[!zeros], function(x) x$heights[2])
         height <- lapply(split(height, layer_id[!zeros]), max_height)
         height <- do.call(unit.c, height)
@@ -176,7 +176,7 @@ Strip <- ggproto(
       }
       width  <- rep(unit(1, "null"), length(height))
     } else {
-      if (utils::packageVersion("ggplot2") <= "3.4.2") {
+      if (!new_guide_system) {
         width <- lapply(labels[!zeros], function(x) x$widths[2])
         width <- lapply(split(width, layer_id[!zeros]), max_width)
         width <- do.call(unit.c, width)
@@ -186,7 +186,7 @@ Strip <- ggproto(
       height <- rep(unit(1, "null"), length(width))
     }
 
-    if (utils::packageVersion("ggplot2") <= "3.4.2") {
+    if (!new_guide_system) {
       # Set all margins equal
       idx_w <- c("vp", "parent", "layout", "widths")
       idx_h <- c("vp", "parent", "layout", "heights")

R/utils.R

@@ -47,6 +47,10 @@ find_global <- function(name, env, mode = "any") {
   NULL
 }
 
+new_guide_system <- NA
+on_load(new_guide_system <- inherits(guide_none(), "Guide"))
+
 .onLoad <- function(...) {
   ggh4x_theme_elements()
+  run_on_load()
 }

tests/testthat/test-coord_axes_inside.R

@@ -19,7 +19,7 @@ test_that("coord_axis_inside can place axes inside", {
   axis <- test$grobs[test$layout$name == "axis-l"][[1]]$children
   axis <- axis[names(axis) == "axis"][[1]]
 
-  if (utils::packageVersion("ggplot2") > "3.4.2") {
+  if (new_guide_system) {
     expect_s3_class(axis$grobs[[1]], "zeroGrob")
     expect_s3_class(axis$grobs[[2]], "titleGrob")
   } else {

tests/testthat/test-facet_grid2.R

@@ -21,7 +21,7 @@ test_that("facet_grid2 can duplicate axes and remove labels", {
   b <- vapply(b, function(x){length(x$children[[2]]$grobs)}, integer(1))
   l <- vapply(l, function(x){length(x$children[[2]]$grobs)}, integer(1))
 
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     expect_equal(b, c(2L, 2L, 2L, 2L))
     expect_equal(l, c(1L, 1L, 2L, 2L))
   } else {

tests/testthat/test-facet_wrap2.R

@@ -97,7 +97,7 @@ test_that("facet_wrap2() can remove some labels", {
   ctrl2 <- ggplotGrob(ctrl2)
 
   # Compare x-axis
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     expect_equal(nchildren(case1, "b"), rep(2L, 6))
     expect_equal(nchildren(case2, "b"), c(2L, 2L, 2L, 1L, 1L, 1L))
     expect_equal(nchildren(ctrl1, "b"), c(2L, 2L, 2L, 0L, 0L, 0L))
@@ -110,7 +110,7 @@ test_that("facet_wrap2() can remove some labels", {
   }
 
   # Compare y-axis
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     expect_equal(nchildren(case1, "l"), c(1L, 1L, 1L, 1L, 2L, 2L))
     expect_equal(nchildren(case2, "l"), rep(2L, 6))
     expect_equal(nchildren(ctrl1, "l"), c(0L, 0L, 0L, 0L, 2L, 2L))

tests/testthat/test-facetted_pos_scales.R

@@ -102,7 +102,7 @@ grab_axis <- function(plot, where = "b", what = "label") {
   if (is.null(what)) {
     return(axes)
   }
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     label_index <- 1
   } else {
     label_index <- 2
@@ -227,7 +227,7 @@ test_that("facetted_pos_scales can set position arguments", {
   b <- b$grobs[grepl("axis-l", b$layout$name)]
   c <- c$grobs[grepl("axis-r", c$layout$name)]
 
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     a <- lapply(a, function(x) x$children$axis$grobs[[1]]$children[[1]]$label)
     b <- lapply(b, function(x) x$children$axis$grobs[[1]]$children[[1]]$label)
     c <- lapply(c, function(x) x$children$axis$grobs[[2]]$children[[1]]$label)
@@ -261,7 +261,7 @@ test_that("facetted_pos_scales can set secondary axis", {
   b <- b$grobs[grepl("axis-l", b$layout$name)]
   c <- c$grobs[grepl("axis-r", c$layout$name)]
 
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     a <- lapply(a, function(x) x$children$axis$grobs[[1]]$children[[1]]$label)
     b <- lapply(b, function(x) x$children$axis$grobs[[1]]$children[[1]]$label)
     c <- lapply(c, function(x) x$children$axis$grobs[[2]]$children[[1]]$label)

tests/testthat/test-guide_axis_logticks.R

@@ -109,7 +109,7 @@ test_that("guide_axis_logticks errors upon misuse", {
     geom_point(aes(colour = Species)) +
     scale_colour_discrete(guide = "axis_logticks")
 
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     expect_snapshot_error(ggplotGrob(g))
   } else {
     expect_snapshot_warning(ggplotGrob(g))

tests/testthat/test-guide_axis_minor.R

@@ -32,7 +32,7 @@ test_that("guide_axis_minor works on y-scales", {
   expect_length(unique(test), 3) # 1 at base, 1 for long ticks, 1 for short
 
   ctrl <- grab_axis(base, "l")
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     ctrl <- grid::convertX(ctrl$grobs[[2]]$x, "cm", valueOnly = TRUE)
   } else {
     ctrl <- grid::convertX(ctrl$grobs[[1]]$x, "cm", valueOnly = TRUE)
@@ -51,7 +51,7 @@ test_that("guide_axis_minor works on top x-scales", {
   expect_length(unique(test), 3) # 1 at base, 1 for long ticks, 1 for short
 
   ctrl <- grab_axis(ctrl, "t")
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     ctrl <- grid::convertX(ctrl$grobs[[2]]$y, "cm", valueOnly = TRUE)
   } else {
     ctrl <- grid::convertX(ctrl$grobs[[1]]$y, "cm", valueOnly = TRUE)
@@ -102,7 +102,7 @@ test_that("guide_axis_minor errors upon misuse", {
     geom_point(aes(colour = Species)) +
     scale_colour_discrete(guide = "axis_minor")
 
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     expect_snapshot_error(ggplotGrob(g))
   } else {
     expect_snapshot_warning(ggplotGrob(g))

tests/testthat/test-guide_axis_nested.R

@@ -89,7 +89,7 @@ test_that("guide_axis_nested errors upon misuse", {
   base <- ggplot(mpg, aes(interaction(cyl, class), hwy)) +
     geom_boxplot(aes(fill = class))
   g <- base + scale_fill_discrete(guide = "axis_nested")
-  if (utils::packageVersion("ggplot2") <= "3.4.2") {
+  if (!new_guide_system) {
     expect_snapshot_error(ggplotGrob(g))
   } else {
     expect_snapshot_warning(ggplotGrob(g))

tests/testthat/test-scale_colour_multi.R

@@ -197,7 +197,7 @@ test_that("scale_colour_multi sets labels independently", {
   guidenames <- vapply(guidebox, function(box) {
     box$grobs[box$layout$name == "title"][[1]]$children[[1]]$children[[1]]$label
   }, character(1))
-  i <- if (utils::packageVersion("ggplot2") <= "3.4.2") "label" else "labels"
+  i <- if (!new_guide_system) "label" else "labels"
   labs <- lapply(guidebox, function(tg){
     tg$grobs[tg$layout$name == i][[1]]$children[[1]]$label
   })[order(guidenames)]

tests/testthat/test-scale_fill_multi.R

@@ -197,7 +197,7 @@ test_that("scale_fill_multi sets labels independently", {
   guidenames <- vapply(guidebox, function(box) {
     box$grobs[box$layout$name == "title"][[1]]$children[[1]]$children[[1]]$label
   }, character(1))
-  i <- if (utils::packageVersion("ggplot2") <= "3.4.2") "label" else "labels"
+  i <- if (!new_guide_system) "label" else "labels"
   labs <- lapply(guidebox, function(tg){
     tg$grobs[tg$layout$name == i][[1]]$children[[1]]$label
   })[order(guidenames)]