Undo license change

The code wasn't actually redundant.

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 0.3.1
+Version: 0.5.0
 Date: 2013-01-23
 Author: RStudio, Inc.
 Maintainer: Winston Chang <winston@rstudio.com>
@@ -18,7 +18,7 @@ Imports:
     utils,
     datasets,
     methods,
-    websockets (>= 1.1.6),
+    httpuv (>= 1.0.5),
     caTools,
     RJSONIO,
     xtable,
@@ -45,3 +45,4 @@ Collate:
     'slider.R'
     'bootstrap.R'
     'run-url.R'
+    'imageutils.R'

NAMESPACE

@@ -1,9 +1,13 @@
 S3method("$",reactivevalues)
+S3method("$",shinyoutput)
 S3method("$<-",reactivevalues)
 S3method("$<-",shinyoutput)
 S3method("[",reactivevalues)
+S3method("[",shinyoutput)
 S3method("[<-",reactivevalues)
+S3method("[<-",shinyoutput)
 S3method("[[",reactivevalues)
+S3method("[[",shinyoutput)
 S3method("[[<-",reactivevalues)
 S3method("[[<-",shinyoutput)
 S3method("names<-",reactivevalues)
@@ -15,8 +19,6 @@ S3method(format,shiny.tag.list)
 S3method(names,reactivevalues)
 S3method(print,shiny.tag)
 S3method(print,shiny.tag.list)
-S3method(reactive,"function")
-S3method(reactive,default)
 export(HTML)
 export(a)
 export(addResourcePath)
@@ -32,6 +34,7 @@ export(downloadButton)
 export(downloadHandler)
 export(downloadLink)
 export(em)
+export(exprToFunction)
 export(fileInput)
 export(h1)
 export(h2)
@@ -42,6 +45,7 @@ export(h6)
 export(headerPanel)
 export(helpText)
 export(htmlOutput)
+export(imageOutput)
 export(img)
 export(includeHTML)
 export(includeMarkdown)
@@ -51,9 +55,12 @@ export(isolate)
 export(mainPanel)
 export(numericInput)
 export(observe)
+export(outputOptions)
 export(p)
 export(pageWithSidebar)
+export(parseQueryString)
 export(plotOutput)
+export(plotPNG)
 export(pre)
 export(radioButtons)
 export(reactive)
@@ -65,6 +72,12 @@ export(reactiveTimer)
 export(reactiveUI)
 export(reactiveValues)
 export(reactiveValuesToList)
+export(renderImage)
+export(renderPlot)
+export(renderPrint)
+export(renderTable)
+export(renderText)
+export(renderUI)
 export(repeatable)
 export(runApp)
 export(runExample)
@@ -95,5 +108,5 @@ export(wellPanel)
 import(RJSONIO)
 import(caTools)
 import(digest)
-import(websockets)
+import(httpuv)
 import(xtable)

NEWS

@@ -1,3 +1,53 @@
+shiny 0.5.0
+--------------------------------------------------------------------------------
+
+* Switch from websockets package for handling websocket connections to httpuv.
+
+* New method for detecting hidden output objects. Instead of checking that
+  height and width are 0, it checks that the object or any ancestor in the DOM
+  has style display:none.
+
+* Add `clientData` reactive values object, which carries information about the
+  client. This includes the hidden status of output objects, height/width plot
+  output objects, and the URL of the browser.
+
+* Add `parseQueryString()` function.
+
+* Add `renderImage()` function for sending arbitrary image files to the client,
+  and its counterpart, `imageOutput()`.
+
+* Add support for high-resolution (Retina) displays.
+
+* Fix bug #55, where `renderTable()` would throw error with an empty data frame.
+
+shiny 0.4.1
+--------------------------------------------------------------------------------
+
+* Fix bug where width and height weren't passed along properly from
+  `reactivePlot` to `renderPlot`.
+
+* Fix bug where infinite recursion would happen when `reactivePlot` was passed
+  a function for width or height.
+
+shiny 0.4.0
+--------------------------------------------------------------------------------
+
+* Added suspend/resume capability to observers.
+
+* Output objects are automatically suspended when they are hidden on the user's
+  web browser.
+
+* `runGist()` accepts GitHub's new URL format, which includes the username.
+
+* `reactive()` and `observe()` now take expressions instead of functions.
+
+* `reactiveText()`, `reactivePlot()`, and so on, have been renamed to
+  `renderText()`, `renderPlot()`, etc.  They also now take expressions instead
+  of functions.
+
+* Fixed a bug where empty values in a numericInput were sent to the R process
+  as 0. They are now sent as NA.
+
 shiny 0.3.1
 --------------------------------------------------------------------------------
 

R/bootstrap.R

