Bump version and update NEWS

Conflicts:
	man/plotOutput.Rd

.Rbuildignore

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

DESCRIPTION

@@ -1,10 +1,10 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 0.1.13
-Date: 2012-11-23
+Version: 0.3.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
@@ -24,8 +24,10 @@ Imports:
     xtable,
     digest
 Suggests:
-    markdown
-URL: https://github.com/rstudio/shiny, http://rstudio.github.com/shiny/tutorial
+    markdown,
+    Cairo,
+    testthat
+URL: http://www.rstudio.com/shiny/
 BugReports: https://github.com/rstudio/shiny/issues
 Collate:
     'map.R'
@@ -42,3 +44,4 @@ Collate:
     'shinyui.R'
     'slider.R'
     'bootstrap.R'
+    'run-url.R'

NAMESPACE

@@ -1,3 +1,22 @@
+S3method("$",reactivevalues)
+S3method("$<-",reactivevalues)
+S3method("$<-",shinyoutput)
+S3method("[",reactivevalues)
+S3method("[<-",reactivevalues)
+S3method("[[",reactivevalues)
+S3method("[[<-",reactivevalues)
+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)
+S3method(reactive,"function")
+S3method(reactive,default)
+export(HTML)
 export(a)
 export(addResourcePath)
 export(animationOptions)
@@ -21,13 +40,13 @@ 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)
@@ -43,10 +62,14 @@ export(reactiveTable)
 export(reactiveText)
 export(reactiveTimer)
 export(reactiveUI)
+export(reactiveValues)
+export(reactiveValuesToList)
 export(repeatable)
 export(runApp)
 export(runExample)
 export(runGist)
+export(runGitHub)
+export(runUrl)
 export(selectInput)
 export(shinyServer)
 export(shinyUI)
@@ -56,8 +79,8 @@ export(sliderInput)
 export(span)
 export(strong)
 export(submitButton)
-export(tableOutput)
 export(tabPanel)
+export(tableOutput)
 export(tabsetPanel)
 export(tag)
 export(tagAppendChild)
@@ -68,20 +91,8 @@ 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,78 @@
+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
 --------------------------------------------------------------------------------
 

R/bootstrap.R

@@ -742,7 +742,9 @@ verbatimTextOutput <- function(outputId) {
 #' 
 #' Render a \link{reactivePlot} 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
@@ -752,7 +754,8 @@ 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)
 }
 
@@ -841,4 +844,15 @@ downloadLink <- function(outputId, label="Download", class=NULL) {
          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/map.R

@@ -61,15 +61,6 @@ 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,

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=NULL) {
       id <<- .getReactiveEnvironment()$nextId()
       .invalidated <<- FALSE
-      .callbacks <<- list()
-      .hintCallbacks <<- list()
+      .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 <<- TRUE
-      .getReactiveEnvironment()$addPendingInvalidate(.self)
+
+      lapply(.invalidateCallbacks, function(func) {
+        func()
+      })
       NULL
     },
     onInvalidate = function(func) {
@@ -43,15 +39,21 @@ 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) {
+      lapply(.flushCallbacks, function(func) {
         withCallingHandlers({
           func()
         }, warning = function(e) {
@@ -66,12 +68,12 @@ Context <- setRefClass(
 
 ReactiveEnvironment <- setRefClass(
   'ReactiveEnvironment',
-  fields = c('.currentContext', '.nextId', '.pendingInvalidate'),
+  fields = c('.currentContext', '.nextId', '.pendingFlush'),
   methods = list(
     initialize = function() {
       .currentContext <<- NULL
       .nextId <<- 0L
-      .pendingInvalidate <<- list()
+      .pendingFlush <<- list()
     },
     nextId = function() {
       .nextId <<- .nextId + 1L
@@ -90,27 +92,22 @@ 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
-        })
+      while (length(.pendingFlush) > 0) {
+        ctx <- .pendingFlush[[1]]
+        .pendingFlush <<- .pendingFlush[-1]
+        ctx$executeFlushCallbacks()
       }
     }
   )
 )
 
+.reactiveEnvironment <- ReactiveEnvironment$new()
 .getReactiveEnvironment <- function() {
-  if (!exists('.ReactiveEnvironment', envir=.GlobalEnv, inherits=FALSE)) {
-    assign('.ReactiveEnvironment', ReactiveEnvironment$new(), envir=.GlobalEnv)
-  }
-  get('.ReactiveEnvironment', envir=.GlobalEnv, inherits=FALSE)
+  .reactiveEnvironment
 }
 
 # Causes any pending invalidations to run.

R/reactives.R

@@ -1,61 +1,55 @@
-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 <- 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=FALSE)) {
-        assign(dep.key, ctx, pos=.dependencies, inherits=FALSE)
+      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=FALSE)
+          rm(list=dep.key, pos=.dependents, inherits=FALSE)
         })
       }
       
