updated renderFunc's to include a shinysession arg

This commit is contained in:
Barbara Borges Ribeiro
2016-03-28 15:31:33 +01:00
parent d7da5df734
commit 0495fe2d71
2 changed files with 28 additions and 7 deletions

View File

@@ -86,8 +86,10 @@ renderTable <- function(expr, striped = FALSE, hover = FALSE,
digitsWrapper <- createWrapper(digits)
naWrapper <- createWrapper(na)
# Main render function
markRenderFunction(tableOutput, function() {
renderFunc <- function(shinysession, name, ...) {
session <<- shinysession
outputName <<- name
striped <- stripedWrapper()
hover <- hoverWrapper()
bordered <- borderedWrapper()
@@ -137,7 +139,7 @@ renderTable <- function(expr, striped = FALSE, hover = FALSE,
cols <- paste(vapply(data, defaultAlignment, character(1)), collapse = "")
cols <- paste0(names, cols)
} else {
## Case 2: user-specified alignment
## Case 2: user-specified alignment
num_cols <- if (rownames) nchar(align) else nchar(align)+1
valid <- !grepl("[^lcr\\?]", align)
if (num_cols == ncol(data)+1 && valid) {
@@ -208,5 +210,8 @@ renderTable <- function(expr, striped = FALSE, hover = FALSE,
}
}
return(tab)
}, outputArgs = outputArgs)
}
# Main render function
markRenderFunction(tableOutput, renderFunc, outputArgs = outputArgs)
}

View File

@@ -177,6 +177,9 @@ renderImage <- function(expr, env=parent.frame(), quoted=FALSE,
installExprFunction(expr, "func", env, quoted)
renderFunc <- function(shinysession, name, ...) {
session <<- shinysession
outputName <<- name
imageinfo <- func()
# Should the file be deleted after being sent? If .deleteFile not set or if
# TRUE, then delete; otherwise don't delete.
@@ -241,7 +244,10 @@ renderPrint <- function(expr, env = parent.frame(), quoted = FALSE, func = NULL,
installExprFunction(expr, "func", env, quoted)
}
renderFunc <- function() {
renderFunc <- function(shinysession, name, ...) {
session <<- shinysession
outputName <<- name
op <- options(width = width)
on.exit(options(op), add = TRUE)
paste(utils::capture.output(func()), collapse = "\n")
@@ -288,7 +294,9 @@ renderText <- function(expr, env=parent.frame(), quoted=FALSE,
installExprFunction(expr, "func", env, quoted)
}
renderFunc <- function() {
renderFunc <- function(shinysession, name, ...) {
session <<- shinysession
outputName <<- name
value <- func()
return(paste(utils::capture.output(cat(value)), collapse="\n"))
}
@@ -335,6 +343,9 @@ renderUI <- function(expr, env=parent.frame(), quoted=FALSE,
}
renderFunc <- function(shinysession, name, ...) {
session <<- shinysession
outputName <<- name
result <- func()
if (is.null(result) || length(result) == 0)
return(NULL)
@@ -402,7 +413,9 @@ renderUI <- function(expr, env=parent.frame(), quoted=FALSE,
#'
#' @export
downloadHandler <- function(filename, content, contentType=NA, outputArgs=list()) {
renderFunc <-function(shinysession, name, ...) {
renderFunc <- function(shinysession, name, ...) {
session <<- shinysession
outputName <<- name
shinysession$registerDownload(name, filename, contentType, content)
}
markRenderFunction(downloadButton, renderFunc, outputArgs = outputArgs)
@@ -479,6 +492,9 @@ renderDataTable <- function(expr, options = NULL, searchDelay = 500,
installExprFunction(expr, "func", env, quoted)
renderFunc <- function(shinysession, name, ...) {
session <<- shinysession
outputName <<- name
if (is.function(options)) options <- options()
options <- checkDT9(options)
res <- checkAsIs(options)