@@ -293,8 +293,25 @@ numericInput <- function(inputId, label, value, min = NA, max = NA, step = NA) {
 #' File Upload Control
 #' 
 #' Create a file upload control that can be used to upload one or more files. 
-#' \bold{Experimental feature. Only works in some browsers (primarily tested on
-#' Chrome and Firefox).}
+#' \bold{Does not work on older browsers, including Internet Explorer 9 and
+#' earlier.}
+#' 
+#' Whenever a file upload completes, the corresponding input variable is set
+#' to a dataframe. This dataframe contains one row for each selected file, and
+#' the following columns:
+#' \describe{
+#'   \item{\code{name}}{The filename provided by the web browser. This is
+#'   \strong{not} the path to read to get at the actual data that was uploaded
+#'   (see
+#'   \code{datapath} column).}
+#'   \item{\code{size}}{The size of the uploaded data, in
+#'   bytes.}
+#'   \item{\code{type}}{The MIME type reported by the browser (for example, 
+#'   \code{text/plain}), or empty string if the browser didn't know.}
+#'   \item{\code{datapath}}{The path to a temp file that contains the data that was
+#'   uploaded. This file may be deleted if the user performs another upload
+#'   operation.}
+#' }
 #' 
 #' @param inputId Input variable to assign the control's value to.
 #' @param label Display label for the control.
@@ -313,7 +330,13 @@ fileInput <- function(inputId, label, multiple = FALSE, accept = NULL) {
   
   tagList(
     tags$label(label),
-    inputTag
+    inputTag,
+    tags$div(
+      id=paste(inputId, "_progress", sep=""),
+      class="progress progress-striped active shiny-file-input-progress",
+      tags$div(class="bar"),
+      tags$label()
+    )
   )
 }
 
@@ -708,7 +731,7 @@ tabsetPanel <- function(..., id = NULL) {
 #' @param outputId output variable to read the value from
 #' @return A text output element that can be included in a panel
 #' @details Text is HTML-escaped prior to rendering. This element is often used 
-#' to dispaly \link{reactiveText} output variables.
+#' to display \link{renderText} output variables.
 #' @examples
 #' h3(textOutput("caption"))
 #' @export
@@ -723,7 +746,7 @@ textOutput <- function(outputId) {
 #' @param outputId output variable to read the value from
 #' @return A verbatim text output element that can be included in a panel
 #' @details Text is HTML-escaped prior to rendering. This element is often used
-#' with the \link{reactivePrint} function to preserve fixed-width formatting
+#' with the \link{renderPrint} function to preserve fixed-width formatting
 #' of printed objects.
 #' @examples
 #' mainPanel(
@@ -738,9 +761,30 @@ verbatimTextOutput <- function(outputId) {
   pre(id = outputId, class =  "shiny-text-output")
 }
 
-#' Create a plot output element
+#' Create a image output element
 #' 
-#' Render a \link{reactivePlot} within an application page.
+#' Render a \link{renderImage} within an application page.
+#' @param outputId output variable to read the image from
+#' @param width Image width. Must be a valid CSS unit (like \code{"100\%"},
+#'   \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
+#'   string and have \code{"px"} appended.
+#' @param height Image height
+#' @return An image output element that can be included in a panel
+#' @examples
+#' # Show an image
+#' mainPanel(
+#'   imageOutput("dataImage")
+#' )
+#' @export
+imageOutput <- function(outputId, width = "100%", height="400px") {
+  style <- paste("width:", validateCssUnit(width), ";",
+    "height:", validateCssUnit(height))
+  div(id = outputId, class = "shiny-image-output", style = style)
+}
+
+#' Create an plot output element
+#' 
+#' Render a \link{renderPlot} within an application page.
 #' @param outputId output variable to read the plot from
 #' @param width Plot width. Must be a valid CSS unit (like \code{"100\%"},
 #'   \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
@@ -756,12 +800,12 @@ verbatimTextOutput <- function(outputId) {
 plotOutput <- function(outputId, width = "100%", height="400px") {
   style <- paste("width:", validateCssUnit(width), ";",
     "height:", validateCssUnit(height))
-  div(id = outputId, class="shiny-plot-output", style = style)
+  div(id = outputId, class = "shiny-plot-output", style = style)
 }
 
 #' Create a table output element
 #' 
-#' Render a \link{reactiveTable} within an application page.
+#' Render a \link{renderTable} within an application page.
 #' @param outputId output variable to read the table from
 #' @return A table output element that can be included in a panel
 #' @examples
@@ -779,7 +823,7 @@ tableOutput <- function(outputId) {
 #' text will be included within an HTML \code{div} tag, and is presumed to 
 #' contain HTML content which should not be escaped.
 #' 
-#' \code{uiOutput} is intended to be used with \code{reactiveUI} on the
+#' \code{uiOutput} is intended to be used with \code{renderUI} on the
 #' server side. It is currently just an alias for \code{htmlOutput}.
 #'   
 #' @param outputId output variable to read the value from

R/fileupload.R

@@ -28,16 +28,23 @@ FileUploadOperation <- setRefClass(
     .files = 'data.frame',
     .dir = 'character',
     .currentFileInfo = 'list',
-    .currentFileData = 'ANY'
+    .currentFileData = 'ANY',
+    .pendingFileInfos = 'list'
   ),
   methods = list(
-    initialize = function(parent, id, dir) {
+    initialize = function(parent, id, dir, fileInfos) {
       .parent <<- parent
       .id <<- id
       .dir <<- dir
+      .pendingFileInfos <<- fileInfos
     },
-    fileBegin = function(file) {
+    fileBegin = function() {
+      if (length(.pendingFileInfos) < 1)
+        stop("fileBegin called too many times")
+
+      file <- .pendingFileInfos[[1]]
       .currentFileInfo <<- file
+      .pendingFileInfos <<- tail(.pendingFileInfos, -1)
 
       filename <- file.path(.dir, as.character(length(.files)))
       row <- data.frame(name=file$name, size=file$size, type=file$type,
@@ -57,6 +64,8 @@ FileUploadOperation <- setRefClass(
       close(.currentFileData)
     },
     finish = function() {
+      if (length(.pendingFileInfos) > 0)
+        stop("File upload job was stopped prematurely")
       .parent$onJobFinished(.id)
       return(.files)
     }
@@ -73,14 +82,14 @@ FileUploadContext <- setRefClass(
     initialize = function(dir=tempdir()) {
       .basedir <<- dir
     },
-    createUploadOperation = function() {
+    createUploadOperation = function(fileInfos) {
       while (TRUE) {
         id <- paste(as.raw(runif(12, min=0, max=0xFF)), collapse='')
         dir <- file.path(.basedir, id)
         if (!dir.create(dir))
           next
         
-        op <- FileUploadOperation$new(.self, id, dir)
+        op <- FileUploadOperation$new(.self, id, dir, fileInfos)
         .operations$set(id, op)
         return(id)
       }

R/imageutils.R

@@ -0,0 +1,46 @@
+#' Run a plotting function and save the output as a PNG
+#'
+#' This function returns the name of the PNG file that it generates. In
+#' essence, it calls \code{png()}, then \code{func()}, then \code{dev.off()}.
+#' So \code{func} must be a function that will generate a plot when used this
+#' way.
+#'
+#' For output, it will try to use the following devices, in this order:
+#' quartz (via \code{\link[grDevices]{png}}), then \code{\link[Cairo]{CairoPNG}},
+#' and finally \code{\link[grDevices]{png}}. This is in order of quality of
+#' output. Notably, plain \code{png} output on Linux and Windows may not
+#' antialias some point shapes, resulting in poor quality output.
+#'
+#' @param func A function that generates a plot.
+#' @param filename The name of the output file. Defaults to a temp file with
+#'   extension \code{.png}.
+#' @param width Width in pixels.
+#' @param height Height in pixels.
+#' @param res Resolution in pixels per inch. This value is passed to
+#'   \code{\link{png}}. Note that this affects the resolution of PNG rendering in
+#'   R; it won't change the actual ppi of the browser.
+#' @param ... Arguments to be passed through to \code{\link[grDevices]{png}}.
+#'   These can be used to set the width, height, background color, etc.
+#'
+#' @export
+plotPNG <- function(func, filename=tempfile(fileext='.png'),
+                    width=400, height=400, res=72, ...) {
+  # If quartz is available, use png() (which will default to quartz).
+  # Otherwise, if the Cairo package is installed, use CairoPNG().
+  # Finally, if neither quartz nor Cairo, use png().
+  if (capabilities("aqua")) {
+    pngfun <- png
+  } else if (nchar(system.file(package = "Cairo"))) {
+    require(Cairo)
+    pngfun <- CairoPNG
+  } else {
+    pngfun <- png
+  }
+
+  do.call(pngfun, c(filename=filename, width=width, height=height, res=res, list(...)))
+  tryCatch(
+    func(),
+    finally=dev.off())
+
+  filename
+}

R/react.R

@@ -68,12 +68,18 @@ Context <- setRefClass(
 
 ReactiveEnvironment <- setRefClass(
   'ReactiveEnvironment',
-  fields = c('.currentContext', '.nextId', '.pendingFlush'),
+  fields = list(
+    .currentContext = 'ANY',
+    .nextId = 'integer',
+    .pendingFlush = 'list',
+    .inFlush = 'logical'
+  ),
   methods = list(
     initialize = function() {
       .currentContext <<- NULL
       .nextId <<- 0L
       .pendingFlush <<- list()
+      .inFlush <<- FALSE
     },
     nextId = function() {
       .nextId <<- .nextId + 1L
@@ -96,6 +102,11 @@ ReactiveEnvironment <- setRefClass(
       .pendingFlush <<- c(ctx, .pendingFlush)
     },
     flush = function() {
+      # If already in a flush, don't start another one
+      if (.inFlush) return()
+      .inFlush <<- TRUE
+      on.exit(.inFlush <<- FALSE)
+
       while (length(.pendingFlush) > 0) {
         ctx <- .pendingFlush[[1]]
         .pendingFlush <<- .pendingFlush[-1]

R/reactives.R

@@ -26,6 +26,8 @@ Dependents <- setRefClass(
 )
 
 
+# ReactiveValues ------------------------------------------------------------
+
 ReactiveValues <- setRefClass(
   'ReactiveValues',
   fields = list(
@@ -112,13 +114,14 @@ ReactiveValues <- setRefClass(
 )
 
 
-# reactivevalues: S3 wrapper class for Values class -----------------------
+# reactivevalues ------------------------------------------------------------
+# S3 wrapper class for ReactiveValues reference class
 
 #' Create an object for storing reactive values
 #'
 #' This function returns an object for storing reactive values. It is similar
 #' to a list, but with special capabilities for reactive programming. When you
-#' read a value from it, the calling reactive function takes a reactive
+#' read a value from it, the calling reactive expression takes a reactive
 #' dependency on that value, and when you write to it, it notifies any reactive
 #' functions that depend on that value.
 #'
@@ -163,15 +166,15 @@ reactiveValues <- function(...) {
   values
 }
 
+# Register the S3 class so that it can be used for a field in a Reference Class
+setOldClass("reactivevalues")
+
 # Create a reactivevalues object
 #
 # @param values A ReactiveValues object
 # @param readonly Should this object be read-only?
 .createReactiveValues <- function(values = NULL, readonly = FALSE) {
-  acc <- list(impl=values)
-  class(acc) <- 'reactivevalues'
-  attr(acc, 'readonly') <- readonly
-  return(acc)
+  structure(list(impl=values), class='reactivevalues', readonly=readonly)
 }
 
 #' @S3method $ reactivevalues
@@ -219,7 +222,7 @@ names.reactivevalues <- function(x) {
 
 #' @S3method as.list reactivevalues
 as.list.reactivevalues <- function(x, all.names=FALSE, ...) {
-  .Deprecated("reactiveValuesToList",
+  shinyDeprecated("reactiveValuesToList",
     msg = paste("'as.list.reactivevalues' is deprecated. ",
       "Use reactiveValuesToList instead.",
       "\nPlease see ?reactiveValuesToList for more information.",
@@ -254,13 +257,15 @@ reactiveValuesToList <- function(x, all.names=FALSE) {
   .subset2(x, 'impl')$toList(all.names)
 }
 
+# Observable ----------------------------------------------------------------
+
 Observable <- setRefClass(
   'Observable',
   fields = list(
     .func = 'function',
     .label = 'character',
     .dependents = 'Dependents',
-    .dirty = 'logical',
+    .invalidated = 'logical',
     .running = 'logical',
     .value = 'ANY',
     .visible = 'logical',
@@ -269,11 +274,11 @@ Observable <- setRefClass(
   methods = list(
     initialize = function(func, label=deparse(substitute(func))) {
       if (length(formals(func)) > 0)
-        stop("Can't make a reactive function from a function that takes one ",
+        stop("Can't make a reactive expression from a function that takes one ",
              "or more parameters; only functions without parameters can be ",
              "reactive.")
       .func <<- func
-      .dirty <<- TRUE
+      .invalidated <<- TRUE
       .running <<- FALSE
       .label <<- label
       .execCount <<- 0L
@@ -281,7 +286,7 @@ Observable <- setRefClass(
     getValue = function() {
       .dependents$register()
 
-      if (.dirty || .running) {
+      if (.invalidated || .running) {
         .self$.updateValue()
       }
       
@@ -296,12 +301,12 @@ Observable <- setRefClass(
     .updateValue = function() {
       ctx <- Context$new(.label)
       ctx$onInvalidate(function() {
-        .dirty <<- TRUE
+        .invalidated <<- TRUE
         .dependents$invalidate()
       })
       .execCount <<- .execCount + 1L
 
-      .dirty <<- FALSE
+      .invalidated <<- FALSE
 
       wasRunning <- .running
       .running <<- TRUE
@@ -316,41 +321,60 @@ Observable <- setRefClass(
   )
 )
 
-#' Create a Reactive Function
-#' 
-#' Wraps a normal function to create a reactive function. Conceptually, a 
-#' reactive function is a function whose result will change over time.
-#' 
-#' Reactive functions are functions that can read reactive values and call other
-#' reactive functions. Whenever a reactive value changes, any reactive functions
-#' that depended on it are marked as "invalidated" and will automatically 
-#' re-execute if necessary. If a reactive function is marked as invalidated, any
-#' other reactive functions that recently called it are also marked as 
-#' invalidated. In this way, invalidations ripple through the functions that 
+#' Create a reactive expression
+#'
+#' Wraps a normal expression to create a reactive expression. Conceptually, a
+#' reactive expression is a expression whose result will change over time.
+#'
+#' Reactive expressions are expressions that can read reactive values and call other
+#' reactive expressions. Whenever a reactive value changes, any reactive expressions
+#' that depended on it are marked as "invalidated" and will automatically
+#' re-execute if necessary. If a reactive expression is marked as invalidated, any
+#' other reactive expressions that recently called it are also marked as
+#' invalidated. In this way, invalidations ripple through the expressions that
 #' depend on each other.
-#' 
-#' See the \href{http://rstudio.github.com/shiny/tutorial/}{Shiny tutorial} for 
-#' more information about reactive functions.
-#' 
-#' @param x The value or function to make reactive. The function must not have 
-#'   any parameters.
-#' @return A reactive function. (Note that reactive functions can only be called
-#'   from within other reactive functions.)
-#'   
+#'
+#' See the \href{http://rstudio.github.com/shiny/tutorial/}{Shiny tutorial} for
+#' more information about reactive expressions.
+#'
+#' @param x An expression (quoted or unquoted).
+#' @param env The parent environment for the reactive expression. By default, this
+#'   is the calling environment, the same as when defining an ordinary
+#'   non-reactive expression.
+#' @param quoted Is the expression quoted? By default, this is \code{FALSE}.
+#'   This is useful when you want to use an expression that is stored in a
+#'   variable; to do so, it must be quoted with `quote()`.
+#' @param label A label for the reactive expression, useful for debugging.
+#'
+#' @examples
+#' values <- reactiveValues(A=1)
+#'
+#' reactiveB <- reactive({
+#'   values$A + 1
+#' })
+#'
+#' # Can use quoted expressions
+#' reactiveC <- reactive(quote({ values$A + 2 }), quoted = TRUE)
+#'
+#' # To store expressions for later conversion to reactive, use quote()
+#' expr_q <- quote({ values$A + 3 })
+#' reactiveD <- reactive(expr_q, quoted = TRUE)
+#'
+#' # View the values from the R console with isolate()
+#' isolate(reactiveB())
+#' isolate(reactiveC())
+#' isolate(reactiveD())
+#'
 #' @export
-reactive <- function(x) {
-  UseMethod("reactive")
-}
-#' @S3method reactive function
-reactive.function <- function(x) {
-  return(Observable$new(x, deparse(substitute(x)))$getValue)
-}
-#' @S3method reactive default
-reactive.default <- function(x) {
-  stop("Don't know how to make this object reactive!")
+reactive <- function(x, env = parent.frame(), quoted = FALSE, label = NULL) {
+  fun <- exprToFunction(x, env, quoted)
+  if (is.null(label))
+    label <- deparse(body(fun))
+
+  Observable$new(fun, label)$getValue
 }
 
-# Return the number of times that a reactive function or observer has been run
+# Return the number of times that a reactive expression or observer has been run
 execCount <- function(x) {
   if (is.function(x))
     return(environment(x)$.execCount)
@@ -360,16 +384,20 @@ execCount <- function(x) {
     stop('Unexpected argument to execCount')
 }
 
+# Observer ------------------------------------------------------------------
+
 Observer <- setRefClass(
   'Observer',
   fields = list(
     .func = 'function',
     .label = 'character',
-    .flushCallbacks = 'list',
-    .execCount = 'integer'
+    .invalidateCallbacks = 'list',
+    .execCount = 'integer',
+    .onResume = 'function',
+    .suspended = 'logical'
   ),
   methods = list(
-    initialize = function(func, label) {
+    initialize = function(func, label, suspended = FALSE) {
       if (length(formals(func)) > 0)
         stop("Can't make an observer from a function that takes parameters; ",
              "only functions without parameters can be reactive.")
@@ -377,68 +405,133 @@ Observer <- setRefClass(
       .func <<- func
       .label <<- label
       .execCount <<- 0L
+      .suspended <<- suspended
+      .onResume <<- function() NULL
 
       # Defer the first running of this until flushReact is called
-      ctx <- Context$new(.label)
-      ctx$onFlush(function() {
-        run()
-      })
-      ctx$addPendingFlush()
+      .createContext()$invalidate()
     },
-    run = function() {
+    .createContext = function() {
       ctx <- Context$new(.label)
 
       ctx$onInvalidate(function() {
-        lapply(.flushCallbacks, function(func) {
+        lapply(.invalidateCallbacks, function(func) {
           func()
           NULL
         })
-        ctx$addPendingFlush()
-      })
 
+        continue <- function() {
+          ctx$addPendingFlush()
+        }
+        
+        if (.suspended == FALSE)
+          continue()
+        else
+          .onResume <<- continue
+      })
+      
       ctx$onFlush(function() {
         run()
       })
+      
+      return(ctx)
+    },
+    run = function() {
+      ctx <- .createContext()
       .execCount <<- .execCount + 1L
       ctx$run(.func)
     },
     onInvalidate = function(func) {
-      .flushCallbacks <<- c(.flushCallbacks, func)
+      "Register a function to run when this observer is invalidated"
+      .invalidateCallbacks <<- c(.invalidateCallbacks, func)
+    },
+    suspend = function() {
+      "Causes this observer to stop scheduling flushes (re-executions) in
+      response to invalidations. If the observer was invalidated prior to this
+      call but it has not re-executed yet (because it waits until onFlush is
+      called) then that re-execution will still occur, becasue the flush is
+      already scheduled."
+      .suspended <<- TRUE
+    },
+    resume = function() {
+      "Causes this observer to start re-executing in response to invalidations.
+      If the observer was invalidated while suspended, then it will schedule
+      itself for re-execution (pending flush)."
+      if (.suspended) {
+        .suspended <<- FALSE
+        .onResume()
+        .onResume <<- function() NULL
+      }
+      invisible()
     }
   )
 )
 
 #' Create a reactive observer
 #' 
-#' Creates an observer from the given function. An observer is like a reactive 
-#' function in that it can read reactive values and call reactive functions, and
+#' Creates an observer from the given expression An observer is like a reactive
+#' expression in that it can read reactive values and call reactive expressions, and
 #' will automatically re-execute when those dependencies change. But unlike 
-#' reactive functions, it doesn't yield a result and can't be used as an input 
-#' to other reactive functions. Thus, observers are only useful for their side 
+#' reactive expression, it doesn't yield a result and can't be used as an input 
+#' to other reactive expressions. Thus, observers are only useful for their side 
 #' effects (for example, performing I/O).
 #' 
-#' Another contrast between reactive functions and observers is their execution
-#' strategy. Reactive functions use lazy evaluation; that is, when their
+#' Another contrast between reactive expressions and observers is their execution
+#' strategy. Reactive expressions use lazy evaluation; that is, when their
 #' dependencies change, they don't re-execute right away but rather wait until
 #' they are called by someone else. Indeed, if they are not called then they
 #' will never re-execute. In contrast, observers use eager evaluation; as soon
 #' as their dependencies change, they schedule themselves to re-execute.
 #' 
-#' @param func The function to observe. It must not have any parameters. Any 
-#'   return value from this function will be ignored.
-#'   
+#' @param x An expression (quoted or unquoted). Any return value will be ignored.
+#' @param env The parent environment for the reactive expression. By default, this
+#'   is the calling environment, the same as when defining an ordinary
+#'   non-reactive expression.
+#' @param quoted Is the expression quoted? By default, this is \code{FALSE}.
+#'   This is useful when you want to use an expression that is stored in a
+#'   variable; to do so, it must be quoted with `quote()`.
+#' @param label A label for the observer, useful for debugging.
+#' @param suspended If \code{TRUE}, start the observer in a suspended state.
+#'   If \code{FALSE} (the default), start in a non-suspended state.
+#'
+#' @examples
+#' values <- reactiveValues(A=1)
+#'
+#' obsB <- observe({
+#'   print(values$A + 1)
+#' })
+#'
+#' # Can use quoted expressions
+#' obsC <- observe(quote({ print(values$A + 2) }), quoted = TRUE)
+#'
+#' # To store expressions for later conversion to observe, use quote()
+#' expr_q <- quote({ print(values$A + 3) })
+#' obsD <- observe(expr_q, quoted = TRUE)
+#'
+#' # In a normal Shiny app, the web client will trigger flush events. If you
+#' # are at the console, you can force a flush with flushReact()
+#' shiny:::flushReact()
+#'
 #' @export
-observe <- function(func) {
-  invisible(Observer$new(func, deparse(substitute(func))))
+observe <- function(x, env=parent.frame(), quoted=FALSE, label=NULL,
+                    suspended=FALSE) {
+
+  fun <- exprToFunction(x, env, quoted)
+  if (is.null(label))
+    label <- deparse(body(fun))
+
+  invisible(Observer$new(fun, label=label, suspended=suspended))
 }
 
+# ---------------------------------------------------------------------------
+
 #' Timer
 #' 
 #' Creates a reactive timer with the given interval. A reactive timer is like a 
 #' reactive value, except reactive values are triggered when they are set, while
 #' reactive timers are triggered simply by the passage of time.
 #' 
-#' \link[=reactive]{Reactive functions} and observers that want to be 
+#' \link[=reactive]{Reactive expressions} and observers that want to be 
 #' invalidated by the timer need to call the timer function that 
 #' \code{reactiveTimer} returns, even if the current time value is not actually 
 #' needed.
@@ -492,22 +585,32 @@ invalidateLater <- function(millis) {
 
 #' Create a non-reactive scope for an expression
 #' 
-#' Executes the given expression in a scope where reactive values or functions 
+#' Executes the given expression in a scope where reactive values or expression 
 #' can be read, but they cannot cause the reactive scope of the caller to be 
 #' re-evaluated when they change.
 #' 
 #' Ordinarily, the simple act of reading a reactive value causes a relationship 
 #' to be established between the caller and the reactive value, where a change 
 #' to the reactive value will cause the caller to re-execute. (The same applies 
-#' for the act of getting a reactive function's value.) The \code{isolate} 
-#' function lets you read a reactive value or function without establishing this
+#' for the act of getting a reactive expression's value.) The \code{isolate} 
+#' function lets you read a reactive value or expression without establishing this
 #' relationship.
 #' 
-#' @param expr An expression that can access reactive values or functions.
+#' The expression given to \code{isolate()} is evaluated in the calling
+#' environment. This means that if you assign a variable inside the
+#' \code{isolate()}, its value will be visible outside of the \code{isolate()}.
+#' If you want to avoid this, you can use \code{\link{local}()} inside the
+#' \code{isolate()}.
+#'
+#' This function can also be useful for calling reactive expression at the
+#' console, which can be useful for debugging. To do so, simply wrap the
+#' calls to the reactive expression with \code{isolate()}.
+#'
+#' @param expr An expression that can access reactive values or expressions.
 #' 
 #' @examples
 #' \dontrun{
-#' observer(function() {
+#' observe({
 #'   input$saveButton  # Do take a dependency on input$saveButton
 #'   
 #'   # isolate a simple expression
@@ -515,7 +618,7 @@ invalidateLater <- function(millis) {
 #'   writeToDatabase(data)
 #' })
 #' 
-#' observer(function() {
+#' observe({
 #'   input$saveButton  # Do take a dependency on input$saveButton
 #'   
 #'   # isolate a whole block
@@ -526,7 +629,30 @@ invalidateLater <- function(millis) {
 #'   })
 #'   writeToDatabase(data)
 #' })
+#'
+#' observe({
+#'   x <- 1
+#'   # x outside of isolate() is affected
+#'   isolate(x <- 2)
+#'   print(x) # 2
+#'
+#'   y <- 1
+#'   # Use local() to avoid affecting calling environment
+#'   isolate(local(y <- 2))
+#'   print(y) # 1
+#' })
+#'
 #' }
+#'
+#' # Can also use isolate to call reactive expressions from the R console
+#' values <- reactiveValues(A=1)
+#' fun <- reactive({ as.character(values$A) })
+#' isolate(fun())
+#' # "1"
+#'
+#' # isolate also works if the reactive expression accesses values from the
+#' # input object, like input$x
+#'
 #' @export
 isolate <- function(expr) {
   ctx <- Context$new('[isolate]')

R/run-url.R

@@ -3,8 +3,9 @@
 #' Download and launch a Shiny application that is hosted on GitHub as a gist.
 #'
 #' @param gist The identifier of the gist. For example, if the gist is
-#'   https://gist.github.com/3239667, then \code{3239667}, \code{'3239667'}, and
-#'   \code{'https://gist.github.com/3239667'} are all valid values.
+#'   https://gist.github.com/jcheng5/3239667, then \code{3239667},
+#'   \code{'3239667'}, and \code{'https://gist.github.com/jcheng5/3239667'}
+#'   are all valid values.
 #' @param port The TCP port that the application should listen on. Defaults to
 #'   port 8100.
 #' @param launch.browser If true, the system's default web browser will be
@@ -13,8 +14,11 @@
 #'
 #' @examples
 #' \dontrun{
-#' runGist(4034323)
-#' runGist("https://gist.github.com/4034323")
+#' runGist(3239667)
+#' runGist("https://gist.github.com/jcheng5/3239667")
+#'
+#' # Old URL format without username
+#' runGist("https://gist.github.com/3239667")
 #' }
 #'
 #' @export
@@ -25,7 +29,7 @@ runGist <- function(gist,
 
   gistUrl <- if (is.numeric(gist) || grepl('^[0-9a-f]+$', gist)) {
     sprintf('https://gist.github.com/%s/download', gist)
-  } else if(grepl('^https://gist.github.com/([0-9a-f]+)$', gist)) {
+  } else if(grepl('^https://gist.github.com/([^/]+/)?([0-9a-f]+)$', gist)) {
     paste(gist, '/download', sep='')
   } else {
     stop('Unrecognized gist identifier format')
@@ -87,6 +91,9 @@ runGitHub <- function(repo, username = getOption("github.user"),
 #'
 #' Download and launch a Shiny application that is hosted at a downloadable
 #' URL. The Shiny application must be saved in a .zip, .tar, or .tar.gz file.
+#' The Shiny application files must be contained in a subdirectory in the
+#' archive. For example, the files might be \code{myapp/server.r} and
+#' \code{myapp/ui.r}.
 #'
 #' @param url URL of the application.
 #' @param filetype The file type (\code{".zip"}, \code{".tar"}, or

R/shiny.R

@@ -1,9 +1,9 @@
 #' @docType package
-#' @import websockets caTools RJSONIO xtable digest
+#' @import httpuv caTools RJSONIO xtable digest
 NULL
 
 suppressPackageStartupMessages({
-  library(websockets)
+  library(httpuv)
   library(RJSONIO)
 })
 
@@ -12,53 +12,75 @@ createUniqueId <- function(bytes) {
   paste(as.character(as.raw(floor(runif(bytes, min=1, max=255)))), collapse='')
 }
 
-ShinyApp <- setRefClass(
-  'ShinyApp',
+ShinySession <- setRefClass(
+  'ShinySession',
   fields = list(
-    .websocket = 'list',
+    .websocket = 'ANY',
     .invalidatedOutputValues = 'Map',
     .invalidatedOutputErrors = 'Map',
+    .outputs = 'list',       # Keeps track of all the output observer objects
+    .outputOptions = 'list', # Options for each of the output observer objects
     .progressKeys = 'character',
     .fileUploadContext = 'FileUploadContext',
-    session = 'ReactiveValues',
+    .input      = 'ReactiveValues', # Internal object for normal input sent from client
+    .clientData = 'ReactiveValues', # Internal object for other data sent from the client
+    input       = 'reactivevalues', # Externally-usable S3 wrapper object for .input
+    clientData  = 'reactivevalues', # Externally-usable S3 wrapper object for .clientData
     token = 'character',  # Used to identify this instance in URLs
-    plots = 'Map',
+    files = 'Map',        # For keeping track of files sent to client
     downloads = 'Map',
-    allowDataUriScheme = 'logical'
+    closed = 'logical'
   ),
   methods = list(
-    initialize = function(ws) {
-      .websocket <<- ws
+    initialize = function(websocket) {
+      .websocket <<- websocket
       .invalidatedOutputValues <<- Map$new()
       .invalidatedOutputErrors <<- Map$new()
       .progressKeys <<- character(0)
+      closed <<- FALSE
       # TODO: Put file upload context in user/app-specific dir if possible
       .fileUploadContext <<- FileUploadContext$new()
-      session <<- ReactiveValues$new()
+
+      .input      <<- ReactiveValues$new()
+      .clientData <<- ReactiveValues$new()
+
+      input      <<- .createReactiveValues(.input,      readonly=TRUE)
+      clientData <<- .createReactiveValues(.clientData, readonly=TRUE)
       
       token <<- createUniqueId(16)
-      
-      allowDataUriScheme <<- TRUE
+      .outputs <<- list()
+      .outputOptions <<- list()
+    },
+    close = function() {
+      closed <<- TRUE
+      for (output in .outputs) {
+        output$suspend()
+      }
     },
     defineOutput = function(name, func, label) {
       "Binds an output generating function to this name. The function can either
       take no parameters, or have named parameters for \\code{name} and
-      \\code{shinyapp} (in the future this list may expand, so it is a good idea
+      \\code{shinysession} (in the future this list may expand, so it is a good idea
       to also include \\code{...} in your function signature)."
       
       # jcheng 08/31/2012: User submitted an example of a dynamically calculated
       # name not working unless name was eagerly evaluated. Yikes!
       force(name)
+
+      # If overwriting an output object, suspend the previous copy of it
+      if (!is.null(.outputs[[name]])) {
+        .outputs[[name]]$suspend()
+      }
       
       if (is.function(func)) {
         if (length(formals(func)) != 0) {
           orig <- func
           func <- function() {
-            orig(name=name, shinyapp=.self)
+            orig(name=name, shinysession=.self)
           }
         }
 
-        obs <- Observer$new(function() {
+        obs <- observe({
           
           value <- try(func(), silent=FALSE)
           
@@ -74,11 +96,15 @@ ShinyApp <- setRefClass(
           }
           else
             .invalidatedOutputValues$set(name, value)
-        }, label)
+        }, label=label, suspended=TRUE)
         
         obs$onInvalidate(function() {
           showProgress(name)
         })
+
+        .outputs[[name]] <<- obs
+        # Default is to suspend when hidden
+        .outputOptions[[name]][['suspendWhenHidden']] <<- TRUE
       }
       else {
         stop(paste("Unexpected", class(func), "output for", name))
@@ -108,6 +134,12 @@ ShinyApp <- setRefClass(
       by \\code{id} is in progress. There is currently no mechanism for
       explicitly turning off progress for an output component; instead, all
       progress is implicitly turned off when flushOutput is next called.'
+
+      # If app is already closed, be sure not to show progress, otherwise we
+      # will get an error because of the closed websocket
+      if (closed)
+        return()
+      
       if (id %in% .progressKeys)
         return()
       
@@ -124,9 +156,10 @@ ShinyApp <- setRefClass(
         .sendErrorResponse(msg, paste('Unknown method', msg$method))
       }
       
-      value <- try(do.call(func, as.list(append(msg$args, msg$blobs))))
+      value <- try(do.call(func, as.list(append(msg$args, msg$blobs))),
+                   silent=TRUE)
       if (inherits(value, 'try-error')) {
-        .sendErrorResponse(msg, paste('Error:', as.character(value)))
+        .sendErrorResponse(msg, conditionMessage(attr(value, 'condition')))
       }
       else {
         .sendResponse(msg, value)
@@ -151,39 +184,36 @@ ShinyApp <- setRefClass(
            gsub('(?m)base64,[a-zA-Z0-9+/=]+','[base64 data]',json,perl=TRUE))
       if (getOption('shiny.transcode.json', TRUE))
         json <- iconv(json, to='UTF-8')
-      websocket_write(json, .websocket)
+      .websocket$send(json)
     },
     
     # Public RPC methods
-    `@uploadInit` = function() {
-      return(list(jobId=.fileUploadContext$createUploadOperation()))
-    },
-    `@uploadFileBegin` = function(jobId, fileName, fileType, fileSize) {
-      .fileUploadContext$getUploadOperation(jobId)$fileBegin(list(
-        name=fileName, type=fileType, size=fileSize
-      ))
-      invisible()
-    },
-    `@uploadFileChunk` = function(jobId, ...) {
-      args <- list(...)
-      if (length(args) != 1)
-        stop("Bad file chunk request")
-      .fileUploadContext$getUploadOperation(jobId)$fileChunk(args[[1]])
-      invisible()
-    },
-    `@uploadFileEnd` = function(jobId) {
-      .fileUploadContext$getUploadOperation(jobId)$fileEnd()
-      invisible()
+    `@uploadInit` = function(fileInfos) {
+      maxSize <- getOption('shiny.maxRequestSize', 5 * 1024 * 1024)
+      fileInfos <- lapply(fileInfos, function(fi) {
+        if (is.null(fi$type))
+          fi$type <- getContentType(tools::file_ext(fi$name))
+        fi
+      })
+      sizes <- sapply(fileInfos, function(fi){ fi$size })
+      if (maxSize > 0 && any(sizes > maxSize)) {
+        stop("Maximum upload size exceeded")
+      }
+
+      jobId <- .fileUploadContext$createUploadOperation(fileInfos)
+      return(list(jobId=jobId,
+                  uploadUrl=paste('session', token, 'upload', jobId, sep='/')))
     },
     `@uploadEnd` = function(jobId, inputId) {
       fileData <- .fileUploadContext$getUploadOperation(jobId)$finish()
-      session$set(inputId, fileData)
+      .input$set(inputId, fileData)
       invisible()
     },
     # Provides a mechanism for handling direct HTTP requests that are posted
     # to the session (rather than going through the websocket)
-    handleRequest = function(ws, header, subpath) {
+    handleRequest = function(req) {
       # TODO: Turn off caching for the response
+      subpath <- req$PATH_INFO
       
       matches <- regmatches(subpath,
                             regexec("^/([a-z]+)/([^?]*)", 
@@ -192,12 +222,30 @@ ShinyApp <- setRefClass(
       if (length(matches) == 0)
         return(httpResponse(400, 'text/html', '<h1>Bad Request</h1>'))
       
-      if (matches[2] == 'plot') {
-        savedPlot <- plots$get(utils::URLdecode(matches[3]))
-        if (is.null(savedPlot))
+      if (matches[2] == 'file') {
+        savedFile <- files$get(utils::URLdecode(matches[3]))
+        if (is.null(savedFile))
           return(httpResponse(404, 'text/html', '<h1>Not Found</h1>'))
         
-        return(httpResponse(200, savedPlot$contentType, savedPlot$data))
+        return(httpResponse(200, savedFile$contentType, savedFile$data))
+      }
+      
+      if (matches[2] == 'upload' && identical(req$REQUEST_METHOD, "POST")) {
+        job <- .fileUploadContext$getUploadOperation(matches[3])
+        if (!is.null(job)) {
+          fileName <- req$HTTP_SHINY_FILE_NAME
+          fileType <- req$HTTP_SHINY_FILE_TYPE
+          fileSize <- req$CONTENT_LENGTH
+          job$fileBegin()
+          
+          reqInput <- req$rook.input
+          while (length(buf <- reqInput$read(2^16)) > 0)
+            job$fileChunk(buf)
+          
+          job$fileEnd()
+          
+          return(httpResponse(200, 'text/plain', 'OK'))
+        }
       }
       
       if (matches[2] == 'download') {
@@ -245,16 +293,17 @@ ShinyApp <- setRefClass(
         }
         
         tmpdata <- tempfile()
-        on.exit(unlink(tmpdata))
         result <- try(Context$new('[download]')$run(function() { download$func(tmpdata) }))
         if (is(result, 'try-error')) {
+          unlink(tmpdata)
           return(httpResponse(500, 'text/plain', 
                               attr(result, 'condition')$message))
         }
         return(httpResponse(
           200,
           download$contentType %OR% getContentType(tools::file_ext(filename)),
-          readBin(tmpdata, 'raw', n=file.info(tmpdata)$size),
+          # owned=TRUE means tmpdata will be deleted after response completes
+          list(file=tmpdata, owned=TRUE),
           c(
             'Content-Disposition' = ifelse(
               dlmatches[3] == '',
@@ -268,13 +317,33 @@ ShinyApp <- setRefClass(
       
       return(httpResponse(404, 'text/html', '<h1>Not Found</h1>'))
     },
-    savePlot = function(name, data, contentType) {
-      plots$set(name, list(data=data, contentType=contentType))
-      return(sprintf('session/%s/plot/%s?%s',
+    saveFileUrl = function(name, data, contentType, extra=list()) {
+      "Creates an entry in the file map for the data, and returns a URL pointing
+      to the file."
+      files$set(name, list(data=data, contentType=contentType))
+      return(sprintf('session/%s/file/%s?%s',
                      URLencode(token, TRUE),
                      URLencode(name, TRUE),
                      createUniqueId(8)))
     },
+    # Send a file to the client
+    fileUrl = function(name, file, contentType='application/octet-stream') {
+      "Return a URL for a file to be sent to the client. If allowDataUriScheme
+      is TRUE, then the file will be base64 encoded and embedded in the URL.
+      Otherwise, a URL pointing to the file will be returned."
+      bytes <- file.info(file)$size
+      if (is.na(bytes))
+        return(NULL)
+
+      fileData <- readBin(file, 'raw', n=bytes)
+
+      if (isTRUE(.clientData$.values$allowDataUriScheme)) {
+        b64 <- base64encode(fileData)
+        return(paste('data:', contentType, ';base64,', b64, sep=''))
+      } else {
+        return(saveFileUrl(name, fileData, contentType))
+      }
+    },
     registerDownload = function(name, filename, contentType, func) {
       
       downloads$set(name, list(filename = filename,
@@ -283,25 +352,144 @@ ShinyApp <- setRefClass(
       return(sprintf('session/%s/download/%s',
                      URLencode(token, TRUE),
                      URLencode(name, TRUE)))
+    },
+    # This function suspends observers for hidden outputs and resumes observers
+    # for un-hidden outputs.
+    manageHiddenOutputs = function() {
+      # Find hidden state for each output, and suspend/resume accordingly
+      for (outputName in names(.outputs)) {
+        # Find corresponding hidden state clientData variable, with the format
+        # "output_foo_hidden". (It comes from .clientdata_output_foo_hidden
+        # on the JS side)
+        # Some tricky stuff: instead of accessing names using input$names(),
+        # get the names directly via input$.values, to avoid triggering reactivity.
+        # Need to handle cases where the output object isn't actually used
+        # in the web page; in these cases, there's no output_foo_hidden flag,
+        # and hidden should be TRUE. In other words, NULL and TRUE should map to
+        # TRUE, FALSE should map to FALSE.
+        hidden <- .clientData$.values[[paste("output_", outputName, "_hidden",
+                                             sep="")]]
+        if (is.null(hidden)) hidden <- TRUE
+
+        if (hidden && .outputOptions[[outputName]][['suspendWhenHidden']]) {
+          .outputs[[outputName]]$suspend()
+        } else {
+          .outputs[[outputName]]$resume()
+        }
+      }
+    },
+    # Set the normal and client data input variables
+    manageInputs = function(data) {
+      data_names <- names(data)
+
+      # Separate normal input variables from client data input variables
+      clientdata_idx <- grepl("^.clientdata_", data_names)
+
+      # Set normal (non-clientData) input values
+      .input$mset(data[data_names[!clientdata_idx]])
+
+      # Strip off .clientdata_ from clientdata input names, and set values
+      input_clientdata <- data[data_names[clientdata_idx]]
+      names(input_clientdata) <- sub("^.clientdata_", "",
+                                     names(input_clientdata))
+      .clientData$mset(input_clientdata)
+    },
+    outputOptions = function(name, ...) {
+      # If no name supplied, return the list of options for all outputs
+      if (is.null(name))
+        return(.outputOptions)
+      if (! name %in% names(.outputs))
+        stop(name, " is not in list of output objects")
+
+      opts <- list(...)
+      # If no options are set, return the options for the specified output
+      if (length(opts) == 0)
+        return(.outputOptions[[name]])
+
+      # Set the appropriate option
+      validOpts <- "suspendWhenHidden"
+      for (optname in names(opts)) {
+        if (! optname %in% validOpts)
+          stop(optname, " is not a valid option")
+
+        .outputOptions[[name]][[optname]] <<- opts[[optname]]
+      }
+
+      # If any changes to suspendWhenHidden, need to re-run manageHiddenOutputs
+      if ("suspendWhenHidden" %in% names(opts)) {
+        manageHiddenOutputs()
+      }
+
+      invisible()
     }
   )
 )
 
-.createOutputWriter <- function(shinyapp) {
-  ow <- list(impl=shinyapp)
-  class(ow) <- 'shinyoutput'
-  return(ow)
+.createOutputWriter <- function(shinysession) {
+  structure(list(impl=shinysession), class='shinyoutput')
 }
 
 #' @S3method $<- shinyoutput
 `$<-.shinyoutput` <- function(x, name, value) {
-  x[['impl']]$defineOutput(name, value, deparse(substitute(value)))
+  .subset2(x, 'impl')$defineOutput(name, value, deparse(substitute(value)))
   return(invisible(x))
 }
 
 #' @S3method [[<- shinyoutput
 `[[<-.shinyoutput` <- `$<-.shinyoutput`
 
+#' @S3method $ shinyoutput
+`$.shinyoutput` <- function(x, name) {
+  stop("Reading objects from shinyoutput object not allowed.")
+}
+
+#' @S3method [[ shinyoutput
+`[[.shinyoutput` <- `$.shinyoutput`
+
+#' @S3method [ shinyoutput
+`[.shinyoutput` <- function(values, name) {
+  stop("Single-bracket indexing of shinyoutput object is not allowed.")
+}
+
+#' @S3method [<- shinyoutput
+`[<-.shinyoutput` <- function(values, name, value) {
+  stop("Single-bracket indexing of shinyoutput object is not allowed.")
+}
+
+#' Set options for an output object.
+#'
+#' These are the available options for an output object:
+#' \itemize{
+#'   \item suspendWhenHidden. When \code{TRUE} (the default), the output object
+#'     will be suspended (not execute) when it is hidden on the web page. When
+#'     \code{FALSE}, the output object will not suspend when hidden, and if it
+#'     was already hidden and suspended, then it will resume immediately.
+#' }
+#'
+#' @examples
+#' \dontrun{
+#' # Get the list of options for all observers within output
+#' outputOptions(output)
+#'
+#' # Disable suspend for output$myplot
+#' outputOptions(output, "myplot", suspendWhenHidden = FALSE)
+#'
+#' # Get the list of options for output$myplot
+#' outputOptions(output, "myplot")
+#' }
+#'
+#' @param x A shinyoutput object (typically \code{output}).
+#' @param name The name of an output observer in the shinyoutput object.
+#' @param ... Options to set for the output observer.
+#' @export
+outputOptions <- function(x, name, ...) {
+  if (!inherits(x, "shinyoutput"))
+    stop("x must be a shinyoutput object.")
+
+  .subset2(x, 'impl')$outputOptions(name, ...)
+}
+
+
 resolve <- function(dir, relpath) {
   abs.path <- file.path(dir, relpath)
   if (!file.exists(abs.path))
@@ -320,44 +508,37 @@ resolve <- function(dir, relpath) {
 httpResponse <- function(status = 200,
                          content_type = "text/html; charset=UTF-8", 
                          content = "",
-                         headers = c()) {
+                         headers = list()) {
+  # Make sure it's a list, not a vector
+  headers <- as.list(headers)
+  if (is.null(headers$`X-UA-Compatible`))
+    headers$`X-UA-Compatible` <- "chrome=1"
   resp <- list(status = status, content_type = content_type, content = content,
                headers = headers)
   class(resp) <- 'httpResponse'
   return(resp)
 }
 
-fixupRequestPath <- function(header) {
-  # Separate the path from the query
-  pathEnd <- regexpr('?', header$RESOURCE, fixed=TRUE)
-  if (pathEnd > 0)
-    header$PATH <- substring(header$RESOURCE, 1, pathEnd - 1)
-  else
-    header$PATH <- header$RESOURCE
-  return(header)
-}
-
 httpServer <- function(handlers) {
   handler <- joinHandlers(handlers)
 
+  # TODO: Figure out what this means after httpuv migration
   filter <- getOption('shiny.http.response.filter', NULL)
   if (is.null(filter))
-    filter <- function(ws, header, response) response
+    filter <- function(req, response) response
   
-  function(ws, header) {
-    header <- fixupRequestPath(header)
-    
-    response <- handler(ws, header)
+  function(req) {
+    response <- handler(req)
     if (is.null(response))
       response <- httpResponse(404, content="<h1>Not Found</h1>")
     
-    response <- filter(ws, header, response)
+    headers <- as.list(response$headers)
+    headers$'Content-Type' <- response$content_type
     
-    return(http_response(ws,
-                         status=response$status,
-                         content_type=response$content_type,
-                         content=response$content,
-                         headers=response$headers))
+    response <- filter(req, response)
+    return(list(status=response$status,
+                body=response$content,
+                headers=headers))
   }
 }
 
@@ -373,13 +554,13 @@ joinHandlers <- function(handlers) {
   handlers <- handlers[!sapply(handlers, is.null)]
   
   if (length(handlers) == 0)
-    return(function(ws, header) NULL)
+    return(function(req) NULL)
   if (length(handlers) == 1)
     return(handlers[[1]])
   
-  function(ws, header) {
+  function(req) {
     for (handler in handlers) {
-      response <- handler(ws, header)
+      response <- handler(req)
       if (!is.null(response))
         return(response)
     }
@@ -387,35 +568,39 @@ joinHandlers <- function(handlers) {
   }
 }
 
-sessionHandler <- function(ws, header) {
-  path <- header$PATH
+sessionHandler <- function(req) {
+  path <- req$PATH_INFO
   if (is.null(path))
     return(NULL)
   
-  matches <- regmatches(path, regexec('^/session/([0-9a-f]+)(/.*)$', path))
+  matches <- regmatches(path, regexec('^(/session/([0-9a-f]+))(/.*)$', path))
   if (length(matches[[1]]) == 0)
     return(NULL)
   
-  session <- matches[[1]][2]
-  subpath <- matches[[1]][3]
+  session <- matches[[1]][3]
+  subpath <- matches[[1]][4]
   
-  shinyapp <- appsByToken$get(session)
-  if (is.null(shinyapp))
+  shinysession <- appsByToken$get(session)
+  if (is.null(shinysession))
     return(NULL)
   
-  return(shinyapp$handleRequest(ws, header, subpath))
+  subreq <- as.environment(as.list(req, all.names=TRUE))
+  subreq$PATH_INFO <- subpath
+  subreq$SCRIPT_NAME <- paste(subreq$SCRIPT_NAME, matches[[1]][2], sep='')
+  
+  return(shinysession$handleRequest(subreq))
 }
 
 dynamicHandler <- function(filePath, dependencyFiles=filePath) {
   lastKnownTimestamps <- NA
-  metaHandler <- function(ws, header) NULL
+  metaHandler <- function(req) NULL
   
   if (!file.exists(filePath))
     return(metaHandler)
   
   cacheContext <- CacheContext$new()
   
-  return (function(ws, header) {
+  return (function(req) {
     # Check if we need to rebuild
     if (cacheContext$isDirty()) {
       cacheContext$reset()
@@ -434,13 +619,16 @@ dynamicHandler <- function(filePath, dependencyFiles=filePath) {
       clearClients()
     }
     
-    return(metaHandler(ws, header))
+    return(metaHandler(req))
   })
 }
 
 staticHandler <- function(root) {
-  return(function(ws, header) {
-    path <- header$PATH
+  return(function(req) {
+    if (!identical(req$REQUEST_METHOD, 'GET'))
+      return(NULL)
+
+    path <- req$PATH_INFO
     
     if (is.null(path))
       return(httpResponse(400, content="<h1>Bad Request</h1>"))
@@ -459,7 +647,6 @@ staticHandler <- function(root) {
   })
 }
 
-apps <- Map$new()
 appsByToken <- Map$new()
 
 # Provide a character representation of the WS that can be used
@@ -470,11 +657,11 @@ wsToKey <- function(WS) {
 
 .globals <- new.env()
 
-.globals$clients <- function(ws, header) NULL
+.globals$clients <- function(req) NULL
 
 
 clearClients <- function() {
-  .globals$clients <- function(ws, header) NULL
+  .globals$clients <- function(req) NULL
 }
 
 
@@ -537,8 +724,11 @@ addResourcePath <- function(prefix, directoryPath) {
                                        func=staticHandler(directoryPath))
 }
 
-resourcePathHandler <- function(ws, header) {
-  path <- header$RESOURCE
+resourcePathHandler <- function(req) {
+  if (!identical(req$REQUEST_METHOD, 'GET'))
+    return(NULL)
+
+  path <- req$PATH_INFO
   
   match <- regexpr('^/([^/]+)/', path, perl=TRUE)
   if (match == -1)
@@ -552,10 +742,11 @@ resourcePathHandler <- function(ws, header) {
   
   suffix <- substr(path, 2 + len, nchar(path))
   
-  header$RESOURCE <- suffix
-  header <- fixupRequestPath(header)
+  subreq <- as.environment(as.list(req, all.names=TRUE))
+  subreq$PATH_INFO <- suffix
+  subreq$SCRIPT_NAME <- paste(subreq$SCRIPT_NAME, substr(path, 1, 2 + len), sep='')
   
-  return(resInfo$func(ws, header))
+  return(resInfo$func(subreq))
 }
 
 .globals$server <- NULL
@@ -584,7 +775,7 @@ resourcePathHandler <- function(ws, header) {
 #' # A very simple Shiny app that takes a message from the user
 #' # and outputs an uppercase version of it.
 #' shinyServer(function(input, output) {
-#'   output$uppercase <- reactiveText(function() {
+#'   output$uppercase <- renderText({
 #'     toupper(input$message)
 #'   })
 #' })
@@ -680,113 +871,140 @@ startApp <- function(port=8101L) {
   })
   serverFunc <- .globals$server
   
-  ws_env <- create_server(
-    port=port,
-    webpage=httpServer(c(sessionHandler,
-                         dynamicHandler(uiR),
-                         wwwDir,
-                         sys.www.root,
-                         resourcePathHandler)))
-  
-  set_callback('established', function(WS, ...) {
-    shinyapp <- ShinyApp$new(WS)
-    apps$set(wsToKey(WS), shinyapp)
-    appsByToken$set(shinyapp$token, shinyapp)
-  }, ws_env)
-  
-  set_callback('closed', function(WS, ...) {
-    shinyapp <- apps$get(wsToKey(WS))
-    if (!is.null(shinyapp))
-      appsByToken$remove(shinyapp$token)
-    apps$remove(wsToKey(WS))
-  }, ws_env)
-  
-  set_callback('receive', function(DATA, WS, ...) {
-    if (getOption('shiny.trace', FALSE)) {
-      if (as.raw(0) %in% DATA)
-        message("RECV ", '$$binary data$$')
-      else
-        message("RECV ", rawToChar(DATA))
-    }
-    
-    if (identical(charToRaw("\003\xe9"), DATA))
-      return()
-    
-    shinyapp <- apps$get(wsToKey(WS))
-    
-    msg <- decodeMessage(DATA)
+  httpuvCallbacks <- list(
+    onHeaders = function(req) {
+      maxSize <- getOption('shiny.maxRequestSize', 5 * 1024 * 1024)
+      if (maxSize <= 0)
+        return(NULL)
 
-    # Do our own list simplifying here. sapply/simplify2array give names to
-    # character vectors, which is rarely what we want.
-    if (!is.null(msg$data)) {
-      for (name in names(msg$data)) {
-        val <- msg$data[[name]]
+      reqSize <- 0
+      if (length(req$CONTENT_LENGTH) > 0)
+        reqSize <- as.numeric(req$CONTENT_LENGTH)
+      else if (length(req$HTTP_TRANSFER_ENCODING) > 0)
+        reqSize <- Inf
+
+      if (reqSize > maxSize) {
+        return(list(status = 413L,
+                    headers = list(
+                      'Content-Type' = 'text/plain'
+                    ),
+                    body = 'Maximum upload size exceeded'))
+      }
+      else {
+        return(NULL)
+      }
+    },
+    call = httpServer(c(sessionHandler,
+                        dynamicHandler(uiR),
+                        wwwDir,
+                        sys.www.root,
+                        resourcePathHandler)),
+    onWSOpen = function(ws) {
+      shinysession <- ShinySession$new(ws)
+      appsByToken$set(shinysession$token, shinysession)
+      
+      ws$onMessage(function(binary, msg) {
         
-        splitName <- strsplit(name, ':')[[1]]
-        if (length(splitName) > 1) {
-          msg$data[[name]] <- NULL
-          
-          # TODO: Make the below a user-extensible registry of deserializers
-          msg$data[[ splitName[[1]] ]] <- switch(
-            splitName[[2]],
-            matrix = unpackMatrix(val),
-            stop('Unknown type specified for ', name)
-          )
+        # To ease transition from websockets-based code. Should remove once we're stable.
+        if (is.character(msg))
+          msg <- charToRaw(msg)
+        
+        if (getOption('shiny.trace', FALSE)) {
+          if (binary)
+            message("RECV ", '$$binary data$$')
+          else
+            message("RECV ", rawToChar(msg))
         }
-        else if (is.list(val) && is.null(names(val))) {
-          val_flat <- unlist(val, recursive = TRUE)
-
-          if (is.null(val_flat)) {
-            # This is to assign NULL instead of deleting the item
-            msg$data[name] <- list(NULL)
-          } else {
-            msg$data[[name]] <- val_flat
+        
+        if (identical(charToRaw("\003\xe9"), msg))
+          return()
+        
+        msg <- decodeMessage(msg)
+        
+        # Do our own list simplifying here. sapply/simplify2array give names to
+        # character vectors, which is rarely what we want.
+        if (!is.null(msg$data)) {
+          for (name in names(msg$data)) {
+            val <- msg$data[[name]]
+            
+            splitName <- strsplit(name, ':')[[1]]
+            if (length(splitName) > 1) {
+              msg$data[[name]] <- NULL
+              
+              # TODO: Make the below a user-extensible registry of deserializers
+              msg$data[[ splitName[[1]] ]] <- switch(
+                splitName[[2]],
+                matrix = unpackMatrix(val),
+                number = ifelse(is.null(val), NA, val),
+                stop('Unknown type specified for ', name)
+              )
+            }
+            else if (is.list(val) && is.null(names(val))) {
+              val_flat <- unlist(val, recursive = TRUE)
+              
+              if (is.null(val_flat)) {
+                # This is to assign NULL instead of deleting the item
+                msg$data[name] <- list(NULL)
+              } else {
+                msg$data[[name]] <- val_flat
+              }
+            }
           }
         }
-      }
-    }
-    
-    switch(
-      msg$method,
-      init = {
         
-        # Check if server.R has changed, and if so, reload
-        mtime <- file.info(serverR)$mtime
-        if (!identical(mtime, serverFileTimestamp)) {
-          shinyServer(NULL)
-          local({
-            serverFileTimestamp <<- mtime
-            source(serverR, local=new.env(parent=.GlobalEnv))
-            if (is.null(.globals$server))
-              stop("No server was defined in server.R")
-          })
-          serverFunc <<- .globals$server
-        }
-        
-        shinyapp$allowDataUriScheme <- msg$data[['__allowDataUriScheme']]
-        msg$data[['__allowDataUriScheme']] <- NULL
-        shinyapp$session$mset(msg$data)
+        switch(
+          msg$method,
+          init = {
+            
+            # Check if server.R has changed, and if so, reload
+            mtime <- file.info(serverR)$mtime
+            if (!identical(mtime, serverFileTimestamp)) {
+              shinyServer(NULL)
+              local({
+                serverFileTimestamp <<- mtime
+                source(serverR, local=new.env(parent=.GlobalEnv))
+                if (is.null(.globals$server))
+                  stop("No server was defined in server.R")
+              })
+              serverFunc <<- .globals$server
+            }
+            
+            shinysession$manageInputs(msg$data)
+            local({
+              args <- list(
+                input=shinysession$input,
+                output=.createOutputWriter(shinysession))
+
+              # The clientData argument is optional; check if it exists
+              if ('clientData' %in% names(formals(serverFunc)))
+                args$clientData <- shinysession$clientData
+
+              do.call(serverFunc, args)
+            })
+          },
+          update = {
+            shinysession$manageInputs(msg$data)
+          },
+          shinysession$dispatch(msg)
+        )
+        shinysession$manageHiddenOutputs()
         flushReact()
-        local({
-          serverFunc(input=.createReactiveValues(shinyapp$session, readonly=TRUE),
-                     output=.createOutputWriter(shinyapp))
+        lapply(appsByToken$values(), function(shinysession) {
+          shinysession$flushOutput()
+          NULL
         })
-      },
-      update = {
-        shinyapp$session$mset(msg$data)
-      },
-      shinyapp$dispatch(msg)
-    )
-    flushReact()
-    lapply(apps$values(), function(shinyapp) {
-      shinyapp$flushOutput()
-      NULL
-    })
-  }, ws_env)
+      })
+      
+      ws$onClose(function() {
+        shinysession$close()
+        appsByToken$remove(shinysession$token)
+      })
+    }
+  )
   
   message('\n', 'Listening on port ', port)
-  
-  return(ws_env)
+
+  return(startServer("0.0.0.0", port, httpuvCallbacks))
 }
 
 # NOTE: we de-roxygenized this comment because the function isn't exported
@@ -796,21 +1014,27 @@ startApp <- function(port=8101L) {
 # @param ws_env The return value from \code{\link{startApp}}.
 serviceApp <- function(ws_env) {
   if (timerCallbacks$executeElapsed()) {
+    for (shinysession in appsByToken$values()) {
+      shinysession$manageHiddenOutputs()
+    }
+
     flushReact()
-     lapply(apps$values(), function(shinyapp) {
-       shinyapp$flushOutput()
-       NULL
-     })
+
+    for (shinysession in appsByToken$values()) {
+      shinysession$flushOutput()
+    }
   }
 
   # If this R session is interactive, then call service() with a short timeout
   # to keep the session responsive to user input
-  maxTimeout <- ifelse(interactive(), 100, 5000)
+  maxTimeout <- ifelse(interactive(), 100, 1000)
   
   timeout <- max(1, min(maxTimeout, timerCallbacks$timeToNextEvent()))
-  service(server=ws_env, timeout=timeout)
+  service(timeout)
 }
 
+.shinyServerMinVersion <- '0.3.4'
+
 #' Run Shiny Application
 #' 
 #' Runs a Shiny application. This function normally does not return; interrupt
@@ -834,14 +1058,29 @@ runApp <- function(appDir=getwd(),
   # Make warnings print immediately
   ops <- options(warn = 1)
   on.exit(options(ops))
-  
+
+  if (nzchar(Sys.getenv('SHINY_PORT'))) {
+    # If SHINY_PORT is set, we're running under Shiny Server. Check the version
+    # to make sure it is compatible. Older versions of Shiny Server don't set
+    # SHINY_SERVER_VERSION, those will return "" which is considered less than
+    # any valid version.
+    ver <- Sys.getenv('SHINY_SERVER_VERSION')
+    if (compareVersion(ver, .shinyServerMinVersion) < 0) {
+      warning('Shiny Server v', .shinyServerMinVersion,
+              ' or later is required; please upgrade!')
+    }
+  }
+
   orig.wd <- getwd()
   setwd(appDir)
   on.exit(setwd(orig.wd), add = TRUE)
   
   require(shiny)
   
-  ws_env <- startApp(port=port)
+  server <- startApp(port=port)
+  on.exit({
+    stopServer(server)
+  }, add = TRUE)
   
   if (launch.browser) {
     appUrl <- paste("http://localhost:", port, sep="")
@@ -850,11 +1089,11 @@ runApp <- function(appDir=getwd(),
   
   tryCatch(
     while (TRUE) {
-      serviceApp(ws_env)
+      serviceApp()
+      Sys.sleep(0.001)
     },
     finally = {
       timerCallbacks$clear()
-      websocket_close(ws_env)
     }
   )
 }
@@ -902,8 +1141,8 @@ runExample <- function(example=NA,
 # The only difference is that, if the protocol is https, it changes the
 # download settings, depending on platform.
 download <- function(url, ...) {
-  # First, check protocol. If https, check platform:
-  if (grepl('^https://', url)) {
+  # First, check protocol. If http or https, check platform:
+  if (grepl('^https?://', url)) {
     
     # If Windows, call setInternet2, then use download.file with defaults.
     if (.Platform$OS.type == "windows") {

R/shinyui.R

@@ -188,9 +188,11 @@ shinyUI <- function(ui, path='/') {
   
   registerClient({
     
-    function(ws, header) {
+    function(req) {
+      if (!identical(req$REQUEST_METHOD, 'GET'))
+        return(NULL)
 
-      if (header$PATH != path)
+      if (req$PATH_INFO != path)
         return(NULL)
       
       textConn <- textConnection(NULL, "w") 

R/shinywrappers.R

@@ -5,19 +5,13 @@ suppressPackageStartupMessages({
 
 #' Plot Output
 #' 
-#' Creates a reactive plot that is suitable for assigning to an \code{output} 
+#' Renders a reactive plot that is suitable for assigning to an \code{output} 
 #' slot.
 #' 
 #' The corresponding HTML output tag should be \code{div} or \code{img} and have
 #' the CSS class name \code{shiny-plot-output}.
 #'
-#' For output, it will try to use the following devices, in this order:
-#' quartz (via \code{\link[grDevices]{png}}), then \code{\link[Cairo]{CairoPNG}},
-#' and finally \code{\link[grDevices]{png}}. This is in order of quality of
-#' output. Notably, plain \code{png} output on Linux and Windows may not
-#' antialias some point shapes, resulting in poor quality output.
-#' 
-#' @param func A function that generates a plot.
+#' @param expr An expression that generates a plot.
 #' @param width The width of the rendered plot, in pixels; or \code{'auto'} to 
 #'   use the \code{offsetWidth} of the HTML element that is bound to this plot. 
 #'   You can also pass in a function that returns the width in pixels or 
@@ -28,72 +22,187 @@ suppressPackageStartupMessages({
 #'   You can also pass in a function that returns the width in pixels or 
 #'   \code{'auto'}; in the body of the function you may reference reactive 
 #'   values and functions.
+#' @param res Resolution of resulting plot, in pixels per inch. This value is
+#'   passed to \code{\link{png}}. Note that this affects the resolution of PNG
+#'   rendering in R; it won't change the actual ppi of the browser.
 #' @param ... Arguments to be passed through to \code{\link[grDevices]{png}}. 
 #'   These can be used to set the width, height, background color, etc.
+#' @param env The environment in which to evaluate \code{expr}.
+#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
+#'   is useful if you want to save an expression in a variable.
+#' @param func A function that generates a plot (deprecated; use \code{expr}
+#'   instead).
 #'   
 #' @export
-reactivePlot <- function(func, width='auto', height='auto', ...) {
+renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
+                       env=parent.frame(), quoted=FALSE, func=NULL) {
+  if (!is.null(func)) {
+    shinyDeprecated(msg="renderPlot: argument 'func' is deprecated. Please use 'expr' instead.")
+  } else {
+    func <- exprToFunction(expr, env, quoted)
+  }
+
+
   args <- list(...)
   
   if (is.function(width))
-    width <- reactive(width)
-  if (is.function(height))
-    height <- reactive(height)
+    widthWrapper <- reactive({ width() })
+  else
+    widthWrapper <- NULL
 
-  return(function(shinyapp, name, ...) {
-    png.file <- tempfile(fileext='.png')
-    
-    if (is.function(width))
-      width <- width()
-    if (is.function(height))
-      height <- height()
+  if (is.function(height))
+    heightWrapper <- reactive({ height() })
+  else
+    heightWrapper <- NULL
+
+  return(function(shinysession, name, ...) {
+    if (!is.null(widthWrapper))
+      width <- widthWrapper()
+    if (!is.null(heightWrapper))
+      height <- heightWrapper()
     
     # Note that these are reactive calls. A change to the width and height
     # will inherently cause a reactive plot to redraw (unless width and 
     # height were explicitly specified).
-    prefix <- '.shinyout_'
+    prefix <- 'output_'
     if (width == 'auto')
-      width <- shinyapp$session$get(paste(prefix, name, '_width', sep=''));
+      width <- shinysession$clientData[[paste(prefix, name, '_width', sep='')]];
     if (height == 'auto')
-      height <- shinyapp$session$get(paste(prefix, name, '_height', sep=''));
+      height <- shinysession$clientData[[paste(prefix, name, '_height', sep='')]];
     
-    if (width <= 0 || height <= 0)
+    if (is.null(width) || is.null(height) || width <= 0 || height <= 0)
       return(NULL)
 
-    # If quartz is available, use png() (which will default to quartz).
-    # Otherwise, if the Cairo package is installed, use CairoPNG().
-    # Finally, if neither quartz nor Cairo, use png().
-    if (capabilities("aqua")) {
-      pngfun <- png
-    } else if (nchar(system.file(package = "Cairo"))) {
-      require(Cairo)
-      pngfun <- CairoPNG
-    } else {
-      pngfun <- png
-    }
+    # Resolution multiplier
+    pixelratio <- shinysession$clientData$pixelratio
+    if (is.null(pixelratio))
+      pixelratio <- 1
 
-    do.call(pngfun, c(args, filename=png.file, width=width, height=height))
-    on.exit(unlink(png.file))
-    tryCatch(
-      func(),
-      finally=dev.off())
+    outfile <- do.call(plotPNG, c(func, width=width*pixelratio,
+                                  height=height*pixelratio, res=res*pixelratio, args))
+    on.exit(unlink(outfile))
     
-    bytes <- file.info(png.file)$size
-    if (is.na(bytes))
-      return(NULL)
-    
-    pngData <- readBin(png.file, 'raw', n=bytes)
-    if (shinyapp$allowDataUriScheme) {
-      b64 <- base64encode(pngData)
-      return(paste("data:image/png;base64,", b64, sep=''))
-    }
-    else {
-      imageUrl <- shinyapp$savePlot(name, pngData, 'image/png')
-      return(imageUrl)
-    }
+    # Return a list of attributes for the img
+    return(list(
+      src=shinysession$fileUrl(name, outfile, contentType='image/png'),
+      width=width, height=height))
   })
 }
 
+#' Image file output
+#'
+#' Renders a reactive image that is suitable for assigning to an \code{output} 
+#' slot.
+#'
+#' The expression \code{expr} must return a list containing the attributes for
+#' the \code{img} object on the client web page. For the image to display,
+#' properly, the list must have at least one entry, \code{src}, which is the
+#' path to the image file. It may also useful to have a \code{contentType}
+#' entry specifying the MIME type of the image. If one is not provided,
+#' \code{renderImage} will try to autodetect the type, based on the file
+#' extension.
+#'
+#' Other elements such as \code{width}, \code{height}, \code{class}, and
+#' \code{alt}, can also be added to the list, and they will be used as
+#' attributes in the \code{img} object.
+#'
+#' The corresponding HTML output tag should be \code{div} or \code{img} and have
+#' the CSS class name \code{shiny-image-output}.
+#'
+#' @param expr An expression that returns a list.
+#' @param env The environment in which to evaluate \code{expr}.
+#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
+#'   is useful if you want to save an expression in a variable.
+#' @param deleteFile Should the file in \code{func()$src} be deleted after
+#'   it is sent to the client browser? Genrrally speaking, if the image is a
+#'   temp file generated within \code{func}, then this should be \code{TRUE};
+#'   if the image is not a temp file, this should be \code{FALSE}.
+#'
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#'
+#' shinyServer(function(input, output, clientData) {
+#'
+#'   # A plot of fixed size
+#'   output$plot1 <- renderImage({
+#'     # A temp file to save the output. It will be deleted after renderImage
+#'     # sends it, because deleteFile=TRUE.
+#'     outfile <- tempfile(fileext='.png')
+#'
+#'     # Generate a png
+#'     png(outfile, width=400, height=400)
+#'     hist(rnorm(input$n))
+#'     dev.off()
+#'
+#'     # Return a list
+#'     list(src = outfile,
+#'          alt = "This is alternate text")
+#'   }, deleteFile = TRUE)
+#'
+#'   # A dynamically-sized plot
+#'   output$plot2 <- renderImage({
+#'     # Read plot2's width and height. These are reactive values, so this
+#'     # expression will re-run whenever these values change.
+#'     width  <- clientData$output_plot2_width
+#'     height <- clientData$output_plot2_height
+#'
+#'     # A temp file to save the output.
+#'     outfile <- tempfile(fileext='.png')
+#'
+#'     png(outfile, width=width, height=height)
+#'     hist(rnorm(input$obs))
+#'     dev.off()
+#'
+#'     # Return a list containing the filename
+#'     list(src = outfile,
+#'          width = width,
+#'          height = height,
+#'          alt = "This is alternate text")
+#'   }, deleteFile = TRUE)
+#'
+#'   # Send a pre-rendered image, and don't delete the image after sending it
+#'   output$plot3 <- renderImage({
+#'     # When input$n is 1, filename is ./images/image1.jpeg
+#'     filename <- normalizePath(file.path('./images',
+#'                               paste('image', input$n, '.jpeg', sep='')))
+#'
+#'     # Return a list containing the filename
+#'     list(src = filename)
+#'   }, deleteFile = FALSE)
+#' })
+#'
+#' }
+renderImage <- function(expr, env=parent.frame(), quoted=FALSE,
+                        deleteFile=TRUE) {
+  func <- exprToFunction(expr, env, quoted)
+
+  return(function(shinysession, name, ...) {
+    imageinfo <- func()
+    # Should the file be deleted after being sent? If .deleteFile not set or if
+    # TRUE, then delete; otherwise don't delete.
+    if (deleteFile) {
+      on.exit(unlink(imageinfo$src))
+    }
+
+    # If contentType not specified, autodetect based on extension
+    if (is.null(imageinfo$contentType)) {
+      contentType <- getContentType(sub('^.*\\.', '', basename(imageinfo$src)))
+    } else {
+      contentType <- imageinfo$contentType
+    }
+
+    # Extra values are everything in imageinfo except 'src' and 'contentType'
+    extra_attr <- imageinfo[!names(imageinfo) %in% c('src', 'contentType')]
+
+    # Return a list with src, and other img attributes
+    c(src = shinysession$fileUrl(name, file=imageinfo$src, contentType=contentType),
+      extra_attr)
+  })
+}
+
+
 #' Table Output
 #' 
 #' Creates a reactive table that is suitable for assigning to an \code{output} 
@@ -102,18 +211,29 @@ reactivePlot <- function(func, width='auto', height='auto', ...) {
 #' The corresponding HTML output tag should be \code{div} and have the CSS class
 #' name \code{shiny-html-output}.
 #' 
-#' @param func A function that returns an R object that can be used with 
+#' @param expr An expression that returns an R object that can be used with 
 #'   \code{\link[xtable]{xtable}}.
 #' @param ... Arguments to be passed through to \code{\link[xtable]{xtable}} and
 #'   \code{\link[xtable]{print.xtable}}.
+#' @param env The environment in which to evaluate \code{expr}.
+#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
+#'   is useful if you want to save an expression in a variable.
+#' @param func A function that returns an R object that can be used with 
+#'   \code{\link[xtable]{xtable}} (deprecated; use \code{expr} instead).
 #'   
 #' @export
-reactiveTable <- function(func, ...) {
-  reactive(function() {
+renderTable <- function(expr, ..., env=parent.frame(), quoted=FALSE, func=NULL) {
+  if (!is.null(func)) {
+    shinyDeprecated(msg="renderTable: argument 'func' is deprecated. Please use 'expr' instead.")
+  } else {
+    func <- exprToFunction(expr, env, quoted)
+  }
+
+  function() {
     classNames <- getOption('shiny.table.class', 'data table table-bordered table-condensed')
     data <- func()
 
-    if (is.null(data))
+    if (is.null(data) || identical(data, data.frame()))
       return("")
     
     return(paste(
@@ -125,7 +245,7 @@ reactiveTable <- function(func, ...) {
                                           '"',
                                           sep=''), ...)),
       collapse="\n"))
-  })
+  }
 }
 
 #' Printable Output
@@ -146,23 +266,33 @@ reactiveTable <- function(func, ...) {
 #' returns \code{NULL} then \code{NULL} will actually be visible in the output. 
 #' To display nothing, make your function return \code{\link{invisible}()}.
 #' 
-#' @param func A function that may print output and/or return a printable R 
+#' @param expr An expression that may print output and/or return a printable R 
 #'   object.
+#' @param env The environment in which to evaluate \code{expr}.
+#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
+#' @param func A function that may print output and/or return a printable R 
+#'   object (deprecated; use \code{expr} instead).
 #'   
-#' @seealso \code{\link{reactiveText}} for displaying the value returned from a 
+#' @seealso \code{\link{renderText}} for displaying the value returned from a 
 #'   function, instead of the printed output.
 #'
 #' @example res/text-example.R
 #'   
 #' @export
-reactivePrint <- function(func) {
-  reactive(function() {
+renderPrint <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
+  if (!is.null(func)) {
+    shinyDeprecated(msg="renderPrint: argument 'func' is deprecated. Please use 'expr' instead.")
+  } else {
+    func <- exprToFunction(expr, env, quoted)
+  }
+
+  function() {
     return(paste(capture.output({
       result <- withVisible(func())
       if (result$visible)
         print(result$value)
     }), collapse="\n"))
-  })
+  }
 }
 
 #' Text Output
@@ -178,20 +308,31 @@ reactivePrint <- function(func) {
 #' The result of executing \code{func} will passed to \code{cat}, inside a 
 #' \code{\link[utils]{capture.output}} call.
 #' 
-#' @param func A function that returns an R object that can be used as an
+#' @param expr An expression that returns an R object that can be used as an
 #'   argument to \code{cat}.
+#' @param env The environment in which to evaluate \code{expr}.
+#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
+#'   is useful if you want to save an expression in a variable.
+#' @param func A function that returns an R object that can be used as an
+#'   argument to \code{cat}.(deprecated; use \code{expr} instead).
 #'   
-#' @seealso \code{\link{reactivePrint}} for capturing the print output of a
+#' @seealso \code{\link{renderPrint}} for capturing the print output of a
 #'   function, rather than the returned text value.
 #'
 #' @example res/text-example.R
 #'   
 #' @export
-reactiveText <- function(func) {
-  reactive(function() {
+renderText <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
+  if (!is.null(func)) {
+    shinyDeprecated(msg="renderText: argument 'func' is deprecated. Please use 'expr' instead.")
+  } else {
+    func <- exprToFunction(expr, env, quoted)
+  }
+
+  function() {
     value <- func()
     return(paste(capture.output(cat(value)), collapse="\n"))
-  })
+  }
 }
 
 #' UI Output
@@ -202,28 +343,39 @@ reactiveText <- function(func) {
 #' The corresponding HTML output tag should be \code{div} and have the CSS class
 #' name \code{shiny-html-output} (or use \code{\link{uiOutput}}).
 #' 
-#' @param func A function that returns a Shiny tag object, \code{\link{HTML}}, 
+#' @param expr An expression that returns a Shiny tag object, \code{\link{HTML}}, 
 #'   or a list of such objects.
+#' @param env The environment in which to evaluate \code{expr}.
+#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
+#'   is useful if you want to save an expression in a variable.
+#' @param func A function that returns a Shiny tag object, \code{\link{HTML}}, 
+#'   or a list of such objects (deprecated; use \code{expr} instead).
 #'   
 #' @seealso conditionalPanel
 #'   
 #' @export
 #' @examples
 #' \dontrun{
-#'   output$moreControls <- reactiveUI(function() {
+#'   output$moreControls <- renderUI({
 #'     list(
 #'       
 #'     )
 #'   })
 #' }
-reactiveUI <- function(func) {
-  reactive(function() {
+renderUI <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
+  if (!is.null(func)) {
+    shinyDeprecated(msg="renderUI: argument 'func' is deprecated. Please use 'expr' instead.")
+  } else {
+    func <- exprToFunction(expr, env, quoted)
+  }
+
+  function() {
     result <- func()
     if (is.null(result) || length(result) == 0)
       return(NULL)
     # Wrap result in tagList in case it is an ordinary list
     return(as.character(tagList(result)))
-  })
+  }
 }
 
 #' File Downloads
@@ -268,7 +420,64 @@ reactiveUI <- function(func) {
 #' 
 #' @export
 downloadHandler <- function(filename, content, contentType=NA) {
-  return(function(shinyapp, name, ...) {
-    shinyapp$registerDownload(name, filename, contentType, content)
+  return(function(shinysession, name, ...) {
+    shinysession$registerDownload(name, filename, contentType, content)
   })
-}
+}
+
+
+# Deprecated functions ------------------------------------------------------
+
+#' Plot output (deprecated)
+#'
+#' See \code{\link{renderPlot}}.
+#' @param func A function.
+#' @param width Width.
+#' @param height Height.
+#' @param ... Other arguments to pass on.
+#' @export
+reactivePlot <- function(func, width='auto', height='auto', ...) {
+  shinyDeprecated(new="renderPlot")
+  renderPlot({ func() }, width=width, height=height, ...)
+}
+
+#' Table output (deprecated)
+#'
+#' See \code{\link{renderTable}}.
+#' @param func A function.
+#' @param ... Other arguments to pass on.
+#' @export
+reactiveTable <- function(func, ...) {
+  shinyDeprecated(new="renderTable")
+  renderTable({ func() })
+}
+
+#' Print output (deprecated)
+#'
+#' See \code{\link{renderPrint}}.
+#' @param func A function.
+#' @export
+reactivePrint <- function(func) {
+  shinyDeprecated(new="renderPrint")
+  renderPrint({ func() })
+}
+
+#' UI output (deprecated)
+#'
+#' See \code{\link{renderUI}}.
+#' @param func A function.
+#' @export
+reactiveUI <- function(func) {
+  shinyDeprecated(new="renderUI")
+  renderUI({ func() })
+}
+
+#' Text output (deprecated)
+#'
+#' See \code{\link{renderText}}.
+#' @param func A function.
+#' @export
+reactiveText <- function(func) {
+  shinyDeprecated(new="renderText")
+  renderText({ func() })
+}

R/utils.R

@@ -101,4 +101,168 @@ knownContentTypes$mset(
 
 getContentType <- function(ext, defaultType='application/octet-stream') {
   knownContentTypes$get(tolower(ext)) %OR% defaultType
-}
+}
+
+# Create a zero-arg function from a quoted expression and environment
+# @examples
+# makeFunction(body=quote(print(3)))
+makeFunction <- function(args = pairlist(), body, env = parent.frame()) {
+  eval(call("function", args, body), env)
+}
+
+#' Convert an expression or quoted expression to a function
+#'
+#' This is to be called from another function, because it will attempt to get
+#' an unquoted expression from two calls back.
+#'
+#' If expr is a quoted expression, then this just converts it to a function.
+#' If expr is a function, then this simply returns expr (and prints a
+#'   deprecation message.
+#' If expr was a non-quoted expression from two calls back, then this will
+#'   quote the original expression and convert it to a function.
+#
+#' @param expr A quoted or unquoted expression, or a function.
+#' @param env The desired environment for the function. Defaults to the
+#'   calling environment two steps back.
+#' @param quoted Is the expression quoted?
+#'
+#' @examples
+#' # Example of a new renderer, similar to renderText
+#' # This is something that toolkit authors will do
+#' renderTriple <- function(expr, env=parent.frame(), quoted=FALSE) {
+#'   # Convert expr to a function
+#'   func <- shiny::exprToFunction(expr, env, quoted)
+#'
+#'   function() {
+#'     value <- func()
+#'     paste(rep(value, 3), collapse=", ")
+#'   }
+#' }
+#'
+#'
+#' # Example of using the renderer.
+#' # This is something that app authors will do.
+#' values <- reactiveValues(A="text")
+#'
+#' \dontrun{
+#' # Create an output object
+#' output$tripleA <- renderTriple({
+#'   values$A
+#' })
+#' }
+#'
+#' # At the R console, you can experiment with the renderer using isolate()
+#' tripleA <- renderTriple({
+#'   values$A
+#' })
+#'
+#' isolate(tripleA())
+#' # "text, text, text"
+#'
+#' @export
+exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE) {
+  # Get the quoted expr from two calls back
+  expr_sub <- eval(substitute(substitute(expr)), parent.frame())
+
+  # Check if expr is a function, making sure not to evaluate expr, in case it
+  # is actually an unquoted expression.
+  # If expr is a single token, then indexing with [[ will error; if it has multiple
+  # tokens, then [[ works. In the former case it will be a name object; in the
+  # latter, it will be a language object.
+  if (!is.name(expr_sub) && expr_sub[[1]] == as.name('function')) {
+    # Get name of function that called this function
+    called_fun <- sys.call(-1)[[1]]
+
+    shinyDeprecated(msg = paste("Passing functions to '", called_fun,
+      "' is deprecated. Please use expressions instead. See ?", called_fun,
+      " for more information.", sep=""))
+    return(expr)
+  }
+
+  if (quoted) {
+    # expr is a quoted expression
+    makeFunction(body=expr, env=env)
+  } else {
+    # expr is an unquoted expression
+    makeFunction(body=expr_sub, env=env)
+  }
+}
+
+#' Parse a GET query string from a URL
+#'
+#' Returns a named character vector of key-value pairs.
+#'
+#' @param str The query string. It can have a leading \code{"?"} or not.
+#' @export
+#' @examples
+#' parseQueryString("?foo=1&bar=b%20a%20r")
+#'
+#' \dontrun{
+#' # Example of usage within a Shiny app
+#' shinyServer(function(input, output, clientData) {
+#'
+#'   output$queryText <- renderText({
+#'     query <- parseQueryString(clientData$url_search)
+#'
+#'     # Ways of accessing the values
+#'     if (as.numeric(query$foo) == 1) {
+#'       # Do something
+#'     }
+#'     if (query[["bar"]] == "targetstring") {
+#'       # Do something else
+#'     }
+#'
+#'     # Return a string with key-value pairs
+#'     paste(names(query), query, sep = "=", collapse=", ")
+#'   })
+#' })
+#' }
+#'
+parseQueryString <- function(str) {
+  if (is.null(str) || nchar(str) == 0)
+    return(list())
+
+  # Remove leading ?
+  if (substr(str, 1, 1) == '?')
+    str <- substr(str, 2, nchar(str))
+
+  pairs <- strsplit(str, '&', fixed = TRUE)[[1]]
+  pairs <- strsplit(pairs, '=', fixed = TRUE)
+
+  keys   <- vapply(pairs, function(x) x[1], FUN.VALUE = character(1))
+  values <- vapply(pairs, function(x) x[2], FUN.VALUE = character(1))
+  # Replace NA with '', so they don't get converted to 'NA' by URLdecode
+  values[is.na(values)] <- ''
+
+  # Convert "+" to " ", since URLdecode doesn't do it
+  keys   <- gsub('+', ' ', keys,   fixed = TRUE)
+  values <- gsub('+', ' ', values, fixed = TRUE)
+
+  keys   <- vapply(keys,   function(x) URLdecode(x), FUN.VALUE = character(1))
+  values <- vapply(values, function(x) URLdecode(x), FUN.VALUE = character(1))
+
+  setNames(as.list(values), keys)
+}
+
+#' Print message for deprecated functions in Shiny
+#'
+#' To disable these messages, use \code{options(shiny.deprecation.messages=FALSE)}.
+#'
+#' @param new Name of replacement function.
+#' @param msg Message to print. If used, this will override the default message.
+#' @param old Name of deprecated function.
+shinyDeprecated <- function(new=NULL, msg=NULL,
+                            old=as.character(sys.call(sys.parent()))[1L]) {
+
+  if (getOption("shiny.deprecation.messages", default=TRUE) == FALSE)
+    return(invisible())
+
+  if (is.null(msg)) {
+    msg <- paste(old, "is deprecated.")
+    if (!is.null(new))
+      msg <- paste(msg, "Please use", new, "instead.",
+        "To disable this message, run options(shiny.deprecation.messages=FALSE)")
+  }
+  # Similar to .Deprecated(), but print a message instead of warning
+  message(msg)
+}

inst/examples/01_hello/server.R

@@ -3,14 +3,14 @@ library(shiny)
 # Define server logic required to generate and plot a random distribution
 shinyServer(function(input, output) {
    
-  # Function that generates a plot of the distribution. The function
-  # is wrapped in a call to reactivePlot to indicate that:
+  # Expression that generates a plot of the distribution. The expression
+  # is wrapped in a call to renderPlot to indicate that:
   #
   #  1) It is "reactive" and therefore should be automatically 
   #     re-executed when inputs change
   #  2) Its output type is a plot 
   #
-  output$distPlot <- reactivePlot(function() {
+  output$distPlot <- renderPlot({
         
     # generate an rnorm distribution and plot it
     dist <- rnorm(input$obs)

inst/examples/02_text/server.R

@@ -5,7 +5,7 @@ library(datasets)
 shinyServer(function(input, output) {
   
   # Return the requested dataset
-  datasetInput <- reactive(function() {
+  datasetInput <- reactive({
     switch(input$dataset,
            "rock" = rock,
            "pressure" = pressure,
@@ -13,13 +13,13 @@ shinyServer(function(input, output) {
   })
   
   # Generate a summary of the dataset
-  output$summary <- reactivePrint(function() {
+  output$summary <- renderPrint({
     dataset <- datasetInput()
     summary(dataset)
   })
   
   # Show the first "n" observations
-  output$view <- reactiveTable(function() {
+  output$view <- renderTable({
     head(datasetInput(), n = input$obs)
   })
 })

inst/examples/03_reactivity/server.R

@@ -4,47 +4,47 @@ library(datasets)
 # Define server logic required to summarize and view the selected dataset
 shinyServer(function(input, output) {
 
-  # By declaring databaseInput as a reactive function we ensure that:
+  # By declaring databaseInput as a reactive expression we ensure that:
   #
   #  1) It is only called when the inputs it depends on changes
   #  2) The computation and result are shared by all the callers (it 
   #     only executes a single time)
-  #  3) When the inputs change and the function is re-executed, the
+  #  3) When the inputs change and the expression is re-executed, the
   #     new result is compared to the previous result; if the two are
   #     identical, then the callers are not notified
   #
-  datasetInput <- reactive(function() {
+  datasetInput <- reactive({
     switch(input$dataset,
            "rock" = rock,
            "pressure" = pressure,
            "cars" = cars)
   })
   
-  # The output$caption is computed based on a reactive function that
+  # The output$caption is computed based on a reactive expression that
   # returns input$caption. When the user changes the "caption" field:
   #
   #  1) This function is automatically called to recompute the output 
   #  2) The new caption is pushed back to the browser for re-display
   # 
-  # Note that because the data-oriented reactive functions below don't 
-  # depend on input$caption, those functions are NOT called when 
+  # Note that because the data-oriented reactive expressions below don't 
+  # depend on input$caption, those expressions are NOT called when 
   # input$caption changes.
-  output$caption <- reactiveText(function() {
+  output$caption <- renderText({
     input$caption
   })
   
-  # The output$summary depends on the datasetInput reactive function, 
+  # The output$summary depends on the datasetInput reactive expression, 
   # so will be re-executed whenever datasetInput is re-executed 
   # (i.e. whenever the input$dataset changes)
-  output$summary <- reactivePrint(function() {
+  output$summary <- renderPrint({
     dataset <- datasetInput()
     summary(dataset)
   })
   
-  # The output$view depends on both the databaseInput reactive function
+  # The output$view depends on both the databaseInput reactive expression
   # and input$obs, so will be re-executed whenever input$dataset or 
   # input$obs is changed. 
-  output$view <- reactiveTable(function() {
+  output$view <- renderTable({
     head(datasetInput(), n = input$obs)
   })
 })

inst/examples/04_mpg/server.R

@@ -11,20 +11,20 @@ mpgData$am <- factor(mpgData$am, labels = c("Automatic", "Manual"))
 # Define server logic required to plot various variables against mpg
 shinyServer(function(input, output) {
   
-  # Compute the forumla text in a reactive function since it is 
+  # Compute the forumla text in a reactive expression since it is 
   # shared by the output$caption and output$mpgPlot functions
-  formulaText <- reactive(function() {
+  formulaText <- reactive({
     paste("mpg ~", input$variable)
   })
    
   # Return the formula text for printing as a caption
-  output$caption <- reactiveText(function() {
+  output$caption <- renderText({
     formulaText()
   })
   
   # Generate a plot of the requested variable against mpg and only 
   # include outliers if requested
-  output$mpgPlot <- reactivePlot(function() {
+  output$mpgPlot <- renderPlot({
     boxplot(as.formula(formulaText()), 
             data = mpgData,
             outline = input$outliers)

inst/examples/05_sliders/server.R

@@ -3,8 +3,8 @@ library(shiny)
 # Define server logic for slider examples
 shinyServer(function(input, output) {
   
-  # Reactive function to compose a data frame containing all of the values
-  sliderValues <- reactive(function() {
+  # Reactive expression to compose a data frame containing all of the values
+  sliderValues <- reactive({
     
     # Compose data frame
     data.frame(
@@ -22,7 +22,7 @@ shinyServer(function(input, output) {
   }) 
   
   # Show the values using an HTML table
-  output$values <- reactiveTable(function() {
+  output$values <- renderTable({
     sliderValues()
   })
 })

inst/examples/06_tabsets/server.R

@@ -3,10 +3,10 @@ library(shiny)
 # Define server logic for random distribution application
 shinyServer(function(input, output) {
   
-  # Reactive function to generate the requested distribution. This is 
+  # Reactive expression to generate the requested distribution. This is 
   # called whenever the inputs change. The output functions defined 
-  # below then all use the value computed from this function
-  data <- reactive(function() {  
+  # below then all use the value computed from this expression
+  data <- reactive({
     dist <- switch(input$dist,
                    norm = rnorm,
                    unif = runif,
@@ -19,9 +19,9 @@ shinyServer(function(input, output) {
   
   # Generate a plot of the data. Also uses the inputs to build the 
   # plot label. Note that the dependencies on both the inputs and
-  # the data reactive function are both tracked, and all functions 
+  # the data reactive expression are both tracked, and all expressions 
   # are called in the sequence implied by the dependency graph
-  output$plot <- reactivePlot(function() {
+  output$plot <- renderPlot({
     dist <- input$dist
     n <- input$n
     
@@ -30,12 +30,12 @@ shinyServer(function(input, output) {
   })
   
   # Generate a summary of the data
-  output$summary <- reactivePrint(function() {
+  output$summary <- renderPrint({
     summary(data())
   })
   
   # Generate an HTML table view of the data
-  output$table <- reactiveTable(function() {
+  output$table <- renderTable({
     data.frame(x=data())
   })
   

inst/examples/07_widgets/server.R

@@ -5,7 +5,7 @@ library(datasets)
 shinyServer(function(input, output) {
   
   # Return the requested dataset
-  datasetInput <- reactive(function() {
+  datasetInput <- reactive({
     switch(input$dataset,
            "rock" = rock,
            "pressure" = pressure,
@@ -13,13 +13,13 @@ shinyServer(function(input, output) {
   })
   
   # Generate a summary of the dataset
-  output$summary <- reactivePrint(function() {
+  output$summary <- renderPrint({
     dataset <- datasetInput()
     summary(dataset)
   })
   
   # Show the first "n" observations
-  output$view <- reactiveTable(function() {
+  output$view <- renderTable({
     head(datasetInput(), n = input$obs)
   })
 })

inst/examples/08_html/server.R

@@ -3,10 +3,10 @@ library(shiny)
 # Define server logic for random distribution application
 shinyServer(function(input, output) {
   
-  # Reactive function to generate the requested distribution. This is 
-  # called whenever the inputs change. The output functions defined 
-  # below then all used the value computed from this function
-  data <- reactive(function() {  
+  # Reactive expression to generate the requested distribution. This is 
+  # called whenever the inputs change. The output expressions defined 
+  # below then all used the value computed from this expression
+  data <- reactive({
     dist <- switch(input$dist,
                    norm = rnorm,
                    unif = runif,
@@ -19,9 +19,9 @@ shinyServer(function(input, output) {
   
   # Generate a plot of the data. Also uses the inputs to build the 
   # plot label. Note that the dependencies on both the inputs and
-  # the data reactive function are both tracked, and all functions 
+  # the data reactive expression are both tracked, and all expressions 
   # are called in the sequence implied by the dependency graph
-  output$plot <- reactivePlot(function() {
+  output$plot <- renderPlot({
     dist <- input$dist
     n <- input$n
     
@@ -30,12 +30,12 @@ shinyServer(function(input, output) {
   })
   
   # Generate a summary of the data
-  output$summary <- reactivePrint(function() {
+  output$summary <- renderPrint({
     summary(data())
   })
   
   # Generate an HTML table view of the data
-  output$table <- reactiveTable(function() {
+  output$table <- renderTable({
     data.frame(x=data())
   })
   

inst/examples/09_upload/server.R

@@ -1,18 +1,18 @@
 library(shiny)
 
 shinyServer(function(input, output) {
-  output$contents <- reactiveTable(function() {
+  output$contents <- renderTable({
     
     # input$file1 will be NULL initially. After the user selects and uploads a 
-    # file, it will be a data frame with 'name', 'size', 'type', and 'data' 
-    # columns. The 'data' column will contain the local filenames where the data
-    # can be found.
+    # file, it will be a data frame with 'name', 'size', 'type', and 'datapath' 
+    # columns. The 'datapath' column will contain the local filenames where the 
+    # data can be found.
 
     inFile <- input$file1
 
     if (is.null(inFile))
       return(NULL)
     
-    read.csv(inFile$data, header=input$header, sep=input$sep, quote=input$quote)
+    read.csv(inFile$datapath, header=input$header, sep=input$sep, quote=input$quote)
   })
 })

inst/examples/09_upload/ui.R

@@ -1,7 +1,7 @@
 library(shiny)
 
 shinyUI(pageWithSidebar(
-  headerPanel("CSV Viewer"),
+  headerPanel("Uploading Files"),
   sidebarPanel(
     fileInput('file1', 'Choose CSV File',
               accept=c('text/csv', 'text/comma-separated-values,text/plain')),

inst/examples/10_download/server.R

@@ -1,12 +1,12 @@
 shinyServer(function(input, output) {
-  datasetInput <- reactive(function() {
+  datasetInput <- reactive({
     switch(input$dataset,
            "rock" = rock,
            "pressure" = pressure,
            "cars" = cars)
   })
   
-  output$table <- reactiveTable(function() {
+  output$table <- renderTable({
     datasetInput()
   })
   

inst/examples/11_timer/server.R

@@ -0,0 +1,6 @@
+shinyServer(function(input, output) {
+  output$currentTime <- renderText({
+    invalidateLater(1000)
+    paste("The current time is", Sys.time())
+  })
+})

inst/examples/11_timer/ui.R

@@ -0,0 +1,3 @@
+shinyUI(bootstrapPage(
+  textOutput("currentTime")
+))

inst/tests/test-gc.r

@@ -0,0 +1,73 @@
+context("garbage collection")
+
+test_that("unreferenced observers are garbage collected", {
+  vals_removed <- FALSE
+  obs_removed  <- FALSE
+  vals <- reactiveValues(A=1)
+  obs  <- observe({ vals$A })
+
+  # These are called when the objects are garbage-collected
+  reg.finalizer(attr(.subset2(vals,'impl'), ".xData"),
+                function(e) vals_removed <<- TRUE)
+  reg.finalizer(attr(obs, ".xData"),
+                function(e) obs_removed  <<- TRUE)
+
+  flushReact()
+
+  # Removing this reference to obs doesn't delete it because vals still has a
+  # reference to it
+  rm(obs)
+  invisible(gc())
+  expect_equal(c(vals_removed, obs_removed), c(FALSE, FALSE))
+
+  # Updating vals$A and flushing won't make obs go away because it creates a new
+  # context, and vals$A's context tracks obs's context as a dependent
+  vals$A <- 2
+  flushReact()
+  invisible(gc())
+  expect_equal(c(vals_removed, obs_removed), c(FALSE, FALSE))
+
+  # Removing vals will result in vals and obs being garbage collected since
+  # there are no other references to them
+  rm(vals)
+  invisible(gc())
+  expect_equal(c(vals_removed, obs_removed), c(TRUE, TRUE))
+})
+
+
+test_that("suspended observers are garbage collected", {
+  vals_removed <- FALSE
+  obs_removed  <- FALSE
+  vals <- reactiveValues(A=1)
+  obs  <- observe({ vals$A })
+
+  # These are called when the objects are garbage-collected
+  reg.finalizer(attr(.subset2(vals,'impl'), ".xData"),
+                function(e) vals_removed <<- TRUE)
+  reg.finalizer(attr(obs, ".xData"),
+                function(e) obs_removed  <<- TRUE)
+
+  flushReact()
+
+  vals$A <- 2
+  flushReact()
+  invisible(gc())
+
+  # Simply suspending and removing our reference to obs doesn't result in GC,
+  # because vals's context still has a reference to obs's context, as a dependent
+  obs$suspend()
+  rm(obs)
+  invisible(gc())
+  expect_equal(c(vals_removed, obs_removed), c(FALSE, FALSE))
+
+  # Next time we update vals$A and flush, there's no more reference to obs
+  vals$A <- 3
+  flushReact()
+  invisible(gc())
+  expect_equal(c(vals_removed, obs_removed), c(FALSE, TRUE))
+
+  # Deleting vals should work immediately now
+  rm(vals)
+  invisible(gc())  # Removes vals object
+  expect_equal(c(vals_removed, obs_removed), c(TRUE, TRUE))
+})

inst/tests/test-reactivity.r

@@ -59,16 +59,16 @@ test_that("Functions are not over-reactive", {
 
   values <- reactiveValues(A=10)
 
-  funcA <- reactive(function() {
+  funcA <- reactive({
     values$A
   })
 
-  funcB <- reactive(function() {
+  funcB <- reactive({
     funcA()
     values$A
   })
 
-  obsC <- observe(function() {
+  obsC <- observe({
     funcB()
   })
 
@@ -100,13 +100,13 @@ test_that("overreactivity2", {
   observed_value2 <- NA
 
   values <- reactiveValues(A=1)
-  funcB  <- reactive(function() {
+  funcB  <- reactive({
     values$A + 5
   })
-  obsC <- observe(function() {
+  obsC <- observe({
     observed_value1 <<-  funcB() * values$A
   })
-  obsD <- observe(function() {
+  obsD <- observe({
     observed_value2 <<-  funcB() * values$A
   })
 
@@ -135,15 +135,15 @@ test_that("overreactivity2", {
 test_that("isolation", {
   values <- reactiveValues(A=10, C=NULL)
 
-  obsB <- observe(function() {
+  obsB <- observe({
     values$C <- values$A > 0
   })
 
-  funcD <- reactive(function() {
+  funcD <- reactive({
     values$C
   })
 
-  obsE <- observe(function() {
+  obsE <- observe({
     funcD()
   })
 
@@ -163,15 +163,15 @@ test_that("laziness", {
 
   values <- reactiveValues(A=10)
 
-  funcA <- reactive(function() {
+  funcA <- reactive({
     values$A > 0
   })
 
-  funcB <- reactive(function() {
+  funcB <- reactive({
     funcA()
   })
 
-  obsC <- observe(function() {
+  obsC <- observe({
     if (values$A > 10)
       return()
     funcB()
@@ -203,10 +203,10 @@ test_that("order of evaluation", {
   observed_value <- NA
 
   values <- reactiveValues(A=1)
-  funcB  <- reactive(function() {
+  funcB  <- reactive({
     values$A + 5
   })
-  obsC <- observe(function() {
+  obsC <- observe({
     observed_value <<- values$A * funcB()
   })
 
@@ -230,10 +230,10 @@ test_that("order of evaluation", {
   observed_value <- NA
 
   values <- reactiveValues(A=1)
-  funcB <- reactive(function() {
+  funcB <- reactive({
     values$A + 5
   })
-  obsC <- observe(function() {
+  obsC <- observe({
     observed_value <<- funcB() * values$A
   })
 
@@ -259,18 +259,18 @@ test_that("isolate() blocks invalidations from propagating", {
   obsD_value <- NA
 
   values <- reactiveValues(A=1, B=10)
-  funcB <- reactive(function() {
+  funcB <- reactive({
     values$B + 100
   })
 
   # References to valueB and funcB are isolated
-  obsC <- observe(function() {
+  obsC <- observe({
     obsC_value <<-
       values$A + isolate(values$B) + isolate(funcB())
   })
 
   # In contrast with obsC, this has a non-isolated reference to funcB
-  obsD <- observe(function() {
+  obsD <- observe({
     obsD_value <<-
       values$A + isolate(values$B) + funcB()
   })
@@ -309,11 +309,29 @@ test_that("isolate() blocks invalidations from propagating", {
   expect_equal(execCount(obsD), 4)
 })
 
+
+test_that("isolate() evaluates expressions in calling environment", {
+  outside <- 1
+  inside <- 1
+  loc <- 1
+
+  outside <- isolate(2)      # Assignment outside isolate
+  isolate(inside <- 2)       # Assignment inside isolate
+  # Should affect vars in the calling environment
+  expect_equal(outside, 2)
+  expect_equal(inside, 2)
+
+  isolate(local(loc <<- 2))  # <<- inside isolate(local)
+  isolate(local(loc <- 3))   # <- inside isolate(local) - should have no effect
+  expect_equal(loc, 2)
+})
+
+
 test_that("Circular refs/reentrancy in reactive functions work", {
 
   values <- reactiveValues(A=3)
 
-  funcB <- reactive(function() {
+  funcB <- reactive({
     # Each time fB executes, it reads and then writes valueA,
     # effectively invalidating itself--until valueA becomes 0.
     if (values$A == 0)
@@ -322,7 +340,7 @@ test_that("Circular refs/reentrancy in reactive functions work", {
     return(values$A)
   })
 
-  obsC <- observe(function() {
+  obsC <- observe({
     funcB()
   })
 
@@ -339,14 +357,14 @@ test_that("Circular refs/reentrancy in reactive functions work", {
 test_that("Simple recursion", {
 
   values <- reactiveValues(A=5)
-  funcB <- reactive(function() {
+  funcB <- reactive({
     if (values$A == 0)
       return(0)
     values$A <- values$A - 1
     funcB()
   })
 
-  obsC <- observe(function() {
+  obsC <- observe({
     funcB()
   })
 
@@ -359,13 +377,13 @@ test_that("Non-reactive recursion", {
   nonreactiveA <- 3
   outputD <- NULL
 
-  funcB <- reactive(function() {
+  funcB <- reactive({
     if (nonreactiveA == 0)
       return(0)
     nonreactiveA <<- nonreactiveA - 1
     return(funcB())
   })
-  obsC <- observe(function() {
+  obsC <- observe({
     outputD <<- funcB()
   })
 
@@ -377,7 +395,7 @@ test_that("Non-reactive recursion", {
 test_that("Circular dep with observer only", {
 
   values <- reactiveValues(A=3)
-  obsB <- observe(function() {
+  obsB <- observe({
     if (values$A == 0)
       return()
     values$A <- values$A - 1
@@ -390,12 +408,12 @@ test_that("Circular dep with observer only", {
 test_that("Writing then reading value is not circular", {
 
   values <- reactiveValues(A=3)
-  funcB <- reactive(function() {
+  funcB <- reactive({
     values$A <- isolate(values$A) - 1
     values$A
   })
 
-  obsC <- observe(function() {
+  obsC <- observe({
     funcB()
   })
 
@@ -413,17 +431,17 @@ test_that("names() and reactiveValuesToList()", {
   values <- reactiveValues(A=1, .B=2)
 
   # Dependent on names
-  depNames <- observe(function() {
+  depNames <- observe({
     names(values)
   })
 
   # Dependent on all non-hidden objects
-  depValues <- observe(function() {
+  depValues <- observe({
     reactiveValuesToList(values)
   })
 
   # Dependent on all objects, including hidden
-  depAllValues <- observe(function() {
+  depAllValues <- observe({
     reactiveValuesToList(values, all.names = TRUE)
   })
 
@@ -441,27 +459,194 @@ test_that("names() and reactiveValuesToList()", {
   expect_equal(execCount(depValues), 1)
   expect_equal(execCount(depAllValues), 1)
 
+  # Update existing variable
   values$A <- 2
   flushReact()
   expect_equal(execCount(depNames), 1)
   expect_equal(execCount(depValues), 2)
   expect_equal(execCount(depAllValues), 2)
 
+  # Update existing hidden variable
   values$.B <- 3
   flushReact()
   expect_equal(execCount(depNames), 1)
   expect_equal(execCount(depValues), 2)
   expect_equal(execCount(depAllValues), 3)
 
+  # Add new variable
   values$C <- 1
   flushReact()
   expect_equal(execCount(depNames), 2)
   expect_equal(execCount(depValues), 3)
   expect_equal(execCount(depAllValues), 4)
 
+  # Add new hidden variable
   values$.D <- 1
   flushReact()
   expect_equal(execCount(depNames), 3)
   expect_equal(execCount(depValues), 3)
   expect_equal(execCount(depAllValues), 5)
 })
+
+test_that("Observer pausing works", {
+  values <- reactiveValues(a=1)
+  
+  funcA <- reactive({
+    values$a
+  })
+  
+  obsB <- observe({
+    funcA()
+  })
+  
+  # Important: suspend() only affects observer at invalidation time
+  
+  # Observers are invalidated at creation time, so it will run once regardless
+  # of being suspended
+  obsB$suspend()
+  flushReact()
+  expect_equal(execCount(funcA), 1)
+  expect_equal(execCount(obsB), 1)
+  
+  # When resuming, if nothing changed, don't do anything
+  obsB$resume()
+  flushReact()
+  expect_equal(execCount(funcA), 1)
+  expect_equal(execCount(obsB), 1)
+  
+  # Make sure suspended observers do not flush, but do invalidate
+  obsB_invalidated <- FALSE
+  obsB$onInvalidate(function() {obsB_invalidated <<- TRUE})
+  obsB$suspend()
+  values$a <- 2
+  flushReact()
+  expect_equal(obsB_invalidated, TRUE)
+  expect_equal(execCount(funcA), 1)
+  expect_equal(execCount(obsB), 1)
+  
+  obsB$resume()
+  values$a <- 2.5
+  obsB$suspend()
+  flushReact()
+  expect_equal(execCount(funcA), 2)
+  expect_equal(execCount(obsB), 2)
+  
+  values$a <- 3
+  flushReact()
+
+  expect_equal(execCount(funcA), 2)
+  expect_equal(execCount(obsB), 2)
+  
+  # If onInvalidate() is added _after_ obsB is suspended and the values$a
+  # changes, then it shouldn't get run (onInvalidate runs on invalidation, not
+  # on flush)
+  values$a <- 4
+  obsB_invalidated2 <- FALSE
+  obsB$onInvalidate(function() {obsB_invalidated2 <<- TRUE})
+  obsB$resume()
+  flushReact()
+
+  expect_equal(execCount(funcA), 3)
+  expect_equal(execCount(obsB), 3)
+  expect_equal(obsB_invalidated2, FALSE)
+})
+
+test_that("suspended/resumed observers run at most once", {
+
+  values <- reactiveValues(A=1)
+  obs <- observe(function() {
+    values$A
+  })
+  expect_equal(execCount(obs), 0)
+  
+  # First flush should run obs once
+  flushReact()
+  expect_equal(execCount(obs), 1)
+
+  # Modify the dependency at each stage of suspend/resume/flush should still
+  # only result in one run of obs()
+  values$A <- 2
+  obs$suspend()
+  values$A <- 3
+  obs$resume()
+  values$A <- 4
+  flushReact()
+  expect_equal(execCount(obs), 2)
+
+})
+
+
+test_that("reactive() accepts quoted and unquoted expressions", {
+  vals <- reactiveValues(A=1)
+
+  # Unquoted expression, with curly braces
+  fun <- reactive({ vals$A + 1 })
+  expect_equal(isolate(fun()), 2)
+
+  # Unquoted expression, no curly braces
+  fun <- reactive(vals$A + 1)
+  expect_equal(isolate(fun()), 2)
+
+  # Quoted expression
+  fun <- reactive(quote(vals$A + 1), quoted = TRUE)
+  expect_equal(isolate(fun()), 2)
+
+  # Quoted expression, saved in a variable
+  q_expr <- quote(vals$A + 1)
+  fun <- reactive(q_expr, quoted = TRUE)
+  expect_equal(isolate(fun()), 2)
+
+  # If function is used, work, but print message
+  expect_message(fun <- reactive(function() { vals$A + 1 }))
+  expect_equal(isolate(fun()), 2)
+
+
+  # Check that environment is correct - parent environment should be this one
+  this_env <- environment()
+  fun <- reactive(environment())
+  expect_identical(isolate(parent.env(fun())), this_env)
+
+  # Sanity check: environment structure for a reactive() should be the same as for
+  # a normal function
+  fun <- function() environment()
+  expect_identical(parent.env(fun()), this_env)
+})
+
+test_that("observe() accepts quoted and unquoted expressions", {
+  vals <- reactiveValues(A=0)
+  valB <- 0
+
+  # Unquoted expression, with curly braces
+  observe({ valB <<- vals$A + 1})
+  flushReact()
+  expect_equal(valB, 1)
+
+  # Unquoted expression, no curly braces
+  observe({ valB <<- vals$A + 2})
+  flushReact()
+  expect_equal(valB, 2)
+
+  # Quoted expression
+  observe(quote(valB <<- vals$A + 3), quoted = TRUE)
+  flushReact()
+  expect_equal(valB, 3)
+
+  # Quoted expression, saved in a variable
+  q_expr <- quote(valB <<- vals$A + 4)
+  fun <- observe(q_expr, quoted = TRUE)
+  flushReact()
+  expect_equal(valB, 4)
+
+  # If function is used, work, but print message
+  expect_message(observe(function() { valB <<- vals$A + 5 }))
+  flushReact()
+  expect_equal(valB, 5)
+
+
+  # Check that environment is correct - parent environment should be this one
+  this_env <- environment()
+  inside_env <- NULL
+  fun <- observe(inside_env <<- environment())
+  flushReact()
+  expect_identical(parent.env(inside_env), this_env)
+})

inst/tests/test-text.R

@@ -1,33 +1,33 @@
 context("text")
 
-test_that("reactivePrint and reactiveText behavior is correct", {
-  expect_equal(isolate(reactivePrint(function() "foo")()),
+test_that("renderPrint and renderText behavior is correct", {
+  expect_equal(isolate(renderPrint({ "foo" })()),
                '[1] "foo"')
-  expect_equal(isolate(reactivePrint(function() invisible("foo"))()),
+  expect_equal(isolate(renderPrint({ invisible("foo") })()),
                '')
-  expect_equal(isolate(reactivePrint(function() { print("foo"); "bar"})()),
+  expect_equal(isolate(renderPrint({ print("foo"); "bar"})()),
                '[1] "foo"\n[1] "bar"')
-  expect_equal(isolate(reactivePrint(function() NULL)()),
+  expect_equal(isolate(renderPrint({ NULL })()),
                'NULL')
-  expect_equal(isolate(reactivePrint(function() invisible())()),
+  expect_equal(isolate(renderPrint({ invisible() })()),
                '')
-  expect_equal(isolate(reactivePrint(function() 1:5)()),
+  expect_equal(isolate(renderPrint({ 1:5 })()),
                '[1] 1 2 3 4 5')
   
-  expect_equal(isolate(reactiveText(function() "foo")()),
+  expect_equal(isolate(renderText({ "foo" })()),
                'foo')
-  expect_equal(isolate(reactiveText(function() invisible("foo"))()),
+  expect_equal(isolate(renderText({ invisible("foo") })()),
                'foo')
   # Capture the print output so it's not shown on console during test, and
   # also check that it is correct
-  print_out <- capture.output(ret <- isolate(reactiveText(function() { print("foo"); "bar"})()))
+  print_out <- capture.output(ret <- isolate(renderText({ print("foo"); "bar"})()))
   expect_equal(ret, 'bar')
   expect_equal(print_out, '[1] "foo"')
-  expect_equal(isolate(reactiveText(function() NULL)()),
+  expect_equal(isolate(renderText({ NULL })()),
                '')
-  expect_equal(isolate(reactiveText(function() invisible())()),
+  expect_equal(isolate(renderText({ invisible() })()),
                '')
-  expect_equal(isolate(reactiveText(function() 1:5)()),
+  expect_equal(isolate(renderText({ 1:5 })()),
                '1 2 3 4 5')  
 })
 
@@ -35,22 +35,22 @@ test_that("reactive functions save visibility state", {
   # Call each function twice - should be no change in state with second call
 
   # invisible NULL
-  f <- reactive(function() invisible())
+  f <- reactive({ invisible() })
   expect_identical(withVisible(isolate(f())), list(value=NULL, visible=FALSE))
   expect_identical(withVisible(isolate(f())), list(value=NULL, visible=FALSE))
 
   # visible NULL
-  f <- reactive(function() NULL)
+  f <- reactive({ NULL })
   expect_identical(withVisible(isolate(f())), list(value=NULL, visible=TRUE))
   expect_identical(withVisible(isolate(f())), list(value=NULL, visible=TRUE))
 
   # invisible non-NULL value
-  f <- reactive(function() invisible(10))
+  f <- reactive({ invisible(10)})
   expect_identical(withVisible(isolate(f())), list(value=10, visible=FALSE))
   expect_identical(withVisible(isolate(f())), list(value=10, visible=FALSE))
 
   # visible non-NULL value
-  f <- reactive(function() 10)
+  f <- reactive({ 10 })
   expect_identical(withVisible(isolate(f())), list(value=10, visible=TRUE))
   expect_identical(withVisible(isolate(f())), list(value=10, visible=TRUE))
 })

inst/tests/test-url.R

@@ -0,0 +1,20 @@
+context("URL")
+
+test_that("Query string parsing", {
+  expect_identical(
+    parseQueryString("?foo=1&bar=b+a%20r&b+a%20z=baz&=nokey&novalue=&=&noequal&end=end"),
+    list(
+      foo     = '1',
+      bar     = 'b a r',
+      `b a z` = 'baz',
+                'nokey',
+      novalue = '',
+                '',
+      noequal = '',
+      end     = 'end'
+    )
+  )
+
+  # Should be the same with or without leading question mark
+  expect_identical(parseQueryString("?foo=1&bar=b"), parseQueryString("foo=1&bar=b"))
+})

inst/www/shared/shiny.css

@@ -58,3 +58,27 @@ span.jslider {
 .slider-animate-button.playing .play {
   display: none;
 }
+
+.progress.shiny-file-input-progress {
+  position: relative;
+  visibility: hidden;
+}
+.progress.shiny-file-input-progress .bar {
+  overflow: hidden;
+}
+.progress.shiny-file-input-progress label {
+  display: block;
+  position: absolute;
+  left: 0;
+  top: 0;
+  right: 0;
+  bottom: 0;
+  font-size: 12px;
+  padding: 0 6px;
+}
+.progress.shiny-file-input-progress .bar.bar-danger {
+  -webkit-transition: none;
+  -moz-transition: none;
+  -o-transition: none;
+  transition: none;
+}

inst/www/shared/shiny.js

@@ -57,6 +57,13 @@
     }
   }
 
+  function pixelRatio() {
+    if (window.devicePixelRatio) {
+      return window.devicePixelRatio;
+    } else {
+      return 1;
+    }
+  }
 
   // Takes a string expression and returns a function that takes an argument.
   // 
@@ -70,6 +77,10 @@
   }
 
 
+  // =========================================================================
+  // Input rate stuff
+  // =========================================================================
+
   var Invoker = function(target, func) {
     this.target = target;
     this.func = func;
@@ -278,8 +289,13 @@
       this.lastSentValues[name] = jsonValue;
       this.target.setInput(name, value);
     };
-    this.reset = function() {
-      this.lastSentValues = {};
+    this.reset = function(values) {
+      values = values || {};
+      var strValues = {};
+      $.each(values, function(key, value) {
+        strValues[key] = JSON.stringify(value);
+      });
+      this.lastSentValues = strValues;
     };
   }).call(InputNoResendDecorator.prototype);
 
@@ -371,6 +387,9 @@
   }
 
 
+  // =========================================================================
+  // ShinyApp
+  // =========================================================================
   var ShinyApp = function() {
     this.$socket = null;
 
@@ -400,7 +419,7 @@
 
       $.extend(initialInput, {
         // IE8 and IE9 have some limitations with data URIs
-        "__allowDataUriScheme": typeof WebSocket !== 'undefined'
+        ".clientdata_allowDataUriScheme": typeof WebSocket !== 'undefined'
       });
 
       this.$socket = this.createSocket();
@@ -475,8 +494,7 @@
     //   response, the function will be called with it as the only argument.
     // @param onError A function that will be called back if the server
     //   responds with error, or if the request fails for any other reason.
-    //   The parameter to onError will be an error object or message (format
-    //   TBD).
+    //   The parameter to onError will be a string describing the error.
     // @param blobs Optionally, an array of Blob, ArrayBuffer, or string
     //   objects that will be made available to the server as part of the
     //   request. Strings will be encoded using UTF-8.
@@ -584,7 +602,8 @@
       }
       if (msgObj.console) {
         for (var i = 0; i < msgObj.console.length; i++) {
-          console.log(msgObj.console[i]);
+          if (console.log)
+            console.log(msgObj.console[i]);
         }
       }
       if (msgObj.progress) {
@@ -668,24 +687,21 @@
   }).call(ShinyApp.prototype);
 
 
+  // =========================================================================
+  // File Processor
+  // =========================================================================
+
   // Generic driver class for doing chunk-wise asynchronous processing of a
   // FileList object. Subclass/clone it and override the `on*` functions to
   // make it do something useful.
   var FileProcessor = function(files) {
     this.files = files;
-    this.fileReader = new FileReader();
     this.fileIndex = -1;
-    this.pos = 0;
     // Currently need to use small chunk size because R-Websockets can't
     // handle continuation frames
-    this.chunkSize = 4096;
     this.aborted = false;
     this.completed = false;
     
-    var self = this;
-    $(this.fileReader).on('load', function(evt) {
-      self.$endReadChunk();
-    });
     // TODO: Register error/abort callbacks
     
     this.$run();
@@ -695,13 +711,7 @@
     this.onBegin = function(files, cont) {
       setTimeout(cont, 0);
     };
-    this.onFileBegin = function(file, cont) {
-      setTimeout(cont, 0);
-    };
-    this.onFileChunk = function(file, offset, blob, cont) {
-      setTimeout(cont, 0);
-    };
-    this.onFileEnd = function(file, cont) {
+    this.onFile = function(file, cont) {
       setTimeout(cont, 0);
     };
     this.onComplete = function() {
@@ -758,49 +768,15 @@
       // in the middle of processing a file, or have just finished
       // processing a file.
       
-      var file = this.files[this.fileIndex];
-      if (this.pos >= file.size) {
-        // We've read past the end of this file--it's done
-        this.fileIndex++;
-        this.pos = 0;
-        this.onFileEnd(file, this.$getRun());
-      }
-      else if (this.pos == 0) {
-        // We're just starting with this file, need to call onFileBegin
-        // before we actually start reading
-        var called = false;
-        this.onFileBegin(file, function() {
-          if (called)
-            return;
-          called = true;
-          self.$beginReadChunk();
-        });
-      }
-      else {
-        // We're neither starting nor ending--just start the next chunk
-        this.$beginReadChunk();
-      }
-    };
-    
-    // Starts asynchronous read of the current chunk of the current file
-    this.$beginReadChunk = function() {
-      var file = this.files[this.fileIndex];
-      var blob = slice(file, this.pos, this.pos + this.chunkSize);
-      this.fileReader.readAsArrayBuffer(blob);
-    };
-    
-    // Called when a chunk has been successfully read
-    this.$endReadChunk = function() {
-      var file = this.files[this.fileIndex];
-      var offset = this.pos;
-      var data = this.fileReader.result;
-      this.pos = this.pos + this.chunkSize;
-      this.onFileChunk(file, offset, makeBlob([data]),
-                       this.$getRun());
+      var file = this.files[this.fileIndex++];
+      this.onFile(file, this.$getRun());
     };
   }).call(FileProcessor.prototype);
 
 
+  // =========================================================================
+  // Binding registry
+  // =========================================================================
   var BindingRegistry = function() {
     this.bindings = [];
     this.bindingNames = {};
@@ -839,6 +815,9 @@
   var inputBindings = exports.inputBindings = new BindingRegistry();
   var outputBindings = exports.outputBindings = new BindingRegistry();
 
+  // =========================================================================
+  // Output bindings
+  // =========================================================================
   
   var OutputBinding = exports.OutputBinding = function() {};
   (function() {
@@ -884,17 +863,20 @@
   });
   outputBindings.register(textOutputBinding, 'shiny.textOutput');
 
-  var plotOutputBinding = new OutputBinding();
-  $.extend(plotOutputBinding, {
+  var imageOutputBinding = new OutputBinding();
+  $.extend(imageOutputBinding, {
     find: function(scope) {
-      return $(scope).find('.shiny-plot-output');
+      return $(scope).find('.shiny-image-output, .shiny-plot-output');
     },
     renderValue: function(el, data) {
       // Load the image before emptying, to minimize flicker
       var img = null;
       if (data) {
         img = document.createElement('img');
-        img.src = data;
+        // Copy items from data to img. This should include 'src'
+        $.each(data, function(key, value) {
+          img[key] = value;
+        })
       }
 
       $(el).empty();
@@ -902,13 +884,17 @@
         $(el).append(img);
     }
   });
-  outputBindings.register(plotOutputBinding, 'shiny.plotOutput');
+  outputBindings.register(imageOutputBinding, 'shiny.imageOutput');
 
   var htmlOutputBinding = new OutputBinding();
   $.extend(htmlOutputBinding, {
     find: function(scope) {
       return $(scope).find('.shiny-html-output');
     },
+    onValueError: function(el, err) {
+      exports.unbindAll(el);
+      this.renderError(el, err);
+    },
     renderValue: function(el, data) {
       exports.unbindAll(el);
       $(el).html(data);
@@ -928,6 +914,9 @@
   })
   outputBindings.register(downloadLinkOutputBinding, 'shiny.downloadLink');
 
+  // =========================================================================
+  // Input bindings
+  // =========================================================================
 
   var InputBinding = exports.InputBinding = function() {
   };
@@ -1007,17 +996,22 @@
     },
     getValue: function(el) {
       var numberVal = $(el).val();
-      if (!isNaN(numberVal))
+      if (/^\s*$/.test(numberVal))  // Return null if all whitespace
+        return null;
+      else if (!isNaN(numberVal))   // If valid Javascript number string, coerce to number
         return +numberVal;
       else
-        return numberVal;
+        return numberVal;           // If other string like "1e6", send it unchanged
+    },
+    getType: function(el) {
+      return "number"
     }
   });
   inputBindings.register(numberInputBinding, 'shiny.numberInput');
 
 
   var sliderInputBinding = {};
-  $.extend(sliderInputBinding, numberInputBinding, {
+  $.extend(sliderInputBinding, textInputBinding, {
     find: function(scope) {
       // Check if jslider plugin is loaded
       if (!$.fn.slider)
@@ -1133,59 +1127,115 @@
     };
     this.onBegin = function(files, cont) {
       var self = this;
-      this.makeRequest(
-        'uploadInit', [],
-        function(response) {
-          self.jobId = response.jobId;
-          cont();
-        },
-        function(error) {
-        });
-    };
-    this.onFileBegin = function(file, cont) {
-      this.onProgress(file, 0);
-      
-      this.makeRequest(
-        'uploadFileBegin', [this.jobId, file.name, file.type, file.size],
-        function(response) {
-          cont();
-        },
-        function(error) {
-        });
-    };
-    this.onFileChunk = function(file, offset, blob, cont) {
-      this.onProgress(file, (offset + blob.size) / file.size);
+
+      // Reset progress bar
+      this.$setError(null);
+      this.$setActive(true);
+      this.$setVisible(true);
+      this.onProgress(null, 0);
+
+      this.totalBytes = 0;
+      this.progressBytes = 0;
+      $.each(files, function(i, file) {
+        self.totalBytes += file.size;
+      });
+
+      var fileInfo = $.map(files, function(file, i) {
+        return {
+          name: file.name,
+          size: file.size,
+          type: file.type
+        };
+      });
 
       this.makeRequest(
-        'uploadFileChunk', [this.jobId],
-        function(response) {
-          cont();
-        },
-        function(error) {
-        },
-        [blob]);
-    };
-    this.onFileEnd = function(file, cont) {
-      this.makeRequest(
-        'uploadFileEnd', [this.jobId],
+        'uploadInit', [fileInfo],
         function(response) {
+          self.jobId = response.jobId;
+          self.uploadUrl = response.uploadUrl;
           cont();
         },
         function(error) {
+          self.onError(error);
         });
     };
+    this.onFile = function(file, cont) {
+      var self = this;
+      this.onProgress(file, 0);
+
+      $.ajax(this.uploadUrl, {
+        type: 'POST',
+        cache: false,
+        xhr: function() {
+          var xhrVal = $.ajaxSettings.xhr();
+          if (xhrVal.upload) {
+            xhrVal.upload.onprogress = function(e) {
+              if (e.lengthComputable) {
+                self.onProgress(
+                  file,
+                  (self.progressBytes + e.loaded) / self.totalBytes);
+              }
+            }
+          }
+          return xhrVal;
+        },
+        data: file,
+        processData: false,
+        success: function() {
+          self.progressBytes += file.size;
+          cont();
+        },
+        error: function(jqXHR, textStatus, errorThrown) {
+          self.onError(jqXHR.responseText || textStatus);
+        }
+      });
+    };
     this.onComplete = function() {
+      var self = this;
       this.makeRequest(
         'uploadEnd', [this.jobId, this.id], 
         function(response) {
+          self.$setActive(false);
+          self.onProgress(null, 1);
+          self.$label().text('Upload complete');
         },
         function(error) {
+          self.onError(error);
         });
+      this.$label().text('Finishing upload');
+    };
+    this.onError = function(message) {
+      this.$setError(message || '');
+      this.$setActive(false);
     };
     this.onAbort = function() {
+      this.$setVisible(false);
     };
     this.onProgress = function(file, completed) {
-      console.log('file: ' + file.name + ' [' + Math.round(completed*100) + '%]');
+      this.$bar().width(Math.round(completed*100) + '%');
+      this.$label().text(file ? file.name : '');
+    };
+    this.$container = function() {
+      return $('#' + this.id + '_progress.shiny-file-input-progress');
+    };
+    this.$bar = function() {
+      return $('#' + this.id + '_progress.shiny-file-input-progress .bar');
+    };
+    this.$label = function() {
+      return $('#' + this.id + '_progress.shiny-file-input-progress label');
+    };
+    this.$setVisible = function(visible) {
+      this.$container().css('visibility', visible ? 'visible' : 'hidden');
+    };
+    this.$setError = function(error) {
+      this.$bar().toggleClass('bar-danger', (error !== null));
+      if (error !== null) {
+        this.onProgress(null, 1);
+        this.$label().text(error);
+      }
+    };
+    this.$setActive = function(active) {
+      this.$container().toggleClass('active', !!active);
     };
   }).call(FileUploader.prototype);
 
@@ -1200,6 +1250,9 @@
     var files = evt.target.files;
     var id = fileInputBinding.getId(evt.target);
 
+    if (files.length == 0)
+      return;
+
     // Start the new upload and put the uploader in 'currentUploader'.
     el.data('currentUploader', new FileUploader(exports.shinyapp, id, files));
   };
@@ -1245,6 +1298,9 @@
   }).call(OutputBindingAdapter.prototype);
 
 
+  // =========================================================================
+  // initShiny
+  // =========================================================================
   function initShiny() {
 
     var shinyapp = exports.shinyapp = new ShinyApp();
@@ -1277,7 +1333,8 @@
       }
 
       // Send later in case DOM layout isn't final yet.
-      setTimeout(sendPlotSize, 0);
+      setTimeout(sendImageSize, 0);
+      setTimeout(sendOutputHiddenState, 0);
     }
 
     function unbindOutputs(scope) {
@@ -1302,12 +1359,14 @@
         return $(el).val();
     }
 
-    var inputs = new InputNoResendDecorator(new InputBatchSender(shinyapp));
-    var inputsRate = new InputRateDecorator(inputs);
-    var inputsDefer = new InputDeferDecorator(inputs);
+    var inputsNoResend = new InputNoResendDecorator(new InputBatchSender(shinyapp));
+    var inputsRate = new InputRateDecorator(inputsNoResend);
+    var inputsDefer = new InputDeferDecorator(inputsNoResend);
 
+    // By default, use rate decorator
     inputs = inputsRate;
     $('input[type="submit"], button[type="submit"]').each(function() {
+      // If there is a submit button on the page, use defer decorator
       inputs = inputsDefer;
       $(this).click(function(event) {
         event.preventDefault();
@@ -1372,7 +1431,7 @@
           var ratePolicy = binding.getRatePolicy();
           if (ratePolicy != null) {
             inputsRate.setRatePolicy(
-              id,
+              effectiveId,
               ratePolicy.policy,
               ratePolicy.delay);
           }
@@ -1487,28 +1546,85 @@
     var initialValues = _bindAll(document);
 
 
-    // The server needs to know the size of each plot output element, in case
-    // the plot is auto-sizing
-    $('.shiny-plot-output').each(function() {
-      var width = this.offsetWidth;
-      var height = this.offsetHeight;
-      initialValues['.shinyout_' + this.id + '_width'] = width;
-      initialValues['.shinyout_' + this.id + '_height'] = height;
+    // The server needs to know the size of each image and plot output element,
+    // in case it is auto-sizing
+    $('.shiny-image-output, .shiny-plot-output').each(function() {
+      if (this.offsetWidth !== 0 || this.offsetHeight !== 0) {
+        initialValues['.clientdata_output_' + this.id + '_width'] = this.offsetWidth;
+        initialValues['.clientdata_output_' + this.id + '_height'] = this.offsetHeight;
+      }
     });
-    function sendPlotSize() {
-      $('.shiny-plot-output').each(function() {
-        inputs.setInput('.shinyout_' + this.id + '_width', this.offsetWidth);
-        inputs.setInput('.shinyout_' + this.id + '_height', this.offsetHeight);
+    function sendImageSize() {
+      $('.shiny-image-output, .shiny-plot-output').each(function() {
+        if (this.offsetWidth !== 0 || this.offsetHeight !== 0) {
+          inputs.setInput('.clientdata_output_' + this.id + '_width', this.offsetWidth);
+          inputs.setInput('.clientdata_output_' + this.id + '_height', this.offsetHeight);
+        }
       });
     }
-    // The size of each plot may change either because the browser window was
+
+    // Return true if the object or one of its ancestors in the DOM tree has
+    // style='display:none'; otherwise return false.
+    function isHidden(obj) {
+      // null means we've hit the top of the tree. If width or height is
+      // non-zero, then we know that no ancestor has display:none.
+      if (obj === null || obj.offsetWidth !== 0 || obj.offsetHeight !== 0) {
+        return false;
+      } else if (getComputedStyle(obj, null).display === 'none') {
+        return true;
+      } else {
+        return(isHidden(obj.parentNode));
+      }
+    }
+    // Set initial state of outputs to hidden, if needed
+    $('.shiny-bound-output').each(function() {
+      if (isHidden(this)) {
+        initialValues['.clientdata_output_' + this.id + '_hidden'] = true;
+      } else {
+        initialValues['.clientdata_output_' + this.id + '_hidden'] = false;
+      }
+    });
+    // Send update when hidden state changes
+    function sendOutputHiddenState() {
+      $('.shiny-bound-output').each(function() {
+        // Assume that the object is hidden when width and height are 0
+        if (isHidden(this)) {
+          inputs.setInput('.clientdata_output_' + this.id + '_hidden', true);
+        } else {
+          inputs.setInput('.clientdata_output_' + this.id + '_hidden', false);
+        }
+      });
+    }
+
+    // The size of each image may change either because the browser window was
     // resized, or because a tab was shown/hidden (hidden elements report size
     // of 0x0). It's OK to over-report sizes because the input pipeline will
     // filter out values that haven't changed.
-    $(window).resize(debounce(500, sendPlotSize));
-    $('body').on('shown.sendPlotSize hidden.sendPlotSize', '*', sendPlotSize);
+    $(window).resize(debounce(500, sendImageSize));
+    $('body').on('shown.sendImageSize', '*', sendImageSize);
+    $('body').on('shown.sendOutputHiddenState hidden.sendOutputHiddenState', '*',
+                 sendOutputHiddenState);
+
+    // Send initial pixel ratio, and update it if it changes
+    initialValues['.clientdata_pixelratio'] = pixelRatio();
+    $(window).resize(function() {
+      inputs.setInput('.clientdata_pixelratio', pixelRatio());
+    });
+
+    // Send initial URL
+    initialValues['.clientdata_url_protocol'] = window.location.protocol;
+    initialValues['.clientdata_url_hostname'] = window.location.hostname;
+    initialValues['.clientdata_url_port']     = window.location.port;
+    initialValues['.clientdata_url_pathname'] = window.location.pathname;
+    initialValues['.clientdata_url_search']   = window.location.search;
+    // This is only the initial value of the hash. The hash can change, but
+    // a reactive version of this isn't sent because w atching for changes can
+    // require polling on some browsers. The JQuery hashchange plugin can be
+    // used if this capability is important.
+    initialValues['.clientdata_url_hash_initial'] = window.location.hash;
 
     // We've collected all the initial values--start the server process!
+    inputsNoResend.reset(initialValues);
     shinyapp.connect(initialValues);
   } // function initShiny()
 

man/exprToFunction.Rd

@@ -0,0 +1,63 @@
+\name{exprToFunction}
+\alias{exprToFunction}
+\title{Convert an expression or quoted expression to a function}
+\usage{
+  exprToFunction(expr, env = parent.frame(2),
+    quoted = FALSE)
+}
+\arguments{
+  \item{expr}{A quoted or unquoted expression, or a
+  function.}
+
+  \item{env}{The desired environment for the function.
+  Defaults to the calling environment two steps back.}
+
+  \item{quoted}{Is the expression quoted?}
+}
+\description{
+  This is to be called from another function, because it
+  will attempt to get an unquoted expression from two calls
+  back.
+}
+\details{
+  If expr is a quoted expression, then this just converts
+  it to a function. If expr is a function, then this simply
+  returns expr (and prints a deprecation message. If expr
+  was a non-quoted expression from two calls back, then
+  this will quote the original expression and convert it to
+  a function.
+}
+\examples{
+# Example of a new renderer, similar to renderText
+# This is something that toolkit authors will do
+renderTriple <- function(expr, env=parent.frame(), quoted=FALSE) {
+  # Convert expr to a function
+  func <- shiny::exprToFunction(expr, env, quoted)
+
+  function() {
+    value <- func()
+    paste(rep(value, 3), collapse=", ")
+  }
+}
+
+
+# Example of using the renderer.
+# This is something that app authors will do.
+values <- reactiveValues(A="text")
+
+\dontrun{
+# Create an output object
+output$tripleA <- renderTriple({
+  values$A
+})
+}
+
+# At the R console, you can experiment with the renderer using isolate()
+tripleA <- renderTriple({
+  values$A
+})
+
+isolate(tripleA())
+# "text, text, text"
+}
+

man/fileInput.Rd

@@ -20,8 +20,23 @@
 }
 \description{
   Create a file upload control that can be used to upload
-  one or more files. \bold{Experimental feature. Only works
-  in some browsers (primarily tested on Chrome and
-  Firefox).}
+  one or more files. \bold{Does not work on older browsers,
+  including Internet Explorer 9 and earlier.}
+}
+\details{
+  Whenever a file upload completes, the corresponding input
+  variable is set to a dataframe. This dataframe contains
+  one row for each selected file, and the following
+  columns: \describe{ \item{\code{name}}{The filename
+  provided by the web browser. This is \strong{not} the
+  path to read to get at the actual data that was uploaded
+  (see \code{datapath} column).} \item{\code{size}}{The
+  size of the uploaded data, in bytes.}
+  \item{\code{type}}{The MIME type reported by the browser
+  (for example, \code{text/plain}), or empty string if the
+  browser didn't know.} \item{\code{datapath}}{The path to
+  a temp file that contains the data that was uploaded.
+  This file may be deleted if the user performs another
+  upload operation.} }
 }
 

man/htmlOutput.Rd

@@ -21,8 +21,8 @@
 }
 \details{
   \code{uiOutput} is intended to be used with
-  \code{reactiveUI} on the server side. It is currently
-  just an alias for \code{htmlOutput}.
+  \code{renderUI} on the server side. It is currently just
+  an alias for \code{htmlOutput}.
 }
 \examples{
 htmlOutput("summary")

man/imageOutput.Rd

@@ -0,0 +1,29 @@
+\name{imageOutput}
+\alias{imageOutput}
+\title{Create a image output element}
+\usage{
+  imageOutput(outputId, width = "100\%", height = "400px")
+}
+\arguments{
+  \item{outputId}{output variable to read the image from}
+
+  \item{width}{Image width. Must be a valid CSS unit (like
+  \code{"100\%"}, \code{"400px"}, \code{"auto"}) or a
+  number, which will be coerced to a string and have
+  \code{"px"} appended.}
+
+  \item{height}{Image height}
+}
+\value{
+  An image output element that can be included in a panel
+}
+\description{
+  Render a \link{renderImage} within an application page.
+}
+\examples{
+# Show an image
+mainPanel(
+  imageOutput("dataImage")
+)
+}
+

man/isolate.Rd

@@ -6,11 +6,11 @@
 }
 \arguments{
   \item{expr}{An expression that can access reactive values
-  or functions.}
+  or expressions.}
 }
 \description{
   Executes the given expression in a scope where reactive
-  values or functions can be read, but they cannot cause
+  values or expression can be read, but they cannot cause
   the reactive scope of the caller to be re-evaluated when
   they change.
 }
@@ -19,14 +19,26 @@
   causes a relationship to be established between the
   caller and the reactive value, where a change to the
   reactive value will cause the caller to re-execute. (The
-  same applies for the act of getting a reactive function's
-  value.) The \code{isolate} function lets you read a
-  reactive value or function without establishing this
-  relationship.
+  same applies for the act of getting a reactive
+  expression's value.) The \code{isolate} function lets you
+  read a reactive value or expression without establishing
+  this relationship.
+
+  The expression given to \code{isolate()} is evaluated in
+  the calling environment. This means that if you assign a
+  variable inside the \code{isolate()}, its value will be
+  visible outside of the \code{isolate()}. If you want to
+  avoid this, you can use \code{\link{local}()} inside the
+  \code{isolate()}.
+
+  This function can also be useful for calling reactive
+  expression at the console, which can be useful for
+  debugging. To do so, simply wrap the calls to the
+  reactive expression with \code{isolate()}.
 }
 \examples{
 \dontrun{
-observer(function() {
+observe({
   input$saveButton  # Do take a dependency on input$saveButton
 
   # isolate a simple expression
@@ -34,7 +46,7 @@ observer(function() {
   writeToDatabase(data)
 })
 
-observer(function() {
+observe({
   input$saveButton  # Do take a dependency on input$saveButton
 
   # isolate a whole block
@@ -45,6 +57,28 @@ observer(function() {
   })
   writeToDatabase(data)
 })
-}
+
+observe({
+  x <- 1
+  # x outside of isolate() is affected
+  isolate(x <- 2)
+  print(x) # 2
+
+  y <- 1
+  # Use local() to avoid affecting calling environment
+  isolate(local(y <- 2))
+  print(y) # 1
+})
+
+}
+
+# Can also use isolate to call reactive expressions from the R console
+values <- reactiveValues(A=1)
+fun <- reactive({ as.character(values$A) })
+isolate(fun())
+# "1"
+
+# isolate also works if the reactive expression accesses values from the
+# input object, like input$x
 }
 

man/observe.Rd

@@ -2,32 +2,67 @@
 \alias{observe}
 \title{Create a reactive observer}
 \usage{
-  observe(func)
+  observe(x, env = parent.frame(), quoted = FALSE,
+    label = NULL, suspended = FALSE)
 }
 \arguments{
-  \item{func}{The function to observe. It must not have any
-  parameters. Any return value from this function will be
-  ignored.}
+  \item{x}{An expression (quoted or unquoted). Any return
+  value will be ignored.}
+
+  \item{env}{The parent environment for the reactive
+  expression. By default, this is the calling environment,
+  the same as when defining an ordinary non-reactive
+  expression.}
+
+  \item{quoted}{Is the expression quoted? By default, this
+  is \code{FALSE}.  This is useful when you want to use an
+  expression that is stored in a variable; to do so, it
+  must be quoted with `quote()`.}
+
+  \item{label}{A label for the observer, useful for
+  debugging.}
+
+  \item{suspended}{If \code{TRUE}, start the observer in a
+  suspended state.  If \code{FALSE} (the default), start in
+  a non-suspended state.}
 }
 \description{
-  Creates an observer from the given function. An observer
-  is like a reactive function in that it can read reactive
-  values and call reactive functions, and will
+  Creates an observer from the given expression An observer
+  is like a reactive expression in that it can read
+  reactive values and call reactive expressions, and will
   automatically re-execute when those dependencies change.
-  But unlike reactive functions, it doesn't yield a result
+  But unlike reactive expression, it doesn't yield a result
   and can't be used as an input to other reactive
-  functions. Thus, observers are only useful for their side
-  effects (for example, performing I/O).
+  expressions. Thus, observers are only useful for their
+  side effects (for example, performing I/O).
 }
 \details{
-  Another contrast between reactive functions and observers
-  is their execution strategy. Reactive functions use lazy
-  evaluation; that is, when their dependencies change, they
-  don't re-execute right away but rather wait until they
-  are called by someone else. Indeed, if they are not
-  called then they will never re-execute. In contrast,
-  observers use eager evaluation; as soon as their
-  dependencies change, they schedule themselves to
-  re-execute.
+  Another contrast between reactive expressions and
+  observers is their execution strategy. Reactive
+  expressions use lazy evaluation; that is, when their
+  dependencies change, they don't re-execute right away but
+  rather wait until they are called by someone else.
+  Indeed, if they are not called then they will never
+  re-execute. In contrast, observers use eager evaluation;
+  as soon as their dependencies change, they schedule
+  themselves to re-execute.
+}
+\examples{
+values <- reactiveValues(A=1)
+
+obsB <- observe({
+  print(values$A + 1)
+})
+
+# Can use quoted expressions
+obsC <- observe(quote({ print(values$A + 2) }), quoted = TRUE)
+
+# To store expressions for later conversion to observe, use quote()
+expr_q <- quote({ print(values$A + 3) })
+obsD <- observe(expr_q, quoted = TRUE)
+
+# In a normal Shiny app, the web client will trigger flush events. If you
+# are at the console, you can force a flush with flushReact()
+shiny:::flushReact()
 }
 

man/outputOptions.Rd

@@ -0,0 +1,36 @@
+\name{outputOptions}
+\alias{outputOptions}
+\title{Set options for an output object.}
+\usage{
+  outputOptions(x, name, ...)
+}
+\arguments{
+  \item{x}{A shinyoutput object (typically \code{output}).}
+
+  \item{name}{The name of an output observer in the
+  shinyoutput object.}
+
+  \item{...}{Options to set for the output observer.}
+}
+\description{
+  These are the available options for an output object:
+  \itemize{ \item suspendWhenHidden. When \code{TRUE} (the
+  default), the output object will be suspended (not
+  execute) when it is hidden on the web page. When
+  \code{FALSE}, the output object will not suspend when
+  hidden, and if it was already hidden and suspended, then
+  it will resume immediately. }
+}
+\examples{
+\dontrun{
+# Get the list of options for all observers within output
+outputOptions(output)
+
+# Disable suspend for output$myplot
+outputOptions(output, "myplot", suspendWhenHidden = FALSE)
+
+# Get the list of options for output$myplot
+outputOptions(output, "myplot")
+}
+}
+

man/parseQueryString.Rd

@@ -0,0 +1,38 @@
+\name{parseQueryString}
+\alias{parseQueryString}
+\title{Parse a GET query string from a URL}
+\usage{
+  parseQueryString(str)
+}
+\arguments{
+  \item{str}{The query string. It can have a leading
+  \code{"?"} or not.}
+}
+\description{
+  Returns a named character vector of key-value pairs.
+}
+\examples{
+parseQueryString("?foo=1&bar=b\%20a\%20r")
+
+\dontrun{
+# Example of usage within a Shiny app
+shinyServer(function(input, output, clientData) {
+
+  output$queryText <- renderText({
+    query <- parseQueryString(clientData$url_search)
+
+    # Ways of accessing the values
+    if (as.numeric(query$foo) == 1) {
+      # Do something
+    }
+    if (query[["bar"]] == "targetstring") {
+      # Do something else
+    }
+
+    # Return a string with key-value pairs
+    paste(names(query), query, sep = "=", collapse=", ")
+  })
+})
+}
+}
+

man/plotOutput.Rd

@@ -1,6 +1,6 @@
 \name{plotOutput}
 \alias{plotOutput}
-\title{Create a plot output element}
+\title{Create an plot output element}
 \usage{
   plotOutput(outputId, width = "100\%", height = "400px")
 }
@@ -18,7 +18,7 @@
   A plot output element that can be included in a panel
 }
 \description{
-  Render a \link{reactivePlot} within an application page.
+  Render a \link{renderPlot} within an application page.
 }
 \examples{
 # Show a plot of the generated distribution

man/plotPNG.Rd

@@ -0,0 +1,43 @@
+\name{plotPNG}
+\alias{plotPNG}
+\title{Run a plotting function and save the output as a PNG}
+\usage{
+  plotPNG(func, filename = tempfile(fileext = ".png"),
+    width = 400, height = 400, res = 72, ...)
+}
+\arguments{
+  \item{func}{A function that generates a plot.}
+
+  \item{filename}{The name of the output file. Defaults to
+  a temp file with extension \code{.png}.}
+
+  \item{width}{Width in pixels.}
+
+  \item{height}{Height in pixels.}
+
+  \item{res}{Resolution in pixels per inch. This value is
+  passed to \code{\link{png}}. Note that this affects the
+  resolution of PNG rendering in R; it won't change the
+  actual ppi of the browser.}
+
+  \item{...}{Arguments to be passed through to
+  \code{\link[grDevices]{png}}.  These can be used to set
+  the width, height, background color, etc.}
+}
+\description{
+  This function returns the name of the PNG file that it
+  generates. In essence, it calls \code{png()}, then
+  \code{func()}, then \code{dev.off()}. So \code{func} must
+  be a function that will generate a plot when used this
+  way.
+}
+\details{
+  For output, it will try to use the following devices, in
+  this order: quartz (via \code{\link[grDevices]{png}}),
+  then \code{\link[Cairo]{CairoPNG}}, and finally
+  \code{\link[grDevices]{png}}. This is in order of quality
+  of output. Notably, plain \code{png} output on Linux and
+  Windows may not antialias some point shapes, resulting in
+  poor quality output.
+}
+

man/reactive.Rd

@@ -1,35 +1,65 @@
 \name{reactive}
 \alias{reactive}
-\title{Create a Reactive Function}
+\title{Create a reactive expression}
 \usage{
-  reactive(x)
+  reactive(x, env = parent.frame(), quoted = FALSE,
+    label = NULL)
 }
 \arguments{
-  \item{x}{The value or function to make reactive. The
-  function must not have any parameters.}
-}
-\value{
-  A reactive function. (Note that reactive functions can
-  only be called from within other reactive functions.)
+  \item{x}{An expression (quoted or unquoted).}
+
+  \item{env}{The parent environment for the reactive
+  expression. By default, this is the calling environment,
+  the same as when defining an ordinary non-reactive
+  expression.}
+
+  \item{quoted}{Is the expression quoted? By default, this
+  is \code{FALSE}.  This is useful when you want to use an
+  expression that is stored in a variable; to do so, it
+  must be quoted with `quote()`.}
+
+  \item{label}{A label for the reactive expression, useful
+  for debugging.}
 }
 \description{
-  Wraps a normal function to create a reactive function.
-  Conceptually, a reactive function is a function whose
-  result will change over time.
+  Wraps a normal expression to create a reactive
+  expression. Conceptually, a reactive expression is a
+  expression whose result will change over time.
 }
 \details{
-  Reactive functions are functions that can read reactive
-  values and call other reactive functions. Whenever a
-  reactive value changes, any reactive functions that
-  depended on it are marked as "invalidated" and will
-  automatically re-execute if necessary. If a reactive
-  function is marked as invalidated, any other reactive
-  functions that recently called it are also marked as
-  invalidated. In this way, invalidations ripple through
-  the functions that depend on each other.
+  Reactive expressions are expressions that can read
+  reactive values and call other reactive expressions.
+  Whenever a reactive value changes, any reactive
+  expressions that depended on it are marked as
+  "invalidated" and will automatically re-execute if
+  necessary. If a reactive expression is marked as
+  invalidated, any other reactive expressions that recently
+  called it are also marked as invalidated. In this way,
+  invalidations ripple through the expressions that depend
+  on each other.
 
   See the
   \href{http://rstudio.github.com/shiny/tutorial/}{Shiny
-  tutorial} for more information about reactive functions.
+  tutorial} for more information about reactive
+  expressions.
+}
+\examples{
+values <- reactiveValues(A=1)
+
+reactiveB <- reactive({
+  values$A + 1
+})
+
+# Can use quoted expressions
+reactiveC <- reactive(quote({ values$A + 2 }), quoted = TRUE)
+
+# To store expressions for later conversion to reactive, use quote()
+expr_q <- quote({ values$A + 3 })
+reactiveD <- reactive(expr_q, quoted = TRUE)
+
+# View the values from the R console with isolate()
+isolate(reactiveB())
+isolate(reactiveC())
+isolate(reactiveD())
 }
 

man/reactivePlot.Rd

@@ -1,45 +1,19 @@
 \name{reactivePlot}
 \alias{reactivePlot}
-\title{Plot Output}
+\title{Plot output (deprecated)}
 \usage{
   reactivePlot(func, width = "auto", height = "auto", ...)
 }
 \arguments{
-  \item{func}{A function that generates a plot.}
+  \item{func}{A function.}
 
-  \item{width}{The width of the rendered plot, in pixels;
-  or \code{'auto'} to use the \code{offsetWidth} of the
-  HTML element that is bound to this plot.  You can also
-  pass in a function that returns the width in pixels or
-  \code{'auto'}; in the body of the function you may
-  reference reactive values and functions.}
+  \item{width}{Width.}
 
-  \item{height}{The height of the rendered plot, in pixels;
-  or \code{'auto'} to use the \code{offsetHeight} of the
-  HTML element that is bound to this plot.  You can also
-  pass in a function that returns the width in pixels or
-  \code{'auto'}; in the body of the function you may
-  reference reactive values and functions.}
+  \item{height}{Height.}
 
-  \item{...}{Arguments to be passed through to
-  \code{\link[grDevices]{png}}.  These can be used to set
-  the width, height, background color, etc.}
+  \item{...}{Other arguments to pass on.}
 }
 \description{
-  Creates a reactive plot that is suitable for assigning to
-  an \code{output} slot.
-}
-\details{
-  The corresponding HTML output tag should be \code{div} or
-  \code{img} and have the CSS class name
-  \code{shiny-plot-output}.
-
-  For output, it will try to use the following devices, in
-  this order: quartz (via \code{\link[grDevices]{png}}),
-  then \code{\link[Cairo]{CairoPNG}}, and finally
-  \code{\link[grDevices]{png}}. This is in order of quality
-  of output. Notably, plain \code{png} output on Linux and
-  Windows may not antialias some point shapes, resulting in
-  poor quality output.
+  See \code{\link{renderPlot}}.
 }
 

man/reactivePrint.Rd

@@ -1,101 +1,13 @@
 \name{reactivePrint}
 \alias{reactivePrint}
-\title{Printable Output}
+\title{Print output (deprecated)}
 \usage{
   reactivePrint(func)
 }
 \arguments{
-  \item{func}{A function that may print output and/or
-  return a printable R object.}
+  \item{func}{A function.}
 }
 \description{
-  Makes a reactive version of the given function that
-  captures any printed output, and also captures its
-  printable result (unless \code{\link{invisible}}), into a
-  string. The resulting function is suitable for assigning
-  to an \code{output} slot.
-}
-\details{
-  The corresponding HTML output tag can be anything (though
-  \code{pre} is recommended if you need a monospace font
-  and whitespace preserved) and should have the CSS class
-  name \code{shiny-text-output}.
-
-  The result of executing \code{func} will be printed
-  inside a \code{\link[utils]{capture.output}} call.
-
-  Note that unlike most other Shiny output functions, if
-  the given function returns \code{NULL} then \code{NULL}
-  will actually be visible in the output. To display
-  nothing, make your function return
-  \code{\link{invisible}()}.
-}
-\examples{
-isolate({
-
-# reactivePrint captures any print output, converts it to a string, and
-# returns it
-visFun <- reactivePrint(function() "foo")
-visFun()
-# '[1] "foo"'
-
-invisFun <- reactivePrint(function() invisible("foo"))
-invisFun()
-# ''
-
-multiprintFun <- reactivePrint(function() {
-  print("foo");
-  "bar"
-})
-multiprintFun()
-# '[1] "foo"\\n[1] "bar"'
-
-nullFun <- reactivePrint(function() NULL)
-nullFun()
-# 'NULL'
-
-invisNullFun <- reactivePrint(function() invisible(NULL))
-invisNullFun()
-# ''
-
-vecFun <- reactivePrint(function() 1:5)
-vecFun()
-# '[1] 1 2 3 4 5'
-
-
-# Contrast with reactiveText, which takes the value returned from the function
-# and uses cat() to convert it to a string
-visFun <- reactiveText(function() "foo")
-visFun()
-# 'foo'
-
-invisFun <- reactiveText(function() invisible("foo"))
-invisFun()
-# 'foo'
-
-multiprintFun <- reactiveText(function() {
-  print("foo");
-  "bar"
-})
-multiprintFun()
-# 'bar'
-
-nullFun <- reactiveText(function() NULL)
-nullFun()
-# ''
-
-invisNullFun <- reactiveText(function() invisible(NULL))
-invisNullFun()
-# ''
-
-vecFun <- reactiveText(function() 1:5)
-vecFun()
-# '1 2 3 4 5'
-
-})
-}
-\seealso{
-  \code{\link{reactiveText}} for displaying the value
-  returned from a function, instead of the printed output.
+  See \code{\link{renderPrint}}.
 }
 

man/reactiveTable.Rd

@@ -1,23 +1,15 @@
 \name{reactiveTable}
 \alias{reactiveTable}
-\title{Table Output}
+\title{Table output (deprecated)}
 \usage{
   reactiveTable(func, ...)
 }
 \arguments{
-  \item{func}{A function that returns an R object that can
-  be used with \code{\link[xtable]{xtable}}.}
+  \item{func}{A function.}
 
-  \item{...}{Arguments to be passed through to
-  \code{\link[xtable]{xtable}} and
-  \code{\link[xtable]{print.xtable}}.}
+  \item{...}{Other arguments to pass on.}
 }
 \description{
-  Creates a reactive table that is suitable for assigning
-  to an \code{output} slot.
-}
-\details{
-  The corresponding HTML output tag should be \code{div}
-  and have the CSS class name \code{shiny-html-output}.
+  See \code{\link{renderTable}}.
 }
 

man/reactiveText.Rd

@@ -1,95 +1,13 @@
 \name{reactiveText}
 \alias{reactiveText}
-\title{Text Output}
+\title{Text output (deprecated)}
 \usage{
   reactiveText(func)
 }
 \arguments{
-  \item{func}{A function that returns an R object that can
-  be used as an argument to \code{cat}.}
+  \item{func}{A function.}
 }
 \description{
-  Makes a reactive version of the given function that also
-  uses \code{\link[base]{cat}} to turn its result into a
-  single-element character vector.
-}
-\details{
-  The corresponding HTML output tag can be anything (though
-  \code{pre} is recommended if you need a monospace font
-  and whitespace preserved) and should have the CSS class
-  name \code{shiny-text-output}.
-
-  The result of executing \code{func} will passed to
-  \code{cat}, inside a \code{\link[utils]{capture.output}}
-  call.
-}
-\examples{
-isolate({
-
-# reactivePrint captures any print output, converts it to a string, and
-# returns it
-visFun <- reactivePrint(function() "foo")
-visFun()
-# '[1] "foo"'
-
-invisFun <- reactivePrint(function() invisible("foo"))
-invisFun()
-# ''
-
-multiprintFun <- reactivePrint(function() {
-  print("foo");
-  "bar"
-})
-multiprintFun()
-# '[1] "foo"\\n[1] "bar"'
-
-nullFun <- reactivePrint(function() NULL)
-nullFun()
-# 'NULL'
-
-invisNullFun <- reactivePrint(function() invisible(NULL))
-invisNullFun()
-# ''
-
-vecFun <- reactivePrint(function() 1:5)
-vecFun()
-# '[1] 1 2 3 4 5'
-
-
-# Contrast with reactiveText, which takes the value returned from the function
-# and uses cat() to convert it to a string
-visFun <- reactiveText(function() "foo")
-visFun()
-# 'foo'
-
-invisFun <- reactiveText(function() invisible("foo"))
-invisFun()
-# 'foo'
-
-multiprintFun <- reactiveText(function() {
-  print("foo");
-  "bar"
-})
-multiprintFun()
-# 'bar'
-
-nullFun <- reactiveText(function() NULL)
-nullFun()
-# ''
-
-invisNullFun <- reactiveText(function() invisible(NULL))
-invisNullFun()
-# ''
-
-vecFun <- reactiveText(function() 1:5)
-vecFun()
-# '1 2 3 4 5'
-
-})
-}
-\seealso{
-  \code{\link{reactivePrint}} for capturing the print
-  output of a function, rather than the returned text
-  value.
+  See \code{\link{renderText}}.
 }
 

man/reactiveTimer.Rd

@@ -21,7 +21,7 @@
   timers are triggered simply by the passage of time.
 }
 \details{
-  \link[=reactive]{Reactive functions} and observers that
+  \link[=reactive]{Reactive expressions} and observers that
   want to be invalidated by the timer need to call the
   timer function that \code{reactiveTimer} returns, even if
   the current time value is not actually needed.

man/reactiveUI.Rd

@@ -1,33 +1,13 @@
 \name{reactiveUI}
 \alias{reactiveUI}
-\title{UI Output}
+\title{UI output (deprecated)}
 \usage{
   reactiveUI(func)
 }
 \arguments{
-  \item{func}{A function that returns a Shiny tag object,
-  \code{\link{HTML}}, or a list of such objects.}
+  \item{func}{A function.}
 }
 \description{
-  \bold{Experimental feature.} Makes a reactive version of
-  a function that generates HTML using the Shiny UI
-  library.
-}
-\details{
-  The corresponding HTML output tag should be \code{div}
-  and have the CSS class name \code{shiny-html-output} (or
-  use \code{\link{uiOutput}}).
-}
-\examples{
-\dontrun{
-  output$moreControls <- reactiveUI(function() {
-    list(
-
-    )
-  })
-}
-}
-\seealso{
-  conditionalPanel
+  See \code{\link{renderUI}}.
 }
 

man/reactiveValues.Rd

@@ -13,7 +13,7 @@
   This function returns an object for storing reactive
   values. It is similar to a list, but with special
   capabilities for reactive programming. When you read a
-  value from it, the calling reactive function takes a
+  value from it, the calling reactive expression takes a
   reactive dependency on that value, and when you write to
   it, it notifies any reactive functions that depend on
   that value.

man/renderImage.Rd

@@ -0,0 +1,102 @@
+\name{renderImage}
+\alias{renderImage}
+\title{Image file output}
+\usage{
+  renderImage(expr, env = parent.frame(), quoted = FALSE,
+    deleteFile = TRUE)
+}
+\arguments{
+  \item{expr}{An expression that returns a list.}
+
+  \item{env}{The environment in which to evaluate
+  \code{expr}.}
+
+  \item{quoted}{Is \code{expr} a quoted expression (with
+  \code{quote()})? This is useful if you want to save an
+  expression in a variable.}
+
+  \item{deleteFile}{Should the file in \code{func()$src} be
+  deleted after it is sent to the client browser? Genrrally
+  speaking, if the image is a temp file generated within
+  \code{func}, then this should be \code{TRUE}; if the
+  image is not a temp file, this should be \code{FALSE}.}
+}
+\description{
+  Renders a reactive image that is suitable for assigning
+  to an \code{output} slot.
+}
+\details{
+  The expression \code{expr} must return a list containing
+  the attributes for the \code{img} object on the client
+  web page. For the image to display, properly, the list
+  must have at least one entry, \code{src}, which is the
+  path to the image file. It may also useful to have a
+  \code{contentType} entry specifying the MIME type of the
+  image. If one is not provided, \code{renderImage} will
+  try to autodetect the type, based on the file extension.
+
+  Other elements such as \code{width}, \code{height},
+  \code{class}, and \code{alt}, can also be added to the
+  list, and they will be used as attributes in the
+  \code{img} object.
+
+  The corresponding HTML output tag should be \code{div} or
+  \code{img} and have the CSS class name
+  \code{shiny-image-output}.
+}
+\examples{
+\dontrun{
+
+shinyServer(function(input, output, clientData) {
+
+  # A plot of fixed size
+  output$plot1 <- renderImage({
+    # A temp file to save the output. It will be deleted after renderImage
+    # sends it, because deleteFile=TRUE.
+    outfile <- tempfile(fileext='.png')
+
+    # Generate a png
+    png(outfile, width=400, height=400)
+    hist(rnorm(input$n))
+    dev.off()
+
+    # Return a list
+    list(src = outfile,
+         alt = "This is alternate text")
+  }, deleteFile = TRUE)
+
+  # A dynamically-sized plot
+  output$plot2 <- renderImage({
+    # Read plot2's width and height. These are reactive values, so this
+    # expression will re-run whenever these values change.
+    width  <- clientData$output_plot2_width
+    height <- clientData$output_plot2_height
+
+    # A temp file to save the output.
+    outfile <- tempfile(fileext='.png')
+
+    png(outfile, width=width, height=height)
+    hist(rnorm(input$obs))
+    dev.off()
+
+    # Return a list containing the filename
+    list(src = outfile,
+         width = width,
+         height = height,
+         alt = "This is alternate text")
+  }, deleteFile = TRUE)
+
+  # Send a pre-rendered image, and don't delete the image after sending it
+  output$plot3 <- renderImage({
+    # When input$n is 1, filename is ./images/image1.jpeg
+    filename <- normalizePath(file.path('./images',
+                              paste('image', input$n, '.jpeg', sep='')))
+
+    # Return a list containing the filename
+    list(src = filename)
+  }, deleteFile = FALSE)
+})
+
+}
+}
+

man/renderPlot.Rd

@@ -0,0 +1,54 @@
+\name{renderPlot}
+\alias{renderPlot}
+\title{Plot Output}
+\usage{
+  renderPlot(expr, width = "auto", height = "auto",
+    res = 72, ..., env = parent.frame(), quoted = FALSE,
+    func = NULL)
+}
+\arguments{
+  \item{expr}{An expression that generates a plot.}
+
+  \item{width}{The width of the rendered plot, in pixels;
+  or \code{'auto'} to use the \code{offsetWidth} of the
+  HTML element that is bound to this plot.  You can also
+  pass in a function that returns the width in pixels or
+  \code{'auto'}; in the body of the function you may
+  reference reactive values and functions.}
+
+  \item{height}{The height of the rendered plot, in pixels;
+  or \code{'auto'} to use the \code{offsetHeight} of the
+  HTML element that is bound to this plot.  You can also
+  pass in a function that returns the width in pixels or
+  \code{'auto'}; in the body of the function you may
+  reference reactive values and functions.}
+
+  \item{res}{Resolution of resulting plot, in pixels per
+  inch. This value is passed to \code{\link{png}}. Note
+  that this affects the resolution of PNG rendering in R;
+  it won't change the actual ppi of the browser.}
+
+  \item{...}{Arguments to be passed through to
+  \code{\link[grDevices]{png}}.  These can be used to set
+  the width, height, background color, etc.}
+
+  \item{env}{The environment in which to evaluate
+  \code{expr}.}
+
+  \item{quoted}{Is \code{expr} a quoted expression (with
+  \code{quote()})? This is useful if you want to save an
+  expression in a variable.}
+
+  \item{func}{A function that generates a plot (deprecated;
+  use \code{expr} instead).}
+}
+\description{
+  Renders a reactive plot that is suitable for assigning to
+  an \code{output} slot.
+}
+\details{
+  The corresponding HTML output tag should be \code{div} or
+  \code{img} and have the CSS class name
+  \code{shiny-plot-output}.
+}
+

man/renderPrint.Rd

@@ -0,0 +1,112 @@
+\name{renderPrint}
+\alias{renderPrint}
+\title{Printable Output}
+\usage{
+  renderPrint(expr, env = parent.frame(), quoted = FALSE,
+    func = NULL)
+}
+\arguments{
+  \item{expr}{An expression that may print output and/or
+  return a printable R object.}
+
+  \item{env}{The environment in which to evaluate
+  \code{expr}.}
+
+  \item{quoted}{Is \code{expr} a quoted expression (with
+  \code{quote()})? This}
+
+  \item{func}{A function that may print output and/or
+  return a printable R object (deprecated; use \code{expr}
+  instead).}
+}
+\description{
+  Makes a reactive version of the given function that
+  captures any printed output, and also captures its
+  printable result (unless \code{\link{invisible}}), into a
+  string. The resulting function is suitable for assigning
+  to an \code{output} slot.
+}
+\details{
+  The corresponding HTML output tag can be anything (though
+  \code{pre} is recommended if you need a monospace font
+  and whitespace preserved) and should have the CSS class
+  name \code{shiny-text-output}.
+
+  The result of executing \code{func} will be printed
+  inside a \code{\link[utils]{capture.output}} call.
+
+  Note that unlike most other Shiny output functions, if
+  the given function returns \code{NULL} then \code{NULL}
+  will actually be visible in the output. To display
+  nothing, make your function return
+  \code{\link{invisible}()}.
+}
+\examples{
+isolate({
+
+# renderPrint captures any print output, converts it to a string, and
+# returns it
+visFun <- renderPrint({ "foo" })
+visFun()
+# '[1] "foo"'
+
+invisFun <- renderPrint({ invisible("foo") })
+invisFun()
+# ''
+
+multiprintFun <- renderPrint({
+  print("foo");
+  "bar"
+})
+multiprintFun()
+# '[1] "foo"\\n[1] "bar"'
+
+nullFun <- renderPrint({ NULL })
+nullFun()
+# 'NULL'
+
+invisNullFun <- renderPrint({ invisible(NULL) })
+invisNullFun()
+# ''
+
+vecFun <- renderPrint({ 1:5 })
+vecFun()
+# '[1] 1 2 3 4 5'
+
+
+# Contrast with renderText, which takes the value returned from the function
+# and uses cat() to convert it to a string
+visFun <- renderText({ "foo" })
+visFun()
+# 'foo'
+
+invisFun <- renderText({ invisible("foo") })
+invisFun()
+# 'foo'
+
+multiprintFun <- renderText({
+  print("foo");
+  "bar"
+})
+multiprintFun()
+# 'bar'
+
+nullFun <- renderText({ NULL })
+nullFun()
+# ''
+
+invisNullFun <- renderText({ invisible(NULL) })
+invisNullFun()
+# ''
+
+vecFun <- renderText({ 1:5 })
+vecFun()
+# '1 2 3 4 5'
+
+})
+}
+\seealso{
+  \code{\link{renderText}} for displaying the value
+  returned from a function, instead of the printed output.
+}
+

man/renderTable.Rd

@@ -0,0 +1,35 @@
+\name{renderTable}
+\alias{renderTable}
+\title{Table Output}
+\usage{
+  renderTable(expr, ..., env = parent.frame(),
+    quoted = FALSE, func = NULL)
+}
+\arguments{
+  \item{expr}{An expression that returns an R object that
+  can be used with \code{\link[xtable]{xtable}}.}
+
+  \item{...}{Arguments to be passed through to
+  \code{\link[xtable]{xtable}} and
+  \code{\link[xtable]{print.xtable}}.}
+
+  \item{env}{The environment in which to evaluate
+  \code{expr}.}
+
+  \item{quoted}{Is \code{expr} a quoted expression (with
+  \code{quote()})? This is useful if you want to save an
+  expression in a variable.}
+
+  \item{func}{A function that returns an R object that can
+  be used with \code{\link[xtable]{xtable}} (deprecated;
+  use \code{expr} instead).}
+}
+\description{
+  Creates a reactive table that is suitable for assigning
+  to an \code{output} slot.
+}
+\details{
+  The corresponding HTML output tag should be \code{div}
+  and have the CSS class name \code{shiny-html-output}.
+}
+

man/renderText.Rd

@@ -0,0 +1,106 @@
+\name{renderText}
+\alias{renderText}
+\title{Text Output}
+\usage{
+  renderText(expr, env = parent.frame(), quoted = FALSE,
+    func = NULL)
+}
+\arguments{
+  \item{expr}{An expression that returns an R object that
+  can be used as an argument to \code{cat}.}
+
+  \item{env}{The environment in which to evaluate
+  \code{expr}.}
+
+  \item{quoted}{Is \code{expr} a quoted expression (with
+  \code{quote()})? This is useful if you want to save an
+  expression in a variable.}
+
+  \item{func}{A function that returns an R object that can
+  be used as an argument to \code{cat}.(deprecated; use
+  \code{expr} instead).}
+}
+\description{
+  Makes a reactive version of the given function that also
+  uses \code{\link[base]{cat}} to turn its result into a
+  single-element character vector.
+}
+\details{
+  The corresponding HTML output tag can be anything (though
+  \code{pre} is recommended if you need a monospace font
+  and whitespace preserved) and should have the CSS class
+  name \code{shiny-text-output}.
+
+  The result of executing \code{func} will passed to
+  \code{cat}, inside a \code{\link[utils]{capture.output}}
+  call.
+}
+\examples{
+isolate({
+
+# renderPrint captures any print output, converts it to a string, and
+# returns it
+visFun <- renderPrint({ "foo" })
+visFun()
+# '[1] "foo"'
+
+invisFun <- renderPrint({ invisible("foo") })
+invisFun()
+# ''
+
+multiprintFun <- renderPrint({
+  print("foo");
+  "bar"
+})
+multiprintFun()
+# '[1] "foo"\\n[1] "bar"'
+
+nullFun <- renderPrint({ NULL })
+nullFun()
+# 'NULL'
+
+invisNullFun <- renderPrint({ invisible(NULL) })
+invisNullFun()
+# ''
+
+vecFun <- renderPrint({ 1:5 })
+vecFun()
+# '[1] 1 2 3 4 5'
+
+
+# Contrast with renderText, which takes the value returned from the function
+# and uses cat() to convert it to a string
+visFun <- renderText({ "foo" })
+visFun()
+# 'foo'
+
+invisFun <- renderText({ invisible("foo") })
+invisFun()
+# 'foo'
+
+multiprintFun <- renderText({
+  print("foo");
+  "bar"
+})
+multiprintFun()
+# 'bar'
+
+nullFun <- renderText({ NULL })
+nullFun()
+# ''
+
+invisNullFun <- renderText({ invisible(NULL) })
+invisNullFun()
+# ''
+
+vecFun <- renderText({ 1:5 })
+vecFun()
+# '1 2 3 4 5'
+
+})
+}
+\seealso{
+  \code{\link{renderPrint}} for capturing the print output
+  of a function, rather than the returned text value.
+}
+

man/renderUI.Rd

@@ -0,0 +1,45 @@
+\name{renderUI}
+\alias{renderUI}
+\title{UI Output}
+\usage{
+  renderUI(expr, env = parent.frame(), quoted = FALSE,
+    func = NULL)
+}
+\arguments{
+  \item{expr}{An expression that returns a Shiny tag
+  object, \code{\link{HTML}}, or a list of such objects.}
+
+  \item{env}{The environment in which to evaluate
+  \code{expr}.}
+
+  \item{quoted}{Is \code{expr} a quoted expression (with
+  \code{quote()})? This is useful if you want to save an
+  expression in a variable.}
+
+  \item{func}{A function that returns a Shiny tag object,
+  \code{\link{HTML}}, or a list of such objects
+  (deprecated; use \code{expr} instead).}
+}
+\description{
+  \bold{Experimental feature.} Makes a reactive version of
+  a function that generates HTML using the Shiny UI
+  library.
+}
+\details{
+  The corresponding HTML output tag should be \code{div}
+  and have the CSS class name \code{shiny-html-output} (or
+  use \code{\link{uiOutput}}).
+}
+\examples{
+\dontrun{
+  output$moreControls <- renderUI({
+    list(
+
+    )
+  })
+}
+}
+\seealso{
+  conditionalPanel
+}
+

man/runGist.Rd

@@ -7,10 +7,10 @@
 }
 \arguments{
   \item{gist}{The identifier of the gist. For example, if
-  the gist is https://gist.github.com/3239667, then
+  the gist is https://gist.github.com/jcheng5/3239667, then
   \code{3239667}, \code{'3239667'}, and
-  \code{'https://gist.github.com/3239667'} are all valid
-  values.}
+  \code{'https://gist.github.com/jcheng5/3239667'} are all
+  valid values.}
 
   \item{port}{The TCP port that the application should
   listen on. Defaults to port 8100.}
@@ -25,8 +25,11 @@
 }
 \examples{
 \dontrun{
-runGist(4034323)
-runGist("https://gist.github.com/4034323")
+runGist(3239667)
+runGist("https://gist.github.com/jcheng5/3239667")
+
+# Old URL format without username
+runGist("https://gist.github.com/3239667")
 }
 }
 

man/runUrl.Rd

@@ -27,7 +27,10 @@
 \description{
   Download and launch a Shiny application that is hosted at
   a downloadable URL. The Shiny application must be saved
-  in a .zip, .tar, or .tar.gz file.
+  in a .zip, .tar, or .tar.gz file. The Shiny application
+  files must be contained in a subdirectory in the archive.
+  For example, the files might be \code{myapp/server.r} and
+  \code{myapp/ui.r}.
 }
 \examples{
 \dontrun{

man/shinyDeprecated.Rd

@@ -0,0 +1,20 @@
+\name{shinyDeprecated}
+\alias{shinyDeprecated}
+\title{Print message for deprecated functions in Shiny}
+\usage{
+  shinyDeprecated(new = NULL, msg = NULL,
+    old = as.character(sys.call(sys.parent()))[1L])
+}
+\arguments{
+  \item{new}{Name of replacement function.}
+
+  \item{msg}{Message to print. If used, this will override
+  the default message.}
+
+  \item{old}{Name of deprecated function.}
+}
+\description{
+  To disable these messages, use
+  \code{options(shiny.deprecation.messages=FALSE)}.
+}
+

man/shinyServer.Rd

@@ -32,7 +32,7 @@
 # A very simple Shiny app that takes a message from the user
 # and outputs an uppercase version of it.
 shinyServer(function(input, output) {
-  output$uppercase <- reactiveText(function() {
+  output$uppercase <- renderText({
     toupper(input$message)
   })
 })

man/tableOutput.Rd

@@ -11,7 +11,7 @@
   A table output element that can be included in a panel
 }
 \description{
-  Render a \link{reactiveTable} within an application page.
+  Render a \link{renderTable} within an application page.
 }
 \examples{
 mainPanel(

man/textOutput.Rd

@@ -17,8 +17,7 @@
 }
 \details{
   Text is HTML-escaped prior to rendering. This element is
-  often used to dispaly \link{reactiveText} output
-  variables.
+  often used to display \link{renderText} output variables.
 }
 \examples{
 h3(textOutput("caption"))

man/verbatimTextOutput.Rd

@@ -18,7 +18,7 @@
 }
 \details{
   Text is HTML-escaped prior to rendering. This element is
-  often used with the \link{reactivePrint} function to
+  often used with the \link{renderPrint} function to
   preserve fixed-width formatting of printed objects.
 }
 \examples{

res/text-example.R

@@ -1,61 +1,61 @@
 isolate({
 
-# reactivePrint captures any print output, converts it to a string, and
+# renderPrint captures any print output, converts it to a string, and
 # returns it
-visFun <- reactivePrint(function() "foo")
+visFun <- renderPrint({ "foo" })
 visFun()
 # '[1] "foo"'
 
-invisFun <- reactivePrint(function() invisible("foo"))
+invisFun <- renderPrint({ invisible("foo") })
 invisFun()
 # ''
 
-multiprintFun <- reactivePrint(function() {
+multiprintFun <- renderPrint({
   print("foo");
   "bar"
 })
 multiprintFun()
 # '[1] "foo"\n[1] "bar"'
 
-nullFun <- reactivePrint(function() NULL)
+nullFun <- renderPrint({ NULL })
 nullFun()
 # 'NULL'
 
-invisNullFun <- reactivePrint(function() invisible(NULL))
+invisNullFun <- renderPrint({ invisible(NULL) })
 invisNullFun()
 # ''
 
-vecFun <- reactivePrint(function() 1:5)
+vecFun <- renderPrint({ 1:5 })
 vecFun()
 # '[1] 1 2 3 4 5'
 
 
-# Contrast with reactiveText, which takes the value returned from the function
+# Contrast with renderText, which takes the value returned from the function
 # and uses cat() to convert it to a string
-visFun <- reactiveText(function() "foo")
+visFun <- renderText({ "foo" })
 visFun()
 # 'foo'
 
-invisFun <- reactiveText(function() invisible("foo"))
+invisFun <- renderText({ invisible("foo") })
 invisFun()
 # 'foo'
 
-multiprintFun <- reactiveText(function() {
+multiprintFun <- renderText({
   print("foo");
   "bar"
 })
 multiprintFun()
 # 'bar'
 
-nullFun <- reactiveText(function() NULL)
+nullFun <- renderText({ NULL })
 nullFun()
 # ''
 
-invisNullFun <- reactiveText(function() invisible(NULL))
+invisNullFun <- renderText({ invisible(NULL) })
 invisNullFun()
 # ''
 
-vecFun <- reactiveText(function() 1:5)
+vecFun <- renderText({ 1:5 })
 vecFun()
 # '1 2 3 4 5'