Merge pull request #18 from dmurdoch/deparse

Always deparse to one line.  Avoid deparsing in All().

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tables
 Title: Formula-Driven Table Generation
-Version: 0.9.21
+Version: 0.9.22
 Author: Duncan Murdoch
 Description: Computes and displays complex tables of summary statistics.
   Output may be in LaTeX, HTML, plain text, or an R

NEWS.md

@@ -1,9 +1,10 @@
-# tables 0.9.21
+# tables 0.9.22
 
 - `PlusMinus()` and `Paste()` didn't handle formatting properly 
 when multiple columns were involved (issue #13).
 - `toLatex()` with a non-empty `file` argument didn't write 
 to file properly.  (Reported by Reinhard Kerschner and F. Hortner.)
+- In some cases `All()` would give an error (issue #17).
 
 # tables 0.9.17
 

R/All.R

@@ -1,74 +1,50 @@
-All <- function(df, numeric=TRUE, character=FALSE, logical=FALSE, factor=FALSE,
-		    complex=FALSE, raw=FALSE, other=FALSE,
-		    texify=getOption("tables.texify", FALSE)) {
-
-    if (is.character(numeric)) numeric <- get(numeric, mode="function", 
-    	envir=parent.frame())
-    if (is.character(character)) character <- get(character, mode="function",
-    	envir=parent.frame())
-    if (is.character(logical)) logical <- get(logical, mode="function",
-    	envir=parent.frame())
-    if (is.character(factor)) factor <- get(factor, mode="function",
-    	envir=parent.frame())
-    if (is.character(complex)) complex <- get(complex, mode="function",
-    	envir=parent.frame())
-    if (is.character(complex)) complex <- get(complex, mode="function",
-    	envir=parent.frame())
-    if (is.character(raw)) raw <- get(raw, mode="function", 
-        envir=parent.frame())
-    if (is.character(other)) other <- get(other, mode="function", 
-        envir=parent.frame())
-
+All <- function(df,
+           numeric = TRUE,
+           character = FALSE,
+           logical = FALSE,
+           factor = FALSE,
+           complex = FALSE,
+           raw = FALSE,
+           other = FALSE,
+           texify = getOption("tables.texify", FALSE)) {
     names <- colnames(df)
     if (texify)
-    	names <- Hmisc::latexTranslate(names)
+      names <- Hmisc::latexTranslate(names)
 
     f <- NULL
     for (i in seq_along(names)) {
-        value <- df[[i]]
-        if (is.numeric(value)) {
-            if (is.function(numeric))
-            	value <- numeric(value)
-            else if (!isTRUE(numeric))
-            	next
-        } else if (is.character(value)) {
-            if (is.function(character))
-            	value <- character(value)
-            else if (!isTRUE(character))
-            	next
-        }  else if (is.logical(value)) {
-            if (is.function(logical)) 
-            	value <- logical(value)
-            else if (!isTRUE(logical))
-            	next
-        } else if (is.factor(value)) {
-            if (is.function(factor))
-            	value <- factor(value)
-            else if (!isTRUE(factor))
-            	next
-        } else if (is.complex(value)) {
-            if (is.function(complex)) 
-            	value <- complex(value)
-            else if (!isTRUE(complex))
-            	next
-        } else if (is.raw(value)) {
-	    if (is.function(raw)) 
-	     	value <- raw(value)
-	    else if (!isTRUE(raw))
-	    	next
-        } else {
-            if (is.function(other))
-            	value <- other(value)
-            else if (!isTRUE(other))
-            	next
-        }
-
-        f1 <- call("*", call("Heading", as.name(names[i])),
-                   value)
-        if (is.null(f))
-            f <- f1
-        else
-            f <- call("+", f, f1)
+      value <- df[[i]]
+      if (is.numeric(value))
+        sel <- numeric
+      else if (is.character(value))
+        sel <- character
+      else if (is.logical(value))
+        sel <- logical
+      else if (is.factor(value))
+        sel <- factor
+      else if (is.complex(value))
+        sel <- complex
+      else if (is.raw(value))
+        sel <- raw
+      else
+        sel <- other
+
+      if (is.character(sel))
+        sel <- get(sel, mode = "function", envir = parent.frame())
+
+      if (is.function(sel))
+        value <- sel(value)
+      else if (isTRUE(sel))
+        value <- call("[[", substitute(df), i)
+      else
+        next
+
+      f1 <- call("*", call("Heading", as.name(names[i])),
+                 value)
+      if (is.null(f))
+        f <- f1
+      else
+        f <- call("+", f, f1)
     }
     f
-}
+  }

R/deparse.R

@@ -0,0 +1,6 @@
+# base::deparse might return more than one line; this 
+# replaces it with a function that chops the results
+
+deparse <- function(expr, width.cutoff = 500L, nlines = 1L, ...) {
+  base::deparse(expr, width.cutoff = width.cutoff, nlines = nlines, ...)
+}