fix: labels and ggplot-v4

R/girafe_options.R

@@ -144,8 +144,11 @@ opts_tooltip <- function(
   call_args <- names(match.call())[-1]
   # Map function arg names to list element names
   arg_mapping <- c(delay_mouseover = "delay_over", delay_mouseout = "delay_out")
-  call_args <- ifelse(call_args %in% names(arg_mapping),
-                      arg_mapping[call_args], call_args)
+  call_args <- ifelse(
+    call_args %in% names(arg_mapping),
+    arg_mapping[call_args],
+    call_args
+  )
   attr(x, "explicit_args") <- call_args
   x
 }
@@ -624,8 +627,11 @@ opts_toolbar <- function(
   call_args <- names(match.call())[-1]
   # Map function arg names to list element names
   arg_mapping <- c(delay_mouseover = "delay_over", delay_mouseout = "delay_out")
-  call_args <- ifelse(call_args %in% names(arg_mapping),
-                      arg_mapping[call_args], call_args)
+  call_args <- ifelse(
+    call_args %in% names(arg_mapping),
+    arg_mapping[call_args],
+    call_args
+  )
   attr(x, "explicit_args") <- call_args
   x
 }

R/guide_bins_interactive.R

@@ -32,7 +32,25 @@ GuideInteractiveBins <- ggproto(
     )
     if (!is.null(params) && is.data.frame(params$key) && nrow(params$key)) {
       parsed <- interactive_guide_parse_binned_breaks(scale, params)
-      params <- interactive_guide_train(params, scale, parsed$all_breaks)
+      breaks <- parsed$all_breaks
+      # ggplot2 >= 4.0
+      # Pass label_breaks separately from breaks to match what scale$get_labels()
+      # will return. This prevents length mismatch warnings in interactive_guide_train.
+      label_breaks <- parsed$breaks
+      show.limits <- params$show.limits %||% scale$show.limits %||% FALSE
+      # ggplot2 >= 4.0: show.limits can be a length-2 vector, use any()
+      if (
+        any(show.limits) &&
+          !(is.character(scale$labels) || is.numeric(scale$labels))
+      ) {
+        label_breaks <- parsed$all_breaks
+      }
+      params <- interactive_guide_train(
+        params,
+        scale,
+        breaks,
+        label_breaks = label_breaks
+      )
     }
     params
   },
@@ -44,19 +62,28 @@ GuideInteractiveBins <- ggproto(
     decor <- interactive_guide_build_decor(decor, params)
     GuideBins$build_decor(decor, grobs, elements, params)
   },
+  # In ggplot2 4.0, GuideBins$build_labels calls validate_labels() which
+  # processes lists with unlist(), stripping the 'interactive_label' class.
+  # We override build_labels to convert the single interactive_label object
+  # into a list of individual label_interactive objects BEFORE calling parent.
   build_labels = function(key, elements, params) {
-    grobs <- GuideBins$build_labels(key, elements, params)
-    if (inherits(key$.label, "interactive_label") && !all(params$show.limits)) {
-      valid_ind <- setdiff(
-        seq_len(nrow(key)),
-        c(1, nrow(key))[!params$show.limits]
-      )
-      idata <- grobs$labels$children[[1]]$.interactive
-      idata <- lapply(idata, function(a) {
-        a[valid_ind]
+    if (inherits(key$.label, "interactive_label")) {
+      labels <- key$.label
+      lbl_ipar <- get_ipar(labels)
+      lbl_ip <- transpose(get_interactive_data(labels))
+      extra_interactive_params <- setdiff(lbl_ipar, IPAR_NAMES)
+      labels <- lapply(seq_along(labels), function(i) {
+        args <- c(
+          list(
+            label = labels[[i]],
+            extra_interactive_params = extra_interactive_params
+          ),
+          lbl_ip[[i]]
+        )
+        do.call(label_interactive, args)
       })
-      grobs$labels$children[[1]]$.interactive <- idata
+      key$.label <- labels
     }
-    grobs
+    GuideBins$build_labels(key, elements, params)
   }
 )

R/guide_colourbar_interactive.R

@@ -68,5 +68,31 @@ GuideInteractiveColourbar <- ggproto(
       )
     }
     result
+  },
+  # In ggplot2 4.0, GuideColourbar$build_labels calls validate_labels() which
+  # processes lists with unlist(), stripping the 'interactive_label' class.
+  # We override build_labels to convert the single interactive_label object
+  # (containing multiple labels) into a list of individual label_interactive
+  # objects BEFORE calling the parent method. Each individual label_interactive
+  # preserves its interactive attributes when passed to element_grob().
+  build_labels = function(key, elements, params) {
+    if (inherits(key$.label, "interactive_label")) {
+      labels <- key$.label
+      lbl_ipar <- get_ipar(labels)
+      lbl_ip <- transpose(get_interactive_data(labels))
+      extra_interactive_params <- setdiff(lbl_ipar, IPAR_NAMES)
+      labels <- lapply(seq_along(labels), function(i) {
+        args <- c(
+          list(
+            label = labels[[i]],
+            extra_interactive_params = extra_interactive_params
+          ),
+          lbl_ip[[i]]
+        )
+        do.call(label_interactive, args)
+      })
+      key$.label <- labels
+    }
+    GuideColourbar$build_labels(key, elements, params)
   }
 )

R/guide_coloursteps_interactive.R

@@ -44,8 +44,9 @@ GuideInteractiveColoursteps <- ggproto(
       label_breaks <- parsed$breaks
       if (params$even.steps || !is.numeric(parsed$scale_breaks)) {
         show.limits <- params$show.limits %||% scale$show.limits %||% FALSE
+        # ggplot2 >= 4.0: show.limits can be a length-2 vector, use any()
         if (
-          show.limits &&
+          any(show.limits) &&
             !(is.character(scale$labels) || is.numeric(scale$labels))
         ) {
           label_breaks <- parsed$all_breaks
@@ -67,5 +68,9 @@ GuideInteractiveColoursteps <- ggproto(
   },
   build_decor = function(decor, grobs, elements, params) {
     GuideInteractiveColourbar$build_decor(decor, grobs, elements, params)
+  },
+  # Delegate to GuideInteractiveColourbar which handles interactive_label
+  build_labels = function(key, elements, params) {
+    GuideInteractiveColourbar$build_labels(key, elements, params)
   }
 )

R/guide_interactive.R

@@ -114,17 +114,23 @@ interactive_guide_train <- function(
       params$.ipar <- ipar
       params$.interactive <- idata
 
-      # continuous scales might break the label_interactive struct
-      # and we need to replace the labels
+      # Continuous scales might break the label_interactive struct
+      # and we need to replace the labels in the key.
+      # ggplot2 >= 4.0 compatibility fix:
+      # - Compare length(labels) with length(label_breaks) instead of nrow(key)
+      #   because for binned guides, key includes limit rows but label_breaks may not.
+      # - Only replace key$.label when labels match key rows exactly (continuous guides).
+      # - For binned guides with hidden limits, the build_labels method handles
+      #   interactive labels by converting them before calling the parent method.
       if (is.numeric(label_breaks)) {
         labels <- scale$get_labels(label_breaks)
         if (inherits(labels, "interactive_label")) {
-          if (length(labels) != nrow(key)) {
+          if (length(labels) != length(label_breaks)) {
             warning(paste0(
               "Cannot set the guide interactive labels, ",
               "', because its length differs from the breaks length"
             ))
-          } else {
+          } else if (length(labels) == nrow(key)) {
             key$.label <- labels
             params$key <- key
           }