diff --git a/DESCRIPTION b/DESCRIPTION index 73e5ea45d..b150628d8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,10 +26,12 @@ Suggests: datasets, markdown, Cairo (>= 1.5-5), - testthat + testthat, + knitr URL: http://www.rstudio.com/shiny/ BugReports: https://github.com/rstudio/shiny/issues Collate: + 'app.R' 'bootstrap-layout.R' 'bootstrap.R' 'cache.R' @@ -43,10 +45,10 @@ Collate: 'react.R' 'reactives.R' 'run-url.R' + 'server.R' 'sessioncontext.R' 'utils.R' 'shiny.R' - 'server.R' 'shinyui.R' 'shinywrappers.R' 'showcase.R' diff --git a/NAMESPACE b/NAMESPACE index e7c0fca86..8419714d0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -22,6 +22,8 @@ S3method(format,shiny.tag.list) S3method(names,reactivevalues) S3method(print,html) S3method(print,reactive) +S3method(print,shiny.appdir) +S3method(print,shiny.appobj) S3method(print,shiny.tag) S3method(print,shiny.tag.list) export(HTML) @@ -78,6 +80,8 @@ export(invalidateLater) export(is.reactive) export(is.reactivevalues) export(isolate) +export(knit_print.shiny.appdir) +export(knit_print.shiny.appobj) export(mainPanel) export(makeReactiveBinding) export(navbarMenu) @@ -118,9 +122,12 @@ export(runApp) export(runExample) export(runGist) export(runGitHub) +export(runRmdContainer) export(runUrl) export(selectInput) export(selectizeInput) +export(shinyAppDir) +export(shinyAppObj) export(shinyServer) export(shinyUI) export(showReactLog) diff --git a/R/app.R b/R/app.R new file mode 100644 index 000000000..bb1b6dfe8 --- /dev/null +++ b/R/app.R @@ -0,0 +1,125 @@ +#' Create a Shiny app object +#' +#' These functions create Shiny app objects from either an explicit UI/server +#' pair (\code{shinyAppObj}), or by passing the path of a directory that +#' contains a Shiny app (\code{shinyAppDir}). You generally shouldn't need to +#' use these functions to create/run applications; they are intended for +#' interoperability purposes, such as embedding Shiny apps inside a \pkg{knitr} +#' document. +#' +#' @param ui The UI definition of the app (for example, a call to +#' \code{fluidPage()} with nested controls) +#' @param server A server function +#' @param onStart A function that will be called before the app is actually run. +#' This is only needed for \code{shinyAppObj}, since in the \code{shinyAppDir} +#' case, a \code{global.R} file can be used for this purpose. +#' @param options Named options that should be passed to the `runApp` call. You +#' can also specify \code{width} and \code{height} parameters which provide a +#' hint to the embedding environment about the ideal height/width for the app. +#' @return An object that represents the app. Printing the object will run the +#' app. +#' +#' @examples +#' \dontrun{ +#' shinyAppObj( +#' ui = fluidPage( +#' numericInput("n", "n", 1), +#' plotOutput("plot") +#' ), +#' server = function(input, output) { +#' output$plot <- renderPlot( plot(head(cars, input$n)) ) +#' }, +#' options=list(launch.browser = rstudio::viewer) +#' ) +#' +#' shinyAppDir( +#' +#' ) +#' } +#' +#' @export +shinyAppObj <- function(ui, server, onStart=NULL, options=list()) { + structure( + list(ui=ui, server=server, onStart=onStart), + shiny.options = options, + class = "shiny.appobj" + ) +} + +#' @rdname shinyAppObj +#' @export +shinyAppDir <- function(dir, options=list()) { + dir <- normalizePath(dir, mustWork = TRUE) + structure( + dir, + shiny.options = options, + class = "shiny.appdir" + ) +} + +#' Run a Shiny app object +#' +#' @param x A Shiny app, as returned from \code{\link{shinyAppObj}} or +#' \code{\link{shinyAppDir}}. +#' +#' @export +print.shiny.appobj <- function(x) { + opts <- attr(x, "shiny.options") + opts <- opts[names(opts) %in% + c("port", "launch.browser", "host", "quiet", "display.mode")] + + args <- c(list(x), opts) + + do.call(runApp, args) +} + +#' @rdname print.shiny.appobj +#' @export +print.shiny.appdir <- print.shiny.appobj + +#' @export +knit_print.shiny.appobj <- function(x) { + path <- addSubAppObj(x) + opts <- attr(x, "shiny.options") + width <- if (is.null(opts$width)) "100%" else opts$width + height <- if (is.null(opts$height)) "400" else opts$height + iframe <- tags$iframe(src=path, width=width, height=height) + knitr::asis_output(format(iframe)) +} + +#' @export +knit_print.shiny.appdir <- function(x) { + path <- addSubAppDir(x) + opts <- attr(x, "shiny.options") + width <- if (is.null(opts$width)) "100%" else opts$width + height <- if (is.null(opts$height)) "400" else opts$height + iframe <- tags$iframe(src=path, width=width, height=height) + knitr::asis_output(format(iframe)) +} + +#' @export +runRmdContainer <- function(input, text = NULL, ..., knit.options = list()) { + appdir <- tempfile() + dir.create(appdir) + on.exit(unlink(appdir, recursive = TRUE), add = TRUE) + + wwwdir <- file.path(appdir, "www") + dir.create(wwwdir) + + if (missing(input)) + input <- NULL + output <- file.path(wwwdir, "index.html") + knitArgs <- c(list( + input = input, text = text, + output = if (!is.null(text)) NULL else output + ), knit.options) + + result <- do.call(knitr::knit2html, knitArgs) + if (!is.null(text)) + writeLines(result, output) + + writeLines("shinyServer(function(input, output) NULL)", + file.path(appdir, "server.R")) + + runApp(appdir, ...) +} diff --git a/R/server.R b/R/server.R index 3a226ec52..5b33902d5 100644 --- a/R/server.R +++ b/R/server.R @@ -549,7 +549,6 @@ proxyCallbacks <- function(prefix, targetCallbacks) { pathPattern <- paste("^\\Q", prefix, "\\E/", sep = "") matchReq <- function(req) { if (isTRUE(grepl(pathPattern, req$PATH_INFO))) { - message("Matched with ", prefix) req <- as.environment(as.list(req)) pathInfo <- substr(req$PATH_INFO, nchar(prefix)+1, nchar(req$PATH_INFO)) req$SCRIPT_NAME <- paste(req$SCRIPT_NAME, prefix, sep = "") @@ -562,6 +561,20 @@ proxyCallbacks <- function(prefix, targetCallbacks) { list( onHeaders = function(req) { + if (identical(req$PATH_INFO, prefix)) { + # We could return a 302 response here, but doing so seems to cause + # httpuv to report "ERROR: [on_request_read] parse error" for some + # reason. Instead, let the request proceed as normal and handle it + # in call(). + return(NULL) + } + req <- matchReq(req) + if (is.null(req)) + return(FALSE) + else + return(targetCallbacks$onHeaders(req)) + }, + call = function(req) { if (identical(req$PATH_INFO, prefix)) { return(list( status = 302L, @@ -572,15 +585,7 @@ proxyCallbacks <- function(prefix, targetCallbacks) { body = "" )) } - cat("onHeaders: ", req$PATH_INFO, "\n") - req <- matchReq(req) - if (is.null(req)) - return(FALSE) - else - return(targetCallbacks$onHeaders(req)) - }, - call = function(req) { - cat("call: ", req$PATH_INFO, "\n") + req <- matchReq(req) if (is.null(req)) return(FALSE) @@ -794,7 +799,6 @@ httpuvCallbackSet <- local({ callbacks <<- list(cb) else callbacks <<- c(callbacks, list(cb)) - message("Callback length: ", length(callbacks)) }, clear = function() { callbacks <<- list() @@ -832,7 +836,6 @@ httpuvCallbackSet <- local({ addSubAppObj <- function(appObj, workerId="") { appParts <- createAppObj(appObj$ui, appObj$server) path <- registerSubApp(appParts$httpHandlers, appParts$serverFuncSource, workerId) - message(path) invisible(path) } @@ -845,7 +848,6 @@ addSubAppDir <- function(appDir, workerId="") { finally = setwd(oldwd) ) path <- registerSubApp(appParts$httpHandlers, appParts$serverFuncSource, workerId) - message(path) invisible(path) } @@ -853,7 +855,6 @@ registerSubApp <- function(httpHandlers, serverFuncSource, workerId) { path <- sprintf("/%s", createUniqueId(8)) httpuvCallbacks <- proxyCallbacks(path, createAppCallbacks(httpHandlers, serverFuncSource, workerId)) - message("GOT HERE 1") httpuvCallbackSet$add(httpuvCallbacks) return(path) } @@ -861,7 +862,6 @@ registerSubApp <- function(httpHandlers, serverFuncSource, workerId) { startApp <- function(httpHandlers, serverFuncSource, port, host, workerId, quiet) { httpuvCallbacks <- proxyCallbacks("", createAppCallbacks(httpHandlers, serverFuncSource, workerId)) - message("GOT HERE 2") httpuvCallbackSet$add(httpuvCallbacks) if (is.numeric(port) || is.integer(port)) { diff --git a/inst/rmd-examples/subapps.Rmd b/inst/rmd-examples/subapps.Rmd new file mode 100644 index 000000000..cae9cfb53 --- /dev/null +++ b/inst/rmd-examples/subapps.Rmd @@ -0,0 +1,23 @@ +# Subapp test + +This is an R Markdown document that contains several embedded Shiny apps. + +```{r} +library(shiny) +shinyAppDir( + system.file("examples/01_hello", package="shiny"), + options=list( + width="100%", height=250 + ) +) +shinyAppObj( + ui = fluidPage( + numericInput("n", "n", 1), + plotOutput("plot") + ), + server = function(input, output) { + output$plot <- renderPlot( plot(head(cars, input$n)) ) + }, + options=list(width=450) +) +``` diff --git a/man/print.shiny.appobj.Rd b/man/print.shiny.appobj.Rd new file mode 100644 index 000000000..359ebb8e7 --- /dev/null +++ b/man/print.shiny.appobj.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2 (4.0.0): do not edit by hand +\name{print.shiny.appobj} +\alias{print.shiny.appdir} +\alias{print.shiny.appobj} +\title{Run a Shiny app object} +\usage{ +\method{print}{shiny.appobj}(x) + +\method{print}{shiny.appdir}(x) +} +\arguments{ +\item{x}{A Shiny app, as returned from \code{\link{shinyAppObj}} or + \code{\link{shinyAppDir}}.} +} +\description{ +Run a Shiny app object +} + diff --git a/man/shinyAppObj.Rd b/man/shinyAppObj.Rd new file mode 100644 index 000000000..ccef15adc --- /dev/null +++ b/man/shinyAppObj.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2 (4.0.0): do not edit by hand +\name{shinyAppObj} +\alias{shinyAppDir} +\alias{shinyAppObj} +\title{Create a Shiny app object} +\usage{ +shinyAppObj(ui, server, onStart = NULL, options = list()) + +shinyAppDir(dir, options = list()) +} +\arguments{ +\item{ui}{The UI definition of the app (for example, a call to +\code{fluidPage()} with nested controls)} + +\item{server}{A server function} + +\item{onStart}{A function that will be called before the app is actually run. +This is only needed for \code{shinyAppObj}, since in the \code{shinyAppDir} +case, a \code{global.R} file can be used for this purpose.} + +\item{options}{Named options that should be passed to the `runApp` call. You +can also specify \code{width} and \code{height} parameters which provide a +hint to the embedding environment about the ideal height/width for the app.} +} +\value{ +An object that represents the app. Printing the object will run the + app. +} +\description{ +These functions create Shiny app objects from either an explicit UI/server +pair (\code{shinyAppObj}), or by passing the path of a directory that +contains a Shiny app (\code{shinyAppDir}). You generally shouldn't need to +use these functions to create/run applications; they are intended for +interoperability purposes, such as embedding Shiny apps inside a \pkg{knitr} +document. +} + diff --git a/staticdocs/index.r b/staticdocs/index.r index e5bc42621..8641bfac4 100644 --- a/staticdocs/index.r +++ b/staticdocs/index.r @@ -80,8 +80,8 @@ list( sd_section("Rendering functions", "Functions that you use in your application's server side code, assigning them to outputs that appear in your user interface.", c( - "renderPlot", - "renderText", + "renderPlot", + "renderText", "renderPrint", "renderDataTable", "renderImage", @@ -148,6 +148,13 @@ list( "repeatable", "shinyDeprecated" ) + ), + sd_section("Embedding", + "Functions that are intended for third-party packages that embed Shiny applications.", + c( + "shinyAppObj", + "print.shiny.appobj" + ) ) ) )