mirror of
https://github.com/rstudio/shiny.git
synced 2026-04-07 03:00:20 -04:00
Merge remote-tracking branch 'upstream/master'
This commit is contained in:
@@ -1,7 +1,7 @@
|
||||
Package: shiny
|
||||
Type: Package
|
||||
Title: Web Application Framework for R
|
||||
Version: 0.9.1.9007
|
||||
Version: 0.9.1.9008
|
||||
Date: 2014-03-19
|
||||
Author: RStudio, Inc.
|
||||
Maintainer: Winston Chang <winston@rstudio.com>
|
||||
|
||||
35
R/app.R
35
R/app.R
@@ -106,14 +106,18 @@ shinyAppDir <- function(appDir, options=list()) {
|
||||
# ui.R as a webpage. The "cachedFuncWithFile" call makes sure that the closure
|
||||
# we're creating here only gets executed when ui.R's contents change.
|
||||
uiHandlerSource <- cachedFuncWithFile(appDir, "ui.R", case.sensitive = FALSE,
|
||||
function() {
|
||||
# Have to use file.path.ci every time in case the case of ui.R has
|
||||
# changed. (Hmmm, overengineering a bit?)
|
||||
uiR <- file.path.ci(appDir, "ui.R")
|
||||
function(uiR) {
|
||||
if (file.exists(uiR)) {
|
||||
# If ui.R contains a call to shinyUI (which sets .globals$ui), use that.
|
||||
# If not, then take the last expression that's returned from ui.R.
|
||||
.globals$ui <- NULL
|
||||
on.exit(.globals$ui <- NULL, add = FALSE)
|
||||
ui <- source(uiR,
|
||||
local = new.env(parent = globalenv()),
|
||||
keep.source = TRUE)$value
|
||||
if (!is.null(.globals$ui)) {
|
||||
ui <- .globals$ui[[1]]
|
||||
}
|
||||
return(uiHttpHandler(ui))
|
||||
} else {
|
||||
return(function(req) NULL)
|
||||
@@ -126,14 +130,29 @@ shinyAppDir <- function(appDir, options=list()) {
|
||||
|
||||
wwwDir <- file.path.ci(appDir, "www")
|
||||
fallbackWWWDir <- system.file("www-dir", package = "shiny")
|
||||
serverSource <- cachedSource(appDir, "server.R", case.sensitive = FALSE)
|
||||
serverSource <- cachedFuncWithFile(appDir, "server.R", case.sensitive = FALSE,
|
||||
function(serverR) {
|
||||
# If server.R contains a call to shinyServer (which sets .globals$server),
|
||||
# use that. If not, then take the last expression that's returned from
|
||||
# server.R.
|
||||
.globals$server <- NULL
|
||||
on.exit(.globals$server <- NULL, add = TRUE)
|
||||
result <- source(
|
||||
serverR,
|
||||
local = new.env(parent = globalenv()),
|
||||
keep.source = TRUE
|
||||
)$value
|
||||
if (!is.null(.globals$server)) {
|
||||
result <- .globals$server[[1]]
|
||||
}
|
||||
return(result)
|
||||
}
|
||||
)
|
||||
|
||||
# This function stands in for the server function, and reloads the
|
||||
# real server function as necessary whenever server.R changes
|
||||
serverFuncSource <- function() {
|
||||
serverFunction <- serverSource(
|
||||
local = new.env(parent = globalenv()),
|
||||
keep.source = TRUE)$value
|
||||
serverFunction <- serverSource()
|
||||
if (is.null(serverFunction)) {
|
||||
return(function(input, output) NULL)
|
||||
} else if (is.function(serverFunction)) {
|
||||
|
||||
@@ -240,6 +240,7 @@ resourcePathHandler <- function(req) {
|
||||
#'
|
||||
#' @export
|
||||
shinyServer <- function(func) {
|
||||
.globals$server <- list(func)
|
||||
invisible(func)
|
||||
}
|
||||
|
||||
|
||||
@@ -246,7 +246,10 @@ renderPage <- function(ui, connection, showcase=0) {
|
||||
#' @return The user interface definition, without modifications or side effects.
|
||||
#'
|
||||
#' @export
|
||||
shinyUI <- function(ui) ui
|
||||
shinyUI <- function(ui) {
|
||||
.globals$ui <- list(ui)
|
||||
ui
|
||||
}
|
||||
|
||||
uiHttpHandler <- function(ui, path = "/") {
|
||||
|
||||
|
||||
@@ -84,7 +84,16 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
|
||||
else
|
||||
heightWrapper <- NULL
|
||||
|
||||
return(markRenderFunction(plotOutput, function(shinysession, name, ...) {
|
||||
# If renderPlot isn't going to adapt to the height of the div, then the
|
||||
# div needs to adapt to the height of renderPlot. By default, plotOutput
|
||||
# sets the height to 400px, so to make it adapt we need to override it
|
||||
# with NULL.
|
||||
outputFunc <- if (identical(height, 'auto'))
|
||||
plotOutput
|
||||
else
|
||||
function(outputId) plotOutput(outputId, height = NULL)
|
||||
|
||||
return(markRenderFunction(outputFunc, function(shinysession, name, ...) {
|
||||
if (!is.null(widthWrapper))
|
||||
width <- widthWrapper()
|
||||
if (!is.null(heightWrapper))
|
||||
|
||||
@@ -714,7 +714,7 @@ cachedFuncWithFile <- function(dir, file, func, case.sensitive = FALSE) {
|
||||
|
||||
now <- file.info(fname)$mtime
|
||||
if (!identical(mtime, now)) {
|
||||
value <<- func(...)
|
||||
value <<- func(fname, ...)
|
||||
mtime <<- now
|
||||
}
|
||||
value
|
||||
@@ -725,11 +725,7 @@ cachedFuncWithFile <- function(dir, file, func, case.sensitive = FALSE) {
|
||||
# calls, unless the file's mtime changes.
|
||||
cachedSource <- function(dir, file, case.sensitive = FALSE) {
|
||||
dir <- normalizePath(dir, mustWork=TRUE)
|
||||
cachedFuncWithFile(dir, file, function(...) {
|
||||
fname <- if (case.sensitive)
|
||||
file.path(dir, file)
|
||||
else
|
||||
file.path.ci(dir, file)
|
||||
cachedFuncWithFile(dir, file, function(fname, ...) {
|
||||
if (file.exists(fname))
|
||||
return(source(fname, ...))
|
||||
else
|
||||
|
||||
Reference in New Issue
Block a user