Bump version to 0.4.0

Previously when getType() was defined for a type of object, shiny.js would
send updates immediately instead of applying the rate policy.

.Rbuildignore

@@ -7,3 +7,4 @@
 ^shiny\.cmd$
 ^run\.R$
 ^\.gitignore$
+^res$

DESCRIPTION

@@ -1,34 +1,41 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 0.1.7
-Date: 2012-10-24
+Version: 0.4.0
+Date: 2013-01-23
 Author: RStudio, Inc.
-Maintainer: Joe Cheng <joe@rstudio.org>
+Maintainer: Winston Chang <winston@rstudio.com>
 Description: Shiny makes it incredibly easy to build interactive web
     applications with R. Automatic "reactive" binding between inputs and
     outputs and extensive pre-built widgets make it possible to build
     beautiful, responsive, and powerful applications with minimal effort.
 License: GPL-3
 Depends:
-    R (>= 2.14.1), websockets (>= 1.1.5)
+    R (>= 2.14.1)
 Imports:
     stats,
     tools,
     utils,
     datasets,
     methods,
+    websockets (>= 1.1.6),
     caTools,
     RJSONIO,
     xtable,
     digest
-URL: https://github.com/rstudio/shiny, http://rstudio.github.com/shiny/tutorial
+Suggests:
+    markdown,
+    Cairo,
+    testthat
+URL: http://www.rstudio.com/shiny/
 BugReports: https://github.com/rstudio/shiny/issues
 Collate:
     'map.R'
-    'random.R'
+    'utils.R'
+    'tar.R'
     'timer.R'
     'tags.R'
+    'cache.R'
     'react.R'
     'reactives.R'
     'fileupload.R'
@@ -37,3 +44,4 @@ Collate:
     'shinyui.R'
     'slider.R'
     'bootstrap.R'
+    'run-url.R'

NAMESPACE

@@ -1,13 +1,40 @@
+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)
+S3method(as.character,shiny.tag)
+S3method(as.character,shiny.tag.list)
+S3method(as.list,reactivevalues)
+S3method(format,shiny.tag)
+S3method(format,shiny.tag.list)
+S3method(names,reactivevalues)
+S3method(print,shiny.tag)
+S3method(print,shiny.tag.list)
+export(HTML)
 export(a)
 export(addResourcePath)
 export(animationOptions)
+export(bootstrapPage)
 export(br)
 export(checkboxGroupInput)
 export(checkboxInput)
 export(code)
 export(conditionalPanel)
 export(div)
+export(downloadButton)
+export(downloadHandler)
+export(downloadLink)
 export(em)
+export(exprToFunction)
 export(fileInput)
 export(h1)
 export(h2)
@@ -17,12 +44,17 @@ export(h5)
 export(h6)
 export(headerPanel)
 export(helpText)
-export(HTML)
 export(htmlOutput)
 export(img)
+export(includeHTML)
+export(includeMarkdown)
+export(includeText)
 export(invalidateLater)
+export(isolate)
 export(mainPanel)
 export(numericInput)
+export(observe)
+export(outputOptions)
 export(p)
 export(pageWithSidebar)
 export(plotOutput)
@@ -35,9 +67,19 @@ export(reactiveTable)
 export(reactiveText)
 export(reactiveTimer)
 export(reactiveUI)
+export(reactiveValues)
+export(reactiveValuesToList)
+export(renderPlot)
+export(renderPrint)
+export(renderTable)
+export(renderText)
+export(renderUI)
 export(repeatable)
 export(runApp)
 export(runExample)
+export(runGist)
+export(runGitHub)
+export(runUrl)
 export(selectInput)
 export(shinyServer)
 export(shinyUI)
@@ -47,8 +89,8 @@ export(sliderInput)
 export(span)
 export(strong)
 export(submitButton)
-export(tableOutput)
 export(tabPanel)
+export(tableOutput)
 export(tabsetPanel)
 export(tag)
 export(tagAppendChild)
@@ -58,20 +100,9 @@ export(textInput)
 export(textOutput)
 export(uiOutput)
 export(verbatimTextOutput)
+export(wellPanel)
+import(RJSONIO)
 import(caTools)
 import(digest)
-import(RJSONIO)
 import(websockets)
 import(xtable)
-S3method(as.character,shiny.tag)
-S3method(as.character,shiny.tag.list)
-S3method(as.list,reactvaluesreader)
-S3method(format,shiny.tag)
-S3method(format,shiny.tag.list)
-S3method(names,reactvaluesreader)
-S3method(print,shiny.tag)
-S3method(print,shiny.tag.list)
-S3method(reactive,default)
-S3method(reactive,"function")
-S3method("$",reactvaluesreader)
-S3method("$<-",shinyoutput)

NEWS

