fix: call a function passed as an argument from the caller's environment

R/attributes.R

@@ -1327,6 +1327,12 @@ igraph.i.attribute.combination <- function(comb, allow_rename = FALSE) {
       "Attribute combination element must be a function or character scalar."
     )
   }
+  # A plain loop, not lapply(): as_user_callback() reads the call stack to
+  # find out who igraph was called by, and a functional in between would hide
+  # the caller behind a frame of its own.
+  for (i in seq_along(comb)) {
+    comb[[i]] <- as_user_callback(comb[[i]])
+  }
   if (is.null(names(comb))) {
     names(comb) <- rep("", length(comb))
   }

R/cliques.R

@@ -257,6 +257,7 @@ clique.number <- function(graph) {
 cliques <- function(graph, min = NULL, max = NULL, ..., callback = NULL) {
   ensure_igraph(graph)
   check_dots_empty()
+  callback <- as_user_callback(callback)
 
   if (is.null(callback)) {
     # Collector mode: use original implementation
@@ -308,6 +309,7 @@ max_cliques <- function(
 ) {
   ensure_igraph(graph)
   check_dots_empty()
+  callback <- as_user_callback(callback)
 
   # Handle file and subset modes (original functionality)
   if (!is.null(file)) {

R/cycles.R

@@ -166,6 +166,7 @@ simple_cycles <- function(
   # Argument checks
   ensure_igraph(graph)
   check_dots_empty()
+  callback <- as_user_callback(callback)
 
   if (is.null(callback)) {
     simple_cycles_impl(

R/layout.R

@@ -1181,7 +1181,7 @@ layout_nicely <- function(graph, dim = 2, ...) {
     lay <- graph_attr(graph, "layout")
     if (is.function(lay)) {
       if (!identical(lay, layout_nicely)) {
-        return(lay(graph, ...))
+        return(call_user_callback(lay, graph, ...))
       } else {
         # nop, we'll deal with it later below
       }
@@ -3409,6 +3409,7 @@ layout_components <- function(graph, layout = NULL, ...) {
   if (is.null(layout)) {
     layout <- layout_with_kk
   }
+  layout <- as_user_callback(layout)
 
   V(graph)$id <- seq(vcount(graph))
   gl <- decompose(graph)

R/motifs.R

@@ -221,6 +221,7 @@ motifs <- function(
   if (!is.null(cut.prob) && length(cut.prob) != size) {
     cli::cli_abort("{.arg cut.prob} must be the same length as {.arg size}")
   }
+  callback <- as_user_callback(callback)
 
   # If callback is provided, use the callback implementation
   if (!is.null(callback)) {

R/plot.common.R

@@ -552,7 +552,7 @@ i.parse.plot.params <- function(graph, params) {
     ret <- function() {
       v <- p[[type]][[name]]
       if (is.function(v) && !dontcall) {
-        v <- v(graph)
+        v <- call_user_callback(v, graph)
       }
       if (is.null(range)) {
         return(v)

R/plot.shapes.R

@@ -459,6 +459,11 @@ add_shape <- function(
     ))
   }
 
+  # Wrapped here, where the user chose them, rather than at the plot call
+  # that eventually reaches them.
+  clip <- as_user_callback(clip)
+  plot <- as_user_callback(plot)
+
   assign(shape, value = list(clip = clip, plot = plot), envir = .igraph.shapes)
   do.call(igraph_options, parameters)
   invisible(TRUE)

R/printr.R

@@ -35,7 +35,7 @@ printer_callback <- function(fun) {
   if (!is.function(fun)) {
     warning("'fun' is not a function")
   }
-  add_class(fun, "printer_callback")
+  add_class(as_user_callback(fun), "printer_callback")
 }
 
 #' Is this a printer callback?
@@ -58,7 +58,7 @@ print_footer <- function(footer) {
 }
 
 print_head_foot <- function(head_foot) {
-  if (is.function(head_foot)) head_foot() else cat(head_foot)
+  if (is.function(head_foot)) call_user_callback(head_foot) else cat(head_foot)
 }
 
 #' Print the only the head of an R object
@@ -199,6 +199,7 @@ indent_print <- function(..., .indent = " ", .printer = NULL) {
   if (is.null(.printer)) {
     .printer <- print
   }
+  .printer <- as_user_callback(.printer)
 
   if (length(.indent) != 1 || !is.character(.indent)) {
     indent <- .indent # cli literal cannot start with a dot

R/scan.R

@@ -130,6 +130,7 @@ local_scan <- function(
   stopifnot(
     is.null(FUN) || is.function(FUN) || (is.character(FUN) && length(FUN) == 1)
   )
+  FUN <- as_user_callback(FUN)
 
   ## Logical
   stopifnot(is.logical(weighted), length(weighted) == 1)

R/tkplot.R

@@ -700,6 +700,7 @@ tk_center <- function(tkp.id) {
 #' @export
 tk_reshape <- function(tkp.id, newlayout, ..., params) {
   # nocov start
+  newlayout <- as_user_callback(newlayout)
   tkp <- .tkplot.get(tkp.id)
   new_coords <- do_call(
     newlayout,

R/topology.R

@@ -1054,6 +1054,7 @@ graph.count.subisomorphisms.vf2 <- function(
 #' @family graph isomorphism
 isomorphisms <- function(graph1, graph2, method = "vf2", ..., callback = NULL) {
   method <- igraph_match_arg(method)
+  callback <- as_user_callback(callback)
 
   if (method != "vf2") {
     cli::cli_abort(
@@ -1185,6 +1186,7 @@ subgraph_isomorphisms <- function(
   callback = NULL
 ) {
   method <- igraph_match_arg(method)
+  callback <- as_user_callback(callback)
 
   if (!is.null(callback) && method != "vf2") {
     cli::cli_abort(

R/utils-user-callbacks.R

@@ -0,0 +1,62 @@
+# Call a function the user passed as an argument, as if they had called it
+# themselves.
+#
+# lifecycle attributes a deprecation to the caller of the deprecated function.
+# When igraph calls a function the user handed it, that caller is an igraph
+# frame: `deprecate_soft()` then says nothing at all, and `deprecate_warn()`
+# blames igraph and asks the user to report a bug against it. Neither tells the
+# user that the function they chose is on its way out, which is what they need
+# to hear before the deprecation becomes hard.
+#
+# `bfs()`, `dfs()`, `arpack()` and `cluster_leading_eigen()` already evaluate
+# their callback in the environment they were called from, through their `rho`
+# and `env` arguments, and are attributed correctly because of it. These
+# helpers extend that treatment to the remaining function arguments, without an
+# argument to pass in and thread through.
+call_user_callback <- function(fn, ...) {
+  as_user_callback(fn)(...)
+}
+
+# `fn`, wrapped so that it is called from the environment igraph was called
+# from. Anything but a function, `NULL` included, is returned unchanged.
+#
+# Use this for a function that igraph hands on -- to the C layer, or to a later
+# call -- rather than calls itself; the environment is the one current when the
+# function was passed, which is where the user chose it.
+as_user_callback <- function(fn) {
+  if (!is.function(fn)) {
+    return(fn)
+  }
+
+  # The wrapper is enclosed in a child of the user's environment, so that `fn`
+  # sees a caller that belongs to the user rather than to igraph. lifecycle
+  # asks `topenv()` who that caller is, and `topenv()` looks through the child.
+  rlang::new_function(
+    args = rlang::pairlist2(... = ),
+    body = quote(fn(...)),
+    env = rlang::env(igraph_user_env(), fn = fn)
+  )
+}
+
+# The environment igraph was called from: the innermost caller that does not
+# belong to igraph itself.
+#
+# Walking the caller chain keeps this independent of how deeply a function
+# argument is passed on inside igraph before it is called, which a fixed
+# `rlang::caller_env(n)` would have to track. Callers must not reach this
+# through a functional such as `lapply()`, whose frame would end the walk in
+# place of the user's.
+igraph_user_env <- function() {
+  ns <- topenv(environment(igraph_user_env))
+
+  generation <- 1L
+  repeat {
+    env <- parent.frame(generation)
+    # parent.frame() bottoms out at the global environment, so the walk
+    # terminates there even if every frame belongs to igraph.
+    if (identical(env, globalenv()) || !identical(topenv(env), ns)) {
+      return(env)
+    }
+    generation <- generation + 1L
+  }
+}

tests/testthat/_snaps/utils-user-callbacks.md

@@ -0,0 +1,98 @@
+# lifecycle names the user rather than igraph
+
+    Code
+      as_user(igraph_function(FALSE), deprecated_igraph_function("soft_plain()"))
+      as_user(igraph_function(FALSE), deprecated_igraph_function("warn_plain()",
+        "deprecate_warn"))
+    Condition
+      Warning:
+      `warn_plain()` was deprecated in igraph 2.0.0.
+      i The deprecated feature was likely used in the igraph package.
+        Please report the issue at <https://github.com/igraph/rigraph/issues>.
+    Code
+      as_user(igraph_function(TRUE), deprecated_igraph_function("soft_wrapped()"))
+    Condition
+      Warning:
+      `soft_wrapped()` was deprecated in igraph 2.0.0.
+    Code
+      as_user(igraph_function(TRUE), deprecated_igraph_function("warn_wrapped()",
+        "deprecate_warn"))
+    Condition
+      Warning:
+      `warn_wrapped()` was deprecated in igraph 2.0.0.
+
+# plot() reports a deprecated layout function
+
+    Code
+      cat(warnings, sep = "\n")
+    Output
+      `layout.circle()` was deprecated in igraph 2.1.0.
+      i Please use `layout_in_circle()` instead.
+
+# plot() reports a deprecated layout graph attribute
+
+    Code
+      cat(warnings, sep = "\n")
+    Output
+      `layout.random()` was deprecated in igraph 2.1.0.
+      i Please use `layout_randomly()` instead.
+
+# layout_nicely() reports a deprecated layout graph attribute
+
+    Code
+      coords <- as_user(layout_nicely, g)
+    Condition
+      Warning:
+      `layout.circle()` was deprecated in igraph 2.1.0.
+      i Please use `layout_in_circle()` instead.
+
+# layout_components() reports a deprecated layout function
+
+    Code
+      coords <- as_user(layout_components, g, layout.circle)
+    Condition
+      Warning:
+      `layout.circle()` was deprecated in igraph 2.1.0.
+      i Please use `layout_in_circle()` instead.
+      Warning:
+      `layout.circle()` was deprecated in igraph 2.1.0.
+      i Please use `layout_in_circle()` instead.
+
+# add_shape() reports a deprecated shape function when it is used
+
+    Code
+      cat(warnings, sep = "\n")
+    Output
+      `igraph.shape.noplot()` was deprecated in igraph 2.0.0.
+      i Please use `shape_noplot()` instead.
+
+# local_scan() reports a deprecated FUN
+
+    Code
+      scan <- as_user(local_scan, g, FUN = graph.density)
+    Condition
+      Warning:
+      `graph.density()` was deprecated in igraph 2.0.0.
+      i Please use `edge_density()` instead.
+      Warning:
+      `graph.density()` was deprecated in igraph 2.0.0.
+      i Please use `edge_density()` instead.
+
+# attribute combinations report a deprecated function
+
+    Code
+      simple <- as_user(simplify, g, edge.attr.comb = list(weight = is.igraph))
+    Condition
+      Warning:
+      `is.igraph()` was deprecated in igraph 2.0.0.
+      i Please use `is_igraph()` instead.
+
+# callbacks report a deprecated function
+
+    Code
+      as_user(cliques, g, min = 3, callback = is.igraph)
+    Condition
+      Warning:
+      `is.igraph()` was deprecated in igraph 2.0.0.
+      i Please use `is_igraph()` instead.
+