resolve merge conflict

teunbrand · teunbrand · commit f3114fc5c79e · 2025-06-05T14:33:29.000+02:00
Merge branch 'main' into S7_objects

# Conflicts:
#	R/guides-.R
diff --git a/R/coord-cartesian-.R b/R/coord-cartesian-.R
@@ -97,8 +97,14 @@ coord_cartesian <- function(xlim = NULL, ylim = NULL, expand = TRUE,
 #' @export
 CoordCartesian <- ggproto("CoordCartesian", Coord,
 
-  is_linear = function() TRUE,
-  is_free = function(self) is.null(self$ratio),
+  is_linear = function() {
+    TRUE
+  },
+
+  is_free = function(self) {
+    is.null(self$ratio)
+  },
+
   aspect = function(self, ranges) {
     if (is.null(self$ratio)) {
       return(NULL)
diff --git a/R/coord-fixed.R b/R/coord-fixed.R
@@ -37,7 +37,9 @@ coord_equal <- coord_fixed
 #' @usage NULL
 #' @export
 CoordFixed <- ggproto("CoordFixed", CoordCartesian,
-  is_free = function() FALSE,
+  is_free = function() {
+    FALSE
+  },
 
   aspect = function(self, ranges) {
     diff(ranges$y.range) / diff(ranges$x.range) * self$ratio
diff --git a/R/coord-polar.R b/R/coord-polar.R
@@ -20,9 +20,13 @@ coord_polar <- function(theta = "x", start = 0, direction = 1, clip = "on") {
 #' @export
 CoordPolar <- ggproto("CoordPolar", Coord,
 
-  aspect = function(details) 1,
+  aspect = function(details) {
+    1
+  },
 
-  is_free = function() TRUE,
+  is_free = function() {
+    TRUE
+  },
 
   distance = function(self, x, y, details, boost = 0.75) {
     arc <- self$start + c(0, 2 * pi)
diff --git a/R/coord-radial.R b/R/coord-radial.R
@@ -199,7 +199,9 @@ CoordRadial <- ggproto("CoordRadial", Coord,
     diff(details$bbox$y) / diff(details$bbox$x)
   },
 
-  is_free = function() TRUE,
+  is_free = function() {
+    TRUE
+  },
 
   distance = function(self, x, y, details, boost = 0.75) {
     arc <- details$arc %||% c(0, 2 * pi)
diff --git a/R/coord-sf.R b/R/coord-sf.R
@@ -303,11 +303,15 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
   },
 
   # CoordSf enforces a fixed aspect ratio -> axes cannot be changed freely under faceting
-  is_free = function() FALSE,
+  is_free = function() {
+    FALSE
+  },
 
   # for regular geoms (such as geom_path, geom_polygon, etc.), CoordSf is non-linear
   # if the default_crs option is being used, i.e., not set to NULL
-  is_linear = function(self) is.null(self$get_default_crs()),
+  is_linear = function(self) {
+    is.null(self$get_default_crs())
+  },
 
   distance = function(self, x, y, panel_params) {
     d <- self$backtransform_range(panel_params)
@@ -328,7 +332,9 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     diff(panel_params$y_range) / diff(panel_params$x_range) / ratio
   },
 
-  labels = function(labels, panel_params) labels,
+  labels = function(labels, panel_params) {
+    labels
+  },
 
   render_bg = function(self, panel_params, theme) {
     el <- calc_element("panel.grid.major", theme)
diff --git a/R/coord-transform.R b/R/coord-transform.R
@@ -126,7 +126,11 @@ coord_trans <- function(...) {
 #' @export
 CoordTransform <- ggproto(
   "CoordTransform", Coord,
-  is_free = function() TRUE,
+
+  is_free = function() {
+    TRUE
+  },
+
   distance = function(self, x, y, panel_params) {
     max_dist <- dist_euclidean(panel_params$x.range, panel_params$y.range)
     dist_euclidean(self$trans$x$transform(x), self$trans$y$transform(y)) / max_dist
diff --git a/R/geom-blank.R b/R/geom-blank.R
@@ -35,7 +35,11 @@ geom_blank <- function(mapping = NULL, data = NULL,
 #' @export
 GeomBlank <- ggproto("GeomBlank", Geom,
   default_aes = aes(),
-  handle_na = function(data, params) data,
+  handle_na = function(data, params) {
+    data
+  },
   check_constant_aes = FALSE,
-  draw_panel = function(...) nullGrob()
+  draw_panel = function(...) {
+    nullGrob()
+  }
 )
diff --git a/R/guide-colorbar.R b/R/guide-colorbar.R
@@ -291,10 +291,10 @@ GuideColourbar <- ggproto(
     # We set the defaults in `theme` so that the `params$theme` can still
     # overrule defaults given here
     if (params$direction == "horizontal") {
-      theme$legend.key.width <- rel(5)
+      theme$legend.key.width <- (theme$legend.key.width %||% rel(1)) * 5
       valid_position <- c("bottom", "top")
     } else {
-      theme$legend.key.height <- rel(5)
+      theme$legend.key.height <- (theme$legend.key.height %||% rel(1)) * 5
       valid_position <- c("right", "left")
     }
 
diff --git a/R/labels.R b/R/labels.R
@@ -81,10 +81,17 @@ setup_plot_labels <- function(plot, layers, data) {
   extra_labels <- setdiff(names(plot_labels), known_labels)
 
   if (length(extra_labels) > 0) {
-    extra_labels <- paste0(
-      "{.code ", extra_labels, " = \"", plot_labels[extra_labels], "\"}"
+
+    warn_labels <- plot_labels[extra_labels]
+    warn_labels <- ifelse(
+      vapply(warn_labels, is.function, logical(1)),
+      "{.cls function}",
+      paste0("{.val ", warn_labels, "}")
     )
+
+    extra_labels <- paste0("{.field ", extra_labels, "} : ", warn_labels)
     names(extra_labels) <- rep("*", length(extra_labels))
+
     cli::cli_warn(c(
       "Ignoring unknown labels:",
       extra_labels
diff --git a/R/layer.R b/R/layer.R
@@ -181,6 +181,7 @@ layer <- function(geom = NULL, stat = NULL,
   geom <- set_draw_key(geom, key_glyph %||% params$key_glyph)
 
   fr_call <- layer_class$constructor %||% frame_call(call_env) %||% current_call()
+  attr(fr_call, "srcref") <- NULL
 
   ggproto("LayerInstance", layer_class,
     constructor = fr_call,
diff --git a/R/scale-.R b/R/scale-.R
@@ -458,7 +458,9 @@ Scale <- ggproto("Scale", NULL,
   #' as described in e.g. [`?continuous_scale`][continuous_scale].
   #' Note that `limits` is expected in transformed space.
   aesthetics = character(),
-  palette = function() cli::cli_abort("Not implemented."),
+  palette = function() {
+    cli::cli_abort("Not implemented.")
+  },
 
   limits = NULL,
   na.value = NA,
@@ -998,7 +1000,9 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale,
   n.breaks = NULL,
   trans = transform_identity(),
 
-  is_discrete = function() FALSE,
+  is_discrete = function() {
+    FALSE
+  },
 
   train = function(self, x) {
     if (length(x) == 0) {
@@ -1257,7 +1261,9 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
   n.breaks.cache = NULL,
   palette.cache = NULL,
 
-  is_discrete = function() TRUE,
+  is_discrete = function() {
+    TRUE
+  },
 
   train = function(self, x) {
     if (length(x) == 0) {
@@ -1271,7 +1277,9 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
     )
   },
 
-  transform = identity,
+  transform = function(self, x) {
+    x
+  },
 
   map = function(self, x, limits = self$get_limits()) {
     limits <- vec_slice(limits, !is.na(limits))
@@ -1483,7 +1491,9 @@ ScaleBinned <- ggproto("ScaleBinned", Scale,
   after.stat = FALSE,
   show.limits = FALSE,
 
-  is_discrete = function() FALSE,
+  is_discrete = function() {
+    FALSE
+  },
 
   train = function(self, x) {
     if (length(x) == 0) {
@@ -1644,7 +1654,9 @@ ScaleBinned <- ggproto("ScaleBinned", Scale,
     transformation$transform(breaks)
   },
 
-  get_breaks_minor = function(...) NULL,
+  get_breaks_minor = function(...) {
+    NULL
+  },
 
   get_labels = function(self, breaks = self$get_breaks()) {
     if (is.null(breaks)) return(NULL)
diff --git a/R/scale-view.R b/R/scale-view.R
@@ -107,13 +107,27 @@ ViewScale <- ggproto("ViewScale", NULL,
   is_empty = function(self) {
     is.null(self$get_breaks()) && is.null(self$get_breaks_minor())
   },
-  is_discrete = function(self) self$scale_is_discrete,
-  dimension = function(self) self$continuous_range,
-  get_limits = function(self) self$limits,
-  get_breaks = function(self) self$breaks,
-  get_breaks_minor = function(self) self$minor_breaks,
-  get_labels = function(self, breaks = self$get_breaks()) self$scale$get_labels(breaks),
-  get_transformation = function(self) self$scale$get_transformation(),
+  is_discrete = function(self) {
+    self$scale_is_discrete
+  },
+  dimension = function(self) {
+    self$continuous_range
+  },
+  get_limits = function(self) {
+    self$limits
+  },
+  get_breaks = function(self) {
+    self$breaks
+  },
+  get_breaks_minor = function(self) {
+    self$minor_breaks
+  },
+  get_labels = function(self, breaks = self$get_breaks()) {
+    self$scale$get_labels(breaks)
+  },
+  get_transformation = function(self) {
+    self$scale$get_transformation()
+  },
   rescale = function(self, x) {
     self$scale$rescale(x, self$limits, self$continuous_range)
   },
diff --git a/R/stat-unique.R b/R/stat-unique.R
@@ -4,7 +4,9 @@
 #' @export
 StatUnique <- ggproto(
   "StatUnique", Stat,
-  compute_panel = function(data, scales) unique0(data)
+  compute_panel = function(data, scales) {
+    unique0(data)
+  }
 )
 
 #' Remove duplicates
diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -7,6 +7,20 @@ template:
   includes:
     in_header: |
       <script defer data-domain="ggplot2.tidyverse.org,all.tidyverse.org" src="https://plausible.io/js/plausible.js"></script>
+      <script async src="https://widget.kapa.ai/kapa-widget.bundle.js"
+      data-button-hide="true"
+      data-modal-disclaimer="This is a custom LLM for answering questions about dplyr, tidyr, and ggplot2. Answers are based on the contents of the documentation. Rate the answers to let us know what you think!"
+      data-modal-ask-ai-input-placeholder="Ask me a question about dplyr, tidyr, or ggplot2."
+      data-modal-header-bg-color="#f9f9f9"
+      data-modal-override-open-class="open-kapa-widget"
+      data-project-color="#365a7a"
+      data-project-name="ggplot2"
+      data-modal-title="tidyverse AI ✨"
+      data-project-logo="https://avatars.githubusercontent.com/u/22032646?s=200&u=235532df5cf8543246812f73db051b793f868807&v=4"
+      data-user-analytics-fingerprint-enabled="true"
+      data-bot-protection-mechanism="hcaptcha"
+      data-website-id="5dcac24a-bd5a-4874-9f5b-3341afddd8c3"
+      ></script>
 
 development:
   mode: auto
@@ -25,7 +39,7 @@ home:
   links:
   - text: Learn more
     href: https://r4ds.had.co.nz/data-visualisation.html
-  - text: Extensions
+  - text: Extensions 🧩
     href: https://exts.ggplot2.tidyverse.org/gallery/
 
 reference:
@@ -300,7 +314,13 @@ news:
 navbar:
   structure:
     left: [intro, reference, news, articles, extensions]
+    right: [search, github, ai]
   components:
     extensions:
-      text: Extensions
+      icon: fa-puzzle-piece
+      aria-label: Extensions
       href: https://exts.ggplot2.tidyverse.org/gallery/
+    ai:
+      text: Ask AI ✨
+      href: "#"
+      class: open-kapa-widget
diff --git a/tests/testthat/_snaps/labels.md b/tests/testthat/_snaps/labels.md
@@ -15,7 +15,9 @@
 # warnings are thrown for unknown labels
 
     Ignoring unknown labels:
-    * `foo = "bar"`
+    * foo : "i don't exist"
+    * bar : <function>
+    * qux : "expression(me * neither)"
 
 # plot.tag.position rejects invalid input
 
diff --git a/tests/testthat/test-ggproto.R b/tests/testthat/test-ggproto.R
@@ -10,3 +10,48 @@ test_that("construction checks input", {
   expect_snapshot_error(ggproto("Test", NULL, a <- function(self, a) a))
   expect_snapshot_error(ggproto("Test", mtcars, a = function(self, a) a))
 })
+
+test_that("all ggproto methods start with `{` (#6459)", {
+
+  ggprotos <- Filter(
+    function(x) inherits(x, "ggproto"),
+    mget(ls("package:ggplot2"), asNamespace("ggplot2"), ifnotfound = list(NULL))
+  )
+
+  lacks_brackets <- function(method) {
+    if (!inherits(method, "ggproto_method")) {
+      return(FALSE)
+    }
+    body <- as.list(body(environment(method)$f))
+    if (length(body) == 0 || body[[1]] != quote(`{`)) {
+      return(TRUE)
+    }
+    return(FALSE)
+  }
+
+  report_no_bracket <- function(ggproto_class) {
+    unlist(lapply(
+      ls(envir = ggproto_class),
+      function(method) {
+        has_brackets <- !lacks_brackets(ggproto_class[[method]])
+        if (has_brackets) {
+          return(character())
+        }
+        return(method)
+      }
+    ))
+  }
+
+  # Test to make sure we're testing correctly
+  ctrl <- list(
+    foo = ggproto("Dummy", dummy = function(x) x + 10),
+    bar = ggproto("Dummy", dummy = function(x) {x + 10})
+  )
+  ctrl <- lapply(ctrl, report_no_bracket)
+  expect_equal(ctrl, list(foo = "dummy", bar = character()))
+
+  # Actual relevant test
+  failures <- lapply(ggprotos, report_no_bracket)
+  failures <- failures[lengths(failures) > 0]
+  expect_equal(names(failures), character())
+})
diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R
@@ -110,7 +110,13 @@ test_that("get_alt_text checks dots", {
 })
 
 test_that("warnings are thrown for unknown labels", {
-  p <- ggplot(mtcars, aes(mpg, disp)) + geom_point() + labs(foo = 'bar')
+  p <- ggplot(mtcars, aes(mpg, disp)) +
+    geom_point() +
+    labs(
+      foo = "i don't exist",
+      bar = function(x) "i don't exist either",
+      qux = expression(me * neither)
+    )
   expect_snapshot_warning(ggplot_build(p))
 })
 