@@ -1,3 +1,162 @@
+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
+--------------------------------------------------------------------------------
+
+* Fix issue #91: bug where downloading files did not work.
+
+* Add [[<- operator for shinyoutput object, making it possible to assign values
+  with `output[['plot1']] <- ...`.
+
+* Reactive functions now preserve the visible/invisible state of their returned
+  values.
+
+shiny 0.3.0
+--------------------------------------------------------------------------------
+
+* Reactive functions are now evaluated lazily.
+
+* Add `reactiveValues()`.
+
+* Using `as.list()` to convert a reactivevalues object (like `input`) to a list
+  is deprecated. The new function `reactiveValuesToList()` should be used
+  instead.
+
+* Add `isolate()`. This function is used for accessing reactive functions,
+  without them invalidating their parent contexts.
+
+* Fix issue #58: bug where reactive functions are not re-run when all items in
+  a checkboxGroup are unchecked.
+
+* Fix issue #71, where `reactiveTable()` would return blank if the first
+  element of a data frame was NA.
+
+* In `plotOutput`, better validation for CSS units when specifying width and
+  height.
+
+* `reactivePrint()` no longer displays invisible output.
+
+* `reactiveText()` no longer displays printed output, only the return value
+  from a function.
+
+* The `runGitHub()` and `runUrl()` functions have been added, for running
+  Shiny apps from GitHub repositories and zip/tar files at remote URLs.
+
+* Fix issue #64, where pressing Enter in a textbox would cause a form to
+  submit.
+
+shiny 0.2.4
+--------------------------------------------------------------------------------
+
+* `runGist` has been updated to use the new download URLs from
+  https://gist.github.com.
+
+* Shiny now uses `CairoPNG()` for output, when the Cairo package is available.
+  This provides better-looking output on Linux and Windows.
+
+shiny 0.2.3
+--------------------------------------------------------------------------------
+
+* Ignore request variables for routing purposes
+
+shiny 0.2.2
+--------------------------------------------------------------------------------
+
+* Fix CRAN warning (assigning to global environment)
+
+
+shiny 0.2.1
+--------------------------------------------------------------------------------
+
+* [BREAKING] Modify API of `downloadHandler`: The `content` function now takes
+  a file path, not writable connection, as an argument. This makes it much
+  easier to work with APIs that only write to file paths, not connections.
+
+
+shiny 0.2.0
+--------------------------------------------------------------------------------
+
+* Fix subtle name resolution bug--the usual symptom being S4 methods not being
+  invoked correctly when called from inside of ui.R or server.R
+
+
+shiny 0.1.14
+--------------------------------------------------------------------------------
+
+* Fix slider animator, which broke in 0.1.10
+
+
+shiny 0.1.13
+--------------------------------------------------------------------------------
+
+* Fix temp file leak in reactivePlot
+
+
+shiny 0.1.12
+--------------------------------------------------------------------------------
+
+* Fix problems with runGist on Windows
+* Add feature for on-the-fly file downloads (e.g. CSV data, PDFs)
+* Add CSS hooks for app-wide busy indicators
+
+
+shiny 0.1.11
+--------------------------------------------------------------------------------
+
+* Fix input binding with IE8 on Shiny Server
+* Fix issue #41: reactiveTable should allow print options too
+* Allow dynamic sizing of reactivePlot (i.e. using a function instead of a fixed
+  value)
+
+
+shiny 0.1.10
+--------------------------------------------------------------------------------
+
+* Support more MIME types when serving out of www
+* Fix issue #35: Allow modification of untar args
+* headerPanel can take an explicit window title parameter
+* checkboxInput uses correct attribute `checked` instead of `selected`
+* Fix plot rendering with IE8 on Shiny Server
+
+
+shiny 0.1.9
+--------------------------------------------------------------------------------
+
+* Much less flicker when updating plots
+* More customizable error display
+* Add `includeText`, `includeHTML`, and `includeMarkdown` functions for putting
+  text, HTML, and Markdown content from external files in the application's UI.
+
+
+shiny 0.1.8
+--------------------------------------------------------------------------------
+
+* Add `runGist` function for conveniently running a Shiny app that is published
+  on gist.github.com.
+* Fix issue #27: Warnings cause reactive functions to stop executing.
+* The server.R and ui.R filenames are now case insensitive.
+* Add `wellPanel` function for creating inset areas on the page.
+* Add `bootstrapPage` function for creating new Twitter Bootstrap based
+  layouts from scratch.
+
+
 shiny 0.1.7
 --------------------------------------------------------------------------------
 

R/bootstrap.R

@@ -1,3 +1,63 @@
+#' Create a Twitter Bootstrap page
+#' 
+#' Create a Shiny UI page that loads the CSS and JavaScript for
+#' \href{http://getbootstrap.com}{Twitter Bootstrap}, and has no content in the
+#' page body (other than what you provide).
+#' 
+#' This function is primarily intended for users who are proficient in HTML/CSS,
+#' and know how to lay out pages in Bootstrap. Most users should use template
+#' functions like \code{\link{pageWithSidebar}}.
+#' 
+#' @param ... The contents of the document body.
+#' @return A UI defintion that can be passed to the \link{shinyUI} function.
+#' 
+#' @export
+bootstrapPage <- function(...) {
+  # required head tags for boostrap
+  importBootstrap <- function(min = TRUE, responsive = TRUE) {
+    
+    ext <- function(ext) {
+      ifelse(min, paste(".min", ext, sep=""), ext)
+    }
+    cssExt <- ext(".css")
+    jsExt = ext(".js")
+    bs <- "shared/bootstrap/"
+    
+    result <- tags$head(
+      tags$link(rel="stylesheet", 
+                type="text/css", 
+                href="shared/slider/css/jquery.slider.min.css"),
+      
+      tags$script(src="shared/slider/js/jquery.slider.min.js"),
+      
+      tags$link(rel="stylesheet", 
+                type="text/css", 
+                href=paste(bs, "css/bootstrap", cssExt, sep="")),
+      
+      tags$script(src=paste(bs, "js/bootstrap", jsExt, sep=""))
+    )
+    
+    if (responsive) {
+      result <- tagAppendChild(
+        result, 
+        tags$meta(name="viewport", 
+                  content="width=device-width, initial-scale=1.0"))
+      result <- tagAppendChild(
+        result,
+        tags$link(rel="stylesheet", 
+                  type="text/css", 
+                  href=paste(bs, "css/bootstrap-responsive", cssExt, sep="")))
+    }
+    
+    result
+  }
+  
+  tagList(
+    # inject bootstrap requirements into head
+    importBootstrap(),
+    list(...)
+  )
+}
 
 #' Create a page with a sidebar
 #' 
@@ -34,43 +94,16 @@
 #' @export
 pageWithSidebar <- function(headerPanel, sidebarPanel, mainPanel) {
   
-  # required head tags for boostrap
-  importBootstrap <- function(min = TRUE) {
-    
-    ext <- function(ext) {
-      ifelse(min, paste(".min", ext, sep=""), ext)
-    }
-    cssExt <- ext(".css")
-    jsExt = ext(".js")
-    bs <- "shared/bootstrap/"
-    
-    tags$head(
-      tags$meta(name="viewport", 
-                content="width=device-width, initial-scale=1.0"),
-      tags$link(rel="stylesheet", 
-                type="text/css", 
-                href=paste(bs, "css/bootstrap", cssExt, sep="")),
-      
-      tags$link(rel="stylesheet", 
-                type="text/css", 
-                href=paste(bs, "css/bootstrap-responsive", cssExt, sep="")),
-      
-      tags$script(src=paste(bs, "js/bootstrap", jsExt, sep=""))
-    )
-  }
-  
-  tagList(
-    # inject bootstrap requirements into head
-    importBootstrap(),
-    
+  bootstrapPage(
     # basic application container divs
-    div(class="container-fluid", 
+    div(
+      class="container-fluid", 
       div(class="row-fluid", 
-        headerPanel
+          headerPanel
       ),
       div(class="row-fluid", 
-        sidebarPanel, 
-        mainPanel
+          sidebarPanel, 
+          mainPanel
       )
     )
   )
@@ -82,20 +115,35 @@ pageWithSidebar <- function(headerPanel, sidebarPanel, mainPanel) {
 #' Create a header panel containing an application title.
 #' 
 #' @param title An application title to display
+#' @param windowTitle The title that should be displayed by the browser window. 
+#'   Useful if \code{title} is not a string.
 #' @return A headerPanel that can be passed to \link{pageWithSidebar}
-#' 
+#'   
 #' @examples
 #' headerPanel("Hello Shiny!")
 #' @export
-headerPanel <- function(title) {    
+headerPanel <- function(title, windowTitle=title) {    
   tagList(
-    tags$head(tags$title(title)),
+    tags$head(tags$title(windowTitle)),
     div(class="span12", style="padding: 10px 0px;",
       h1(title)
     )
   )
 }
 
+#' Create a well panel
+#' 
+#' Creates a panel with a slightly inset border and grey background. Equivalent
+#' to Twitter Bootstrap's \code{well} CSS class.
+#' 
+#' @param ... UI elements to include inside the panel.
+#' @return The newly created panel.
+#' 
+#' @export
+wellPanel <- function(...) {
+  div(class="well", ...)
+}
+
 #' Create a sidebar panel
 #' 
 #' Create a sidebar panel containing input controls that can in turn be 
@@ -163,18 +211,18 @@ mainPanel <- function(...) {
 #' sidebarPanel(
 #'    selectInput(
 #'       "plotType", "Plot Type",
-#'       list(Scatter = "scatter",
-#'            Histogram = "hist")),
+#'       c(Scatter = "scatter",
+#'         Histogram = "hist")),
 #' 
 #'    # Only show this panel if the plot type is a histogram
 #'    conditionalPanel(
 #'       condition = "input.plotType == 'hist'",
 #'       selectInput(
 #'          "breaks", "Breaks",
-#'          list("Sturges", 
-#'               "Scott",
-#'               "Freedman-Diaconis",
-#'               "[Custom]" = "custom")),
+#'          c("Sturges",
+#'            "Scott",
+#'            "Freedman-Diaconis",
+#'            "[Custom]" = "custom")),
 #'               
 #'       # Only show this panel if Custom is selected
 #'       conditionalPanel(
@@ -309,9 +357,9 @@ checkboxInput <- function(inputId, label, value = FALSE) {
 #'   
 #' @examples
 #' checkboxGroupInput("variable", "Variable:",
-#'                    list("Cylinders" = "cyl", 
-#'                         "Transmission" = "am", 
-#'                         "Gears" = "gear"))
+#'                    c("Cylinders" = "cyl",
+#'                      "Transmission" = "am",
+#'                      "Gears" = "gear"))
 #'                  
 #' @export
 checkboxGroupInput <- function(inputId, label, choices, selected = NULL) {
@@ -325,7 +373,7 @@ checkboxGroupInput <- function(inputId, label, choices, selected = NULL) {
                            value = choices[[choiceName]])
     
     if (choiceName %in% selected)
-      checkbox$attribs$selected <- 'selected'
+      checkbox$attribs$checked <- 'checked'
     
     checkboxes[[length(checkboxes)+1]] <- checkbox
     checkboxes[[length(checkboxes)+1]] <- choiceName
@@ -341,22 +389,19 @@ checkboxGroupInput <- function(inputId, label, choices, selected = NULL) {
 
 #' Create a help text element
 #' 
-#' Create help text which can be added to an input form to provide
-#' additional explanation or context.
+#' Create help text which can be added to an input form to provide additional
+#' explanation or context.
 #' 
-#' @param text Help text string
-#' @param ... Additional help text strings
+#' @param ... One or more help text strings (or other inline HTML elements)
 #' @return A help text element that can be added to a UI definition.
-#' 
+#'   
 #' @examples
 #' helpText("Note: while the data view will show only",
 #'          "the specified number of observations, the",
 #'          "summary will be based on the full dataset.")
 #' @export
-helpText <- function(text, ...) {
-  text <- c(text, as.character(list(...)))
-  text <- paste(text, collapse=" ")
-  span(class="help-block", text)
+helpText <- function(...) {
+  span(class="help-block", ...)
 }
 
 controlLabel <- function(controlName, label) {
@@ -395,9 +440,9 @@ choicesWithNames <- function(choices) {
 #' 
 #' @examples
 #' selectInput("variable", "Variable:",
-#'             list("Cylinders" = "cyl", 
-#'                  "Transmission" = "am", 
-#'                  "Gears" = "gear"))
+#'             c("Cylinders" = "cyl",
+#'               "Transmission" = "am",
+#'               "Gears" = "gear"))
 #' @export
 selectInput <- function(inputId, 
                         label, 
@@ -440,10 +485,10 @@ selectInput <- function(inputId,
 #' 
 #' @examples
 #' radioButtons("dist", "Distribution type:",
-#'              list("Normal" = "norm",
-#'                   "Uniform" = "unif",
-#'                   "Log-normal" = "lnorm",
-#'                   "Exponential" = "exp"))
+#'              c("Normal" = "norm",
+#'                "Uniform" = "unif",
+#'                "Log-normal" = "lnorm",
+#'                "Exponential" = "exp"))
 #' @export
 radioButtons <- function(inputId, label, choices, selected = NULL) {
   # resolve names
@@ -544,10 +589,10 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
   if (!is.character(labelText))
     stop("label not specified")
   
-  if (identical(animate, T))
+  if (identical(animate, TRUE))
     animate <- animationOptions()
   
-  if (!is.null(animate) && !identical(animate, F)) {
+  if (!is.null(animate) && !identical(animate, FALSE)) {
     if (is.null(animate$playButton))
       animate$playButton <- tags$i(class='icon-play')
     if (is.null(animate$pauseButton))
@@ -663,7 +708,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
@@ -678,7 +723,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(
@@ -695,9 +740,11 @@ verbatimTextOutput <- function(outputId) {
 
 #' Create a plot output element
 #' 
-#' Render a \link{reactivePlot} within an application page.
+#' Render a \link{renderPlot} within an application page.
 #' @param outputId output variable to read the plot from
-#' @param width Plot width
+#' @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
+#'   string and have \code{"px"} appended.
 #' @param height Plot height
 #' @return A plot output element that can be included in a panel
 #' @examples
@@ -707,13 +754,14 @@ verbatimTextOutput <- function(outputId) {
 #' )
 #' @export
 plotOutput <- function(outputId, width = "100%", height="400px") {
-  style <- paste("width:", width, ";", "height:", height)
+  style <- paste("width:", validateCssUnit(width), ";",
+    "height:", validateCssUnit(height))
   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
@@ -731,7 +779,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
@@ -748,3 +796,63 @@ htmlOutput <- function(outputId) {
 uiOutput <- function(outputId) {
   htmlOutput(outputId)
 }
+
+#' Create a download button or link
+#' 
+#' Use these functions to create a download button or link; when clicked, it 
+#' will initiate a browser download. The filename and contents are specified by 
+#' the corresponding \code{\link{downloadHandler}} defined in the server 
+#' function.
+#' 
+#' @param outputId The name of the output slot that the \code{downloadHandler}
+#'   is assigned to.
+#' @param label The label that should appear on the button.
+#' @param class Additional CSS classes to apply to the tag, if any.
+#'   
+#' @examples
+#' \dontrun{
+#' # In server.R:
+#' output$downloadData <- downloadHandler(
+#'   filename = function() {
+#'     paste('data-', Sys.Date(), '.csv', sep='')
+#'   },
+#'   content = function(con) {
+#'     write.csv(data, con)
+#'   }
+#' )
+#' 
+#' # In ui.R:
+#' downloadLink('downloadData', 'Download')
+#' }
+#' 
+#' @aliases downloadLink
+#' @seealso downloadHandler
+#' @export
+downloadButton <- function(outputId, label="Download", class=NULL) {
+  tags$a(id=outputId,
+         class=paste(c('btn shiny-download-link', class), collapse=" "),
+         href='',
+         target='_blank',
+         label)
+}
+
+#' @rdname downloadButton
+#' @export
+downloadLink <- function(outputId, label="Download", class=NULL) {
+  tags$a(id=outputId,
+         class=paste(c('shiny-download-link', class), collapse=" "),
+         href='',
+         target='_blank',
+         label)
+}
+
+validateCssUnit <- function(x) {
+  if (is.character(x) &&
+     !grepl("^(auto|((\\.\\d+)|(\\d+(\\.\\d+)?))(%|in|cm|mm|em|ex|pt|pc|px))$", x)) {
+    stop('"', x, '" is not a valid CSS unit (e.g., "100%", "400px", "auto")')
+  }
+  if (is.numeric(x)) {
+    x <- paste(x, "px", sep = "")
+  }
+  x
+}

R/cache.R

@@ -0,0 +1,80 @@
+# A context object for tracking a cache that needs to be dirtied when a set of 
+# files changes on disk. Each time the cache is dirtied, the set of files is 
+# cleared. Therefore, the set of files needs to be re-built each time the cached
+# code executes. This approach allows for dynamic dependency graphs.
+CacheContext <- setRefClass(
+  'CacheContext',
+  fields = list(
+    .dirty = 'logical',
+    .tests = 'list'
+  ),
+  methods = list(
+    initialize = function() {
+      .dirty <<- TRUE
+      # List of functions that return TRUE if dirty
+      .tests <<- list()
+    },
+    addDependencyFile = function(file) {
+      if (.dirty)
+        return()
+      
+      file <- normalizePath(file)
+
+      mtime <- file.info(file)$mtime
+      .tests <<- c(.tests, function() {
+        newMtime <- try(file.info(file)$mtime, silent=TRUE)
+        if (is(newMtime, 'try-error'))
+          return(TRUE)
+        return(!identical(mtime, newMtime))
+      })
+      invisible()
+    },
+    forceDirty = function() {
+      .dirty <<- TRUE
+      .tests <<- list()
+      invisible()
+    },
+    isDirty = function() {
+      if (.dirty)
+        return(TRUE)
+      
+      for (test in .tests) {
+        if (test()) {
+          forceDirty()
+          return(TRUE)
+        }
+      }
+      
+      return(FALSE)
+    },
+    reset = function() {
+      .dirty <<- FALSE
+      .tests <<- list()
+    },
+    with = function(func) {
+      oldCC <- .currentCacheContext$cc
+      .currentCacheContext$cc <- .self
+      on.exit(.currentCacheContext$cc <- oldCC)
+      
+      return(func())
+    }
+  )
+)
+
+.currentCacheContext <- new.env()
+
+# Indicates to Shiny that the given file path is part of the dependency graph 
+# for whatever is currently executing (so far, only ui.R). By default, ui.R only
+# gets re-executed when it is detected to have changed; this function allows the
+# caller to indicate that it should also re-execute if the given file changes.
+# 
+# If NULL or NA is given as the argument, then ui.R will re-execute next time.
+dependsOnFile <- function(filepath) {
+  if (is.null(.currentCacheContext$cc))
+    stop("addFileDependency was called at an unexpected time (no cache context found)")
+  
+  if (is.null(filepath) || is.na(filepath))
+    .currentCacheContext$cc$forceDirty()
+  else
+    .currentCacheContext$cc$addDependencyFile(filepath)
+}

R/fileupload.R

@@ -41,7 +41,7 @@ FileUploadOperation <- setRefClass(
 
       filename <- file.path(.dir, as.character(length(.files)))
       row <- data.frame(name=file$name, size=file$size, type=file$type,
-                        datapath=filename, stringsAsFactors=F)
+                        datapath=filename, stringsAsFactors=FALSE)
       
       if (length(.files) == 0)
         .files <<- row
@@ -74,7 +74,7 @@ FileUploadContext <- setRefClass(
       .basedir <<- dir
     },
     createUploadOperation = function() {
-      while (T) {
+      while (TRUE) {
         id <- paste(as.raw(runif(12, min=0, max=0xFF)), collapse='')
         dir <- file.path(.basedir, id)
         if (!dir.create(dir))

R/map.R

@@ -20,30 +20,36 @@ Map <- setRefClass(
     },
     get = function(key) {
       if (.self$containsKey(key))
-        return(base::get(key, pos=.env, inherits=F))
+        return(base::get(key, pos=.env, inherits=FALSE))
       else
         return(NULL)
     },
     set = function(key, value) {
-      assign(key, value, pos=.env, inherits=F)
+      assign(key, value, pos=.env, inherits=FALSE)
       return(value)
     },
+    mset = function(...) {
+      args <- list(...)
+      for (key in names(args))
+        set(key, args[[key]])
+      return()
+    },
     remove = function(key) {
       if (.self$containsKey(key)) {
         result <- .self$get(key)
-        rm(list = key, pos=.env, inherits=F)
+        rm(list = key, pos=.env, inherits=FALSE)
         return(result)
       }
       return(NULL)
     },
     containsKey = function(key) {
-      exists(key, where=.env, inherits=F)
+      exists(key, where=.env, inherits=FALSE)
     },
     keys = function() {
-      ls(envir=.env, all.names=T)
+      ls(envir=.env, all.names=TRUE)
     },
     values = function() {
-      mget(.self$keys(), envir=.env, inherits=F)
+      mget(.self$keys(), envir=.env, inherits=FALSE)
     },
     clear = function() {
       .env <<- new.env(parent=emptyenv())
@@ -55,19 +61,10 @@ Map <- setRefClass(
   )
 )
 
-`[.Map` <- function(map, name) {
-  map$get(name)
-}
-
-`[<-.Map` <- function(map, name, value) {
-  map$set(name, value)
-  return(map)
-}
-
 as.list.Map <- function(map) {
   sapply(map$keys(),
          map$get,
-         simplify=F)
+         simplify=FALSE)
 }
 length.Map <- function(map) {
   map$size()

R/random.R

@@ -1,33 +0,0 @@
-#' Make a random number generator repeatable
-#' 
-#' Given a function that generates random data, returns a wrapped version of 
-#' that function that always uses the same seed when called. The seed to use can
-#' be passed in explicitly if desired; otherwise, a random number is used.
-#' 
-#' @param rngfunc The function that is affected by the R session's seed.
-#' @param seed The seed to set every time the resulting function is called.
-#' @return A repeatable version of the function that was passed in.
-#'   
-#' @note When called, the returned function attempts to preserve the R session's
-#'   current seed by snapshotting and restoring
-#'   \code{\link[base]{.Random.seed}}.
-#'
-#' @examples
-#' rnormA <- repeatable(rnorm)
-#' rnormB <- repeatable(rnorm)
-#' rnormA(3)  # [1]  1.8285879 -0.7468041 -0.4639111
-#' rnormA(3)  # [1]  1.8285879 -0.7468041 -0.4639111
-#' rnormA(5)  # [1]  1.8285879 -0.7468041 -0.4639111 -1.6510126 -1.4686924
-#' rnormB(5)  # [1] -0.7946034  0.2568374 -0.6567597  1.2451387 -0.8375699
-#' 
-#' @export
-repeatable <- function(rngfunc, seed = runif(1, 0, .Machine$integer.max)) {
-  function(...) {
-    currentSeed <- .Random.seed
-    on.exit(.Random.seed <- currentSeed)
-    
-    set.seed(seed)
-    
-    do.call(rngfunc, list(...))
-  }
-}

R/react.R

@@ -2,38 +2,34 @@ Context <- setRefClass(
   'Context',
   fields = list(
     id = 'character',
+    .label = 'character',      # For debug purposes
     .invalidated = 'logical',
-    .callbacks = 'list',
-    .hintCallbacks = 'list'
+    .invalidateCallbacks = 'list',
+    .flushCallbacks = 'list'
   ),
   methods = list(
-    initialize = function() {
+    initialize = function(label='') {
       id <<- .getReactiveEnvironment()$nextId()
-      .invalidated <<- F
-      .callbacks <<- list()
-      .hintCallbacks <<- list()
+      .invalidated <<- FALSE
+      .invalidateCallbacks <<- list()
+      .flushCallbacks <<- list()
+      .label <<- label
     },
     run = function(func) {
       "Run the provided function under this context."
       env <- .getReactiveEnvironment()
       env$runWith(.self, func)
     },
-    invalidateHint = function() {
-      "Let this context know it may or may not be invalidated very soon; that
-      is, something in its dependency graph has been invalidated but there's no
-      guarantee that the cascade of invalidations will reach all the way here.
-      This is used to show progress in the UI."
-      lapply(.hintCallbacks, function(func) {
-        func()
-      })
-    },
     invalidate = function() {
-      "Schedule this context for invalidation. It will not actually be
-        invalidated until the next call to \\code{\\link{flushReact}}."
+      "Invalidate this context. It will immediately call the callbacks
+        that have been registered with onInvalidate()."
       if (.invalidated)
         return()
-      .invalidated <<- T
-      .getReactiveEnvironment()$addPendingInvalidate(.self)
+      .invalidated <<- TRUE
+
+      lapply(.invalidateCallbacks, function(func) {
+        func()
+      })
       NULL
     },
     onInvalidate = function(func) {
@@ -43,23 +39,27 @@ Context <- setRefClass(
       if (.invalidated)
         func()
       else
-        .callbacks <<- c(.callbacks, func)
+        .invalidateCallbacks <<- c(.invalidateCallbacks, func)
       NULL
     },
-    onInvalidateHint = function(func) {
-      .hintCallbacks <<- c(.hintCallbacks, func)
+    addPendingFlush = function() {
+      "Tell the reactive environment that this context should be flushed the
+        next time flushReact() called."
+      .getReactiveEnvironment()$addPendingFlush(.self)
     },
-    executeCallbacks = function() {
+    onFlush = function(func) {
+      "Register a function to be called when this context is flushed."
+      .flushCallbacks <<- c(.flushCallbacks, func)
+    },
+    executeFlushCallbacks = function() {
       "For internal use only."
-      lapply(.callbacks, function(func) {
-        tryCatch({
+      lapply(.flushCallbacks, function(func) {
+        withCallingHandlers({
           func()
         }, warning = function(e) {
           # TODO: Callbacks in app
-          print(e)
         }, error = function(e) {
           # TODO: Callbacks in app
-          print(e)
         })
       })
     }
@@ -68,12 +68,18 @@ Context <- setRefClass(
 
 ReactiveEnvironment <- setRefClass(
   'ReactiveEnvironment',
-  fields = c('.currentContext', '.nextId', '.pendingInvalidate'),
+  fields = list(
+    .currentContext = 'ANY',
+    .nextId = 'integer',
+    .pendingFlush = 'list',
+    .inFlush = 'logical'
+  ),
   methods = list(
     initialize = function() {
       .currentContext <<- NULL
       .nextId <<- 0L
-      .pendingInvalidate <<- list()
+      .pendingFlush <<- list()
+      .inFlush <<- FALSE
     },
     nextId = function() {
       .nextId <<- .nextId + 1L
@@ -92,27 +98,27 @@ ReactiveEnvironment <- setRefClass(
       on.exit(.currentContext <<- old.ctx)
       func()
     },
-    addPendingInvalidate = function(ctx) {
-      .pendingInvalidate <<- c(.pendingInvalidate, ctx)
+    addPendingFlush = function(ctx) {
+      .pendingFlush <<- c(ctx, .pendingFlush)
     },
     flush = function() {
-      while (length(.pendingInvalidate) > 0) {
-        contexts <- .pendingInvalidate
-        .pendingInvalidate <<- list()
-        lapply(contexts, function(ctx) {
-          ctx$executeCallbacks()
-          NULL
-        })
+      # 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]
+        ctx$executeFlushCallbacks()
       }
     }
   )
 )
 
+.reactiveEnvironment <- ReactiveEnvironment$new()
 .getReactiveEnvironment <- function() {
-  if (!exists('.ReactiveEnvironment', envir=.GlobalEnv, inherits=F)) {
-    assign('.ReactiveEnvironment', ReactiveEnvironment$new(), envir=.GlobalEnv)
-  }
-  get('.ReactiveEnvironment', envir=.GlobalEnv, inherits=F)
+  .reactiveEnvironment
 }
 
 # Causes any pending invalidations to run.

R/reactives.R

@@ -1,90 +1,91 @@
-Dependencies <- setRefClass(
-  'Dependencies',
+Dependents <- setRefClass(
+  'Dependents',
   fields = list(
-    .dependencies = 'Map'
+    .dependents = 'Map'
   ),
   methods = list(
     register = function() {
       ctx <- .getReactiveEnvironment()$currentContext()
-      if (!.dependencies$containsKey(ctx$id)) {
-        .dependencies$set(ctx$id, ctx)
+      if (!.dependents$containsKey(ctx$id)) {
+        .dependents$set(ctx$id, ctx)
         ctx$onInvalidate(function() {
-          .dependencies$remove(ctx$id)
+          .dependents$remove(ctx$id)
         })
       }
     },
     invalidate = function() {
       lapply(
-        .dependencies$values(),
+        .dependents$values(),
         function(ctx) {
-          ctx$invalidateHint()
           ctx$invalidate()
           NULL
         }
       )
-    },
-    invalidateHint = function() {
-      lapply(
-        .dependencies$values(),
-        function(dep.ctx) {
-          dep.ctx$invalidateHint()
-          NULL
-        })
     }
   )
 )
 
-Values <- setRefClass(
-  'Values',
+
+# ReactiveValues ------------------------------------------------------------
+
+ReactiveValues <- setRefClass(
+  'ReactiveValues',
   fields = list(
     .values = 'environment',
-    .dependencies = 'environment',
-    # Dependencies for the list of names
-    .namesDeps = 'Dependencies',
-    # Dependencies for all values
-    .allDeps = 'Dependencies'
+    .dependents = 'environment',
+    # Dependents for the list of all names, including hidden
+    .namesDeps = 'Dependents',
+    # Dependents for all values, including hidden
+    .allValuesDeps = 'Dependents',
+    # Dependents for all values
+    .valuesDeps = 'Dependents'
   ),
   methods = list(
     initialize = function() {
       .values <<- new.env(parent=emptyenv())
-      .dependencies <<- new.env(parent=emptyenv())
+      .dependents <<- new.env(parent=emptyenv())
     },
     get = function(key) {
       ctx <- .getReactiveEnvironment()$currentContext()
       dep.key <- paste(key, ':', ctx$id, sep='')
-      if (!exists(dep.key, where=.dependencies, inherits=F)) {
-        assign(dep.key, ctx, pos=.dependencies, inherits=F)
+      if (!exists(dep.key, where=.dependents, inherits=FALSE)) {
+        assign(dep.key, ctx, pos=.dependents, inherits=FALSE)
         ctx$onInvalidate(function() {
-          rm(list=dep.key, pos=.dependencies, inherits=F)
+          rm(list=dep.key, pos=.dependents, inherits=FALSE)
         })
       }
       
-      if (!exists(key, where=.values, inherits=F))
+      if (!exists(key, where=.values, inherits=FALSE))
         NULL
       else
-        base::get(key, pos=.values, inherits=F)
+        base::get(key, pos=.values, inherits=FALSE)
     },
     set = function(key, value) {
-      if (exists(key, where=.values, inherits=F)) {
-        if (identical(base::get(key, pos=.values, inherits=F), value)) {
+      hidden <- substr(key, 1, 1) == "."
+
+      if (exists(key, where=.values, inherits=FALSE)) {
+        if (identical(base::get(key, pos=.values, inherits=FALSE), value)) {
           return(invisible())
         }
       }
       else {
         .namesDeps$invalidate()
       }
-      .allDeps$invalidate()
+
+      if (hidden)
+        .allValuesDeps$invalidate()
+      else
+        .valuesDeps$invalidate()
       
-      assign(key, value, pos=.values, inherits=F)
+      assign(key, value, pos=.values, inherits=FALSE)
       dep.keys <- objects(
-        pos=.dependencies,
+        pos=.dependents,
         pattern=paste('^\\Q', key, ':', '\\E', '\\d+$', sep=''),
-        all.names=T
+        all.names=TRUE
       )
       lapply(
-        mget(dep.keys, envir=.dependencies),
+        mget(dep.keys, envir=.dependents),
         function(ctx) {
-          ctx$invalidateHint()
           ctx$invalidate()
           NULL
         }
@@ -99,192 +100,435 @@ Values <- setRefClass(
     },
     names = function() {
       .namesDeps$register()
-      return(ls(.values, all.names=T))
+      return(ls(.values, all.names=TRUE))
     },
-    toList = function() {
-      .allDeps$register()
-      return(as.list(.values))
+    toList = function(all.names=FALSE) {
+      if (all.names)
+        .allValuesDeps$register()
+
+      .valuesDeps$register()
+
+      return(as.list(.values, all.names=all.names))
     }
   )
 )
 
-`[.Values` <- function(values, name) {
-  values$get(name)
+
+# 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 expression takes a reactive
+#' dependency on that value, and when you write to it, it notifies any reactive
+#' functions that depend on that value.
+#'
+#' @examples
+#' # Create the object with no values
+#' values <- reactiveValues()
+#'
+#' # Assign values to 'a' and 'b'
+#' values$a <- 3
+#' values[['b']] <- 4
+#'
+#' \dontrun{
+#' # From within a reactive context, you can access values with:
+#' values$a
+#' values[['a']]
+#' }
+#'
+#' # If not in a reactive context (e.g., at the console), you can use isolate()
+#' # to retrieve the value:
+#' isolate(values$a)
+#' isolate(values[['a']])
+#'
+#' # Set values upon creation
+#' values <- reactiveValues(a = 1, b = 2)
+#' isolate(values$a)
+#'
+#' @param ... Objects that will be added to the reactivevalues object. All of
+#'   these objects must be named.
+#'
+#' @seealso \code{\link{isolate}}.
+#'
+#' @export
+reactiveValues <- function(...) {
+  args <- list(...)
+  if ((length(args) > 0) && (is.null(names(args)) || any(names(args) == "")))
+    stop("All arguments passed to reactiveValues() must be named.")
+
+  values <- .createReactiveValues(ReactiveValues$new())
+
+  # Use .subset2() instead of [[, to avoid method dispatch
+  .subset2(values, 'impl')$mset(args)
+  values
 }
 
-`[<-.Values` <- function(values, name, value) {
-  values$set(name, value)
-  return(values)
+# Create a reactivevalues object
+#
+# @param values A ReactiveValues object
+# @param readonly Should this object be read-only?
+.createReactiveValues <- function(values = NULL, readonly = FALSE) {
+  structure(list(impl=values), class='reactivevalues', readonly=readonly)
 }
 
-.createValuesReader <- function(values) {
-  acc <- list(impl=values)
-  class(acc) <- 'reactvaluesreader'
-  return(acc)
+#' @S3method $ reactivevalues
+`$.reactivevalues` <- function(x, name) {
+  .subset2(x, 'impl')$get(name)
 }
 
-#' @S3method $ reactvaluesreader
-`$.reactvaluesreader` <- function(x, name) {
-  x[['impl']]$get(name)
+#' @S3method [[ reactivevalues
+`[[.reactivevalues` <- `$.reactivevalues`
+
+#' @S3method $<- reactivevalues
+`$<-.reactivevalues` <- function(x, name, value) {
+  if (attr(x, 'readonly')) {
+    stop("Attempted to assign value to a read-only reactivevalues object")
+  } else if (length(name) != 1 || !is.character(name)) {
+    stop("Must use single string to index into reactivevalues")
+  } else {
+    .subset2(x, 'impl')$set(name, value)
+    x
+  }
 }
 
-#' @S3method names reactvaluesreader
-names.reactvaluesreader <- function(x) {
-  x[['impl']]$names()
+#' @S3method [[<- reactivevalues
+`[[<-.reactivevalues` <- `$<-.reactivevalues`
+
+#' @S3method [ reactivevalues
+`[.reactivevalues` <- function(values, name) {
+  stop("Single-bracket indexing of reactivevalues object is not allowed.")
 }
 
-#' @S3method as.list reactvaluesreader
-as.list.reactvaluesreader <- function(x, ...) {
-  x[['impl']]$toList()
+#' @S3method [<- reactivevalues
+`[<-.reactivevalues` <- function(values, name, value) {
+  stop("Single-bracket indexing of reactivevalues object is not allowed.")
 }
 
+#' @S3method names reactivevalues
+names.reactivevalues <- function(x) {
+  .subset2(x, 'impl')$names()
+}
+
+#' @S3method names<- reactivevalues
+`names<-.reactivevalues` <- function(x, value) {
+  stop("Can't assign names to reactivevalues object")
+}
+
+#' @S3method as.list reactivevalues
+as.list.reactivevalues <- function(x, all.names=FALSE, ...) {
+  shinyDeprecated("reactiveValuesToList",
+    msg = paste("'as.list.reactivevalues' is deprecated. ",
+      "Use reactiveValuesToList instead.",
+      "\nPlease see ?reactiveValuesToList for more information.",
+      sep = ""))
+
+  reactiveValuesToList(x, all.names)
+}
+
+#' Convert a reactivevalues object to a list
+#'
+#' This function does something similar to what you might \code{\link{as.list}}
+#' to do. The difference is that the calling context will take dependencies on
+#' every object in the reactivevalues object. To avoid taking dependencies on
+#' all the objects, you can wrap the call with \code{\link{isolate}()}.
+#'
+#' @param x A reactivevalues object.
+#' @param all.names If \code{TRUE}, include objects with a leading dot. If
+#'   \code{FALSE} (the default) don't include those objects.
+#' @examples
+#' values <- reactiveValues(a = 1)
+#' \dontrun{
+#' reactiveValuesToList(values)
+#' }
+#'
+#' # To get the objects without taking dependencies on them, use isolate().
+#' # isolate() can also be used when calling from outside a reactive context (e.g.
+#' # at the console)
+#' isolate(reactiveValuesToList(values))
+#'
+#' @export
+reactiveValuesToList <- function(x, all.names=FALSE) {
+  .subset2(x, 'impl')$toList(all.names)
+}
+
+# Observable ----------------------------------------------------------------
+
 Observable <- setRefClass(
   'Observable',
   fields = list(
     .func = 'function',
-    .dependencies = 'Dependencies',
-    .initialized = 'logical',
-    .value = 'ANY'
+    .label = 'character',
+    .dependents = 'Dependents',
+    .invalidated = 'logical',
+    .running = 'logical',
+    .value = 'ANY',
+    .visible = 'logical',
+    .execCount = 'integer'
   ),
   methods = list(
-    initialize = function(func) {
+    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
-      .initialized <<- F
+      .invalidated <<- TRUE
+      .running <<- FALSE
+      .label <<- label
+      .execCount <<- 0L
     },
     getValue = function() {
-      if (!.initialized) {
-        .initialized <<- T
+      .dependents$register()
+
+      if (.invalidated || .running) {
         .self$.updateValue()
       }
       
-      .dependencies$register()
-      
       if (identical(class(.value), 'try-error'))
         stop(attr(.value, 'condition'))
-      return(.value)
+
+      if (.visible)
+        .value
+      else
+        invisible(.value)
     },
     .updateValue = function() {
-      old.value <- .value
-      
-      ctx <- Context$new()
+      ctx <- Context$new(.label)
       ctx$onInvalidate(function() {
-        .self$.updateValue()
-      })
-      ctx$onInvalidateHint(function() {
-        .dependencies$invalidateHint()
+        .invalidated <<- TRUE
+        .dependents$invalidate()
       })
+      .execCount <<- .execCount + 1L
+
+      .invalidated <<- FALSE
+
+      wasRunning <- .running
+      .running <<- TRUE
+      on.exit(.running <<- wasRunning)
+
       ctx$run(function() {
-        .value <<- try(.func(), silent=F)
+        result <- withVisible(try(.func(), silent=FALSE))
+        .visible <<- result$visible
+        .value <<- result$value
       })
-      if (!identical(old.value, .value)) {
-        .dependencies$invalidate()
-      }
     }
   )
 )
 
-#' 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")
+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
 }
-#' @S3method reactive function
-reactive.function <- function(x) {
-  return(Observable$new(x)$getValue)
-}
-#' @S3method reactive default
-reactive.default <- function(x) {
-  stop("Don't know how to make this object reactive!")
+
+# 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)
+  else if (is(x, 'Observer'))
+    return(x$.execCount)
+  else
+    stop('Unexpected argument to execCount')
 }
 
+# Observer ------------------------------------------------------------------
+
 Observer <- setRefClass(
   'Observer',
   fields = list(
     .func = 'function',
-    .hintCallbacks = 'list'
+    .label = 'character',
+    .invalidateCallbacks = 'list',
+    .execCount = 'integer',
+    .onResume = 'function',
+    .suspended = 'logical'
   ),
   methods = list(
-    initialize = function(func) {
+    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.")
 
       .func <<- func
+      .label <<- label
+      .execCount <<- 0L
+      .suspended <<- suspended
+      .onResume <<- function() NULL
 
       # Defer the first running of this until flushReact is called
-      ctx <- Context$new()
-      ctx$onInvalidate(function() {
-        run()
-      })
-      ctx$invalidate()
+      .createContext()$invalidate()
     },
-    run = function() {
-      ctx <- Context$new()
+    .createContext = function() {
+      ctx <- Context$new(.label)
+
       ctx$onInvalidate(function() {
-        run()
-      })
-      ctx$onInvalidateHint(function() {
-        lapply(.hintCallbacks, function(func) {
+        lapply(.invalidateCallbacks, function(func) {
           func()
           NULL
         })
+
+        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)
     },
-    onInvalidateHint = function(func) {
-      .hintCallbacks <<- c(.hintCallbacks, func)
+    onInvalidate = function(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()
     }
   )
 )
 
-# NOTE: we de-roxygenized this comment because the function isn't exported
-# Observe
-# 
-# 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 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 
-# effects (for example, performing I/O).
-#
-# @param func The function to observe. It must not have any parameters. Any
-# return value from this function will be ignored.
-#
-observe <- function(func) {
-  Observer$new(func)
+#' Create a reactive observer
+#' 
+#' 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 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 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 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(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.
@@ -299,11 +543,11 @@ observe <- function(func) {
 #' @seealso invalidateLater
 #' @export
 reactiveTimer <- function(intervalMs=1000) {
-  dependencies <- Map$new()
+  dependents <- Map$new()
   timerCallbacks$schedule(intervalMs, function() {
     timerCallbacks$schedule(intervalMs, sys.function())
     lapply(
-      dependencies$values(),
+      dependents$values(),
       function(dep.ctx) {
         dep.ctx$invalidate()
         NULL
@@ -311,10 +555,10 @@ reactiveTimer <- function(intervalMs=1000) {
   })
   return(function() {
     ctx <- .getReactiveEnvironment()$currentContext()
-    if (!dependencies$containsKey(ctx$id)) {
-      dependencies$set(ctx$id, ctx)
+    if (!dependents$containsKey(ctx$id)) {
+      dependents$set(ctx$id, ctx)
       ctx$onInvalidate(function() {
-        dependencies$remove(ctx$id)
+        dependents$remove(ctx$id)
       })
     }
     return(Sys.time())
@@ -335,3 +579,81 @@ invalidateLater <- function(millis) {
   })
   invisible()
 }
+
+#' Create a non-reactive scope for an expression
+#' 
+#' 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 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()}.
+#'
+#' @param expr An expression that can access reactive values or expressions.
+#' 
+#' @examples
+#' \dontrun{
+#' observe({
+#'   input$saveButton  # Do take a dependency on input$saveButton
+#'   
+#'   # isolate a simple expression
+#'   data <- get(isolate(input$dataset))  # No dependency on input$dataset
+#'   writeToDatabase(data)
+#' })
+#' 
+#' observe({
+#'   input$saveButton  # Do take a dependency on input$saveButton
+#'   
+#'   # isolate a whole block
+#'   data <- isolate({
+#'     a <- input$valueA   # No dependency on input$valueA or input$valueB
+#'     b <- input$valueB
+#'     c(a=a, b=b)
+#'   })
+#'   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]')
+  ctx$run(function() {
+    expr
+  })
+}

R/run-url.R

@@ -0,0 +1,164 @@
+#' Run a Shiny application from https://gist.github.com
+#'
+#' 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/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
+#'   launched automatically after the app is started. Defaults to true in
+#'   interactive sessions only.
+#'
+#' @examples
+#' \dontrun{
+#' runGist(3239667)
+#' runGist("https://gist.github.com/jcheng5/3239667")
+#'
+#' # Old URL format without username
+#' runGist("https://gist.github.com/3239667")
+#' }
+#'
+#' @export
+runGist <- function(gist,
+                    port=8100L,
+                    launch.browser=getOption('shiny.launch.browser',
+                                             interactive())) {
+
+  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)) {
+    paste(gist, '/download', sep='')
+  } else {
+    stop('Unrecognized gist identifier format')
+  }
+
+  runUrl(gistUrl, filetype=".tar.gz", subdir=NULL, port=port,
+    launch.browser=launch.browser)
+}
+
+
+#' Run a Shiny application from a GitHub repository
+#'
+#' Download and launch a Shiny application that is hosted in a GitHub repository.
+#'
+#' @param repo Name of the repository
+#' @param username GitHub username
+#' @param ref Desired git reference. Could be a commit, tag, or branch
+#'   name. Defaults to \code{"master"}.
+#' @param subdir A subdirectory in the repository that contains the app. By
+#'   default, this function will run an app from the top level of the repo, but
+#'   you can use a path such as `\code{"inst/shinyapp"}.
+#' @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
+#'   launched automatically after the app is started. Defaults to true in
+#'   interactive sessions only.
+#'
+#' @examples
+#' \dontrun{
+#' runGitHub("shiny_example", "rstudio")
+#'
+#' # Can run an app from a subdirectory in the repo
+#' runGitHub("shiny_example", "rstudio", subdir = "inst/shinyapp/")
+#' }
+#'
+#' @export
+runGitHub <- function(repo, username = getOption("github.user"),
+  ref = "master", subdir = NULL, port = 8100,
+  launch.browser = getOption('shiny.launch.browser', interactive())) {
+
+  if (is.null(ref)) {
+    stop("Must specify either a ref. ")
+  }
+
+  message("Downloading github repo(s) ",
+    paste(repo, ref, sep = "/", collapse = ", "),
+    " from ",
+    paste(username, collapse = ", "))
+  name <- paste(username, "-", repo, sep = "")
+
+  url <- paste("https://github.com/", username, "/", repo, "/archive/",
+    ref, ".tar.gz", sep = "")
+
+  runUrl(url, subdir=subdir, port=port, launch.browser=launch.browser)
+}
+
+
+#' Run a Shiny application from a URL
+#'
+#' 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
+#'   \code{".tar.gz"}. Defaults to the file extension taken from the url.
+#' @param subdir A subdirectory in the repository that contains the app. By
+#'   default, this function will run an app from the top level of the repo, but
+#'   you can use a path such as `\code{"inst/shinyapp"}.
+#' @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
+#'   launched automatically after the app is started. Defaults to true in
+#'   interactive sessions only.
+#'
+#' @examples
+#' \dontrun{
+#' runUrl('https://github.com/rstudio/shiny_example/archive/master.tar.gz')
+#'
+#' # Can run an app from a subdirectory in the archive
+#' runUrl("https://github.com/rstudio/shiny_example/archive/master.zip",
+#'  subdir = "inst/shinyapp/")
+#' }
+#'
+#' @export
+runUrl <- function(url, filetype = NULL, subdir = NULL, port = 8100,
+  launch.browser = getOption('shiny.launch.browser', interactive())) {
+
+  if (!is.null(subdir) && ".." %in% strsplit(subdir, '/')[[1]])
+    stop("'..' not allowed in subdir")
+
+  if (is.null(filetype))
+    filetype <- basename(url)
+
+  if (grepl("\\.tar\\.gz$", filetype))
+    fileext <- ".tar.gz"
+  else if (grepl("\\.tar$", filetype))
+    fileext <- ".tar"
+  else if (grepl("\\.zip$", filetype))
+    fileext <- ".zip"
+  else
+    stop("Unknown file extension.")
+
+  message("Downloading ", url)
+  filePath <- tempfile('shinyapp', fileext=fileext)
+  if (download(url, filePath, mode = "wb", quiet = TRUE) != 0)
+    stop("Failed to download URL ", url)
+  on.exit(unlink(filePath))
+
+  if (fileext %in% c(".tar", ".tar.gz")) {
+    # Regular untar commonly causes two problems on Windows with github tarballs:
+    #   1) If RTools' tar.exe is in the path, you get cygwin path warnings which
+    #      throw list=TRUE off;
+    #   2) If the internal untar implementation is used, it chokes on the 'g'
+    #      type flag that github uses (to stash their commit hash info).
+    # By using our own forked/modified untar2 we sidestep both issues.
+    dirname <- untar2(filePath, list=TRUE)[1]
+    untar2(filePath, exdir = dirname(filePath))
+
+  } else if (fileext == ".zip") {
+    dirname <- as.character(unzip(filePath, list=TRUE)$Name[1])
+    unzip(filePath, exdir = dirname(filePath))
+  }
+
+  appdir <- file.path(dirname(filePath), dirname)
+  on.exit(unlink(appdir, recursive = TRUE), add = TRUE)
+
+  appsubdir <- ifelse(is.null(subdir), appdir, file.path(appdir, subdir))
+  runApp(appsubdir, port=port, launch.browser=launch.browser)
+}

R/shiny.R

@@ -7,15 +7,26 @@ suppressPackageStartupMessages({
   library(RJSONIO)
 })
 
+createUniqueId <- function(bytes) {
+  # TODO: Use a method that isn't affected by the R seed
+  paste(as.character(as.raw(floor(runif(bytes, min=1, max=255)))), collapse='')
+}
+
 ShinyApp <- setRefClass(
   'ShinyApp',
   fields = list(
     .websocket = 'list',
     .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 = 'Values'
+    session = 'ReactiveValues',
+    token = 'character',  # Used to identify this instance in URLs
+    plots = 'Map',
+    downloads = 'Map',
+    allowDataUriScheme = 'logical'
   ),
   methods = list(
     initialize = function(ws) {
@@ -25,9 +36,15 @@ ShinyApp <- setRefClass(
       .progressKeys <<- character(0)
       # TODO: Put file upload context in user/app-specific dir if possible
       .fileUploadContext <<- FileUploadContext$new()
-      session <<- Values$new()
+      session <<- ReactiveValues$new()
+      
+      token <<- createUniqueId(16)
+      .outputs <<- list()
+      .outputOptions <<- list()
+      
+      allowDataUriScheme <<- TRUE
     },
-    defineOutput = function(name, func) {
+    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
@@ -36,6 +53,11 @@ ShinyApp <- setRefClass(
       # 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) {
@@ -45,9 +67,9 @@ ShinyApp <- setRefClass(
           }
         }
 
-        obs <- Observer$new(function() {
+        obs <- observe({
           
-          value <- try(func(), silent=F)
+          value <- try(func(), silent=FALSE)
           
           .invalidatedOutputErrors$remove(name)
           .invalidatedOutputValues$remove(name)
@@ -61,11 +83,15 @@ ShinyApp <- setRefClass(
           }
           else
             .invalidatedOutputValues$set(name, value)
-        })
+        }, label=label, suspended=TRUE)
         
-        obs$onInvalidateHint(function() {
+        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))
@@ -106,7 +132,7 @@ ShinyApp <- setRefClass(
     },
     dispatch = function(msg) {
       method <- paste('@', msg$method, sep='')
-      func <- try(do.call(`$`, list(.self, method)), silent=T)
+      func <- try(do.call(`$`, list(.self, method)), silent=TRUE)
       if (inherits(func, 'try-error')) {
         .sendErrorResponse(msg, paste('Unknown method', msg$method))
       }
@@ -133,9 +159,10 @@ ShinyApp <- setRefClass(
       .write(toJSON(list(response=list(tag=requestMsg$tag, error=error))))
     },
     .write = function(json) {
-      if (getOption('shiny.trace', F))
-        message('SEND ', json)
-      if (getOption('shiny.transcode.json', T))
+      if (getOption('shiny.trace', FALSE))
+        message('SEND ', 
+           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)
     },
@@ -164,29 +191,237 @@ ShinyApp <- setRefClass(
     `@uploadEnd` = function(jobId, inputId) {
       fileData <- .fileUploadContext$getUploadOperation(jobId)$finish()
       session$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) {
+      # TODO: Turn off caching for the response
+      
+      matches <- regmatches(subpath,
+                            regexec("^/([a-z]+)/([^?]*)", 
+                                    subpath, 
+                                    ignore.case=TRUE))[[1]]
+      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))
+          return(httpResponse(404, 'text/html', '<h1>Not Found</h1>'))
+        
+        return(httpResponse(200, savedPlot$contentType, savedPlot$data))
+      }
+      
+      if (matches[2] == 'download') {
+        
+        # A bunch of ugliness here. Filenames can be dynamically generated by
+        # the user code, so we don't know what they'll be in advance. But the
+        # most reliable way to use non-ASCII filenames for downloads is to
+        # put the actual filename in the URL. So we will start with URLs in
+        # the form:
+        # 
+        #   /session/$TOKEN/download/$NAME
+        #
+        # When a request matching that pattern is received, we will calculate
+        # the filename and see if it's non-ASCII; if so, we'll redirect to
+        #
+        #   /session/$TOKEN/download/$NAME/$FILENAME
+        #
+        # And when that pattern is received, we will actually return the file.
+        # Note that this means the filename and contents could be determined
+        # a few moments apart from each other (an HTTP roundtrip basically),
+        # hopefully that won't be enough to matter for anyone.
+        
+        dlmatches <- regmatches(matches[3],
+                                regexec("^([^/]+)(/[^/]+)?$",
+                                        matches[3]))[[1]]
+        dlname <- utils::URLdecode(dlmatches[2])
+        download <- downloads$get(dlname)
+        if (is.null(download))
+          return(httpResponse(404, 'text/html', '<h1>Not Found</h1>'))
+        
+        filename <- ifelse(is.function(download$filename),
+                           Context$new('[download]')$run(download$filename),
+                           download$filename)
+
+        # If the URL does not contain the filename, and the desired filename
+        # contains non-ASCII characters, then do a redirect with the desired
+        # name tacked on the end.
+        if (dlmatches[3] == '' && grepl('[^ -~]', filename)) {
+          
+          return(httpResponse(302, 'text/html', '<h1>Found</h1>', c(
+            'Location' = sprintf('%s/%s',
+                                 utils::URLencode(dlname, TRUE),
+                                 utils::URLencode(filename, TRUE)),
+            'Cache-Control' = 'no-cache')))
+        }
+        
+        tmpdata <- tempfile()
+        on.exit(unlink(tmpdata))
+        result <- try(Context$new('[download]')$run(function() { download$func(tmpdata) }))
+        if (is(result, 'try-error')) {
+          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),
+          c(
+            'Content-Disposition' = ifelse(
+              dlmatches[3] == '',
+              'attachment; filename="' %.% 
+                gsub('(["\\\\])', '\\\\\\1', filename) %.%  # yes, that many \'s
+                '"',
+              'attachment'
+            ),
+            'Cache-Control'='no-cache')))
+      }
+      
+      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',
+                     URLencode(token, TRUE),
+                     URLencode(name, TRUE),
+                     createUniqueId(8)))
+    },
+    registerDownload = function(name, filename, contentType, func) {
+      
+      downloads$set(name, list(filename = filename,
+                               contentType = contentType,
+                               func = func))
+      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 input variable, with the format
+        # ".shinyout_foo_hidden".
+        # Some tricky stuff: instead of accessing names using session$names(),
+        # get the names directly via session$.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 .shinyout_foo_hidden flag,
+        # and hidden should be TRUE. In other words, NULL and TRUE should map
+        # to TRUE, FALSE should map to FALSE.
+        hidden <- session$.values[[paste(".shinyout_", outputName, "_hidden", sep="")]]
+        if (is.null(hidden)) hidden <- TRUE
+
+        if (hidden && .outputOptions[[outputName]][['suspendWhenHidden']]) {
+          .outputs[[outputName]]$suspend()
+        } else {
+          .outputs[[outputName]]$resume()
+        }
+      }
+    },
+    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)
+  structure(list(impl=shinyapp), class='shinyoutput')
 }
 
 #' @S3method $<- shinyoutput
 `$<-.shinyoutput` <- function(x, name, value) {
-  x[['impl']]$defineOutput(name, 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))
     return(NULL)
-  abs.path <- normalizePath(abs.path, winslash='/', mustWork=T)
-  dir <- normalizePath(dir, winslash='/', mustWork=T)
+  abs.path <- normalizePath(abs.path, winslash='/', mustWork=TRUE)
+  dir <- normalizePath(dir, winslash='/', mustWork=TRUE)
   if (nchar(abs.path) <= nchar(dir) + 1)
     return(NULL)
   if (substr(abs.path, 1, nchar(dir)) != dir ||
@@ -198,12 +433,28 @@ resolve <- function(dir, relpath) {
 
 httpResponse <- function(status = 200,
                          content_type = "text/html; charset=UTF-8", 
-                         content = "") {
-  resp <- list(status = status, content_type = content_type, content = content);
+                         content = "",
+                         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)
 
@@ -212,6 +463,8 @@ httpServer <- function(handlers) {
     filter <- function(ws, header, response) response
   
   function(ws, header) {
+    header <- fixupRequestPath(header)
+    
     response <- handler(ws, header)
     if (is.null(response))
       response <- httpResponse(404, content="<h1>Not Found</h1>")
@@ -221,7 +474,8 @@ httpServer <- function(handlers) {
     return(http_response(ws,
                          status=response$status,
                          content_type=response$content_type,
-                         content=response$content))
+                         content=response$content,
+                         headers=response$headers))
   }
 }
 
@@ -251,6 +505,25 @@ joinHandlers <- function(handlers) {
   }
 }
 
+sessionHandler <- function(ws, header) {
+  path <- header$PATH
+  if (is.null(path))
+    return(NULL)
+  
+  matches <- regmatches(path, regexec('^/session/([0-9a-f]+)(/.*)$', path))
+  if (length(matches[[1]]) == 0)
+    return(NULL)
+  
+  session <- matches[[1]][2]
+  subpath <- matches[[1]][3]
+  
+  shinyapp <- appsByToken$get(session)
+  if (is.null(shinyapp))
+    return(NULL)
+  
+  return(shinyapp$handleRequest(ws, header, subpath))
+}
+
 dynamicHandler <- function(filePath, dependencyFiles=filePath) {
   lastKnownTimestamps <- NA
   metaHandler <- function(ws, header) NULL
@@ -258,15 +531,21 @@ dynamicHandler <- function(filePath, dependencyFiles=filePath) {
   if (!file.exists(filePath))
     return(metaHandler)
   
+  cacheContext <- CacheContext$new()
+  
   return (function(ws, header) {
     # Check if we need to rebuild
-    mtime <- file.info(dependencyFiles)$mtime
-    if (!identical(lastKnownTimestamps, mtime)) {
-      lastKnownTimestamps <<- mtime
+    if (cacheContext$isDirty()) {
+      cacheContext$reset()
+      for (dep in dependencyFiles)
+        cacheContext$addDependencyFile(dep)
+
       clearClients()
       if (file.exists(filePath)) {
         local({
-          source(filePath, local=T)
+          cacheContext$with(function() {
+            source(filePath, local=new.env(parent=.GlobalEnv))
+          })
         })
       }
       metaHandler <<- joinHandlers(.globals$clients)
@@ -279,7 +558,7 @@ dynamicHandler <- function(filePath, dependencyFiles=filePath) {
 
 staticHandler <- function(root) {
   return(function(ws, header) {
-    path <- header$RESOURCE
+    path <- header$PATH
     
     if (is.null(path))
       return(httpResponse(400, content="<h1>Bad Request</h1>"))
@@ -292,22 +571,14 @@ staticHandler <- function(root) {
       return(NULL)
     
     ext <- tools::file_ext(abs.path)
-    content.type <- switch(ext,
-                           html='text/html; charset=UTF-8',
-                           htm='text/html; charset=UTF-8',
-                           js='text/javascript',
-                           css='text/css',
-                           png='image/png',
-                           jpg='image/jpeg',
-                           jpeg='image/jpeg',
-                           gif='image/gif',
-                           'application/octet-stream')
+    content.type <- getContentType(ext)
     response.content <- readBin(abs.path, 'raw', n=file.info(abs.path)$size)
     return(httpResponse(200, content.type, response.content))
   })
 }
 
 apps <- Map$new()
+appsByToken <- Map$new()
 
 # Provide a character representation of the WS that can be used
 # as a key in a Map.
@@ -358,7 +629,7 @@ registerClient <- function(client) {
 #' @export
 addResourcePath <- function(prefix, directoryPath) {
   prefix <- prefix[1]
-  if (!grepl('^[a-z][a-z0-9\\-_]*$', prefix, ignore.case=T, perl=T)) {
+  if (!grepl('^[a-z][a-z0-9\\-_]*$', prefix, ignore.case=TRUE, perl=TRUE)) {
     stop("addResourcePath called with invalid prefix; please see documentation")
   }
   
@@ -367,7 +638,7 @@ addResourcePath <- function(prefix, directoryPath) {
          "please use a different prefix")
   }
   
-  directoryPath <- normalizePath(directoryPath, mustWork=T)
+  directoryPath <- normalizePath(directoryPath, mustWork=TRUE)
   
   existing <- .globals$resources[[prefix]]
   
@@ -387,7 +658,7 @@ addResourcePath <- function(prefix, directoryPath) {
 resourcePathHandler <- function(ws, header) {
   path <- header$RESOURCE
   
-  match <- regexpr('^/([^/]+)/', path, perl=T)
+  match <- regexpr('^/([^/]+)/', path, perl=TRUE)
   if (match == -1)
     return(NULL)
   len <- attr(match, 'capture.length')
@@ -400,6 +671,7 @@ resourcePathHandler <- function(ws, header) {
   suffix <- substr(path, 2 + len, nchar(path))
   
   header$RESOURCE <- suffix
+  header <- fixupRequestPath(header)
   
   return(resInfo$func(ws, header))
 }
@@ -430,7 +702,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)
 #'   })
 #' })
@@ -448,7 +720,7 @@ decodeMessage <- function(data) {
   }
   
   if (readInt(1) != 0x01020202L)
-    return(fromJSON(rawToChar(data), asText=T, simplify=F))
+    return(fromJSON(rawToChar(data), asText=TRUE, simplify=FALSE))
   
   i <- 5
   parts <- list()
@@ -467,16 +739,46 @@ decodeMessage <- function(data) {
   return(mainMessage)
 }
 
+# Takes a list-of-lists and returns a matrix. The lists
+# must all be the same length. NULL is replaced by NA.
+unpackMatrix <- function(data) {
+  if (length(data) == 0)
+    return(matrix(nrow=0, ncol=0))
+  
+  m <- matrix(unlist(lapply(data, function(x) {
+    sapply(x, function(y) {
+      ifelse(is.null(y), NA, y)
+    })
+  })), nrow = length(data[[1]]), ncol = length(data))
+  return(m)
+}
+
+# Combine dir and (file)name into a file path. If a file already exists with a
+# name differing only by case, then use it instead.
+file.path.ci <- function(dir, name) {
+  default <- file.path(dir, name)
+  if (file.exists(default))
+    return(default)
+  if (!file.exists(dir))
+    return(default)
+  
+  matches <- list.files(dir, name, ignore.case=TRUE, full.names=TRUE,
+                        include.dirs=TRUE)
+  if (length(matches) == 0)
+    return(default)
+  return(matches[[1]])
+}
+
 # Instantiates the app in the current working directory.
 # port - The TCP port that the application should listen on.
 startApp <- function(port=8101L) {
 
   sys.www.root <- system.file('www', package='shiny')
   
-  globalR <- file.path(getwd(), 'global.R')
-  uiR <- file.path(getwd(), 'ui.R')
-  serverR <- file.path(getwd(), 'server.R')
-  wwwDir <- file.path(getwd(), 'www')
+  globalR <- file.path.ci(getwd(), 'global.R')
+  uiR <- file.path.ci(getwd(), 'ui.R')
+  serverR <- file.path.ci(getwd(), 'server.R')
+  wwwDir <- file.path.ci(getwd(), 'www')
   
   if (!file.exists(uiR) && !file.exists(wwwDir))
     stop(paste("Neither ui.R nor a www subdirectory was found in", getwd()))
@@ -484,13 +786,13 @@ startApp <- function(port=8101L) {
     stop(paste("server.R file was not found in", getwd()))
   
   if (file.exists(globalR))
-    source(globalR, local=F)
+    source(globalR, local=FALSE)
   
   shinyServer(NULL)
   serverFileTimestamp <- NULL
   local({
     serverFileTimestamp <<- file.info(serverR)$mtime
-    source(serverR, local=T)
+    source(serverR, local=new.env(parent=.GlobalEnv))
     if (is.null(.globals$server))
       stop("No server was defined in server.R")
   })
@@ -498,7 +800,8 @@ startApp <- function(port=8101L) {
   
   ws_env <- create_server(
     port=port,
-    webpage=httpServer(c(dynamicHandler(uiR),
+    webpage=httpServer(c(sessionHandler,
+                         dynamicHandler(uiR),
                          wwwDir,
                          sys.www.root,
                          resourcePathHandler)))
@@ -506,14 +809,18 @@ startApp <- function(port=8101L) {
   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', F)) {
+    if (getOption('shiny.trace', FALSE)) {
       if (as.raw(0) %in% DATA)
         message("RECV ", '$$binary data$$')
       else
@@ -530,12 +837,32 @@ startApp <- function(port=8101L) {
     # Do our own list simplifying here. sapply/simplify2array give names to
     # character vectors, which is rarely what we want.
     if (!is.null(msg$data)) {
-      msg$data <- lapply(msg$data, function(x) {
-        if (is.list(x) && is.null(names(x)))
-          unlist(x, recursive=F)
-        else
-          x
-      })
+      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(
@@ -548,17 +875,18 @@ startApp <- function(port=8101L) {
           shinyServer(NULL)
           local({
             serverFileTimestamp <<- mtime
-            source(serverR, local=T)
+            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)
-        flushReact()
         local({
-          serverFunc(input=.createValuesReader(shinyapp$session),
+          serverFunc(input=.createReactiveValues(shinyapp$session, readonly=TRUE),
                      output=.createOutputWriter(shinyapp))
         })
       },
@@ -567,8 +895,12 @@ startApp <- function(port=8101L) {
       },
       shinyapp$dispatch(msg)
     )
+    shinyapp$manageHiddenOutputs()
     flushReact()
-    shinyapp$flushOutput()
+    lapply(apps$values(), function(shinyapp) {
+      shinyapp$flushOutput()
+      NULL
+    })
   }, ws_env)
   
   message('\n', 'Listening on port ', port)
@@ -578,16 +910,20 @@ startApp <- function(port=8101L) {
 
 # NOTE: we de-roxygenized this comment because the function isn't exported
 # Run an application that was created by \code{\link{startApp}}. This
-# function should normally be called in a \code{while(T)} loop.
+# function should normally be called in a \code{while(TRUE)} loop.
 # 
 # @param ws_env The return value from \code{\link{startApp}}.
 serviceApp <- function(ws_env) {
   if (timerCallbacks$executeElapsed()) {
+    for (shinyapp in apps$values()) {
+      shinyapp$manageHiddenOutputs()
+    }
+
     flushReact()
-     lapply(apps$values(), function(shinyapp) {
-       shinyapp$flushOutput()
-       NULL
-     })
+
+    for (shinyapp in apps$values()) {
+      shinyapp$flushOutput()
+    }
   }
 
   # If this R session is interactive, then call service() with a short timeout
@@ -624,7 +960,9 @@ runApp <- function(appDir=getwd(),
   
   orig.wd <- getwd()
   setwd(appDir)
-  on.exit(setwd(orig.wd))
+  on.exit(setwd(orig.wd), add = TRUE)
+  
+  require(shiny)
   
   ws_env <- startApp(port=port)
   
@@ -634,10 +972,11 @@ runApp <- function(appDir=getwd(),
   }
   
   tryCatch(
-    while (T) {
+    while (TRUE) {
       serviceApp(ws_env)
     },
     finally = {
+      timerCallbacks$clear()
       websocket_close(ws_env)
     }
   )
@@ -681,3 +1020,52 @@ runExample <- function(example=NA,
     runApp(dir, port = port, launch.browser = launch.browser)
   }
 }
+
+# This is a wrapper for download.file and has the same interface.
+# 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 http or https, check platform:
+  if (grepl('^https?://', url)) {
+    
+    # If Windows, call setInternet2, then use download.file with defaults.
+    if (.Platform$OS.type == "windows") {
+      # If we directly use setInternet2, R CMD CHECK gives a Note on Mac/Linux
+      mySI2 <- `::`(utils, 'setInternet2')
+      # Store initial settings
+      internet2_start <- mySI2(NA)
+      on.exit(mySI2(internet2_start))
+      
+      # Needed for https
+      mySI2(TRUE)
+      download.file(url, ...)
+      
+    } else {
+      # If non-Windows, check for curl/wget/lynx, then call download.file with
+      # appropriate method.
+      
+      if (nzchar(Sys.which("wget")[1])) {
+        method <- "wget"
+      } else if (nzchar(Sys.which("curl")[1])) {
+        method <- "curl"
+        
+        # curl needs to add a -L option to follow redirects.
+        # Save the original options and restore when we exit.
+        orig_extra_options <- getOption("download.file.extra")
+        on.exit(options(download.file.extra = orig_extra_options))
+        
+        options(download.file.extra = paste("-L", orig_extra_options))
+        
+      } else if (nzchar(Sys.which("lynx")[1])) {
+        method <- "lynx"
+      } else {
+        stop("no download method found")
+      }
+      
+      download.file(url, method = method, ...)
+    }
+    
+  } else {
+    download.file(url, ...)
+  }
+}

R/shinyui.R

@@ -47,6 +47,31 @@ strong <- function(...) tags$strong(...)
 #' @export
 em <- function(...) tags$em(...)
 
+#' @export
+includeHTML <- function(path) {
+  dependsOnFile(path)
+  lines <- readLines(path, warn=FALSE, encoding='UTF-8')
+  return(HTML(paste(lines, collapse='\r\n')))
+}
+
+#' @export
+includeText <- function(path) {
+  dependsOnFile(path)
+  lines <- readLines(path, warn=FALSE, encoding='UTF-8')
+  return(HTML(paste(lines, collapse='\r\n')))
+}
+
+#' @export
+includeMarkdown <- function(path) {
+  if (!require(markdown))
+    stop("Markdown package is not installed")
+  
+  dependsOnFile(path)
+  html <- markdown::markdownToHTML(path, fragment.only=TRUE)
+  Encoding(html) <- 'UTF-8'
+  return(HTML(html))
+}
+
 
 #' Include Content Only Once
 #' 
@@ -81,7 +106,7 @@ renderPage <- function(ui, connection) {
     if (isTag(content) && identical(content$name, "head")) {
       textConn <- textConnection(NULL, "w") 
       textConnWriter <- function(text) cat(text, file = textConn)
-      tagWriteChildren(content, textConnWriter, 1, context)
+      tagWrite(content$children, textConnWriter, 1, context)
       context$head <- append(context$head, textConnectionValue(textConn))
       close(textConn)
       return (FALSE)
@@ -101,10 +126,10 @@ renderPage <- function(ui, connection) {
   writeLines(c('<!DOCTYPE html>',
                '<html>',
                '<head>',
-               '   <meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>',
-               '   <script src="shared/jquery.js" type="text/javascript"></script>',
-               '   <script src="shared/shiny.js" type="text/javascript"></script>',
-               '   <link rel="stylesheet" type="text/css" href="shared/shiny.css"/>',
+               '  <meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>',
+               '  <script src="shared/jquery.js" type="text/javascript"></script>',
+               '  <script src="shared/shiny.js" type="text/javascript"></script>',
+               '  <link rel="stylesheet" type="text/css" href="shared/shiny.css"/>',
                context$head,
                '</head>',
                '<body>', 
@@ -159,10 +184,13 @@ renderPage <- function(ui, connection) {
 #' @export
 shinyUI <- function(ui, path='/') {
   
+  force(ui)
+  
   registerClient({
     
     function(ws, header) {
-      if (header$RESOURCE != path)
+
+      if (header$PATH != path)
         return(NULL)
       
       textConn <- textConnection(NULL, "w") 

R/shinywrappers.R

@@ -5,27 +5,62 @@ 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 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.
-#' @param 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.
+#' @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 
+#'   \code{'auto'}; in the body of the function you may reference reactive 
+#'   values and functions.
+#' @param 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.
 #' @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', ...,
+                       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() })
+
   return(function(shinyapp, name, ...) {
     png.file <- tempfile(fileext='.png')
     
+    if (is.function(width))
+      width <- width()
+    if (is.function(height))
+      height <- height()
+    
     # 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).
@@ -37,8 +72,21 @@ reactivePlot <- function(func, width='auto', height='auto', ...) {
     
     if (width <= 0 || height <= 0)
       return(NULL)
-    
-    do.call(png, c(args, filename=png.file, width=width, height=height))
+
+    # 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(args, filename=png.file, width=width, height=height))
+    on.exit(unlink(png.file))
     tryCatch(
       func(),
       finally=dev.off())
@@ -47,8 +95,15 @@ reactivePlot <- function(func, width='auto', height='auto', ...) {
     if (is.na(bytes))
       return(NULL)
     
-    b64 <- base64encode(readBin(png.file, 'raw', n=bytes))
-    return(paste("data:image/png;base64,", b64, sep=''))
+    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)
+    }
   })
 }
 
@@ -60,17 +115,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}}.
+#' @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) || is.na(data))
+    if (is.null(data))
       return("")
     
     return(paste(
@@ -78,18 +145,19 @@ reactiveTable <- function(func, ...) {
         print(xtable(data, ...), 
               type='html', 
               html.table.attributes=paste('class="',
-                                          htmlEscape(classNames, T),
+                                          htmlEscape(classNames, TRUE),
                                           '"',
-                                          sep=''))),
+                                          sep=''), ...)),
       collapse="\n"))
-  })
+  }
 }
 
 #' Printable Output
 #' 
-#' Makes a reactive version of the given function that also turns its printable
-#' result into a string. The reactive function is suitable for assigning to an 
-#' \code{output} slot.
+#' 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.
 #' 
 #' The corresponding HTML output tag can be anything (though \code{pre} is 
 #' recommended if you need a monospace font and whitespace preserved) and should
@@ -98,13 +166,37 @@ reactiveTable <- function(func, ...) {
 #' The result of executing \code{func} will be printed inside a 
 #' \code{\link[utils]{capture.output}} call.
 #' 
-#' @param func A function that returns a printable R object.
+#' 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}()}.
+#' 
+#' @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{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() {
-    return(paste(capture.output(print(func())), collapse="\n"))
-  })
+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
@@ -120,14 +212,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{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() {
-    return(paste(capture.output(cat(func())), collapse="\n"))
-  })
+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
@@ -138,25 +247,141 @@ 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)
-    return(as.character(result))
+    # Wrap result in tagList in case it is an ordinary list
+    return(as.character(tagList(result)))
+  }
+}
+
+#' File Downloads
+#' 
+#' Allows content from the Shiny application to be made available to the user as
+#' file downloads (for example, downloading the currently visible data as a CSV 
+#' file). Both filename and contents can be calculated dynamically at the time 
+#' the user initiates the download. Assign the return value to a slot on 
+#' \code{output} in your server function, and in the UI use 
+#' \code{\link{downloadButton}} or \code{\link{downloadLink}} to make the
+#' download available.
+#' 
+#' @param filename A string of the filename, including extension, that the 
+#'   user's web browser should default to when downloading the file; or a 
+#'   function that returns such a string. (Reactive values and functions may be 
+#'   used from this function.)
+#' @param content A function that takes a single argument \code{file} that is a 
+#'   file path (string) of a nonexistent temp file, and writes the content to
+#'   that file path. (Reactive values and functions may be used from this
+#'   function.)
+#' @param contentType A string of the download's 
+#'   \href{http://en.wikipedia.org/wiki/Internet_media_type}{content type}, for 
+#'   example \code{"text/csv"} or \code{"image/png"}. If \code{NULL} or 
+#'   \code{NA}, the content type will be guessed based on the filename 
+#'   extension, or \code{application/octet-stream} if the extension is unknown.
+#'   
+#' @examples
+#' \dontrun{
+#' # In server.R:
+#' output$downloadData <- downloadHandler(
+#'   filename = function() {
+#'     paste('data-', Sys.Date(), '.csv', sep='')
+#'   },
+#'   content = function(file) {
+#'     write.csv(data, file)
+#'   }
+#' )
+#' 
+#' # In ui.R:
+#' downloadLink('downloadData', 'Download')
+#' }
+#' 
+#' @export
+downloadHandler <- function(filename, content, contentType=NA) {
+  return(function(shinyapp, name, ...) {
+    shinyapp$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='auto', height='auto', ...)
+}
+
+#' 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/slider.R

@@ -70,7 +70,7 @@ slider <- function(inputId, min, max, value, step = NULL, ...,
   }
   
   # Default state is to not have ticks
-  if (identical(ticks, T)) {
+  if (identical(ticks, TRUE)) {
     # Automatic ticks
     tickCount <- (range / step) + 1
     if (tickCount <= 26)
@@ -101,28 +101,18 @@ slider <- function(inputId, min, max, value, step = NULL, ...,
   }
   
   # build slider
-  sliderFragment <- list(
-    singleton(
-      tags$head(
-        tags$link(rel="stylesheet", 
-                  type="text/css", 
-                  href="shared/slider/css/jquery.slider.min.css"),
-        
-        tags$script(src="shared/slider/js/jquery.slider.min.js")
-      )
-    ),
-    tags$input(id=inputId, type="slider", 
-               name=inputId, value=paste(value, collapse=';'), class="jslider",
-               'data-from'=min, 'data-to'=max, 'data-step'=step,
-               'data-skin'='plastic', 'data-round'=round, 'data-locale'=locale,
-               'data-format'=format, 'data-scale'=ticks,
-               'data-smooth'=FALSE)
-  )
-  
-  if (identical(animate, T))
+  sliderFragment <- list(tags$input(
+    id=inputId, type="slider", 
+    name=inputId, value=paste(value, collapse=';'), class="jslider",
+    'data-from'=min, 'data-to'=max, 'data-step'=step,
+    'data-skin'='plastic', 'data-round'=round, 'data-locale'=locale,
+    'data-format'=format, 'data-scale'=ticks,
+    'data-smooth'=FALSE))
+
+  if (identical(animate, TRUE))
     animate <- animationOptions()
   
-  if (!is.null(animate) && !identical(animate, F)) {
+  if (!is.null(animate) && !identical(animate, FALSE)) {
     if (is.null(animate$playButton))
       animate$playButton <- 'Play'
     if (is.null(animate$pauseButton))

R/tags.R

@@ -16,7 +16,7 @@ htmlEscape <- local({
   )
   .htmlSpecialsPatternAttrib <- paste(names(.htmlSpecialsAttrib), collapse='|')
   
-  function(text, attribute=T) {
+  function(text, attribute=TRUE) {
     pattern <- if(attribute)
       .htmlSpecialsPatternAttrib 
     else
@@ -32,7 +32,7 @@ htmlEscape <- local({
       .htmlSpecials
     
     for (chr in names(specials)) {
-      text <- gsub(chr, specials[[chr]], text, fixed=T)
+      text <- gsub(chr, specials[[chr]], text, fixed=TRUE)
     }
     
     return(text)
@@ -61,7 +61,7 @@ as.character.shiny.tag <- function(x, ...) {
     cat(text, file=f)
   }
   tagWrite(x, textWriter)
-  return(HTML(paste(readLines(f), collapse='\n')))
+  return(HTML(paste(readLines(f, warn=FALSE), collapse='\n')))
 }
 
 #' @S3method print shiny.tag.list
@@ -160,23 +160,7 @@ tag <- function(`_tag_name`, varArgs) {
   return (tag)
 }
 
-tagWriteChildren <- function(tag, textWriter, indent, context) {
-  for (child in tag$children) {
-    if (isTag(child)) {
-      tagWrite(child, textWriter, indent, context)
-    }
-    else {
-      # first call optional filter -- exit function if it returns false
-      if (is.null(context) || is.null(context$filter) || context$filter(child)) {
-        child <- normalizeText(child)
-        indentText <- paste(rep(" ", indent*3), collapse="")
-        textWriter(paste(indentText, child, "\n", sep=""))
-      }
-    }
-  }
-}
-
-tagWrite <- function(tag, textWriter, indent=0, context = NULL) {
+tagWrite <- function(tag, textWriter, indent=0, context = NULL, eol = "\n") {
   
   # optionally process a list of tags
   if (!isTag(tag) && is.list(tag)) {
@@ -189,7 +173,13 @@ tagWrite <- function(tag, textWriter, indent=0, context = NULL) {
     return (NULL)
   
   # compute indent text
-  indentText <- paste(rep(" ", indent*3), collapse="")
+  indentText <- paste(rep(" ", indent*2), collapse="")
+  
+  # Check if it's just text (may either be plain-text or HTML)
+  if (is.character(tag)) {
+    textWriter(paste(indentText, normalizeText(tag), eol, sep=""))
+    return (NULL)
+  }
   
   # write tag name
   textWriter(paste(indentText, "<", tag$name, sep=""))
@@ -210,19 +200,18 @@ tagWrite <- function(tag, textWriter, indent=0, context = NULL) {
   
   # write any children
   if (length(tag$children) > 0) {
+    textWriter(">")
     
     # special case for a single child text node (skip newlines and indentation)
     if ((length(tag$children) == 1) && is.character(tag$children[[1]]) ) {
-      if (is.null(context) || is.null(context$filter) 
-          || context$filter(tag$children[[1]])) {
-        text <- normalizeText(tag$children[[1]])
-        textWriter(paste(">", text, "</", tag$name, ">\n", sep=""))
-      }
+      tagWrite(tag$children[[1]], textWriter, 0, context, "")
+      textWriter(paste("</", tag$name, ">", eol, sep=""))
     }
     else {
-      textWriter(">\n")
-      tagWriteChildren(tag, textWriter, indent+1, context)
-      textWriter(paste(indentText, "</", tag$name, ">\n", sep=""))
+      textWriter("\n")
+      for (child in tag$children)
+        tagWrite(child, textWriter, indent+1, context)
+      textWriter(paste(indentText, "</", tag$name, ">", eol, sep=""))
     }
   }
   else {
@@ -231,16 +220,15 @@ tagWrite <- function(tag, textWriter, indent=0, context = NULL) {
     if (tag$name %in% c("area", "base", "br", "col", "command", "embed", "hr", 
                         "img", "input", "keygen", "link", "meta", "param",
                         "source", "track", "wbr")) {
-      textWriter("/>\n")
+      textWriter(paste("/>", eol, sep=""))
     }
     else {
-      textWriter(paste("></", tag$name, ">\n", sep=""))
+      textWriter(paste("></", tag$name, ">", eol, sep=""))
     }
   }
 }
 
 
-
 # environment used to store all available tags
 #' @export
 tags <- new.env()

R/tar.R

@@ -0,0 +1,191 @@
+# This file was pulled from the R code base as of
+# Thursday, November 22, 2012 at 6:24:55 AM UTC
+# and edited to remove everything but the copyright
+# header and untar2, and to make untar2 more tolerant
+# of the 'x' and 'g' extended block indicators, the
+# latter of which is used in tar files generated by
+# GitHub.
+
+
+#  File src/library/utils/R/tar.R
+#  Part of the R package, http://www.R-project.org
+#
+#  Copyright (C) 1995-2012 The R Core Team
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  A copy of the GNU General Public License is available at
+#  http://www.r-project.org/Licenses/
+
+untar2 <- function(tarfile, files = NULL, list = FALSE, exdir = ".")
+{
+    getOct <- function(x, offset, len)
+    {
+        x <- 0L
+        for(i in offset + seq_len(len)) {
+            z <- block[i]
+            if(!as.integer(z)) break; # terminate on nul
+            switch(rawToChar(z),
+                   " " = {},
+                   "0"=,"1"=,"2"=,"3"=,"4"=,"5"=,"6"=,"7"=
+                   {x <- 8*x + (as.integer(z)-48)},
+                   stop("invalid octal digit")
+                   )
+        }
+        x
+    }
+
+    mydir.create <- function(path, ...) {
+        ## for Windows' sake
+        path <- sub("[\\/]$", "", path)
+        if(file_test("-d", path)) return()
+        if(!dir.create(path, showWarnings = TRUE, recursive = TRUE, ...))
+           stop(gettextf("failed to create directory %s", sQuote(path)),
+                domain = NA)
+    }
+
+    warn1 <- character()
+
+    ## A tar file is a set of 512 byte records,
+    ## a header record followed by file contents (zero-padded).
+    ## See http://en.wikipedia.org/wiki/Tar_%28file_format%29
+    if(is.character(tarfile) && length(tarfile) == 1L) {
+        con <- gzfile(path.expand(tarfile), "rb") # reads compressed formats
+        on.exit(close(con))
+    } else if(inherits(tarfile, "connection")) con <- tarfile
+    else stop("'tarfile' must be a character string or a connection")
+    if (!missing(exdir)) {
+        mydir.create(exdir)
+        od <- setwd(exdir)
+        on.exit(setwd(od), add = TRUE)
+    }
+    contents <- character()
+    llink <- lname <- NULL
+    repeat{
+        block <- readBin(con, "raw", n = 512L)
+        if(!length(block)) break
+        if(length(block) < 512L) stop("incomplete block on file")
+        if(all(block == 0)) break
+        ns <- max(which(block[1:100] > 0))
+        name <- rawToChar(block[seq_len(ns)])
+        magic <- rawToChar(block[258:262])
+        if ((magic == "ustar") && block[346] > 0) {
+            ns <- max(which(block[346:500] > 0))
+            prefix <- rawToChar(block[345+seq_len(ns)])
+            name <- file.path(prefix, name)
+        }
+        ## mode zero-padded 8 bytes (including nul) at 101
+        ## Aargh: bsdtar has this one incorrectly with 6 bytes+space
+        mode <- as.octmode(getOct(block, 100, 8))
+        size <- getOct(block, 124, 12)
+        ts <- getOct(block, 136, 12)
+        ft <- as.POSIXct(as.numeric(ts), origin="1970-01-01", tz="UTC")
+        csum <- getOct(block, 148, 8)
+        block[149:156] <- charToRaw(" ")
+        xx <- as.integer(block)
+        checksum <- sum(xx) %% 2^24 # 6 bytes
+        if(csum != checksum) {
+            ## try it with signed bytes.
+            checksum <- sum(ifelse(xx > 127, xx - 128, xx)) %% 2^24 # 6 bytes
+            if(csum != checksum)
+                warning(gettextf("checksum error for entry '%s'", name),
+                        domain = NA)
+        }
+        type <- block[157L]
+        ctype <- rawToChar(type)
+        if(type == 0L || ctype == "0") {
+            if(!is.null(lname)) {name <- lname; lname <- NULL}
+            contents <- c(contents, name)
+            remain <- size
+            dothis <- !list
+            if(dothis && length(files)) dothis <- name %in% files
+            if(dothis) {
+                mydir.create(dirname(name))
+                out <- file(name, "wb")
+            }
+            for(i in seq_len(ceiling(size/512L))) {
+                block <- readBin(con, "raw", n = 512L)
+                if(length(block) < 512L)
+                    stop("incomplete block on file")
+                if (dothis) {
+                    writeBin(block[seq_len(min(512L, remain))], out)
+                    remain <- remain - 512L
+                }
+            }
+            if(dothis) {
+                close(out)
+                Sys.chmod(name, mode, FALSE) # override umask
+                Sys.setFileTime(name, ft)
+            }
+        } else if(ctype %in% c("1", "2")) { # hard and symbolic links
+            contents <- c(contents, name)
+            ns <- max(which(block[158:257] > 0))
+            name2 <- rawToChar(block[157L + seq_len(ns)])
+            if(!is.null(lname)) {name <- lname; lname <- NULL}
+            if(!is.null(llink)) {name2 <- llink; llink <- NULL}
+            if(!list) {
+                if(ctype == "1") {
+                    if (!file.link(name2, name)) { # will give a warning
+                        ## link failed, so try a file copy
+                        if(file.copy(name2, name))
+                             warn1 <- c(warn1, "restoring hard link as a file copy")
+                        else
+                            warning(gettextf("failed to copy %s to %s", sQuote(name2), sQuote(name)), domain = NA)
+                    }
+                } else {
+                    if(.Platform$OS.type == "windows") {
+                        ## this will not work for links to dirs
+                        from <- file.path(dirname(name), name2)
+                        if (!file.copy(from, name))
+                            warning(gettextf("failed to copy %s to %s", sQuote(from), sQuote(name)), domain = NA)
+                        else
+                            warn1 <- c(warn1, "restoring symbolic link as a file copy")
+                   } else {
+                       if(!file.symlink(name2, name)) { # will give a warning
+                        ## so try a file copy: will not work for links to dirs
+                        from <- file.path(dirname(name), name2)
+                        if (file.copy(from, name))
+                            warn1 <- c(warn1, "restoring symbolic link as a file copy")
+                           else
+                               warning(gettextf("failed to copy %s to %s", sQuote(from), sQuote(name)), domain = NA)
+                       }
+                   }
+                }
+            }
+        } else if(ctype == "5") {
+            contents <- c(contents, name)
+            if(!list) {
+                mydir.create(name)
+                Sys.chmod(name, mode, TRUE) # FIXME: check result
+                ## no point is setting time, as dir will be populated later.
+            }
+        } else if(ctype %in% c("L", "K")) {
+            ## This is a GNU extension that should no longer be
+            ## in use, but it is.
+            name_size <- 512L * ceiling(size/512L)
+            block <- readBin(con, "raw", n = name_size)
+            if(length(block) < name_size)
+                stop("incomplete block on file")
+            ns <- max(which(block > 0)) # size on file may or may not include final nul
+            if(ctype == "L")
+                lname <- rawToChar(block[seq_len(ns)])
+            else
+                llink <- rawToChar(block[seq_len(ns)])
+        } else if(ctype %in% c("x", "g")) {
+            readBin(con, "raw", n = 512L*ceiling(size/512L))
+        } else stop("unsupported entry type ", sQuote(ctype))
+    }
+    if(length(warn1)) {
+        warn1 <- unique(warn1)
+        for (w in warn1) warning(w, domain = NA)
+    }
+    if(list) contents else invisible(0L)
+}

R/timer.R

@@ -15,6 +15,11 @@ TimerCallbacks <- setRefClass(
     initialize = function() {
       .nextId <<- 0L
     },
+    clear = function() {
+      .nextId <<- 0L
+      .funcs$clear()
+      .times <<- data.frame()
+    },
     schedule = function(millis, func) {
       id <- .nextId
       .nextId <<- .nextId + 1L
@@ -51,7 +56,7 @@ TimerCallbacks <- setRefClass(
     executeElapsed = function() {
       elapsed <- takeElapsed()
       if (length(elapsed) == 0)
-        return(F)
+        return(FALSE)
       
       for (id in elapsed$id) {
         thisFunc <- .funcs$remove(as.character(id))
@@ -59,7 +64,7 @@ TimerCallbacks <- setRefClass(
         # TODO: Detect NULL, and...?
         thisFunc()
       }
-      return(T)
+      return(TRUE)
     }
   )
 )

R/utils.R

@@ -0,0 +1,212 @@
+#' Make a random number generator repeatable
+#' 
+#' Given a function that generates random data, returns a wrapped version of 
+#' that function that always uses the same seed when called. The seed to use can
+#' be passed in explicitly if desired; otherwise, a random number is used.
+#' 
+#' @param rngfunc The function that is affected by the R session's seed.
+#' @param seed The seed to set every time the resulting function is called.
+#' @return A repeatable version of the function that was passed in.
+#'   
+#' @note When called, the returned function attempts to preserve the R session's
+#'   current seed by snapshotting and restoring
+#'   \code{\link[base]{.Random.seed}}.
+#'
+#' @examples
+#' rnormA <- repeatable(rnorm)
+#' rnormB <- repeatable(rnorm)
+#' rnormA(3)  # [1]  1.8285879 -0.7468041 -0.4639111
+#' rnormA(3)  # [1]  1.8285879 -0.7468041 -0.4639111
+#' rnormA(5)  # [1]  1.8285879 -0.7468041 -0.4639111 -1.6510126 -1.4686924
+#' rnormB(5)  # [1] -0.7946034  0.2568374 -0.6567597  1.2451387 -0.8375699
+#' 
+#' @export
+repeatable <- function(rngfunc, seed = runif(1, 0, .Machine$integer.max)) {
+  force(seed)
+  
+  function(...) {
+    # When we exit, restore the seed to its original state
+    if (exists('.Random.seed', where=globalenv())) {
+      currentSeed <- get('.Random.seed', pos=globalenv())
+      on.exit(assign('.Random.seed', currentSeed, pos=globalenv()))
+    }
+    else {
+      on.exit(rm('.Random.seed', pos=globalenv()))
+    }
+    
+    set.seed(seed)
+    
+    do.call(rngfunc, list(...))
+  }
+}
+
+`%OR%` <- function(x, y) {
+  ifelse(is.null(x) || is.na(x), y, x)
+}
+
+`%AND%` <- function(x, y) {
+  if (!is.null(x) && !is.na(x))
+    if (!is.null(y) && !is.na(y))
+      return(y)
+  return(NULL)
+}
+
+`%.%` <- function(x, y) {
+  paste(x, y, sep='')
+}
+
+knownContentTypes <- Map$new()
+knownContentTypes$mset(
+  html='text/html; charset=UTF-8',
+  htm='text/html; charset=UTF-8',
+  js='text/javascript',
+  css='text/css',
+  png='image/png',
+  jpg='image/jpeg',
+  jpeg='image/jpeg',
+  gif='image/gif',
+  svg='image/svg+xml',
+  txt='text/plain',
+  pdf='application/pdf',
+  ps='application/postscript',
+  xml='application/xml',
+  m3u='audio/x-mpegurl',
+  m4a='audio/mp4a-latm',
+  m4b='audio/mp4a-latm',
+  m4p='audio/mp4a-latm',
+  mp3='audio/mpeg',
+  wav='audio/x-wav',
+  m4u='video/vnd.mpegurl',
+  m4v='video/x-m4v',
+  mp4='video/mp4',
+  mpeg='video/mpeg',
+  mpg='video/mpeg',
+  avi='video/x-msvideo',
+  mov='video/quicktime',
+  ogg='application/ogg',
+  swf='application/x-shockwave-flash',
+  doc='application/msword',
+  xls='application/vnd.ms-excel',
+  ppt='application/vnd.ms-powerpoint',
+  xlsx='application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
+  xltx='application/vnd.openxmlformats-officedocument.spreadsheetml.template',
+  potx='application/vnd.openxmlformats-officedocument.presentationml.template',
+  ppsx='application/vnd.openxmlformats-officedocument.presentationml.slideshow',
+  pptx='application/vnd.openxmlformats-officedocument.presentationml.presentation',
+  sldx='application/vnd.openxmlformats-officedocument.presentationml.slide',
+  docx='application/vnd.openxmlformats-officedocument.wordprocessingml.document',
+  dotx='application/vnd.openxmlformats-officedocument.wordprocessingml.template',
+  xlam='application/vnd.ms-excel.addin.macroEnabled.12',
+  xlsb='application/vnd.ms-excel.sheet.binary.macroEnabled.12')
+
+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)
+  }
+}
+
+#' 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)
+}

README.md

@@ -2,6 +2,8 @@
 
 Shiny is a new package from RStudio that makes it incredibly easy to build interactive web applications with R.
 
+For an introduction and examples, visit the [Shiny homepage](http://www.rstudio.com/shiny/).
+
 ## Features
 
 * Build useful web applications with only a few lines of code—no JavaScript required.
@@ -20,7 +22,6 @@ Shiny is a new package from RStudio that makes it incredibly easy to build inter
 From an R console:
 
 ```r
-options(repos=c(RStudio="http://rstudio.org/_packages", getOption("repos")))
 install.packages("shiny")
 ```
 

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/04_mpg/ui.R

@@ -10,10 +10,10 @@ shinyUI(pageWithSidebar(
   # and to specify whether outliers should be included
   sidebarPanel(
     selectInput("variable", "Variable:",
-                list("Cylinders" = "cyl", 
-                     "Transmission" = "am", 
-                     "Gears" = "gear")),
-    
+                c("Cylinders" = "cyl",
+                  "Transmission" = "am",
+                  "Gears" = "gear")),
+
     checkboxInput("outliers", "Show outliers", FALSE)
   ),
   

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/05_sliders/ui.R

@@ -27,7 +27,7 @@ shinyUI(pageWithSidebar(
     
     # Animation with custom interval (in ms) to control speed, plus looping
     sliderInput("animation", "Looping Animation:", 1, 2000, 1, step = 10, 
-                animate=animationOptions(interval=300, loop=T))
+                animate=animationOptions(interval=300, loop=TRUE))
   ),
   
   # Show a table summarizing the values entered

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/06_tabsets/ui.R

@@ -11,10 +11,10 @@ shinyUI(pageWithSidebar(
   # element to introduce extra vertical spacing
   sidebarPanel(
     radioButtons("dist", "Distribution type:",
-                 list("Normal" = "norm",
-                      "Uniform" = "unif",
-                      "Log-normal" = "lnorm",
-                      "Exponential" = "exp")),
+                 c("Normal" = "norm",
+                   "Uniform" = "unif",
+                   "Log-normal" = "lnorm",
+                   "Exponential" = "exp")),
     br(),
     
     sliderInput("n", 

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,7 +1,7 @@
 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' 

inst/examples/09_upload/ui.R

@@ -8,14 +8,14 @@ shinyUI(pageWithSidebar(
     tags$hr(),
     checkboxInput('header', 'Header', TRUE),
     radioButtons('sep', 'Separator',
-                 list(Comma=',',
-                      Semicolon=';',
-                      Tab='\t'),
+                 c(Comma=',',
+                   Semicolon=';',
+                   Tab='\t'),
                  'Comma'),
     radioButtons('quote', 'Quote',
-                 list(None='',
-                      'Double Quote'='"',
-                      'Single Quote'="'"),
+                 c(None='',
+                   'Double Quote'='"',
+                   'Single Quote'="'"),
                  'Double Quote')
   ),
   mainPanel(

inst/examples/10_download/server.R

@@ -0,0 +1,19 @@
+shinyServer(function(input, output) {
+  datasetInput <- reactive({
+    switch(input$dataset,
+           "rock" = rock,
+           "pressure" = pressure,
+           "cars" = cars)
+  })
+  
+  output$table <- renderTable({
+    datasetInput()
+  })
+  
+  output$downloadData <- downloadHandler(
+    filename = function() { paste(input$dataset, '.csv', sep='') },
+    content = function(file) {
+      write.csv(datasetInput(), file)
+    }
+  )
+})

inst/examples/10_download/ui.R

@@ -0,0 +1,11 @@
+shinyUI(pageWithSidebar(
+  headerPanel('Downloading Data'),
+  sidebarPanel(
+    selectInput("dataset", "Choose a dataset:", 
+                choices = c("rock", "pressure", "cars")),
+    downloadButton('downloadData', 'Download')
+  ),
+  mainPanel(
+    tableOutput('table')
+  )
+))

inst/tests/test-bootstrap.r

@@ -0,0 +1,17 @@
+context("bootstrap")
+
+test_that("CSS unit validation", {
+  # On error, return NA; on success, return result
+  validateCssUnit_wrap <- function(x) {
+    tryCatch(validateCssUnit(x), error = function(e) { NA_character_ })
+  }
+
+  # Test strings and expected results
+  strings  <- c("100x", "10px", "10.4px", ".4px", "1px0", "px", "5", "%", "5%", "auto", "1auto", "") 
+  expected <- c(NA,     "10px", "10.4px", ".4px", NA,     NA,   NA,  NA,  "5%", "auto", NA,      NA)
+  results <- vapply(strings, validateCssUnit_wrap, character(1), USE.NAMES = FALSE)
+  expect_equal(results, expected)
+
+  # Numbers should return string with "px"
+  expect_equal(validateCssUnit(100), "100px")
+})

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

@@ -0,0 +1,652 @@
+context("reactivity")
+
+
+# Test for correct behavior of ReactiveValues
+test_that("ReactiveValues", {
+  # Creation and indexing into ReactiveValues -------------------------------
+  values <- reactiveValues()
+
+  # $ indexing
+  values$a <- 3
+  expect_equal(isolate(values$a), 3)
+
+  # [[ indexing
+  values[['a']] <- 4
+  expect_equal(isolate(values[['a']]), 4)
+
+  # Create with initialized values
+  values <- reactiveValues(a=1, b=2)
+  expect_equal(isolate(values$a), 1)
+  expect_equal(isolate(values[['b']]), 2)
+
+  # NULL values -------------------------------------------------------------
+  # Initializing with NULL value
+  values <- reactiveValues(a=NULL, b=2)
+  # a should exist and be NULL
+  expect_equal(isolate(names(values)), c("a", "b"))
+  expect_true(is.null(isolate(values$a)))
+
+  # Assigning NULL should keep object (not delete it), and set value to NULL
+  values$b <- NULL
+  expect_equal(isolate(names(values)), c("a", "b"))
+  expect_true(is.null(isolate(values$b)))
+
+
+  # Errors -----------------------------------------------------------------
+  # Error: indexing with non-string
+  expect_error(isolate(values[[1]]))
+  expect_error(isolate(values[[NULL]]))
+  expect_error(isolate(values[[list('a')]]))
+
+  # Error: [ indexing shouldn't work
+  expect_error(isolate(values['a']))
+  expect_error(isolate(values['a'] <- 1))
+
+  # Error: unnamed arguments
+  expect_error(reactiveValues(1))
+  expect_error(reactiveValues(1, b=2))
+
+  # Error: assignment to readonly values
+  values <- .createReactiveValues(ReactiveValues$new(), readonly = TRUE)
+  expect_error(values$a <- 1)
+})
+
+
+# Test for overreactivity. funcB has an indirect dependency on valueA (via
+# funcA) and also a direct dependency on valueA. When valueA changes, funcB
+# should only execute once.
+test_that("Functions are not over-reactive", {
+
+  values <- reactiveValues(A=10)
+
+  funcA <- reactive({
+    values$A
+  })
+
+  funcB <- reactive({
+    funcA()
+    values$A
+  })
+
+  obsC <- observe({
+    funcB()
+  })
+
+  flushReact()
+  expect_equal(execCount(funcB), 1)
+  expect_equal(execCount(obsC), 1)
+
+  values$A <- 11
+  flushReact()
+  expect_equal(execCount(funcB), 2)
+  expect_equal(execCount(obsC), 2)
+})
+
+## "foo => bar" is defined as "foo is a dependency of bar"
+##
+## vA => fB
+## (fB, vA) => obsE
+## (fB, vA) => obsF
+##
+## obsE and obsF should each execute once when vA changes.
+test_that("overreactivity2", {
+  # ----------------------------------------------
+  # Test 1
+  # B depends on A, and observer depends on A and B. The observer uses A and
+  # B, in that order.
+
+  # This is to store the value from observe()
+  observed_value1 <- NA
+  observed_value2 <- NA
+
+  values <- reactiveValues(A=1)
+  funcB  <- reactive({
+    values$A + 5
+  })
+  obsC <- observe({
+    observed_value1 <<-  funcB() * values$A
+  })
+  obsD <- observe({
+    observed_value2 <<-  funcB() * values$A
+  })
+
+  flushReact()
+  expect_equal(observed_value1, 6)   # Should be 1 * (1 + 5) = 6
+  expect_equal(observed_value2, 6)   # Should be 1 * (1 + 5) = 6
+  expect_equal(execCount(funcB), 1)
+  expect_equal(execCount(obsC), 1)
+  expect_equal(execCount(obsD), 1)
+
+  values$A <- 2
+  flushReact()
+  expect_equal(observed_value1, 14)  # Should be 2 * (2 + 5) = 14
+  expect_equal(observed_value2, 14)  # Should be 2 * (2 + 5) = 14
+  expect_equal(execCount(funcB), 2)
+  expect_equal(execCount(obsC), 2)
+  expect_equal(execCount(obsD), 2)
+})
+
+## Test for isolation. funcB depends on funcA depends on valueA. When funcA
+## is invalidated, if its new result is not different than its old result,
+## then it doesn't invalidate its dependents. This is done by adding an observer
+## (valueB) between obsA and funcC.
+##
+## valueA => obsB => valueC => funcD => obsE
+test_that("isolation", {
+  values <- reactiveValues(A=10, C=NULL)
+
+  obsB <- observe({
+    values$C <- values$A > 0
+  })
+
+  funcD <- reactive({
+    values$C
+  })
+
+  obsE <- observe({
+    funcD()
+  })
+
+  flushReact()
+  countD <- execCount(funcD)
+
+  values$A <- 11
+  flushReact()
+  expect_equal(execCount(funcD), countD)
+})
+
+
+## Test for laziness. With lazy evaluation, the observers should "pull" values
+## from their dependent functions. In contrast, eager evaluation would have
+## reactive values and functions "push" their changes down to their descendents.
+test_that("laziness", {
+
+  values <- reactiveValues(A=10)
+
+  funcA <- reactive({
+    values$A > 0
+  })
+
+  funcB <- reactive({
+    funcA()
+  })
+
+  obsC <- observe({
+    if (values$A > 10)
+      return()
+    funcB()
+  })
+
+  flushReact()
+  expect_equal(execCount(funcA), 1)
+  expect_equal(execCount(funcB), 1)
+  expect_equal(execCount(obsC), 1)
+
+  values$A <- 11
+  flushReact()
+  expect_equal(execCount(funcA), 1)
+  expect_equal(execCount(funcB), 1)
+  expect_equal(execCount(obsC), 2)
+})
+
+
+## Suppose B depends on A and C depends on A and B. Then when A is changed,
+## the evaluation order should be A, B, C. Also, each time A is changed, B and
+## C should be run once, if we want to be maximally efficient.
+test_that("order of evaluation", {
+  # ----------------------------------------------
+  # Test 1
+  # B depends on A, and observer depends on A and B. The observer uses A and
+  # B, in that order.
+
+  # This is to store the value from observe()
+  observed_value <- NA
+
+  values <- reactiveValues(A=1)
+  funcB  <- reactive({
+    values$A + 5
+  })
+  obsC <- observe({
+    observed_value <<- values$A * funcB()
+  })
+
+  flushReact()
+  expect_equal(observed_value, 6)   # Should be 1 * (1 + 5) = 6
+  expect_equal(execCount(funcB), 1)
+  expect_equal(execCount(obsC), 1)
+
+  values$A <- 2
+  flushReact()
+  expect_equal(observed_value, 14)  # Should be 2 * (2 + 5) = 14
+  expect_equal(execCount(funcB), 2)
+  expect_equal(execCount(obsC), 2)
+
+
+  # ----------------------------------------------
+  # Test 2:
+  # Same as Test 1, except the observer uses A and B in reversed order.
+  # Resulting values should be the same.
+
+  observed_value <- NA
+
+  values <- reactiveValues(A=1)
+  funcB <- reactive({
+    values$A + 5
+  })
+  obsC <- observe({
+    observed_value <<- funcB() * values$A
+  })
+
+  flushReact()
+  # Should be 1 * (1 + 5) = 6
+  expect_equal(observed_value, 6)
+  expect_equal(execCount(funcB), 1)
+  expect_equal(execCount(obsC), 1)
+
+  values$A <- 2
+  flushReact()
+  # Should be 2 * (2 + 5) = 14
+  expect_equal(observed_value, 14)
+  expect_equal(execCount(funcB), 2)
+  expect_equal(execCount(obsC), 2)
+})
+
+
+## Expressions in isolate() should not invalidate the parent context.
+test_that("isolate() blocks invalidations from propagating", {
+
+  obsC_value <- NA
+  obsD_value <- NA
+
+  values <- reactiveValues(A=1, B=10)
+  funcB <- reactive({
+    values$B + 100
+  })
+
+  # References to valueB and funcB are isolated
+  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({
+    obsD_value <<-
+      values$A + isolate(values$B) + funcB()
+  })
+
+
+  flushReact()
+  expect_equal(obsC_value, 121)
+  expect_equal(execCount(obsC), 1)
+  expect_equal(obsD_value, 121)
+  expect_equal(execCount(obsD), 1)
+
+  # Changing A should invalidate obsC and obsD
+  values$A <- 2
+  flushReact()
+  expect_equal(obsC_value, 122)
+  expect_equal(execCount(obsC), 2)
+  expect_equal(obsD_value, 122)
+  expect_equal(execCount(obsD), 2)
+
+  # Changing B shouldn't invalidate obsC becuause references to B are in isolate()
+  # But it should invalidate obsD.
+  values$B <- 20
+  flushReact()
+  expect_equal(obsC_value, 122)
+  expect_equal(execCount(obsC), 2)
+  expect_equal(obsD_value, 142)
+  expect_equal(execCount(obsD), 3)
+
+  # Changing A should invalidate obsC and obsD, and they should see updated
+  # values for valueA, valueB, and funcB
+  values$A <- 3
+  flushReact()
+  expect_equal(obsC_value, 143)
+  expect_equal(execCount(obsC), 3)
+  expect_equal(obsD_value, 143)
+  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({
+    # Each time fB executes, it reads and then writes valueA,
+    # effectively invalidating itself--until valueA becomes 0.
+    if (values$A == 0)
+      return()
+    values$A <- values$A - 1
+    return(values$A)
+  })
+
+  obsC <- observe({
+    funcB()
+  })
+
+  flushReact()
+  expect_equal(execCount(obsC), 4)
+
+  values$A <- 3
+
+  flushReact()
+  expect_equal(execCount(obsC), 8)
+
+})
+
+test_that("Simple recursion", {
+
+  values <- reactiveValues(A=5)
+  funcB <- reactive({
+    if (values$A == 0)
+      return(0)
+    values$A <- values$A - 1
+    funcB()
+  })
+
+  obsC <- observe({
+    funcB()
+  })
+
+  flushReact()
+  expect_equal(execCount(obsC), 2)
+  expect_equal(execCount(funcB), 6)
+})
+
+test_that("Non-reactive recursion", {
+  nonreactiveA <- 3
+  outputD <- NULL
+
+  funcB <- reactive({
+    if (nonreactiveA == 0)
+      return(0)
+    nonreactiveA <<- nonreactiveA - 1
+    return(funcB())
+  })
+  obsC <- observe({
+    outputD <<- funcB()
+  })
+
+  flushReact()
+  expect_equal(execCount(funcB), 4)
+  expect_equal(outputD, 0)
+})
+
+test_that("Circular dep with observer only", {
+
+  values <- reactiveValues(A=3)
+  obsB <- observe({
+    if (values$A == 0)
+      return()
+    values$A <- values$A - 1
+  })
+
+  flushReact()
+  expect_equal(execCount(obsB), 4)
+})
+
+test_that("Writing then reading value is not circular", {
+
+  values <- reactiveValues(A=3)
+  funcB <- reactive({
+    values$A <- isolate(values$A) - 1
+    values$A
+  })
+
+  obsC <- observe({
+    funcB()
+  })
+
+  flushReact()
+  expect_equal(execCount(obsC), 1)
+
+  values$A <- 10
+
+  flushReact()
+  expect_equal(execCount(obsC), 2)
+})
+
+test_that("names() and reactiveValuesToList()", {
+
+  values <- reactiveValues(A=1, .B=2)
+
+  # Dependent on names
+  depNames <- observe({
+    names(values)
+  })
+
+  # Dependent on all non-hidden objects
+  depValues <- observe({
+    reactiveValuesToList(values)
+  })
+
+  # Dependent on all objects, including hidden
+  depAllValues <- observe({
+    reactiveValuesToList(values, all.names = TRUE)
+  })
+
+  # names() returns all names
+  expect_equal(sort(isolate(names(values))), sort(c(".B", "A")))
+  # Assigning names fails
+  expect_error(isolate(names(v) <- c('x', 'y')))
+
+  expect_equal(isolate(reactiveValuesToList(values)), list(A=1))
+  expect_equal(isolate(reactiveValuesToList(values, all.names=TRUE)), list(A=1, .B=2))
+
+
+  flushReact()
+  expect_equal(execCount(depNames), 1)
+  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-tags.r

@@ -0,0 +1,23 @@
+context("tags")
+
+test_that("Basic tag writing works", {
+  expect_equal(as.character(tagList("hi")), HTML("hi"))
+  expect_equal(
+    as.character(tagList("one", "two", tagList("three"))),
+    HTML("one\ntwo\nthree"))
+  expect_equal(
+    as.character(tags$b("one")),
+    HTML("<b>one</b>"))
+  expect_equal(
+    as.character(tags$b("one", "two")),
+    HTML("<b>\n  one\n  two\n</b>"))
+  expect_equal(
+    as.character(tagList(list("one"))),
+    HTML("one"))
+  expect_equal(
+    as.character(tagList(list(tagList("one")))),
+    HTML("one"))
+  expect_equal(
+    as.character(tagList(tags$br(), "one")),
+    HTML("<br/>\none"))
+})

inst/tests/test-text.R

@@ -0,0 +1,56 @@
+context("text")
+
+test_that("renderPrint and renderText behavior is correct", {
+  expect_equal(isolate(renderPrint({ "foo" })()),
+               '[1] "foo"')
+  expect_equal(isolate(renderPrint({ invisible("foo") })()),
+               '')
+  expect_equal(isolate(renderPrint({ print("foo"); "bar"})()),
+               '[1] "foo"\n[1] "bar"')
+  expect_equal(isolate(renderPrint({ NULL })()),
+               'NULL')
+  expect_equal(isolate(renderPrint({ invisible() })()),
+               '')
+  expect_equal(isolate(renderPrint({ 1:5 })()),
+               '[1] 1 2 3 4 5')
+  
+  expect_equal(isolate(renderText({ "foo" })()),
+               '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(renderText({ print("foo"); "bar"})()))
+  expect_equal(ret, 'bar')
+  expect_equal(print_out, '[1] "foo"')
+  expect_equal(isolate(renderText({ NULL })()),
+               '')
+  expect_equal(isolate(renderText({ invisible() })()),
+               '')
+  expect_equal(isolate(renderText({ 1:5 })()),
+               '1 2 3 4 5')  
+})
+
+test_that("reactive functions save visibility state", {
+  # Call each function twice - should be no change in state with second call
+
+  # invisible NULL
+  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({ 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({ 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({ 10 })
+  expect_identical(withVisible(isolate(f())), list(value=10, visible=TRUE))
+  expect_identical(withVisible(isolate(f())), list(value=10, visible=TRUE))
+})

inst/www/shared/shiny.css

@@ -14,6 +14,10 @@ table.data td[align=right] {
 .shiny-output-error {
   color: red;
 }
+.shiny-output-error:before {
+  content: 'Error: ';
+  font-weight: bold;
+}
 
 .jslider {
   /* Fix jslider running into the control above it */

inst/www/shared/shiny.js

@@ -4,6 +4,10 @@
 
   var exports = window.Shiny = window.Shiny || {};
 
+  $(document).on('submit', 'form:not([action])', function(e) {
+    e.preventDefault();
+  });
+
   function randomId() {
     return Math.floor(0x100000000 + (Math.random() * 0xF00000000)).toString(16);
   }
@@ -274,8 +278,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);
 
@@ -350,12 +359,12 @@
     }
 
     // Don't mutate list argument
-    list = slice(list, 0);
+    list = list.slice(0);
 
     for (var chunkSize = 1; chunkSize < list.length; chunkSize *= 2) {
       for (var i = 0; i < list.length; i += chunkSize * 2) {
-        var listA = slice(list, i, i + chunkSize);
-        var listB = slice(list, i + chunkSize, i + chunkSize * 2);
+        var listA = list.slice(i, i + chunkSize);
+        var listB = list.slice(i + chunkSize, i + chunkSize * 2);
         var merged = merge(sortfunc, listA, listB);
         var args = [i, merged.length];
         Array.prototype.push.apply(args, merged);
@@ -394,6 +403,11 @@
       if (this.$socket)
         throw "Connect was already called on this application object";
 
+      $.extend(initialInput, {
+        // IE8 and IE9 have some limitations with data URIs
+        "__allowDataUriScheme": typeof WebSocket !== 'undefined'
+      });
+
       this.$socket = this.createSocket();
       this.$initialInput = initialInput;
       $.extend(this.$inputValues, initialInput);
@@ -563,6 +577,7 @@
         exports.oncustommessage(msgObj.custom);
       }
       if (msgObj.values) {
+        $(document.documentElement).removeClass('shiny-busy');
         for (name in this.$bindings)
           this.$bindings[name].showProgress(false);
       }
@@ -578,6 +593,7 @@
         }
       }
       if (msgObj.progress) {
+        $(document.documentElement).addClass('shiny-busy');
         for (var i = 0; i < msgObj.progress.length; i++) {
           var key = msgObj.progress[i];
           var binding = this.$bindings[key];
@@ -847,7 +863,7 @@
       this.renderError(el, err);
     };
     this.renderError = function(el, err) {
-      $(el).addClass('shiny-output-error').text('ERROR: ' + err.message);
+      $(el).addClass('shiny-output-error').text(err.message);
     };
     this.clearError = function(el) {
       $(el).removeClass('shiny-output-error');
@@ -879,12 +895,16 @@
       return $(scope).find('.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;
+      }
+
       $(el).empty();
-      if (!data)
-        return;
-      var img = document.createElement('img');
-      img.src = data;
-      $(el).append(img);
+      if (img)
+        $(el).append(img);
     }
   });
   outputBindings.register(plotOutputBinding, 'shiny.plotOutput');
@@ -901,6 +921,17 @@
     }
   });
   outputBindings.register(htmlOutputBinding, 'shiny.htmlOutput');
+  
+  var downloadLinkOutputBinding = new OutputBinding();
+  $.extend(downloadLinkOutputBinding, {
+    find: function(scope) {
+      return $(scope).find('a.shiny-download-link');
+    },
+    renderValue: function(el, data) {
+      $(el).attr('href', data);
+    }
+  })
+  outputBindings.register(downloadLinkOutputBinding, 'shiny.downloadLink');
 
 
   var InputBinding = exports.InputBinding = function() {
@@ -916,6 +947,9 @@
       return el['data-input-id'] || el.id;
     };
   
+    // Gives the input a type in case the server needs to know it
+    // to deserialize the JSON correctly
+    this.getType = function() { return false; }
     this.getValue = function(el) { throw "Not implemented"; };
     this.subscribe = function(el, callback) { };
     this.unsubscribe = function(el) { };
@@ -978,17 +1012,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)
@@ -1249,6 +1288,7 @@
 
       // Send later in case DOM layout isn't final yet.
       setTimeout(sendPlotSize, 0);
+      setTimeout(sendOutputHiddenState, 0);
     }
 
     function unbindOutputs(scope) {
@@ -1273,9 +1313,9 @@
         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);
 
     inputs = inputsRate;
     $('input[type="submit"], button[type="submit"]').each(function() {
@@ -1294,9 +1334,13 @@
     
     function valueChangeCallback(binding, el, allowDeferred) {
       var id = binding.getId(el);
-      var el = binding.getValue(el);
-      if (id)
+      if (id) {
+        var el = binding.getValue(el);
+        var type = binding.getType(el);
+        if (type)
+          id = id + ":" + type
         inputs.setInput(id, el, !allowDeferred);
+      }
     }
     
     function bindInputs(scope) {
@@ -1321,7 +1365,9 @@
           if (!id || boundInputs[id])
             continue;
     
-          currentValues[id] = binding.getValue(el);
+          var type = binding.getType(el);
+          var effectiveId = type ? id + ":" + type : id;
+          currentValues[effectiveId] = binding.getValue(el);
 
           var thisCallback = (function() {
             var thisBinding = binding;
@@ -1337,7 +1383,7 @@
           var ratePolicy = binding.getRatePolicy();
           if (ratePolicy != null) {
             inputsRate.setRatePolicy(
-              id,
+              effectiveId,
               ratePolicy.policy,
               ratePolicy.delay);
           }
@@ -1455,15 +1501,37 @@
     // 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;
+      if (this.offsetWidth !== 0 || this.offsetHeight !== 0) {
+        initialValues['.shinyout_' + this.id + '_width'] = this.offsetWidth;
+        initialValues['.shinyout_' + 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);
+        if (this.offsetWidth !== 0 || this.offsetHeight !== 0) {
+          inputs.setInput('.shinyout_' + this.id + '_width', this.offsetWidth);
+          inputs.setInput('.shinyout_' + this.id + '_height', this.offsetHeight);
+        }
+      });
+    }
+
+    // Set initial state of outputs to hidden, if needed
+    $('.shiny-bound-output').each(function() {
+      if (this.offsetWidth === 0 && this.offsetHeight === 0) {
+        initialValues['.shinyout_' + this.id + '_hidden'] = true;
+      } else {
+        initialValues['.shinyout_' + 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 (this.offsetWidth === 0 && this.offsetHeight === 0) {
+          inputs.setInput('.shinyout_' + this.id + '_hidden', true);
+        } else {
+          inputs.setInput('.shinyout_' + this.id + '_hidden', false);
+        }
       });
     }
     // The size of each plot may change either because the browser window was
@@ -1471,9 +1539,12 @@
     // 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);
+    $('body').on('shown.sendPlotSize', '*', sendPlotSize);
+    $('body').on('shown.sendOutputHiddenState hidden.sendOutputHiddenState', '*',
+                 sendOutputHiddenState);
 
     // We've collected all the initial values--start the server process!
+    inputsNoResend.reset(initialValues);
     shinyapp.connect(initialValues);
   } // function initShiny()
 

man/bootstrapPage.Rd

@@ -0,0 +1,26 @@
+\name{bootstrapPage}
+\alias{bootstrapPage}
+\title{Create a Twitter Bootstrap page}
+\usage{
+  bootstrapPage(...)
+}
+\arguments{
+  \item{...}{The contents of the document body.}
+}
+\value{
+  A UI defintion that can be passed to the \link{shinyUI}
+  function.
+}
+\description{
+  Create a Shiny UI page that loads the CSS and JavaScript
+  for \href{http://getbootstrap.com}{Twitter Bootstrap},
+  and has no content in the page body (other than what you
+  provide).
+}
+\details{
+  This function is primarily intended for users who are
+  proficient in HTML/CSS, and know how to lay out pages in
+  Bootstrap. Most users should use template functions like
+  \code{\link{pageWithSidebar}}.
+}
+

man/checkboxGroupInput.Rd

@@ -29,9 +29,9 @@
 }
 \examples{
 checkboxGroupInput("variable", "Variable:",
-                   list("Cylinders" = "cyl",
-                        "Transmission" = "am",
-                        "Gears" = "gear"))
+                   c("Cylinders" = "cyl",
+                     "Transmission" = "am",
+                     "Gears" = "gear"))
 }
 \seealso{
   \code{\link{checkboxInput}}

man/conditionalPanel.Rd

@@ -30,18 +30,18 @@
 sidebarPanel(
    selectInput(
       "plotType", "Plot Type",
-      list(Scatter = "scatter",
-           Histogram = "hist")),
+      c(Scatter = "scatter",
+        Histogram = "hist")),
 
    # Only show this panel if the plot type is a histogram
    conditionalPanel(
       condition = "input.plotType == 'hist'",
       selectInput(
          "breaks", "Breaks",
-         list("Sturges",
-              "Scott",
-              "Freedman-Diaconis",
-              "[Custom]" = "custom")),
+         c("Sturges",
+           "Scott",
+           "Freedman-Diaconis",
+           "[Custom]" = "custom")),
 
       # Only show this panel if Custom is selected
       conditionalPanel(

man/downloadButton.Rd

@@ -0,0 +1,46 @@
+\name{downloadButton}
+\alias{downloadButton}
+\alias{downloadLink}
+\title{Create a download button or link}
+\usage{
+  downloadButton(outputId, label = "Download",
+    class = NULL)
+
+  downloadLink(outputId, label = "Download", class = NULL)
+}
+\arguments{
+  \item{outputId}{The name of the output slot that the
+  \code{downloadHandler} is assigned to.}
+
+  \item{label}{The label that should appear on the button.}
+
+  \item{class}{Additional CSS classes to apply to the tag,
+  if any.}
+}
+\description{
+  Use these functions to create a download button or link;
+  when clicked, it will initiate a browser download. The
+  filename and contents are specified by the corresponding
+  \code{\link{downloadHandler}} defined in the server
+  function.
+}
+\examples{
+\dontrun{
+# In server.R:
+output$downloadData <- downloadHandler(
+  filename = function() {
+    paste('data-', Sys.Date(), '.csv', sep='')
+  },
+  content = function(con) {
+    write.csv(data, con)
+  }
+)
+
+# In ui.R:
+downloadLink('downloadData', 'Download')
+}
+}
+\seealso{
+  downloadHandler
+}
+

man/downloadHandler.Rd

@@ -0,0 +1,55 @@
+\name{downloadHandler}
+\alias{downloadHandler}
+\title{File Downloads}
+\usage{
+  downloadHandler(filename, content, contentType = NA)
+}
+\arguments{
+  \item{filename}{A string of the filename, including
+  extension, that the user's web browser should default to
+  when downloading the file; or a function that returns
+  such a string. (Reactive values and functions may be used
+  from this function.)}
+
+  \item{content}{A function that takes a single argument
+  \code{file} that is a file path (string) of a nonexistent
+  temp file, and writes the content to that file path.
+  (Reactive values and functions may be used from this
+  function.)}
+
+  \item{contentType}{A string of the download's
+  \href{http://en.wikipedia.org/wiki/Internet_media_type}{content
+  type}, for example \code{"text/csv"} or
+  \code{"image/png"}. If \code{NULL} or \code{NA}, the
+  content type will be guessed based on the filename
+  extension, or \code{application/octet-stream} if the
+  extension is unknown.}
+}
+\description{
+  Allows content from the Shiny application to be made
+  available to the user as file downloads (for example,
+  downloading the currently visible data as a CSV file).
+  Both filename and contents can be calculated dynamically
+  at the time the user initiates the download. Assign the
+  return value to a slot on \code{output} in your server
+  function, and in the UI use \code{\link{downloadButton}}
+  or \code{\link{downloadLink}} to make the download
+  available.
+}
+\examples{
+\dontrun{
+# In server.R:
+output$downloadData <- downloadHandler(
+  filename = function() {
+    paste('data-', Sys.Date(), '.csv', sep='')
+  },
+  content = function(file) {
+    write.csv(data, file)
+  }
+)
+
+# In ui.R:
+downloadLink('downloadData', 'Download')
+}
+}
+

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/headerPanel.Rd

@@ -2,10 +2,14 @@
 \alias{headerPanel}
 \title{Create a header panel}
 \usage{
-  headerPanel(title)
+  headerPanel(title, windowTitle = title)
 }
 \arguments{
   \item{title}{An application title to display}
+
+  \item{windowTitle}{The title that should be displayed by
+  the browser window.  Useful if \code{title} is not a
+  string.}
 }
 \value{
   A headerPanel that can be passed to

man/helpText.Rd

@@ -2,12 +2,11 @@
 \alias{helpText}
 \title{Create a help text element}
 \usage{
-  helpText(text, ...)
+  helpText(...)
 }
 \arguments{
-  \item{text}{Help text string}
-
-  \item{...}{Additional help text strings}
+  \item{...}{One or more help text strings (or other inline
+  HTML elements)}
 }
 \value{
   A help text element that can be added to a UI definition.

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/include.Rd

@@ -0,0 +1,54 @@
+\name{includeHTML}
+\alias{includeHTML}
+\alias{includeText}
+\alias{includeMarkdown}
+
+\usage{
+  includeHTML(path)
+  includeText(path)
+  includeMarkdown(path)
+}
+
+\title{Include Content From a File}
+
+\arguments{
+  \item{path}{
+    The path of the file to be included. It is highly recommended to
+    use a relative path (the base path being the Shiny application
+    directory), not an absolute path.
+  }
+}
+\description{
+  Include HTML, text, or rendered Markdown into a \link[=shinyUI]{Shiny UI}.
+}
+\details{
+  These functions provide a convenient way to include an extensive amount
+  of HTML, textual, or Markdown content, rather than using a large literal R
+  string.
+}
+\note{
+  \code{includeText} escapes its contents, but does no other processing. This
+  means that hard breaks and multiple spaces will be rendered as they usually
+  are in HTML: as a single space character. If you are looking for
+  preformatted text, wrap the call with \code{\link{pre}}, or consider using
+  \code{includeMarkdown} instead.
+}
+\note{
+  The \code{includeMarkdown} function requires the \code{markdown} package.
+}
+\examples{
+doc <- tags$html(
+  tags$head(
+    tags$title('My first page')
+  ),
+  tags$body(
+    h1('My first heading'),
+    p('My first paragraph, with some ',
+      strong('bold'),
+      ' text.'),
+    div(id='myDiv', class='simpleDiv',
+        'Here is a div with some attributes.')
+  )
+)
+cat(as.character(doc))
+}

man/isolate.Rd

@@ -0,0 +1,84 @@
+\name{isolate}
+\alias{isolate}
+\title{Create a non-reactive scope for an expression}
+\usage{
+  isolate(expr)
+}
+\arguments{
+  \item{expr}{An expression that can access reactive values
+  or expressions.}
+}
+\description{
+  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.
+}
+\details{
+  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
+  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{
+observe({
+  input$saveButton  # Do take a dependency on input$saveButton
+
+  # isolate a simple expression
+  data <- get(isolate(input$dataset))  # No dependency on input$dataset
+  writeToDatabase(data)
+})
+
+observe({
+  input$saveButton  # Do take a dependency on input$saveButton
+
+  # isolate a whole block
+  data <- isolate({
+    a <- input$valueA   # No dependency on input$valueA or input$valueB
+    b <- input$valueB
+    c(a=a, b=b)
+  })
+  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

@@ -0,0 +1,68 @@
+\name{observe}
+\alias{observe}
+\title{Create a reactive observer}
+\usage{
+  observe(x, env = parent.frame(), quoted = FALSE,
+    label = NULL, suspended = FALSE)
+}
+\arguments{
+  \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 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 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).
+}
+\details{
+  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/plotOutput.Rd

@@ -7,7 +7,10 @@
 \arguments{
   \item{outputId}{output variable to read the plot from}
 
-  \item{width}{Plot width}
+  \item{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 string and have
+  \code{"px"} appended.}
 
   \item{height}{Plot height}
 }
@@ -15,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/radioButtons.Rd

@@ -27,9 +27,9 @@
 }
 \examples{
 radioButtons("dist", "Distribution type:",
-             list("Normal" = "norm",
-                  "Uniform" = "unif",
-                  "Log-normal" = "lnorm",
-                  "Exponential" = "exp"))
+             c("Normal" = "norm",
+               "Uniform" = "unif",
+               "Log-normal" = "lnorm",
+               "Exponential" = "exp"))
 }
 

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,31 +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.}
+  \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.}
+  \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}.
+  See \code{\link{renderPlot}}.
 }
 

man/reactivePrint.Rd

@@ -1,26 +1,13 @@
 \name{reactivePrint}
 \alias{reactivePrint}
-\title{Printable Output}
+\title{Print output (deprecated)}
 \usage{
   reactivePrint(func)
 }
 \arguments{
-  \item{func}{A function that returns a printable R
-  object.}
+  \item{func}{A function.}
 }
 \description{
-  Makes a reactive version of the given function that also
-  turns its printable result into a string. The reactive
-  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.
+  See \code{\link{renderPrint}}.
 }
 

man/reactiveTable.Rd

@@ -1,22 +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}}.}
+  \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,26 +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.
+  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

@@ -0,0 +1,47 @@
+\name{reactiveValues}
+\alias{reactiveValues}
+\title{Create an object for storing reactive values}
+\usage{
+  reactiveValues(...)
+}
+\arguments{
+  \item{...}{Objects that will be added to the
+  reactivevalues object. All of these objects must be
+  named.}
+}
+\description{
+  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 expression takes a
+  reactive dependency on that value, and when you write to
+  it, it notifies any reactive functions that depend on
+  that value.
+}
+\examples{
+# Create the object with no values
+values <- reactiveValues()
+
+# Assign values to 'a' and 'b'
+values$a <- 3
+values[['b']] <- 4
+
+\dontrun{
+# From within a reactive context, you can access values with:
+values$a
+values[['a']]
+}
+
+# If not in a reactive context (e.g., at the console), you can use isolate()
+# to retrieve the value:
+isolate(values$a)
+isolate(values[['a']])
+
+# Set values upon creation
+values <- reactiveValues(a = 1, b = 2)
+isolate(values$a)
+}
+\seealso{
+  \code{\link{isolate}}.
+}
+

man/reactiveValuesToList.Rd

@@ -0,0 +1,33 @@
+\name{reactiveValuesToList}
+\alias{reactiveValuesToList}
+\title{Convert a reactivevalues object to a list}
+\usage{
+  reactiveValuesToList(x, all.names = FALSE)
+}
+\arguments{
+  \item{x}{A reactivevalues object.}
+
+  \item{all.names}{If \code{TRUE}, include objects with a
+  leading dot. If \code{FALSE} (the default) don't include
+  those objects.}
+}
+\description{
+  This function does something similar to what you might
+  \code{\link{as.list}} to do. The difference is that the
+  calling context will take dependencies on every object in
+  the reactivevalues object. To avoid taking dependencies
+  on all the objects, you can wrap the call with
+  \code{\link{isolate}()}.
+}
+\examples{
+values <- reactiveValues(a = 1)
+\dontrun{
+reactiveValuesToList(values)
+}
+
+# To get the objects without taking dependencies on them, use isolate().
+# isolate() can also be used when calling from outside a reactive context (e.g.
+# at the console)
+isolate(reactiveValuesToList(values))
+}
+

man/renderPlot.Rd

@@ -0,0 +1,56 @@
+\name{renderPlot}
+\alias{renderPlot}
+\title{Plot Output}
+\usage{
+  renderPlot(expr, width = "auto", height = "auto", ...,
+    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{...}{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}.
+
+  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/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

@@ -0,0 +1,35 @@
+\name{runGist}
+\alias{runGist}
+\title{Run a Shiny application from https://gist.github.com}
+\usage{
+  runGist(gist, port = 8100L,
+    launch.browser = getOption("shiny.launch.browser", interactive()))
+}
+\arguments{
+  \item{gist}{The identifier of the gist. For example, if
+  the gist is https://gist.github.com/jcheng5/3239667, then
+  \code{3239667}, \code{'3239667'}, and
+  \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.}
+
+  \item{launch.browser}{If true, the system's default web
+  browser will be launched automatically after the app is
+  started. Defaults to true in interactive sessions only.}
+}
+\description{
+  Download and launch a Shiny application that is hosted on
+  GitHub as a gist.
+}
+\examples{
+\dontrun{
+runGist(3239667)
+runGist("https://gist.github.com/jcheng5/3239667")
+
+# Old URL format without username
+runGist("https://gist.github.com/3239667")
+}
+}
+

man/runGitHub.Rd

@@ -0,0 +1,41 @@
+\name{runGitHub}
+\alias{runGitHub}
+\title{Run a Shiny application from a GitHub repository}
+\usage{
+  runGitHub(repo, username = getOption("github.user"),
+    ref = "master", subdir = NULL, port = 8100,
+    launch.browser = getOption("shiny.launch.browser", interactive()))
+}
+\arguments{
+  \item{repo}{Name of the repository}
+
+  \item{username}{GitHub username}
+
+  \item{ref}{Desired git reference. Could be a commit, tag,
+  or branch name. Defaults to \code{"master"}.}
+
+  \item{subdir}{A subdirectory in the repository that
+  contains the app. By default, this function will run an
+  app from the top level of the repo, but you can use a
+  path such as `\code{"inst/shinyapp"}.}
+
+  \item{port}{The TCP port that the application should
+  listen on. Defaults to port 8100.}
+
+  \item{launch.browser}{If true, the system's default web
+  browser will be launched automatically after the app is
+  started. Defaults to true in interactive sessions only.}
+}
+\description{
+  Download and launch a Shiny application that is hosted in
+  a GitHub repository.
+}
+\examples{
+\dontrun{
+runGitHub("shiny_example", "rstudio")
+
+# Can run an app from a subdirectory in the repo
+runGitHub("shiny_example", "rstudio", subdir = "inst/shinyapp/")
+}
+}
+

man/runUrl.Rd

@@ -0,0 +1,44 @@
+\name{runUrl}
+\alias{runUrl}
+\title{Run a Shiny application from a URL}
+\usage{
+  runUrl(url, filetype = NULL, subdir = NULL, port = 8100,
+    launch.browser = getOption("shiny.launch.browser", interactive()))
+}
+\arguments{
+  \item{url}{URL of the application.}
+
+  \item{filetype}{The file type (\code{".zip"},
+  \code{".tar"}, or \code{".tar.gz"}. Defaults to the file
+  extension taken from the url.}
+
+  \item{subdir}{A subdirectory in the repository that
+  contains the app. By default, this function will run an
+  app from the top level of the repo, but you can use a
+  path such as `\code{"inst/shinyapp"}.}
+
+  \item{port}{The TCP port that the application should
+  listen on. Defaults to port 8100.}
+
+  \item{launch.browser}{If true, the system's default web
+  browser will be launched automatically after the app is
+  started. Defaults to true in interactive sessions only.}
+}
+\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. 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{
+runUrl('https://github.com/rstudio/shiny_example/archive/master.tar.gz')
+
+# Can run an app from a subdirectory in the archive
+runUrl("https://github.com/rstudio/shiny_example/archive/master.zip",
+ subdir = "inst/shinyapp/")
+}
+}
+

man/selectInput.Rd

@@ -33,8 +33,8 @@
 }
 \examples{
 selectInput("variable", "Variable:",
-            list("Cylinders" = "cyl",
-                 "Transmission" = "am",
-                 "Gears" = "gear"))
+            c("Cylinders" = "cyl",
+              "Transmission" = "am",
+              "Gears" = "gear"))
 }
 

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{

man/wellPanel.Rd

@@ -0,0 +1,18 @@
+\name{wellPanel}
+\alias{wellPanel}
+\title{Create a well panel}
+\usage{
+  wellPanel(...)
+}
+\arguments{
+  \item{...}{UI elements to include inside the panel.}
+}
+\value{
+  The newly created panel.
+}
+\description{
+  Creates a panel with a slightly inset border and grey
+  background. Equivalent to Twitter Bootstrap's \code{well}
+  CSS class.
+}
+

res/text-example.R

@@ -0,0 +1,62 @@
+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'
+
+})

tests/test-all.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(shiny)
+
+test_package("shiny")