Backport deparse1() (#7823)

* backport deparse1()

* Fix %iscall% for complex LHS

* Comment, style change

* width.cutoff=500L

Co-authored-by: Benjamin Schwendinger <52290390+ben-schwen@users.noreply.github.com>

* Fix widths according to default argument

Co-authored-by: aitap <krylov.r00t@gmail.com>

---------

Co-authored-by: Ivan K <krylov.r00t@gmail.com>
Co-authored-by: Benjamin Schwendinger <52290390+ben-schwen@users.noreply.github.com>

Author: 3 people

R/data.table.R

@@ -567,7 +567,7 @@ replace_dot_alias = function(e) {
         stopf("When by and keyby are both provided, keyby must be TRUE or FALSE")
     }
     if (missing(by)) { missingby=TRUE; by=bysub=NULL }  # possible when env is used, PR#4304
-    else if (verbose && !is.null(env)) catf("Argument '%s' after substitute: %s\n", "by", paste(deparse(bysub, width.cutoff=500L), collapse="\n"))
+    else if (verbose && !is.null(env)) catf("Argument '%s' after substitute: %s\n", "by", deparse1(bysub, collapse="\n"))
   }
   bynull = !missingby && is.null(by) #3530
   byjoin = !is.null(by) && is.symbol(bysub) && bysub==".EACHI"
@@ -632,7 +632,7 @@ replace_dot_alias = function(e) {
         substitute2(.j, env),
         list(.j = substitute(j))
       ))
-      if (missing(jsub)) {j = substitute(); jsub=NULL} else if (verbose && !is.null(env)) catf("Argument '%s' after substitute: %s\n", "j", paste(deparse(jsub, width.cutoff=500L), collapse="\n"))
+      if (missing(jsub)) {j = substitute(); jsub=NULL} else if (verbose && !is.null(env)) catf("Argument '%s' after substitute: %s\n", "j", deparse1(jsub, collapse="\n"))
     }
   }
   if (!missing(j)) {
@@ -722,7 +722,7 @@ replace_dot_alias = function(e) {
         substitute2(.i, env),
         list(.i = substitute(i))
       ))
-      if (missing(isub)) {i = substitute(); isub=NULL} else if (verbose && !is.null(env)) catf("Argument '%s' after substitute: %s\n", "i", paste(deparse(isub, width.cutoff=500L), collapse="\n"))
+      if (missing(isub)) {i = substitute(); isub=NULL} else if (verbose && !is.null(env)) catf("Argument '%s' after substitute: %s\n", "i", deparse1(isub, collapse="\n"))
     }
   }
   if (!missing(i)) {
@@ -2252,7 +2252,7 @@ replace_dot_alias = function(e) {
 
 # What's the name of the top-level call in 'j'?
 # NB: earlier, we used 'as.character()' but that fails for closures/builtins (#6026).
-root_name = function(jsub) if (is.call(jsub)) paste(deparse(jsub[[1L]]), collapse = " ") else ""
+root_name = function(jsub) if (is.call(jsub)) deparse1(jsub[[1L]], width.cutoff=60L) else ""
 
 DT = function(x, ...) {  #4872
   old = getOption("datatable.optimize")

R/transpose.R

@@ -51,7 +51,7 @@ tstrsplit = function(x, ..., fill=NA, type.convert=FALSE, keep, names=FALSE) {
       if(!n) stopf("The argument 'type.convert' does not support empty list.")
       is_named = nzchar(names(type.convert))
       all_is_named = length(is_named) && all(is_named)                  # because all(is_named)=TRUE if is_named=NULL <-- names(type.convert)=NULL
-      last_item = paste(deparse(substitute(type.convert)[[n + 1L]], width.cutoff=500L), collapse=" ")
+      last_item = deparse1(substitute(type.convert)[[n + 1L]])
       if (!all_is_named) {
         if (!(sum(!is_named) == 1L && !is_named[n] && is.function(type.convert[[n]])))
           stopf("When the argument 'type.convert' contains an unnamed element, it is expected to be the last element and should be a function. More than one unnamed element is not allowed unless all elements are functions with length equal to %d (the length of the transpose list or 'keep' argument if it is specified).", length(keep))

R/utils.R

@@ -11,6 +11,9 @@ nan_is_na = function(x) {
   stopf("Argument 'nan' must be NA or NaN")
 }
 
+# R 4.4.0
+if (!exists("deparse1", "package:base")) deparse1 = function(x, collapse=" ", width.cutoff=500L) paste(deparse(x, width.cutoff=width.cutoff), collapse=collapse) # nolint: paste_linter.
+
 # R 4.4.0
 if (!exists("%||%", "package:base")) `%||%` <- function(x, y) if (is.null(x)) y else x # nolint: coalesce_linter.
 
@@ -202,7 +205,7 @@ is_utc = function(tz) {
   if (!is.call(e)) return(FALSE)
   if (is.name(e1 <- e[[1L]])) return(e1 %chin% f)
   if (e1 %iscall% c('::', ':::')) return(e1[[3L]] %chin% f)
-  paste(deparse(e1), collapse = " ") %chin% f # complicated cases e.g. a closure/builtin on LHS of call; note that format() is much (e.g. 40x) slower than deparse()
+  deparse1(e1, width.cutoff=60L) %chin% f # complicated cases e.g. a closure/builtin on LHS of call; note that format() is much (e.g. 40x) slower than deparse()
 }
 
 # nocov start #593 always return a data.table