Files
shiny/R/render-table.R
2015-11-05 13:04:43 -06:00

60 lines
2.1 KiB
R

#' Table Output
#'
#' Creates a reactive table that is suitable for assigning to an \code{output}
#' slot.
#'
#' The corresponding HTML output tag should be \code{div} and have the CSS class
#' name \code{shiny-html-output}.
#'
#' @param expr An expression that returns an R object that can be used with
#' \code{\link[xtable]{xtable}}.
#' @param ... Arguments to be passed through to \code{\link[xtable]{xtable}} and
#' \code{\link[xtable]{print.xtable}}.
#' @param env The environment in which to evaluate \code{expr}.
#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
#' is useful if you want to save an expression in a variable.
#' @param func A function that returns an R object that can be used with
#' \code{\link[xtable]{xtable}} (deprecated; use \code{expr} instead).
#'
#' @export
renderTable <- function(expr, ..., env=parent.frame(), quoted=FALSE, func=NULL) {
if (!is.null(func)) {
shinyDeprecated(msg="renderTable: argument 'func' is deprecated. Please use 'expr' instead.")
} else {
installExprFunction(expr, "func", env, quoted)
}
markRenderFunction(tableOutput, function() {
classNames <- getOption('shiny.table.class') %OR% 'data table table-bordered table-condensed'
data <- func()
if (is.null(data) || identical(data, data.frame()))
return("")
# Separate the ... args to pass to xtable() vs print.xtable()
dots <- list(...)
xtable_argnames <- setdiff(names(formals(xtable)), c("x", "..."))
xtable_args <- dots[intersect(names(dots), xtable_argnames)]
non_xtable_args <- dots[setdiff(names(dots), xtable_argnames)]
# Call xtable with its args
xtable_res <- do.call(xtable, c(list(data), xtable_args))
# Set up print args
print_args <- list(
xtable_res,
type = 'html',
html.table.attributes = paste('class="', htmlEscape(classNames, TRUE),
'"', sep='')
)
print_args <- c(print_args, non_xtable_args)
return(paste(
utils::capture.output(
do.call(print, print_args)
),
collapse="\n"
))
})
}