From fa9cfd7fc09dc569df75d08e5c792bc58573213c Mon Sep 17 00:00:00 2001
From: dscott <dscott@edb9625f-4e0d-4859-8d74-9fd3b1da38cb>
Date: Wed, 13 Jan 2016 05:16:46 +0000
Subject: [PATCH] Adding support for ftable objects---still incomplete

git-svn-id: svn://scm.r-forge.r-project.org/svnroot/xtable@93 edb9625f-4e0d-4859-8d74-9fd3b1da38cb
---
 pkg/NAMESPACE              |  2 ++
 pkg/R/xtableFtable.R       | 54 ++++++++++++++++++++++++++++++++++++++
 pkg/R/xtableList.R         |  2 ++
 pkg/man/xtable-internal.Rd |  2 ++
 4 files changed, 60 insertions(+)
 create mode 100644 pkg/R/xtableFtable.R

diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE
index 3e815f6..77c56f0 100644
--- a/pkg/NAMESPACE
+++ b/pkg/NAMESPACE
@@ -7,6 +7,7 @@ export("caption<-", "caption", "label", "label<-",
        "display", "xtable",
        "xtableMatharray","xtableList", "xtableLSMeans",
        "print.xtable", "print.xtableMatharray", "print.xtableList",
+       "xtableFtable", "print.xtableFtable",
        "toLatex.xtable",
        "autoformat", "xalign", "xdigits", "xdisplay",
        "sanitize", "sanitize.numbers", "sanitize.final")
@@ -14,6 +15,7 @@ export("caption<-", "caption", "label", "label<-",
 S3method("print", "xtable")
 S3method("print", "xtableMatharray")
 S3method("print", "xtableList")
+S3method("print", "xtableFtable")
 S3method("toLatex", "xtable")
 
 S3method("caption<-", "xtable")
diff --git a/pkg/R/xtableFtable.R b/pkg/R/xtableFtable.R
new file mode 100644
index 0000000..4294169
--- /dev/null
+++ b/pkg/R/xtableFtable.R
@@ -0,0 +1,54 @@
+### ftable objects, requested by Charles Roosen
+### Feature request #2248, 2/9/2012
+xtableFtable <- function(x, caption = NULL, label = NULL, align = NULL,
+                         digits = NULL, display = NULL, auto = FALSE,
+                         quote = TRUE,
+                         method = c("non.compact", "row.compact",
+                                    "col.compact", "compact"),
+                         lsep = " | ", ...) {
+  ftbl <- format.ftable(x, quote = quote, digits = digits,
+                        method = method, lsep = lsep)
+  xftbl <- xtable.matrix(ftbl,
+                         caption = caption, label = label, align = align,
+                         digits = digits, display = display, auto = auto)
+  class(xftbl) <- c("xtableFtable", "data.frame")
+  attributes(xftbl) <- list(attributes(xftbl), attributes(ftbl))
+  return(xftbl)
+}
+                         
+print.xtableFtable <- function(x,
+  type = getOption("xtable.type", "latex"),
+  file = getOption("xtable.file", ""),
+  append = getOption("xtable.append", FALSE),
+  floating = getOption("xtable.floating", TRUE),
+  floating.environment = getOption("xtable.floating.environment", "table"),
+  table.placement = getOption("xtable.table.placement", "ht"),
+  caption.placement = getOption("xtable.caption.placement", "bottom"),
+  caption.width = getOption("xtable.caption.width", NULL),
+  latex.environments = getOption("xtable.latex.environments", c("center")),
+  tabular.environment = getOption("xtable.tabular.environment", "tabular"),
+  size = getOption("xtable.size", NULL),
+  hline.after = getOption("xtable.hline.after", c(-1,0,nrow(x))),
+  NA.string = getOption("xtable.NA.string", ""),
+  only.contents = getOption("xtable.only.contents", FALSE),
+  add.to.row = getOption("xtable.add.to.row", NULL),
+  sanitize.text.function = getOption("xtable.sanitize.text.function", NULL),
+  math.style.negative = getOption("xtable.math.style.negative", FALSE),
+  math.style.exponents = getOption("xtable.math.style.exponents", FALSE),
+  html.table.attributes = getOption("xtable.html.table.attributes", "border=1"),
+  print.results = getOption("xtable.print.results", TRUE),
+  format.args = getOption("xtable.format.args", NULL),
+  booktabs = getOption("xtable.booktabs", FALSE),
+  scalebox = getOption("xtable.scalebox", NULL),
+  width = getOption("xtable.width", NULL),
+  comment = getOption("xtable.comment", TRUE),
+  timestamp = getOption("xtable.timestamp", date()),
+  ...) {
+  if (type == "latex"){
+    if (is.null(align) {
+      align <- c(rep("r", nRowVars)
+    } else {
+    stop("print.xtableFtable not yet implemented for this type")
+  }
+}
+  
diff --git a/pkg/R/xtableList.R b/pkg/R/xtableList.R
index 10b2f26..775d5c7 100644
--- a/pkg/R/xtableList.R
+++ b/pkg/R/xtableList.R
@@ -61,6 +61,7 @@ print.xtableList <- function(x,
     getOption("xtable.sanitize.message.function",
               sanitize.text.function),
   math.style.negative = getOption("xtable.math.style.negative", FALSE),
+  math.style.exponents = getOption("xtable.math.style.exponents", FALSE),
   html.table.attributes = getOption("xtable.html.table.attributes", "border=1"),
   print.results = getOption("xtable.print.results", TRUE),
   format.args = getOption("xtable.format.args", NULL),
@@ -192,6 +193,7 @@ print.xtableList <- function(x,
                  sanitize.rownames.function = sanitize.rownames.function,
                  sanitize.colnames.function = sanitize.colnames.function,
                  math.style.negative = math.style.negative,
+                 math.style.exponents = math.style.exponents,
                  html.table.attributes = html.table.attributes,
                  print.results = print.results,
                  format.args = format.args,
diff --git a/pkg/man/xtable-internal.Rd b/pkg/man/xtable-internal.Rd
index 671ec83..4d86df2 100644
--- a/pkg/man/xtable-internal.Rd
+++ b/pkg/man/xtable-internal.Rd
@@ -2,6 +2,8 @@
 \alias{xtableList}
 \alias{print.xtableList}
 \alias{xtableLSMeans}
+\alias{xtableFtable}
+\alias{print.xtableFtable}
 
 \title{Internal xtable Functions}
 \description{
-- 
2.39.2