a few minor tweaks

This commit is contained in:
Barbara Borges Ribeiro
2016-04-03 15:24:17 +01:00
parent 5dafdab3d7
commit 7eb29586a7
2 changed files with 24 additions and 19 deletions

View File

@@ -25,39 +25,44 @@ markRenderFunction <- function(uiFunc, renderFunc, outputArgs = list()) {
# a mutable object that keeps track of whether `useRenderFunction` has been
# executed (this usually only happens when rendering Shiny code snippets in
# an interactive R Markdown document); its initial value is FALSE
executed_useRenderFunction <- MutableObj$new()
executed_useRenderFunction$set(FALSE)
hasExecuted <- Mutable$new()
hasExecuted$set(FALSE)
origRenderFunc <- renderFunc
renderFunc <- function(...) {
# if the user provided something through `outputArgs` BUT the
# `useRenderFunction` was not executed, then outputArgs will be ignored,
# so throw a warning to let user know the correct usage
if (length(outputArgs) != 0 && !executed_useRenderFunction$get()) {
if (length(outputArgs) != 0 && !hasExecuted$get()) {
warning("Unused argument: outputArgs. The argument outputArgs is only ",
"meant to be used when embedding snippets of Shiny code in an ",
"R Markdown code chunk (using runtime: shiny). When running a ",
"full Shiny app, please set the output arguments directly in ",
"the corresponding output function of your UI code.")
# stop warning from happening again for the same object
executed_useRenderFunction$set(TRUE)
hasExecuted$set(TRUE)
}
if (is.null(formals(origRenderFunc))) {
warning("The render function should take at least two arguments (`name` ",
"and `shinysession`.")
origRenderFunc()
} else {
origRenderFunc(...)
}
if (is.null(formals(origRenderFunc))) origRenderFunc()
else origRenderFunc(...)
}
structure(renderFunc,
class = c("shiny.render.function", "function"),
outputFunc = uiFunc,
outputArgs = outputArgs,
executed_useRenderFunction = executed_useRenderFunction)
class = c("shiny.render.function", "function"),
outputFunc = uiFunc,
outputArgs = outputArgs,
hasExecuted = hasExecuted)
}
useRenderFunction <- function(renderFunc, inline = FALSE) {
outputFunction <- attr(renderFunc, "outputFunc")
outputArgs <- attr(renderFunc, "outputArgs")
executed <- attr(renderFunc, "executed_useRenderFunction")
executed$set(TRUE)
hasExecuted <- attr(renderFunc, "hasExecuted")
hasExecuted$set(TRUE)
for (arg in names(outputArgs)) {
if (!arg %in% names(formals(outputFunction))) {
@@ -243,7 +248,7 @@ renderPrint <- function(expr, env = parent.frame(), quoted = FALSE,
width = getOption('width'), outputArgs=list()) {
installExprFunction(expr, "func", env, quoted)
renderFunc <- function() {
renderFunc <- function(shinysession, name, ...) {
op <- options(width = width)
on.exit(options(op), add = TRUE)
paste(utils::capture.output(func()), collapse = "\n")
@@ -284,7 +289,7 @@ renderText <- function(expr, env=parent.frame(), quoted=FALSE,
outputArgs=list()) {
installExprFunction(expr, "func", env, quoted)
renderFunc <- function() {
renderFunc <- function(shinysession, name, ...) {
value <- func()
return(paste(utils::capture.output(cat(value)), collapse="\n"))
}

View File

@@ -1297,12 +1297,12 @@ wrapFunctionLabel <- function(func, name, ..stacktraceon = FALSE) {
}
# This is a very simple mutable object which only stores one boolean value
# (which we can set and get). Using this class is sometimes useful when
# communicating persistent changes across functions.
MutableObj <- R6Class("MutableObj",
# This is a very simple mutable object which only stores one value
# (which we can set and get). Using this class is sometimes useful
# when communicating persistent changes across functions.
Mutable <- R6Class("Mutable",
private = list(
value = NA
value = NULL
),
public = list(
set = function(value) { private$value <- value },