Extend cedta for more lapply() usages (#7166)

* refactor cedta rules into helper

* implement for bug

* test, NEWS

* About 100 packages define this now, no sense keeping track

* trailing ws

* rearrange: .datatable.aware to the top

* push isNamespace check into helper

* Fix: look up another level, use %iscall%

* Revert "Fix: look up another level, use %iscall%"

This reverts commit 5462a20.

* Revert "push isNamespace check into helper"

This reverts commit f7be165.

* Revert "rearrange: .datatable.aware to the top"

This reverts commit c43cee8.

* Revert "trailing ws"

This reverts commit 1643f36.

* Revert "About 100 packages define this now, no sense keeping track"

This reverts commit 885dbb1.

* Revert "test, NEWS"

This reverts commit d82923e.

* Revert "implement for bug"

This reverts commit c5e1284.

* Revert "refactor cedta rules into helper"

This reverts commit 41c8f67.

* fix j=.SD passed to lapply '...'

Author: MichaelChirico

NEWS.md

@@ -72,6 +72,8 @@
 
 12. `print(..., col.names = 'none')` now correctly adapts column widths to the data content, ignoring the original column names and producing a more compact output, [#6882](https://github.com/Rdatatable/data.table/issues/6882). Thanks to @brooksambrose for the report and @venom1204 for the PR.
 
+13. Reference to `.SD` in `...` arguments to `lapply()`, e.g. ``lapply(list_of_tables, `[`, j=.SD[1L])`` is evaluated correctly, [#2982](https://github.com/Rdatatable/data.table/issues/2982). Thanks @franknarf1 for the report and @MichaelChirico for the fix.
+
 ### NOTES
 
 1. The following in-progress deprecations have proceeded:

R/cedta.R

@@ -39,6 +39,16 @@ cedta.pkgEvalsUserCode = c("gWidgetsWWW","statET","FastRWeb","slidify","rmarkdow
 }
 # nocov end
 
+.any_sd_queries_in_stack = function(calls) {
+  for (ii in length(calls):1) { # nolint: seq_linter. As above.
+    if (!calls[[ii]] %iscall% "[") next
+    the_lhs = calls[[ii]][[2L]]
+    if (!is.name(the_lhs) || the_lhs != ".SD") next
+    return(TRUE)
+  }
+  FALSE
+}
+
 # cedta = Calling Environment Data.Table-Aware
 cedta = function(n=2L) {
   # Calling Environment Data Table Aware
@@ -52,12 +62,15 @@ cedta = function(n=2L) {
     return(TRUE)
   }
   nsname = getNamespaceName(ns)
+  sc = sys.calls()
   ans = nsname=="data.table" ||
     "data.table" %chin% names(getNamespaceImports(ns)) ||   # most common and recommended cases first for speed
     (nsname=="utils" &&
       (exists("debugger.look", parent.frame(n+1L)) ||
-      (length(sc<-sys.calls())>=8L && sc[[length(sc)-7L]] %iscall% 'example')) ) || # 'example' for #2972
-    (nsname=="base" && all(c("FUN", "X") %chin% ls(parent.frame(n)))) || # lapply
+      (length(sc)>=8L && sc[[length(sc)-7L]] %iscall% 'example')) ) || # 'example' for #2972
+    (nsname=="base" && # lapply
+      (all(c("FUN", "X") %chin% ls(parent.frame(n))) ||
+      .any_sd_queries_in_stack(sc))) ||
     (nsname %chin% cedta.pkgEvalsUserCode && .any_eval_calls_in_stack()) ||
     nsname %chin% cedta.override ||
     isTRUE(ns$.datatable.aware) ||  # As of Sep 2018: RCAS, caretEnsemble, dtplyr, rstanarm, rbokeh, CEMiTool, rqdatatable, RImmPort, BPRMeth, rlist

inst/tests/tests.Rraw

@@ -21426,3 +21426,6 @@ test(2330.7, as.data.table(list(z), keep.rownames=TRUE), data.table(rn=rep("", 3
 
 M <- matrix(1:6, nrow=3, dimnames=list(rep("", 3), c("V1", "V2")))   #  test of list(M) for empty-rowname'd matrix input
 test(2330.8, as.data.table(list(M), keep.rownames=TRUE), data.table(rn=rep("", 3), V1=1:3, V2=4:6))
+
+# .SD reference in '...' passed to lapply(FUN=) is recognized as data.table
+test(2331, lapply(list(data.table(a=1:2)), `[`, j=.SD[1L]), list(data.table(a=1L)))