Solve the knitr auto-printing problem by registering a method for knit_print (#6589)

* Respect shouldPrint when auto-printing from knitr

Implementing a method for the knitr::knit_print generic makes it
possible to customise the behaviour without looking up the call stack.

The current solution only works on R >= 3.6.0 because that's where
delayed S3 registration has been introduced.

* Delay S3method(knit_print, data.table) for R < 3.6

Use setHook() to ensure that registerS3method() will be called in the
same session if 'knitr' is loaded later. Not needed on R >= 3.6.0 where
S3method(knitr::knit_print) will do the right thing by itself.

* ws-only style

* put setHook() in a branch

* Position comment on the same line

* Restore the still-required #2369 condition

* Regression test for #2369

Avoid breaking it again like in #6589

* NEWS entry

* Comment the .onLoad condition

Co-authored-by: Michael Chirico <[email protected]>

* restore unconditional setHook()

---------

Co-authored-by: Michael Chirico <[email protected]>

Author: aitap

NAMESPACE

@@ -104,6 +104,7 @@ if (getRversion() >= "4.0.0") {
   # version of R (and that is checked in .onLoad with error if not).
   export(.rbind.data.table) # only export in R<4.0.0 where it is still used; R-devel now detects it is missing doc, #5600
 }
+if (getRversion() >= "3.6.0") S3method(knitr::knit_print, data.table) # else manual delayed registration from the onLoad hook
 S3method(dim, data.table)
 S3method(dimnames, data.table)
 S3method("dimnames<-", data.table)

NEWS.md

@@ -115,6 +115,8 @@ rowwiseDT(
 
 14. Added a `data.frame` method for `format_list_item()` to fix error printing data.tables with columns containing 1-column data.frames, [#6592](https://github.com/Rdatatable/data.table/issues/6592). Thanks to @r2evans for the bug report and fix.
 
+15. The auto-printing suppression in `knitr` documents is now done by implementing a method for `knit_print` instead of looking up the call stack, [#6589](https://github.com/Rdatatable/data.table/pull/6589). Thanks to @jangorecki for the report [#6509](https://github.com/Rdatatable/data.table/issues/6509) and @aitap for the fix.
+
 ## NOTES
 
 1. Tests run again when some Suggests packages are missing, [#6411](https://github.com/Rdatatable/data.table/issues/6411). Thanks @aadler for the note and @MichaelChirico for the fix.

R/onLoad.R

@@ -66,6 +66,15 @@
       lockBinding("rbind.data.frame",baseenv())
     }
   }
+  if (session_r_version < "3.6.0") { # corresponds to S3method() directive in NAMESPACE
+    # no delayed registration support for NAMESPACE; perform it manually
+    if (isNamespaceLoaded("knitr")) {
+      registerS3method("knit_print", "data.table", knit_print.data.table, envir = asNamespace("knitr"))
+    }
+    setHook(packageEvent("knitr", "onLoad"), function(...) {
+      registerS3method("knit_print", "data.table", knit_print.data.table, envir = asNamespace("knitr"))
+    })
+  }
 
   # Set options for the speed boost in v1.8.0 by avoiding 'default' arg of getOption(,default=)
   # In fread and fwrite we have moved back to using getOption's default argument since it is unlikely fread and fread will be called in a loop many times, plus they

R/print.data.table.R

@@ -32,21 +32,8 @@ print.data.table = function(x, topn=getOption("datatable.print.topn"),
     SYS = sys.calls()
     if (length(SYS) <= 2L ||  # "> DT" auto-print or "> print(DT)" explicit print (cannot distinguish from R 3.2.0 but that's ok)
         ( length(SYS) >= 3L && is.symbol(thisSYS <- SYS[[length(SYS)-2L]][[1L]]) &&
-          as.character(thisSYS) == 'source') || # suppress printing from source(echo = TRUE) calls, #2369
-        ( length(SYS) > 3L && is.symbol(thisSYS <- SYS[[length(SYS)-3L]][[1L]]) &&
-          as.character(thisSYS) %chin% mimicsAutoPrint ) || # suppress printing from knitr, #6509
-          # In previous versions of knitr, call stack when auto-printing looked like:
-          #  knit_print -> knit_print.default -> normal_print -> print -> print.data.table
-          # and we detected and avoided that by checking fourth last call in the stack.
-          # As of September 2024, the call stack can also look like:
-          #  knit_print.default -> normal_print -> render -> evalq -> evalq -> print -> print.data.table
-          # so we have to check the 7th last call in the stack too.
-          # Ideally, we would like to return invisibly from DT[, foo := bar] and have knitr respect that, but a flag in
-          # .Primitive("[") sets all values returned from [.data.table to visible, hence the need for printing hacks later.
-        ( length(SYS) > 6L && is.symbol(thisSYS <- SYS[[length(SYS)-6L]][[1L]]) &&
-          as.character(thisSYS) %chin% mimicsAutoPrint ) )  {
+          as.character(thisSYS) == 'source') ) { # suppress printing from source(echo = TRUE) calls, #2369
       return(invisible(x))
-      # is.symbol() temp fix for #1758.
     }
   }
   if (!is.numeric(nrows)) nrows = 100L
@@ -168,9 +155,6 @@ format.data.table = function(x, ..., justify="none") {
   do.call(cbind, lapply(x, format_col, ..., justify=justify))
 }
 
-mimicsAutoPrint = c("knit_print.default")
-# add maybe repr_text.default.  See https://github.com/Rdatatable/data.table/issues/933#issuecomment-220237965
-
 shouldPrint = function(x) {
   ret = (identical(.global$print, "") ||   # to save address() calls and adding lots of address strings to R's global cache
      address(x)!=.global$print)
@@ -303,3 +287,9 @@ trunc_cols_message = function(not_printed, abbs, class, col.names){
     domain=NA
   )
 }
+
+# Maybe add a method for repr::repr_text.  See https://github.com/Rdatatable/data.table/issues/933#issuecomment-220237965
+knit_print.data.table <- function(x, ...) {
+  if (!shouldPrint(x)) return(invisible(x))
+  NextMethod()
+}

tests/autoprint.R

@@ -43,3 +43,15 @@ DT[1,a:=10L][]                        # yes. ...[] == oops, forgot print(...)
 tryCatch(DT[,foo:=ColumnNameTypo], error=function(e) e$message)         # error: not found.
 DT                                    # yes
 DT                                    # yes
+
+# Regression test for auto-printing suppression in source(), #2369
+local({
+  f = tempfile(fileext = ".R")
+  on.exit(unlink(f))
+  writeLines(c(
+    "library(data.table)",
+    "DT = data.table(a = 1)",
+    "DT[,a:=1] # not auto-printed"
+  ), f)
+  source(f, local = TRUE, echo = TRUE)
+})

tests/autoprint.Rout.save

@@ -136,6 +136,24 @@ NULL
 1:    10
 2:    10
 > 
+> # Regression test for auto-printing suppression in source(), #2369
+> local({
++   f = tempfile(fileext = ".R")
++   on.exit(unlink(f))
++   writeLines(c(
++     "library(data.table)",
++     "DT = data.table(a = 1)",
++     "DT[,a:=1] # not auto-printed"
++   ), f)
++   source(f, local = TRUE, echo = TRUE)
++ })
+
+> library(data.table)
+
+> DT = data.table(a = 1)
+
+> DT[, `:=`(a, 1)]
+> 
 > proc.time()
    user  system elapsed 
   0.223   0.016   0.231