Alternative backward compatibility approach for user code (RConsortium#349)

Fixes RConsortium#326

Author: hadley

NAMESPACE

@@ -82,8 +82,9 @@ export(super)
 export(valid_eventually)
 export(valid_implicitly)
 export(validate)
+if (getRversion() < "4.3.0") export(`@`)
 if (getRversion() >= "4.3.0" && !is.null(asNamespace("utils")$.AtNames)) S3method(utils::.AtNames,S7_object)
-if (getRversion() >= "4.3.0") S3method(base::`@`, S7_object) else export("@")
+if (getRversion() >= "4.3.0") S3method(base::`@`, S7_object)
 if (getRversion() >= "4.3.0") S3method(chooseOpsMethod, S7_object)
 if (getRversion() >= "4.3.0") S3method(matrixOps, S7_object)
 if (getRversion() >= "4.3.0") S3method(nameOfClass, S7_class, S7_class_name)

NEWS.md

@@ -1,5 +1,8 @@
 # S7 (development version)
 
+* S7 provides a new automatic backward compatibility mechanism to provide
+  a version of `@` that works in R before version 4.3 (#326).
+
 * Can create multimethods that dispatch on `NULL`.
 
 # S7 0.1.1

R/compatibility.R

@@ -0,0 +1,22 @@
+# Where needed, attach an environment containing @ that works with S7
+activate_backward_compatiblility <- function() {
+  if (getRversion() < "4.3.0" && !"S7_at" %in% search()) {
+    args <- list(list("@" = `@`), name = "S7_at", warn.conflicts = FALSE)
+    do.call("attach", args)
+  }
+  invisible()
+}
+
+#' @aliases @
+#' @usage NULL
+#' @rawNamespace if (getRversion() < "4.3.0") export(`@`)
+#' @name prop
+`@` <- function(object, name) {
+  if (inherits(object, "S7_object")) {
+    name <- as.character(substitute(name))
+    prop(object, name)
+  } else {
+    name <- substitute(name)
+    do.call(base::`@`, list(object, name))
+  }
+}

R/property.R

@@ -260,28 +260,16 @@ prop_label <- function(object, name) {
   sprintf("%s@%s", if (!is.null(object)) obj_desc(object) else "", name)
 }
 
-#' @rdname prop
-#' @usage object@name
-#' @aliases @
-#' @rawNamespace if (getRversion() >= "4.3.0") S3method(base::`@`, S7_object) else export("@")
-`@.S7_object` <- prop
-
 # Note: we need to explicitly refer to base with "base::`@`" in the
 # namespace directive to ensure the method is registered in the correct place.
 # Otherwise, loadNamespace()/registerS3method() gets confused by the
 # presence of a closure w/ the name of the generic (`@`) in the R7 namespace,
 # and incorrectly assumes that R7::`@` is the generic and registers the
 # method in the package namespace instead of base::.__S3MethodsTable__.
-
-`@` <- function(object, name) {
-  if (inherits(object, "S7_object")) {
-    name <- as.character(substitute(name))
-    prop(object, name)
-  } else {
-    name <- substitute(name)
-    do.call(base::`@`, list(object, name))
-  }
-}
+#' @usage object@name
+#' @rawNamespace if (getRversion() >= "4.3.0") S3method(base::`@`, S7_object)
+#' @name prop
+`@.S7_object` <- prop
 
 #' @rawNamespace S3method("@<-",S7_object)
 `@<-.S7_object` <- function(object, name, value) {

R/zzz.R

@@ -119,6 +119,8 @@ methods::setOldClass(c("S7_method", "function", "S7_object"))
 }
 
 .onLoad <- function(...) {
+  activate_backward_compatiblility()
+
   on_load_make_convert_generic()
   on_load_define_matrixOps()
   on_load_define_ops()

man/prop.Rd

@@ -65,13 +65,4 @@ Otherwise, you can conditionally make an S7-aware `@` available to your package
 NULL
 ```
 
-You can additionally make `@` work for users of your package by attaching the S7 package when your package is attached with this `.onAttach()` code:
-
-```{r}
-.onAttach <- function(libname, pkgname) {
-  if (getRversion() < "4.3.0")
-    require(S7)
-}
-```
-
-Use this technique with care as it will attach S7 to the user search path, possibly causing conflicts with other packages/functions.
+`@` will work for users of your package because S7 automatically attaches an environment containing the needed definition when it's loaded.