fix: updated shims and recordings for S7 support.

DESCRIPTION

@@ -35,8 +35,9 @@ LazyData: true
 RoxygenNote: 7.2.1
 URL: https://thebioengineer.github.io/camcorder/, https://github.com/thebioengineer/camcorder
 BugReports: https://github.com/thebioengineer/camcorder/issues
-Imports: 
+Imports:
     ggplot2,
+    S7 (>= 0.1.0),
     gifski,
     tools,
     magick,

R/recording.R

@@ -182,7 +182,7 @@ plot_dim <- function(dim = c(NA, NA),
   from_inches <- function(x) x * c(`in` = 1, cm = 2.54,mm = 2.54 * 10, px = dpi)[units]
   dim <- to_inches(dim) * scale
 
-  if (any(is.na(dim))) {
+  if (anyNA(dim)) {
     if (length(grDevices::dev.list()) == 0) {
       default_dim <- c(7, 7)
     } else {

R/shims.R

@@ -1,4 +1,3 @@
-
 #' @importFrom rlang env_bind caller_env
 declare_lib_shims <- function(env = caller_env()){
   env_bind(env,
@@ -9,66 +8,168 @@ declare_lib_shims <- function(env = caller_env()){
 
 #' @importFrom rlang env_unbind caller_env
 remove_lib_shims <- function(env = caller_env()){
-  env_unbind(  env, nms = c( "library", "require") )
+  env_unbind(env, nms = c("library", "require"))
 }
 
+#' Register camcorder shims for plot recording
+#'
+#' This function registers S7 methods for ggplot and patchwork print methods
+#' to intercept plot printing and save them automatically.
+#'
+#' @return Used for side effects.  Invisibly returns NULL.
+#' @keywords internal
 register_camcorder_shims <- function(){
 
   declare_lib_shims()
 
-  if("package:ggplot2" %in% search()){
-    registerS3method(
-      genname = "print",
-      class = "ggplot",
-      method = "record_ggplot",
-      envir = getNamespace("camcorder")
-    )
+  # Handle ggplot2 - check if it's loaded and if it uses S7
+  if ("package:ggplot2" %in% search()) {
+    tryCatch({
+      # Try S7 method registration first (ggplot2 >= 4.0.0)
+      if (packageVersion("ggplot2") >= "4.0.0") {
+        # Get the ggplot class from ggplot2
+        ggplot_class <- get("ggplot", envir = getNamespace("ggplot2"))
+
+        # Register S7 method for print
+        S7::method(print, ggplot_class) <- record_ggplot
+      } else {
+        # Fallback to S3 method registration for older ggplot2
+        registerS3method(
+          genname = "print",
+          class = "ggplot",
+          method = "record_ggplot",
+          envir = getNamespace("camcorder")
+        )
+      }
+    }, error = function(e) {
+      # If S7 fails, try S3 as fallback
+      registerS3method(
+        genname = "print",
+        class = "ggplot",
+        method = "record_ggplot",
+        envir = getNamespace("camcorder")
+      )
+    })
   }
 
-  if("package:patchwork" %in% search()){
-    registerS3method(
-      genname = "print",
-      class = "patchwork",
-      method = "record_patchwork",
-      envir = getNamespace("camcorder")
-    )
+  # Handle patchwork
+  if ("package:patchwork" %in% search()) {
+    tryCatch({
+      # patchwork may also use S7 in newer versions
+      if (packageVersion("ggplot2") >="4.0.0") {
+        patchwork_class <- get("patchwork", envir = getNamespace("patchwork"))
+        S7::method(print, patchwork_class) <- record_patchwork
+      } else {
+        registerS3method(
+          genname = "print",
+          class = "patchwork",
+          method = "record_patchwork",
+          envir = getNamespace("camcorder")
+        )
+      }
+    }, error = function(e) {
+      # Fallback to S3
+      registerS3method(
+        genname = "print",
+        class = "patchwork",
+        method = "record_patchwork",
+        envir = getNamespace("camcorder")
+      )
+    })
   }
 
   GG_RECORDING_ENV$shims_registered <- TRUE
 
 }
 
+#' Detach camcorder shims
+#'
+#' Restores the original print methods for ggplot and patchwork objects,
+#' stopping the automatic recording of plots.
+#'
+#' @return Used for side effects. Invisibly returns NULL.
+#' @keywords internal
 detach_camcorder_shims <- function(){
 
-  if(!is.null(GG_RECORDING_ENV$shims_registered) &
-     isTRUE(GG_RECORDING_ENV$shims_registered)){
-    remove_lib_shims()
+  if (!isTRUE(GG_RECORDING_ENV$shims_registered)) {
+    return(invisible(NULL))
   }
 
-  if("package:ggplot2" %in% search()){
-    registerS3method(
-      genname = "print",
-      class = "ggplot",
-      method = "print.ggplot",
-      envir = getNamespace("ggplot2")
-    )
+  remove_lib_shims()
+
+  # Restore ggplot2 print method
+  if ("package:ggplot2" %in% search()) {
+    tryCatch({
+      # Try S7 method restoration first
+      if (packageVersion("ggplot2") >= "4.0.0") {
+        ggplot_class <- get("ggplot", envir = getNamespace("ggplot2"))
+        original_print <- get("print. ggplot", envir = getNamespace("ggplot2"))
+        S7::method(print, ggplot_class) <- original_print
+      } else {
+        # S3 fallback
+        registerS3method(
+          genname = "print",
+          class = "ggplot",
+          method = "print.ggplot",
+          envir = getNamespace("ggplot2")
+        )
+      }
+    }, error = function(e) {
+      # S3 fallback
+      registerS3method(
+        genname = "print",
+        class = "ggplot",
+        method = "print.ggplot",
+        envir = getNamespace("ggplot2")
+      )
+    })
   }
 
-  if("package:patchwork" %in% search()){
-    registerS3method(
-      genname = "print",
-      class = "patchwork",
-      method = "print.patchwork",
-      envir = getNamespace("patchwork")
-    )
+  # Restore patchwork print method
+  if ("package:patchwork" %in% search()) {
+    tryCatch({
+      # Try S7 method restoration
+      if (packageVersion("ggplot2") >= "4.0.0") {
+        patchwork_class <- get("patchwork", envir = getNamespace("patchwork"))
+        original_print <- get("print.patchwork", envir = getNamespace("patchwork"))
+        S7::method(print, patchwork_class) <- original_print
+      } else {
+        # S3 fallback
+        registerS3method(
+          genname = "print",
+          class = "patchwork",
+          method = "print. patchwork",
+          envir = getNamespace("patchwork")
+        )
+      }
+    }, error = function(e) {
+      # S3 fallback
+      registerS3method(
+        genname = "print",
+        class = "patchwork",
+        method = "print. patchwork",
+        envir = getNamespace("patchwork")
+      )
+    })
   }
 
   GG_RECORDING_ENV$shims_registered <- FALSE
 
 }
 
 
-shim_library <- function(package, ..., warn.conflicts = TRUE,character.only = FALSE){
+#' Shim library function
+#'
+#' Intercepts library() calls to properly manage print method registration
+#' when packages are loaded/unloaded during recording.
+#'
+#' @param package Package name
+#' @param ... Additional arguments passed to base::library()
+#' @param warn.conflicts Logical, warn about conflicts
+#' @param character.only Logical, package name as character
+#'
+#' @keywords internal
+shim_library <- function(package, ..., warn.conflicts = TRUE, character.only = FALSE){
 
   package <- as.character(substitute(package))
 
@@ -79,10 +180,21 @@ shim_library <- function(package, ..., warn.conflicts = TRUE,character.only = FA
     package = package,
     character.only = TRUE,
     warn.conflicts = camcorder_warn_suppress(package, warn.conflicts),
-    ...
+    ... 
   )
 }
 
+#' Shim require function
+#'
+#' Intercepts require() calls to properly manage print method registration
+#' when packages are loaded/unloaded during recording.
+#'
+#' @param package Package name
+#' @param ... Additional arguments passed to base::require()
+#' @param warn.conflicts Logical, warn about conflicts
+#' @param character.only Logical, package name as character
+#'
+#' @keywords internal
 shim_require <- function(package, ..., warn.conflicts = TRUE, character.only = FALSE){
 
   package <- as.character(substitute(package))
@@ -98,16 +210,19 @@ shim_require <- function(package, ..., warn.conflicts = TRUE, character.only = F
   )
 }
 
+#' Suppress warnings for specific packages
+#'
+#' @param package Package name
+#' @param warn.conflicts Logical, user preference for warnings
+#'
+#' @return Logical value for warn.conflicts parameter
+#' @keywords internal
 camcorder_warn_suppress <- function(package, warn.conflicts = FALSE){
 
-  if(package %in% c("ggplot2","patchwork")){
+  if (package %in% c("ggplot2", "patchwork")) {
     return(TRUE)
   }
 
   return(warn.conflicts)
 
-}
-
-
-
-
+}