guide_level() compatibility with ggplot2 >3.4.2

NAMESPACE

@@ -223,6 +223,7 @@ S3method(generate,dist_uniform)
 S3method(generate,dist_weibull)
 S3method(generate,dist_wrap)
 S3method(generate,distribution)
+S3method(guide_gengrob,guide_level)
 S3method(guide_geom,guide_level)
 S3method(guide_train,level_guide)
 S3method(hdr,default)
@@ -507,6 +508,7 @@ importFrom(farver,convert_colour)
 importFrom(generics,generate)
 importFrom(ggplot2,discrete_scale)
 importFrom(ggplot2,guide_colourbar)
+importFrom(ggplot2,guide_gengrob)
 importFrom(ggplot2,guide_geom)
 importFrom(ggplot2,guide_legend)
 importFrom(ggplot2,guide_train)

R/scale-level.R

@@ -72,6 +72,9 @@ guide_train.level_guide <- function(guide, scale, aesthetic) {
     return()
   if(length(levels)<=guide$max_discrete){
     guide <- do.call("guide_legend", args)
+    if (inherits(guide, "Guide")) {
+      guide <- guide$params
+    }
     class(guide) <- c("guide", "guide_level")
     breaks <- levels
 
@@ -95,6 +98,10 @@ guide_train.level_guide <- function(guide, scale, aesthetic) {
   }
   else{
     guide <- do.call("guide_colourbar", args)
+    if (inherits(guide, "Guide")) {
+      guide <- guide$params
+      class(guide) <- c("guide", "guide_level")
+    }
     breaks <- scale$get_breaks()
     ticks <- as.data.frame(stats::setNames(list(scale$map(breaks)),
                                            aesthetic %||% scale$aesthetics[1]))
@@ -124,8 +131,21 @@ guide_train.level_guide <- function(guide, scale, aesthetic) {
 #' @rdname guide-helpers
 guide_geom.guide_level <- function (guide, layers, default_mapping)
 {
-  class(guide) <- c("guide", "legend")
-  guide <- guide_geom(guide, layers, default_mapping)
+  if (inherits(ggplot2::guide_none(), "Guide")) {
+    if ("bar" %in% names(guide)) {
+      colourbar <- guide_colourbar()
+      guide$decor <- guide$bar
+      names(guide$decor)[names(guide$decor) == "value"] <- ".value"
+      guide <- colourbar$get_layer_key(guide, layers)
+      return(guide)
+    }
+    legend <- guide_legend()
+    guide$geoms <- legend$get_layer_key(guide, layers)$decor
+  } else {
+    class(guide) <- c("guide", "legend")
+    guide <- guide_geom(guide, layers, default_mapping)
+  }
+
   guide$geoms <- lapply(guide$geoms, function(x){
     x$draw_key <- ggplot2::ggproto(NULL, NULL,
                                    draw_key = function(data, params, size){
@@ -147,3 +167,37 @@ guide_geom.guide_level <- function (guide, layers, default_mapping)
   })
   guide
 }
+
+#' @export
+#' @importFrom ggplot2 guide_gengrob
+#' @rdname guide-helpers
+guide_gengrob.guide_level <- function(guide, theme) {
+  if (!inherits(ggplot2::guide_none(), "Guide")) {
+    out <- NextMethod()
+    return(out)
+  }
+  if ("bar" %in% names(guide)) {
+
+    # Make adjustments between versions
+    guide$label.position <- guide$label.position %||% switch(
+      guide$direction,
+      horizontal = "bottom", vertical = "right"
+    )
+    guide$key$.value <- scales::rescale(
+      guide$key$.value,
+      c(0.5, guide$nbin - 0.5) / guide$nbin,
+      guide$decor$.value[c(1, guide$nbin)]
+    )
+
+    # Use new guide for drawing
+    colourbar <- guide_colourbar()
+    colourbar$draw(theme, guide)
+  } else {
+    # Make adjustments between versions
+    guide$decor <- guide$geoms
+
+    # Use new guide for drawing
+    legend <- guide_legend()
+    legend$draw(theme, guide)
+  }
+}

tests/testthat/test-graphics.R

@@ -1,6 +1,9 @@
 dist <- c(dist_normal(0, 1), dist_beta(5, 1))
 
 test_that("geom_hilo_ribbon()", {
+
+  rlang::local_options(lifecycle_verbosity = "quiet")
+
   dist <- dist_normal(1:3, 1:3)
   p <- ggplot2::ggplot(
     data.frame(x = rep(1:3, 2), interval = c(hilo(dist, 80), hilo(dist, 95)))
@@ -17,6 +20,9 @@ test_that("geom_hilo_ribbon()", {
   )
 })
 test_that("geom_hilo_linerange()", {
+
+  rlang::local_options(lifecycle_verbosity = "quiet")
+
   dist <- dist_normal(1:3, 1:3)
   p <- ggplot2::ggplot(
     data.frame(x = rep(1:3, 2), interval = c(hilo(dist, 80), hilo(dist, 95)))