mirror of
https://github.com/rstudio/shiny.git
synced 2026-04-07 03:00:20 -04:00
a few minor tweaks
This commit is contained in:
@@ -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"))
|
||||
}
|
||||
|
||||
10
R/utils.R
10
R/utils.R
@@ -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 },
|
||||
|
||||
Reference in New Issue
Block a user