@@ -65,6 +59,8 @@ Values <- setRefClass(
         base::get(key, pos=.values, inherits=FALSE)
     },
     set = function(key, 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())
@@ -73,18 +69,21 @@ Values <- setRefClass(
       else {
         .namesDeps$invalidate()
       }
-      .allDeps$invalidate()
+
+      if (hidden)
+        .allValuesDeps$invalidate()
+      else
+        .valuesDeps$invalidate()
       
       assign(key, value, pos=.values, inherits=FALSE)
       dep.keys <- objects(
-        pos=.dependencies,
+        pos=.dependents,
         pattern=paste('^\\Q', key, ':', '\\E', '\\d+$', sep=''),
         all.names=TRUE
       )
       lapply(
-        mget(dep.keys, envir=.dependencies),
+        mget(dep.keys, envir=.dependents),
         function(ctx) {
-          ctx$invalidateHint()
           ctx$invalidate()
           NULL
         }
@@ -101,88 +100,211 @@ Values <- setRefClass(
       .namesDeps$register()
       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 Values class -----------------------
+
+#' Create an object for storing reactive values
+#'
+#' This function returns an object for storing reactive values. It is similar
+#' to a list, but with special capabilities for reactive programming. When you
+#' read a value from it, the calling reactive function takes a reactive
+#' 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)
-}
-
-.createValuesReader <- function(values) {
+# Create a reactivevalues object
+#
+# @param values A ReactiveValues object
+# @param readonly Should this object be read-only?
+.createReactiveValues <- function(values = NULL, readonly = FALSE) {
   acc <- list(impl=values)
-  class(acc) <- 'reactvaluesreader'
+  class(acc) <- 'reactivevalues'
+  attr(acc, 'readonly') <- readonly
   return(acc)
 }
 
-#' @S3method $ reactvaluesreader
-`$.reactvaluesreader` <- function(x, name) {
-  x[['impl']]$get(name)
+#' @S3method $ reactivevalues
+`$.reactivevalues` <- function(x, name) {
+  .subset2(x, 'impl')$get(name)
 }
 
-#' @S3method names reactvaluesreader
-names.reactvaluesreader <- function(x) {
-  x[['impl']]$names()
+#' @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 as.list reactvaluesreader
-as.list.reactvaluesreader <- function(x, ...) {
-  x[['impl']]$toList()
+#' @S3method [[<- reactivevalues
+`[[<-.reactivevalues` <- `$<-.reactivevalues`
+
+#' @S3method [ reactivevalues
+`[.reactivevalues` <- function(values, name) {
+  stop("Single-bracket indexing of reactivevalues object is not allowed.")
+}
+
+#' @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, ...) {
+  .Deprecated("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 <- setRefClass(
   'Observable',
   fields = list(
     .func = 'function',
-    .dependencies = 'Dependencies',
-    .initialized = 'logical',
-    .value = 'ANY'
+    .label = 'character',
+    .dependents = 'Dependents',
+    .dirty = 'logical',
+    .running = 'logical',
+    .value = 'ANY',
+    .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 ",
              "or more parameters; only functions without parameters can be ",
              "reactive.")
       .func <<- func
-      .initialized <<- FALSE
+      .dirty <<- TRUE
+      .running <<- FALSE
+      .label <<- label
+      .execCount <<- 0L
     },
     getValue = function() {
-      if (!.initialized) {
-        .initialized <<- TRUE
+      .dependents$register()
+
+      if (.dirty || .running) {
         .self$.updateValue()
       }
       
-      .dependencies$register()
-      
       if (identical(class(.value), 'try-error'))
         stop(attr(.value, 'condition'))
       return(.value)
     },
     .updateValue = function() {
-      old.value <- .value
-      
-      ctx <- Context$new()
+      ctx <- Context$new(.label)
       ctx$onInvalidate(function() {
-        .self$.updateValue()
-      })
-      ctx$onInvalidateHint(function() {
-        .dependencies$invalidateHint()
+        .dirty <<- TRUE
+        .dependents$invalidate()
       })
+      .execCount <<- .execCount + 1L
+
+      .dirty <<- FALSE
+
+      wasRunning <- .running
+      .running <<- TRUE
+      on.exit(.running <<- wasRunning)
+
       ctx$run(function() {
         .value <<- try(.func(), silent=FALSE)
       })
-      if (!identical(old.value, .value)) {
-        .dependencies$invalidate()
-      }
     }
   )
 )
@@ -214,49 +336,67 @@ reactive <- function(x) {
 }
 #' @S3method reactive function
 reactive.function <- function(x) {
-  return(Observable$new(x)$getValue)
+  return(Observable$new(x, deparse(substitute(x)))$getValue)
 }
 #' @S3method reactive default
 reactive.default <- function(x) {
   stop("Don't know how to make this object reactive!")
 }
 
+# Return the number of times that a reactive function 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 <- setRefClass(
   'Observer',
   fields = list(
     .func = 'function',
-    .hintCallbacks = 'list'
+    .label = 'character',
+    .flushCallbacks = 'list',
+    .execCount = 'integer'
   ),
   methods = list(
-    initialize = function(func) {
+    initialize = function(func, label) {
       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
 
       # Defer the first running of this until flushReact is called
-      ctx <- Context$new()
-      ctx$onInvalidate(function() {
+      ctx <- Context$new(.label)
+      ctx$onFlush(function() {
         run()
       })
-      ctx$invalidate()
+      ctx$addPendingFlush()
     },
     run = function() {
-      ctx <- Context$new()
+      ctx <- Context$new(.label)
+
       ctx$onInvalidate(function() {
-        run()
-      })
-      ctx$onInvalidateHint(function() {
-        lapply(.hintCallbacks, function(func) {
+        lapply(.flushCallbacks, function(func) {
           func()
           NULL
         })
+        ctx$addPendingFlush()
       })
+
+      ctx$onFlush(function() {
+        run()
+      })
+      .execCount <<- .execCount + 1L
       ctx$run(.func)
     },
-    onInvalidateHint = function(func) {
-      .hintCallbacks <<- c(.hintCallbacks, func)
+    onInvalidate = function(func) {
+      .flushCallbacks <<- c(.flushCallbacks, func)
     }
   )
 )
@@ -282,8 +422,7 @@ Observer <- setRefClass(
 #'   
 #' @export
 observe <- function(func) {
-  Observer$new(func)
-  invisible()
+  invisible(Observer$new(func, deparse(substitute(func))))
 }
 
 #' Timer
@@ -307,11 +446,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
@@ -319,10 +458,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())
@@ -343,3 +482,48 @@ invalidateLater <- function(millis) {
   })
   invisible()
 }
+
+#' Create a non-reactive scope for an expression
+#' 
+#' Executes the given expression in a scope where reactive values or functions 
+#' can be read, but they cannot cause the reactive scope of the caller to be 
+#' re-evaluated when they change.
+#' 
+#' Ordinarily, the simple act of reading a reactive value causes a relationship 
+#' to be established between the caller and the reactive value, where a change 
+#' to the reactive value will cause the caller to re-execute. (The same applies 
+#' for the act of getting a reactive function's value.) The \code{isolate} 
+#' function lets you read a reactive value or function without establishing this
+#' relationship.
+#' 
+#' @param expr An expression that can access reactive values or functions.
+#' 
+#' @examples
+#' \dontrun{
+#' observer(function() {
+#'   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)
+#' })
+#' 
+#' observer(function() {
+#'   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)
+#' })
+#' }
+#' @export
+isolate <- function(expr) {
+  ctx <- Context$new('[isolate]')
+  ctx$run(function() {
+    eval.parent(expr)
+  })
+}

R/run-url.R

@@ -0,0 +1,157 @@
+#' 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/3239667, then \code{3239667}, \code{'3239667'}, and
+#'   \code{'https://gist.github.com/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(4034323)
+#' runGist("https://gist.github.com/4034323")
+#' }
+#'
+#' @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.
+#'
+#' @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

@@ -20,7 +20,7 @@ ShinyApp <- setRefClass(
     .invalidatedOutputErrors = 'Map',
     .progressKeys = 'character',
     .fileUploadContext = 'FileUploadContext',
-    session = 'Values',
+    session = 'ReactiveValues',
     token = 'character',  # Used to identify this instance in URLs
     plots = 'Map',
     downloads = 'Map',
@@ -34,13 +34,13 @@ 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)
       
       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
@@ -74,9 +74,9 @@ ShinyApp <- setRefClass(
           }
           else
             .invalidatedOutputValues$set(name, value)
-        })
+        }, label)
         
-        obs$onInvalidateHint(function() {
+        obs$onInvalidate(function() {
           showProgress(name)
         })
       }
@@ -147,7 +147,8 @@ ShinyApp <- setRefClass(
     },
     .write = function(json) {
       if (getOption('shiny.trace', FALSE))
-        message('SEND ', json)
+        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)
@@ -245,13 +246,11 @@ ShinyApp <- setRefClass(
         
         tmpdata <- tempfile()
         on.exit(unlink(tmpdata))
-        conn <- file(tmpdata, open = 'wb')
-        result <- try(Context$new()$run(function() { download$func(conn) }))
+        result <- try(Context$new()$run(function() { download$func(tmpdata) }))
         if (is(result, 'try-error')) {
           return(httpResponse(500, 'text/plain', 
                               attr(result, 'condition')$message))
         }
-        close(conn)
         return(httpResponse(
           200,
           download$contentType %OR% getContentType(tools::file_ext(filename)),
@@ -296,7 +295,7 @@ ShinyApp <- setRefClass(
 
 #' @S3method $<- shinyoutput
 `$<-.shinyoutput` <- function(x, name, value) {
-  x[['impl']]$defineOutput(name, value)
+  x[['impl']]$defineOutput(name, value, deparse(substitute(value)))
   return(invisible(x))
 }
 
@@ -325,6 +324,16 @@ httpResponse <- function(status = 200,
   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)
 
@@ -333,6 +342,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>")
@@ -374,7 +385,7 @@ joinHandlers <- function(handlers) {
 }
 
 sessionHandler <- function(ws, header) {
-  path <- header$RESOURCE
+  path <- header$PATH
   if (is.null(path))
     return(NULL)
   
@@ -412,7 +423,7 @@ dynamicHandler <- function(filePath, dependencyFiles=filePath) {
       if (file.exists(filePath)) {
         local({
           cacheContext$with(function() {
-            source(filePath, local=TRUE)
+            source(filePath, local=new.env(parent=.GlobalEnv))
           })
         })
       }
@@ -426,7 +437,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>"))
@@ -539,6 +550,7 @@ resourcePathHandler <- function(ws, header) {
   suffix <- substr(path, 2 + len, nchar(path))
   
   header$RESOURCE <- suffix
+  header <- fixupRequestPath(header)
   
   return(resInfo$func(ws, header))
 }
@@ -659,7 +671,7 @@ startApp <- function(port=8101L) {
   serverFileTimestamp <- NULL
   local({
     serverFileTimestamp <<- file.info(serverR)$mtime
-    source(serverR, local=TRUE)
+    source(serverR, local=new.env(parent=.GlobalEnv))
     if (is.null(.globals$server))
       stop("No server was defined in server.R")
   })
@@ -718,8 +730,16 @@ startApp <- function(port=8101L) {
             stop('Unknown type specified for ', name)
           )
         }
-        else if (is.list(val) && is.null(names(val)))
-          msg$data[[name]] <- unlist(val, recursive=FALSE)
+        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
+          }
+        }
       }
     }
     
@@ -733,7 +753,7 @@ startApp <- function(port=8101L) {
           shinyServer(NULL)
           local({
             serverFileTimestamp <<- mtime
-            source(serverR, local=TRUE)
+            source(serverR, local=new.env(parent=.GlobalEnv))
             if (is.null(.globals$server))
               stop("No server was defined in server.R")
           })
@@ -745,7 +765,7 @@ startApp <- function(port=8101L) {
         shinyapp$session$mset(msg$data)
         flushReact()
         local({
-          serverFunc(input=.createValuesReader(shinyapp$session),
+          serverFunc(input=.createReactiveValues(shinyapp$session, readonly=TRUE),
                      output=.createOutputWriter(shinyapp))
         })
       },
@@ -811,7 +831,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)
   
@@ -918,53 +940,3 @@ download <- function(url, ...) {
     download.file(url, ...)
   }
 }
-
-#' 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/3239667, then \code{3239667}, \code{'3239667'}, and
-#'   \code{'https://gist.github.com/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.
-#'   
-#' @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/gists/%s/download', gist)
-  } else if(grepl('^https://gist.github.com/([0-9a-f]+)$', gist)) {
-    paste(sub('https://gist.github.com/',
-              'https://gist.github.com/gists/',
-              gist),
-          '/download',
-          sep='')
-  } else {
-    stop('Unrecognized gist identifier format')
-  }
-  filePath <- tempfile('shinygist', fileext='.tar.gz')
-  if (download(gistUrl, filePath, mode = "wb", quiet = TRUE) != 0)
-    stop("Failed to download URL ", gistUrl)
-  on.exit(unlink(filePath))
-
-  # 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))
-  
-  appdir <- file.path(dirname(filePath), dirname)
-  on.exit(unlink(appdir, recursive = TRUE))
-  
-  runApp(appdir, port=port, launch.browser=launch.browser)
-}

R/shinyui.R

@@ -106,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)
@@ -126,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>', 
@@ -189,7 +189,8 @@ shinyUI <- function(ui, path='/') {
   registerClient({
     
     function(ws, header) {
-      if (header$RESOURCE != path)
+
+      if (header$PATH != path)
         return(NULL)
       
       textConn <- textConnection(NULL, "w") 

R/shinywrappers.R

@@ -10,6 +10,12 @@ suppressPackageStartupMessages({
 #' 
 #' 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 
@@ -53,8 +59,20 @@ 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(),
@@ -95,7 +113,7 @@ reactiveTable <- function(func, ...) {
     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(
@@ -112,9 +130,10 @@ reactiveTable <- function(func, ...) {
 
 #' 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
@@ -123,12 +142,26 @@ 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 func A function that may print output and/or return a printable R 
+#'   object.
+#'   
+#' @seealso \code{\link{reactiveText}} 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"))
+    return(paste(capture.output({
+      result <- withVisible(func())
+      if (result$visible)
+        print(result$value)
+    }), collapse="\n"))
   })
 }
 
@@ -148,10 +181,16 @@ reactivePrint <- function(func) {
 #' @param func A function that returns an R object that can be used as an
 #'   argument to \code{cat}.
 #'   
+#' @seealso \code{\link{reactivePrint}} 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"))
+    value <- func()
+    return(paste(capture.output(cat(value)), collapse="\n"))
   })
 }
 
@@ -182,7 +221,8 @@ reactiveUI <- function(func) {
     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)))
   })
 }
 
@@ -200,10 +240,10 @@ reactiveUI <- function(func) {
 #'   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{con} that is a 
-#'   file connection opened in mode \code{wb}, and writes the content of the 
-#'   download into the connection. (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 
@@ -217,8 +257,8 @@ reactiveUI <- function(func) {
 #'   filename = function() {
 #'     paste('data-', Sys.Date(), '.csv', sep='')
 #'   },
-#'   content = function(con) {
-#'     write.csv(data, con)
+#'   content = function(file) {
+#'     write.csv(data, file)
 #'   }
 #' )
 #' 

R/slider.R

@@ -101,13 +101,13 @@ slider <- function(inputId, min, max, value, step = NULL, ...,
   }
   
   # build slider
-  sliderFragment <- tags$input(
+  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)
+    'data-smooth'=FALSE))
 
   if (identical(animate, TRUE))
     animate <- animationOptions()

R/tags.R

@@ -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()

README.md

@@ -22,7 +22,6 @@ For an introduction and examples, visit the [Shiny homepage](http://www.rstudio.
 From an R console:
 
 ```r
-options(repos=c(RStudio="http://rstudio.org/_packages", getOption("repos")))
 install.packages("shiny")
 ```
 

inst/examples/10_download/server.R

@@ -12,7 +12,8 @@ shinyServer(function(input, output) {
   
   output$downloadData <- downloadHandler(
     filename = function() { paste(input$dataset, '.csv', sep='') },
-    content = function(conn) {
-      write.csv(datasetInput(), conn)
-    })
+    content = function(file) {
+      write.csv(datasetInput(), file)
+    }
+  )
 })

inst/examples/10_download/ui.R

@@ -1,5 +1,5 @@
 shinyUI(pageWithSidebar(
-  headerPanel('Download Example'),
+  headerPanel('Downloading Data'),
   sidebarPanel(
     selectInput("dataset", "Choose a dataset:", 
                 choices = c("rock", "pressure", "cars")),

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-reactivity.r

@@ -0,0 +1,467 @@
+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(function() {
+    values$A
+  })
+
+  funcB <- reactive(function() {
+    funcA()
+    values$A
+  })
+
+  obsC <- observe(function() {
+    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(function() {
+    values$A + 5
+  })
+  obsC <- observe(function() {
+    observed_value1 <<-  funcB() * values$A
+  })
+  obsD <- observe(function() {
+    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(function() {
+    values$C <- values$A > 0
+  })
+
+  funcD <- reactive(function() {
+    values$C
+  })
+
+  obsE <- observe(function() {
+    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(function() {
+    values$A > 0
+  })
+
+  funcB <- reactive(function() {
+    funcA()
+  })
+
+  obsC <- observe(function() {
+    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(function() {
+    values$A + 5
+  })
+  obsC <- observe(function() {
+    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(function() {
+    values$A + 5
+  })
+  obsC <- observe(function() {
+    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(function() {
+    values$B + 100
+  })
+
+  # References to valueB and funcB are isolated
+  obsC <- observe(function() {
+    obsC_value <<-
+      values$A + isolate(values$B) + isolate(funcB())
+  })
+
+  # In contrast with obsC, this has a non-isolated reference to funcB
+  obsD <- observe(function() {
+    obsD_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("Circular refs/reentrancy in reactive functions work", {
+
+  values <- reactiveValues(A=3)
+
+  funcB <- reactive(function() {
+    # 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(function() {
+    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(function() {
+    if (values$A == 0)
+      return(0)
+    values$A <- values$A - 1
+    funcB()
+  })
+
+  obsC <- observe(function() {
+    funcB()
+  })
+
+  flushReact()
+  expect_equal(execCount(obsC), 2)
+  expect_equal(execCount(funcB), 6)
+})
+
+test_that("Non-reactive recursion", {
+  nonreactiveA <- 3
+  outputD <- NULL
+
+  funcB <- reactive(function() {
+    if (nonreactiveA == 0)
+      return(0)
+    nonreactiveA <<- nonreactiveA - 1
+    return(funcB())
+  })
+  obsC <- observe(function() {
+    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(function() {
+    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(function() {
+    values$A <- isolate(values$A) - 1
+    values$A
+  })
+
+  obsC <- observe(function() {
+    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(function() {
+    names(values)
+  })
+
+  # Dependent on all non-hidden objects
+  depValues <- observe(function() {
+    reactiveValuesToList(values)
+  })
+
+  # Dependent on all objects, including hidden
+  depAllValues <- observe(function() {
+    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)
+
+  values$A <- 2
+  flushReact()
+  expect_equal(execCount(depNames), 1)
+  expect_equal(execCount(depValues), 2)
+  expect_equal(execCount(depAllValues), 2)
+
+  values$.B <- 3
+  flushReact()
+  expect_equal(execCount(depNames), 1)
+  expect_equal(execCount(depValues), 2)
+  expect_equal(execCount(depAllValues), 3)
+
+  values$C <- 1
+  flushReact()
+  expect_equal(execCount(depNames), 2)
+  expect_equal(execCount(depValues), 3)
+  expect_equal(execCount(depAllValues), 4)
+
+  values$.D <- 1
+  flushReact()
+  expect_equal(execCount(depNames), 3)
+  expect_equal(execCount(depValues), 3)
+  expect_equal(execCount(depAllValues), 5)
+})

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,29 @@
+context("text")
+
+test_that("reactivePrint and reactiveText behavior is correct", {
+  expect_equal(isolate(reactivePrint(function() "foo")()),
+               '[1] "foo"')
+  expect_equal(isolate(reactivePrint(function() invisible("foo"))()),
+               '')
+  expect_equal(isolate(reactivePrint(function() { print("foo"); "bar"})()),
+               '[1] "foo"\n[1] "bar"')
+  expect_equal(isolate(reactivePrint(function() NULL)()),
+               'NULL')
+  expect_equal(isolate(reactivePrint(function() invisible())()),
+               '')
+  expect_equal(isolate(reactivePrint(function() 1:5)()),
+               '[1] 1 2 3 4 5')
+  
+  expect_equal(isolate(reactiveText(function() "foo")()),
+               'foo')
+  expect_equal(isolate(reactiveText(function() invisible("foo"))()),
+               'foo')
+  expect_equal(isolate(reactiveText(function() { print("foo"); "bar"})()),
+               'bar')
+  expect_equal(isolate(reactiveText(function() NULL)()),
+               '')
+  expect_equal(isolate(reactiveText(function() invisible())()),
+               '')
+  expect_equal(isolate(reactiveText(function() 1:5)()),
+               '1 2 3 4 5')  
+})

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);
   }

man/downloadHandler.Rd

@@ -12,10 +12,10 @@
   from this function.)}
 
   \item{content}{A function that takes a single argument
-  \code{con} that is a file connection opened in mode
-  \code{wb}, and writes the content of the download into
-  the connection. (Reactive values and functions may be
-  used from this function.)}
+  \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
@@ -43,8 +43,8 @@ output$downloadData <- downloadHandler(
   filename = function() {
     paste('data-', Sys.Date(), '.csv', sep='')
   },
-  content = function(con) {
-    write.csv(data, con)
+  content = function(file) {
+    write.csv(data, file)
   }
 )
 

man/isolate.Rd

@@ -0,0 +1,50 @@
+\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 functions.}
+}
+\description{
+  Executes the given expression in a scope where reactive
+  values or functions 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 function's
+  value.) The \code{isolate} function lets you read a
+  reactive value or function without establishing this
+  relationship.
+}
+\examples{
+\dontrun{
+observer(function() {
+  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)
+})
+
+observer(function() {
+  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)
+})
+}
+}
+

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}
 }

man/reactivePlot.Rd

@@ -33,5 +33,13 @@
   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/reactivePrint.Rd

@@ -5,14 +5,15 @@
   reactivePrint(func)
 }
 \arguments{
-  \item{func}{A function that returns a printable R
-  object.}
+  \item{func}{A function that may print output and/or
+  return a printable R object.}
 }
 \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.
+  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
@@ -22,5 +23,79 @@
 
   The result of executing \code{func} will be printed
   inside a \code{\link[utils]{capture.output}} call.
+
+  Note that unlike most other Shiny output functions, if
+  the given function returns \code{NULL} then \code{NULL}
+  will actually be visible in the output. To display
+  nothing, make your function return
+  \code{\link{invisible}()}.
+}
+\examples{
+isolate({
+
+# reactivePrint captures any print output, converts it to a string, and
+# returns it
+visFun <- reactivePrint(function() "foo")
+visFun()
+# '[1] "foo"'
+
+invisFun <- reactivePrint(function() invisible("foo"))
+invisFun()
+# ''
+
+multiprintFun <- reactivePrint(function() {
+  print("foo");
+  "bar"
+})
+multiprintFun()
+# '[1] "foo"\\n[1] "bar"'
+
+nullFun <- reactivePrint(function() NULL)
+nullFun()
+# 'NULL'
+
+invisNullFun <- reactivePrint(function() invisible(NULL))
+invisNullFun()
+# ''
+
+vecFun <- reactivePrint(function() 1:5)
+vecFun()
+# '[1] 1 2 3 4 5'
+
+
+# Contrast with reactiveText, which takes the value returned from the function
+# and uses cat() to convert it to a string
+visFun <- reactiveText(function() "foo")
+visFun()
+# 'foo'
+
+invisFun <- reactiveText(function() invisible("foo"))
+invisFun()
+# 'foo'
+
+multiprintFun <- reactiveText(function() {
+  print("foo");
+  "bar"
+})
+multiprintFun()
+# 'bar'
+
+nullFun <- reactiveText(function() NULL)
+nullFun()
+# ''
+
+invisNullFun <- reactiveText(function() invisible(NULL))
+invisNullFun()
+# ''
+
+vecFun <- reactiveText(function() 1:5)
+vecFun()
+# '1 2 3 4 5'
+
+})
+}
+\seealso{
+  \code{\link{reactiveText}} for displaying the value
+  returned from a function, instead of the printed output.
 }
 

man/reactiveText.Rd

@@ -23,4 +23,73 @@
   \code{cat}, inside a \code{\link[utils]{capture.output}}
   call.
 }
+\examples{
+isolate({
+
+# reactivePrint captures any print output, converts it to a string, and
+# returns it
+visFun <- reactivePrint(function() "foo")
+visFun()
+# '[1] "foo"'
+
+invisFun <- reactivePrint(function() invisible("foo"))
+invisFun()
+# ''
+
+multiprintFun <- reactivePrint(function() {
+  print("foo");
+  "bar"
+})
+multiprintFun()
+# '[1] "foo"\\n[1] "bar"'
+
+nullFun <- reactivePrint(function() NULL)
+nullFun()
+# 'NULL'
+
+invisNullFun <- reactivePrint(function() invisible(NULL))
+invisNullFun()
+# ''
+
+vecFun <- reactivePrint(function() 1:5)
+vecFun()
+# '[1] 1 2 3 4 5'
+
+
+# Contrast with reactiveText, which takes the value returned from the function
+# and uses cat() to convert it to a string
+visFun <- reactiveText(function() "foo")
+visFun()
+# 'foo'
+
+invisFun <- reactiveText(function() invisible("foo"))
+invisFun()
+# 'foo'
+
+multiprintFun <- reactiveText(function() {
+  print("foo");
+  "bar"
+})
+multiprintFun()
+# 'bar'
+
+nullFun <- reactiveText(function() NULL)
+nullFun()
+# ''
+
+invisNullFun <- reactiveText(function() invisible(NULL))
+invisNullFun()
+# ''
+
+vecFun <- reactiveText(function() 1:5)
+vecFun()
+# '1 2 3 4 5'
+
+})
+}
+\seealso{
+  \code{\link{reactivePrint}} for capturing the print
+  output of a function, rather than the returned text
+  value.
+}
 

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 function 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/runGist.Rd

@@ -23,4 +23,10 @@
   Download and launch a Shiny application that is hosted on
   GitHub as a gist.
 }
+\examples{
+\dontrun{
+runGist(4034323)
+runGist("https://gist.github.com/4034323")
+}
+}
 

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,41 @@
+\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.
+}
+\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/")
+}
+}
+

res/text-example.R

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

tests/test-all.R

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