improve cbind arg name deparsing

Author: Enchufa2

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: errors
 Type: Package
 Title: Uncertainty Propagation for R Vectors
-Version: 0.4.3
+Version: 0.4.3.1
 Authors@R: c(
     person("Iñaki", "Ucar", email="[email protected]",
       role=c("aut", "cph", "cre"), comment=c(ORCID="0000-0001-6403-5550")),

NEWS.md

@@ -1,3 +1,7 @@
+# errors devel
+
+- Improve `cbind` arg name deparsing.
+
 # errors 0.4.3
 
 - Add option `decimals` to `format()` method to add support for uncertainty with

R/misc.R

@@ -195,21 +195,16 @@ t.errors <- function(x) {
 #'
 #' @export
 cbind.errors <- function(..., deparse.level = 1) {
-  call <- as.character(match.call()[[1]])
-  allargs <- lapply(list(...), unclass)
-  nm <- names(as.list(match.call()))
-  nm <- nm[nm != "" & nm != "deparse.level"]
-  if (is.null(nm))
-    names(allargs) <- sapply(substitute(list(...))[-1], deparse)
-  else names(allargs) <- nm
-  allerrs <- lapply(list(...), function(x) {
+  dots <- .deparse(list(...), substitute(list(...)), deparse.level)
+  errs <- lapply(dots, function(x) {
     e <- .e(x)
     dim(e) <- dim(x)
     e
   })
+  call <- as.character(match.call()[[1]])
   set_errors(
-    do.call(call, c(allargs, deparse.level=deparse.level)),
-    as.numeric(do.call(call, allerrs))
+    do.call(call, c(lapply(dots, unclass), deparse.level=deparse.level)),
+    as.numeric(do.call(call, c(errs, deparse.level=0)))
   )
 }
 

R/utils.R

@@ -95,3 +95,23 @@ df2apply <- function(X, Y, FUN, ...) {
   attributes(X) <- attrs
   X
 }
+
+.deparse <- function(dots, symarg, deparse.level) {
+  deparse.level <- as.integer(deparse.level)
+  if (identical(deparse.level, -1L)) deparse.level <- 0L # R Core's hack
+  stopifnot(0 <= deparse.level, deparse.level <= 2)
+
+  nm <- c( ## 0:
+    function(i) NULL,
+    ## 1:
+    function(i) if(is.symbol(s <- symarg[[i]])) deparse(s) else NULL,
+    ## 2:
+    function(i) deparse(symarg[[i]])[[1L]])[[ 1L + deparse.level ]]
+  Nms <- function(i) { if(!is.null(s <- names(symarg)[i]) && nzchar(s)) s else nm(i) }
+
+  symarg <- as.list(symarg)[-1L]
+  dnames <- sapply(seq_along(dots), Nms)
+  if (!all(sapply(dnames, is.null)))
+    names(dots) <- dnames
+  dots
+}