Export is.waive() for extensions to use (#6173)

* Export is.waive()

* Add NEWS bullet about is.waive

* Rename is.waive to is.waiver

NAMESPACE

@@ -475,6 +475,7 @@ export(is.scale)
 export(is.stat)
 export(is.theme)
 export(is.theme_element)
+export(is.waiver)
 export(label_both)
 export(label_bquote)
 export(label_context)

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* The helper function `is.waiver()` is now exported to help extensions to work
+  with `waiver()` objects (@arcresu, #6173).
 * Date(time) scales now throw appropriate errors when `date_breaks`, 
   `date_minor_breaks` or `date_labels` are not strings (@RodDalBen, #5880)
 * `geom_errorbarh()` is deprecated in favour of 

R/axis-secondary.R

@@ -129,7 +129,7 @@ is.sec_axis <- function(x) {
 }
 
 set_sec_axis <- function(sec.axis, scale) {
-  if (!is.waive(sec.axis)) {
+  if (!is.waiver(sec.axis)) {
     if (scale$is_discrete()) {
       if (!identical(.subset2(sec.axis, "trans"), identity)) {
         cli::cli_abort("Discrete secondary axes must have the {.fn identity} transformation.")
@@ -182,9 +182,9 @@ AxisSecondary <- ggproto("AxisSecondary", NULL,
     if (!is.function(transform)) {
       cli::cli_abort("Transformation for secondary axes must be a function.")
     }
-    if (is.derived(self$name) && !is.waive(scale$name)) self$name <- scale$name
+    if (is.derived(self$name) && !is.waiver(scale$name)) self$name <- scale$name
     if (is.derived(self$breaks)) self$breaks <- scale$breaks
-    if (is.waive(self$breaks)) {
+    if (is.waiver(self$breaks)) {
       if (scale$is_discrete()) {
         self$breaks <- scale$get_breaks()
       } else {

R/coord-sf.R

@@ -108,7 +108,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     x_breaks <- graticule$degree[graticule$type == "E"]
     if (is.null(scale_x$labels)) {
       x_labels <- rep(NA, length(x_breaks))
-    } else if (is.waive(scale_x$labels)) {
+    } else if (is.waiver(scale_x$labels)) {
       x_labels <- graticule$degree_label[graticule$type == "E"]
       needs_autoparsing[graticule$type == "E"] <- TRUE
     } else {
@@ -133,7 +133,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     y_breaks <- graticule$degree[graticule$type == "N"]
     if (is.null(scale_y$labels)) {
       y_labels <- rep(NA, length(y_breaks))
-    } else if (is.waive(scale_y$labels)) {
+    } else if (is.waiver(scale_y$labels)) {
       y_labels <- graticule$degree_label[graticule$type == "N"]
       needs_autoparsing[graticule$type == "N"] <- TRUE
     } else {
@@ -534,7 +534,7 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE,
                      label_axes = waiver(), lims_method = "cross",
                      ndiscr = 100, default = FALSE, clip = "on") {
 
-  if (is.waive(label_graticule) && is.waive(label_axes)) {
+  if (is.waiver(label_graticule) && is.waiver(label_axes)) {
     # if both `label_graticule` and `label_axes` are set to waive then we
     # use the default of labels on the left and at the bottom
     label_graticule <- ""
@@ -620,13 +620,13 @@ sf_breaks <- function(scale_x, scale_y, bbox, crs) {
       bbox[is.na(bbox)] <- c(-180, -90, 180, 90)[is.na(bbox)]
     }
 
-    if (!(is.waive(scale_x$breaks) && is.null(scale_x$n.breaks))) {
+    if (!(is.waiver(scale_x$breaks) && is.null(scale_x$n.breaks))) {
       x_breaks <- scale_x$get_breaks(limits = bbox[c(1, 3)])
       finite <- is.finite(x_breaks)
       x_breaks <- if (any(finite)) x_breaks[finite] else NULL
     }
 
-    if (!(is.waive(scale_y$breaks) && is.null(scale_y$n.breaks))) {
+    if (!(is.waiver(scale_y$breaks) && is.null(scale_y$n.breaks))) {
       y_breaks <- scale_y$get_breaks(limits = bbox[c(2, 4)])
       finite <- is.finite(y_breaks)
       y_breaks <- if (any(finite)) y_breaks[finite] else NULL

R/facet-null.R

@@ -27,9 +27,9 @@ FacetNull <- ggproto("FacetNull", Facet,
     layout_null()
   },
   map_data = function(data, layout, params) {
-    # Need the is.waive check for special case where no data, but aesthetics
+    # Need the is.waiver check for special case where no data, but aesthetics
     # are mapped to vectors
-    if (is.waive(data))
+    if (is.waiver(data))
       return(data_frame0(PANEL = factor()))
 
     if (empty(data))

R/guide-axis-theta.R

@@ -200,7 +200,7 @@ GuideAxisTheta <- ggproto(
     }
 
     # Resolve text angle
-    if (is.waive(params$angle) || is.null(params$angle)) {
+    if (is.waiver(params$angle) || is.null(params$angle)) {
       angle <- elements$text$angle
     } else {
       angle <- flip_text_angle(params$angle - rad2deg(key$theta))
@@ -276,7 +276,7 @@ GuideAxisTheta <- ggproto(
     }
 
     # Resolve text angle
-    if (is.waive(params$angle %||% waiver())) {
+    if (is.waiver(params$angle %||% waiver())) {
       angle <- elements$text$angle
     } else {
       angle <- flip_text_angle(params$angle - rad2deg(key$theta))

R/guide-custom.R

@@ -96,7 +96,7 @@ GuideCustom <- ggproto(
     # Render title
     params <- replace_null(params, position = position, direction = direction)
     elems <- GuideLegend$setup_elements(params, self$elements, theme)
-    if (!is.waive(params$title) && !is.null(params$title)) {
+    if (!is.waiver(params$title) && !is.null(params$title)) {
       title <- self$build_title(params$title, elems, params)
     } else {
       title <- zeroGrob()

R/labels.R

@@ -152,7 +152,7 @@ labs <- function(..., title = waiver(), subtitle = waiver(), caption = waiver(),
     tag = tag, alt = allow_lambda(alt), alt_insight = alt_insight,
     .ignore_empty = "all")
 
-  is_waive <- vapply(args, is.waive, logical(1))
+  is_waive <- vapply(args, is.waiver, logical(1))
   args <- args[!is_waive]
   # remove duplicated arguments
   args <- args[!duplicated(names(args))]

R/layer.R

@@ -253,7 +253,7 @@ Layer <- ggproto("Layer", NULL,
   },
 
   layer_data = function(self, plot_data) {
-    if (is.waive(self$data)) {
+    if (is.waiver(self$data)) {
       data <- plot_data
     } else if (is.function(self$data)) {
       data <- self$data(plot_data)
@@ -263,7 +263,7 @@ Layer <- ggproto("Layer", NULL,
     } else {
       data <- self$data
     }
-    if (is.null(data) || is.waive(data)) data else unrowname(data)
+    if (is.null(data) || is.waiver(data)) data else unrowname(data)
   },
 
   # hook to allow a layer access to the final layer data

R/layout.R

@@ -283,7 +283,7 @@ Layout <- ggproto("Layout", NULL,
         } else {
           switch(label, x = ".bottom", y = ".right")
         }
-        if (is.null(labels[[label]][[i]]) || is.waive(labels[[label]][[i]]))
+        if (is.null(labels[[label]][[i]]) || is.waiver(labels[[label]][[i]]))
           return(zeroGrob())
 
         element_render(

R/scale-.R

@@ -753,7 +753,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale,
     # don't support conversion to numeric (#5304)
     if (zero_range(as.numeric(transformation$transform(limits)))) {
       breaks <- limits[1]
-    } else if (is.waive(self$breaks)) {
+    } else if (is.waiver(self$breaks)) {
       if (!is.null(self$n.breaks) && trans_support_nbreaks(transformation)) {
         breaks <- transformation$breaks(limits, self$n.breaks)
       } else {
@@ -795,7 +795,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale,
     b <- b[is.finite(b)]
 
     transformation <- self$get_transformation()
-    if (is.waive(self$minor_breaks)) {
+    if (is.waiver(self$minor_breaks)) {
       if (is.null(b)) {
         breaks <- NULL
       } else {
@@ -842,7 +842,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale,
       )
     }
 
-    if (is.waive(self$labels)) {
+    if (is.waiver(self$labels)) {
       labels <- transformation$format(breaks)
     } else if (is.function(self$labels)) {
       labels <- self$labels(breaks)
@@ -1022,7 +1022,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
       )
     }
 
-    if (is.waive(self$breaks)) {
+    if (is.waiver(self$breaks)) {
       breaks <- limits
     } else if (is.function(self$breaks)) {
       breaks <- self$breaks(limits)
@@ -1084,7 +1084,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
       )
     }
 
-    if (is.waive(self$labels)) {
+    if (is.waiver(self$labels)) {
       if (is.numeric(breaks)) {
         # Only format numbers, because on Windows, format messes up encoding
         format(breaks, justify = "none")
@@ -1244,7 +1244,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale,
         "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.",
         call = self$call
       )
-    } else if (is.waive(self$breaks)) {
+    } else if (is.waiver(self$breaks)) {
       if (self$nice.breaks) {
         if (!is.null(self$n.breaks) && trans_support_nbreaks(transformation)) {
           breaks <- transformation$breaks(limits, n = self$n.breaks)
@@ -1334,7 +1334,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale,
         "Invalid {.arg labels} specification. Use {.code NULL}, not {.code NA}.",
         call = self$call
       )
-    } else if (is.waive(self$labels)) {
+    } else if (is.waiver(self$labels)) {
       labels <- transformation$format(breaks)
     } else if (is.function(self$labels)) {
       labels <- self$labels(breaks)

R/scale-continuous.R

@@ -146,21 +146,21 @@ ScaleContinuousPosition <- ggproto("ScaleContinuousPosition", ScaleContinuous,
   },
   break_info = function(self, range = NULL) {
     breaks <- ggproto_parent(ScaleContinuous, self)$break_info(range)
-    if (!(is.waive(self$secondary.axis) || self$secondary.axis$empty())) {
+    if (!(is.waiver(self$secondary.axis) || self$secondary.axis$empty())) {
       self$secondary.axis$init(self)
       breaks <- c(breaks, self$secondary.axis$break_info(breaks$range, self))
     }
     breaks
   },
   sec_name = function(self) {
-    if (is.waive(self$secondary.axis)) {
+    if (is.waiver(self$secondary.axis)) {
       waiver()
     } else {
       self$secondary.axis$name
     }
   },
   make_sec_title = function(self, title) {
-    if (!is.waive(self$secondary.axis)) {
+    if (!is.waiver(self$secondary.axis)) {
       self$secondary.axis$make_title(title)
     } else {
       ggproto_parent(ScaleContinuous, self)$make_sec_title(title)

R/scale-date.R

@@ -302,15 +302,15 @@ datetime_scale <- function(aesthetics, transform, trans = deprecated(),
   if (is.character(breaks)) breaks <- breaks_width(breaks)
   if (is.character(minor_breaks)) minor_breaks <- breaks_width(minor_breaks)
 
-  if (!is.waive(date_breaks)) {
+  if (!is.waiver(date_breaks)) {
     check_string(date_breaks)
     breaks <- breaks_width(date_breaks)
   }
-  if (!is.waive(date_minor_breaks)) {
+  if (!is.waiver(date_minor_breaks)) {
     check_string(date_minor_breaks)
     minor_breaks <- breaks_width(date_minor_breaks)
   }
-  if (!is.waive(date_labels)) {
+  if (!is.waiver(date_labels)) {
     check_string(date_labels)
     labels <- function(self, x) {
       tz <- self$timezone %||% "UTC"
@@ -379,21 +379,21 @@ ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous,
   },
   break_info = function(self, range = NULL) {
     breaks <- ggproto_parent(ScaleContinuous, self)$break_info(range)
-    if (!(is.waive(self$secondary.axis) || self$secondary.axis$empty())) {
+    if (!(is.waiver(self$secondary.axis) || self$secondary.axis$empty())) {
       self$secondary.axis$init(self)
       breaks <- c(breaks, self$secondary.axis$break_info(breaks$range, self))
     }
     breaks
   },
   sec_name = function(self) {
-    if (is.waive(self$secondary.axis)) {
+    if (is.waiver(self$secondary.axis)) {
       waiver()
     } else {
       self$secondary.axis$name
     }
   },
   make_sec_title = function(self, title) {
-    if (!is.waive(self$secondary.axis)) {
+    if (!is.waiver(self$secondary.axis)) {
       self$secondary.axis$make_title(title)
     } else {
       ggproto_parent(ScaleContinuous, self)$make_sec_title(title)
@@ -430,21 +430,21 @@ ScaleContinuousDate <- ggproto("ScaleContinuousDate", ScaleContinuous,
   },
   break_info = function(self, range = NULL) {
     breaks <- ggproto_parent(ScaleContinuous, self)$break_info(range)
-    if (!(is.waive(self$secondary.axis) || self$secondary.axis$empty())) {
+    if (!(is.waiver(self$secondary.axis) || self$secondary.axis$empty())) {
       self$secondary.axis$init(self)
       breaks <- c(breaks, self$secondary.axis$break_info(breaks$range, self))
     }
     breaks
   },
   sec_name = function(self) {
-    if (is.waive(self$secondary.axis)) {
+    if (is.waiver(self$secondary.axis)) {
       waiver()
     } else {
       self$secondary.axis$name
     }
   },
   make_sec_title = function(self, title) {
-    if (!is.waive(self$secondary.axis)) {
+    if (!is.waiver(self$secondary.axis)) {
       self$secondary.axis$make_title(title)
     } else {
       ggproto_parent(ScaleContinuous, self)$make_sec_title(title)

R/scale-discrete-.R

@@ -170,7 +170,7 @@ ScaleDiscretePosition <- ggproto("ScaleDiscretePosition", ScaleDiscrete,
   },
 
   sec_name = function(self) {
-    if (is.waive(self$secondary.axis)) {
+    if (is.waiver(self$secondary.axis)) {
       waiver()
     } else {
       self$secondary.axis$name

R/scale-manual.R

@@ -171,7 +171,7 @@ manual_scale <- function(aesthetic, values = NULL, breaks = waiver(),
   }
 
   # order values according to breaks
-  if (is.vector(values) && is.null(names(values)) && !is.waive(breaks) &&
+  if (is.vector(values) && is.null(names(values)) && !is.waiver(breaks) &&
       !is.null(breaks) && !is.function(breaks)) {
     if (length(breaks) <= length(values)) {
       names(values) <- breaks

R/scale-view.R

@@ -45,7 +45,7 @@ view_scale_primary <- function(scale, limits = scale$get_limits(),
 view_scale_secondary <- function(scale, limits = scale$get_limits(),
                                  continuous_range = scale$dimension(limits = limits)) {
 
-  if (is.null(scale$secondary.axis) || is.waive(scale$secondary.axis) || scale$secondary.axis$empty()) {
+  if (is.null(scale$secondary.axis) || is.waiver(scale$secondary.axis) || scale$secondary.axis$empty()) {
     # if there is no second axis, return the primary scale with no guide
     # this guide can be overridden using guides()
     primary_scale <- view_scale_primary(scale, limits, continuous_range)

R/utilities.R

@@ -12,7 +12,7 @@ scales::alpha
 }
 
 "%|W|%" <- function(a, b) {
-  if (!is.waive(a)) a else b
+  if (!is.waiver(a)) a else b
 }
 
 # Check required aesthetics are present
@@ -182,13 +182,17 @@ should_stop <- function(expr) {
 #' A waiver is a "flag" object, similar to `NULL`, that indicates the
 #' calling function should just use the default value.  It is used in certain
 #' functions to distinguish between displaying nothing (`NULL`) and
-#' displaying a default value calculated elsewhere (`waiver()`)
+#' displaying a default value calculated elsewhere (`waiver()`).
+#' `is.waiver()` reports whether an object is a waiver.
 #'
 #' @export
 #' @keywords internal
 waiver <- function() structure(list(), class = "waiver")
 
-is.waive <- function(x) inherits(x, "waiver")
+#' @param x An object to test
+#' @export
+#' @rdname waiver
+is.waiver <- function(x) inherits(x, "waiver")
 
 pal_binned <- function(palette) {
   function(x) {
@@ -266,7 +270,7 @@ snake_class <- function(x) {
 }
 
 empty <- function(df) {
-  is.null(df) || nrow(df) == 0 || ncol(df) == 0 || is.waive(df)
+  is.null(df) || nrow(df) == 0 || ncol(df) == 0 || is.waiver(df)
 }
 
 is.discrete <- function(x) {