Firefox compatibility; visual tweaks

Launch reactlog from Shiny app with F3
reactlog: Automatically run first step
2026-01-11 16:08:19 -05:00 · 2013-07-06 18:14:30 -07:00 · 2013-07-03 12:17:36 -07:00 · 2013-07-03 08:56:28 -07:00 · 2013-07-03 00:05:28 -07:00 · 2013-07-02 17:48:09 -07:00
27 changed files with 1426 additions and 248 deletions
--- a/3
+++ b/3
@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 0.6.0
+Version: 0.6.0.99
 Date: 2013-01-23
 Author: RStudio, Inc.
 Maintainer: Winston Chang <winston@rstudio.com>
@@ -37,6 +37,7 @@ Collate:
    'timer.R'
    'tags.R'
    'cache.R'
+    'graph.R'
    'react.R'
    'reactives.R'
    'fileupload.R'
--- a/8
+++ b/8
@@ -51,8 +51,10 @@ export(helpText)
 export(htmlOutput)
 export(imageOutput)
 export(img)
+export(includeCSS)
 export(includeHTML)
 export(includeMarkdown)
+export(includeScript)
 export(includeText)
 export(invalidateLater)
 export(isolate)
@@ -91,10 +93,12 @@ export(runUrl)
 export(selectInput)
 export(shinyServer)
 export(shinyUI)
+export(showReactLog)
 export(sidebarPanel)
 export(singleton)
 export(sliderInput)
 export(span)
+export(stopApp)
 export(strong)
 export(submitButton)
 export(tabPanel)
@@ -102,7 +106,9 @@ export(tableOutput)
 export(tabsetPanel)
 export(tag)
 export(tagAppendChild)
+export(tagAppendChildren)
 export(tagList)
+export(tagSetChildren)
 export(tags)
 export(textInput)
 export(textOutput)
@@ -117,9 +123,11 @@ export(updateSelectInput)
 export(updateSliderInput)
 export(updateTabsetPanel)
 export(updateTextInput)
+export(validateCssUnit)
 export(verbatimTextOutput)
 export(wellPanel)
 export(withTags)
+export(writeReactLog)
 import(RJSONIO)
 import(caTools)
 import(digest)
--- a/4
+++ b/4
@@ -1,3 +1,7 @@
+shiny 0.6.0.99
+--------------------------------------------------------------------------------
+
+
 shiny 0.6.0
 --------------------------------------------------------------------------------

--- a/R/bootstrap.R
+++ b/R/bootstrap.R
@@ -401,25 +401,26 @@ checkboxInput <- function(inputId, label, value = FALSE) {
 checkboxGroupInput <- function(inputId, label, choices, selected = NULL) {
  # resolve names
  choices <- choicesWithNames(choices)
-  
-  checkboxes <- list()
-  for (i in seq_along(choices)) {
-    choiceName <- names(choices)[i]

-    inputTag <- tags$input(type = "checkbox",
-                           name = inputId,
-                           id = paste(inputId, i, sep=""),
-                           value = choices[[i]])
+  # Create tags for each of the options
+  ids <- paste0(inputId, seq_along(choices))

-    if (choiceName %in% selected)
+  checkboxes <- mapply(ids, choices, names(choices),
+    SIMPLIFY = FALSE, USE.NAMES = FALSE,
+    FUN = function(id, value, name) {
+      inputTag <- tags$input(type = "checkbox",
+                             name = inputId,
+                             id = id,
+                             value = value)
+
+    if (name %in% selected)
      inputTag$attribs$checked <- "checked"

-    checkbox <- tags$label(class = "checkbox",
-                           inputTag,
-                           tags$span(choiceName))
-    
-    checkboxes[[i]] <- checkbox
-  } 
+    tags$label(class = "checkbox",
+               inputTag,
+               tags$span(name))
+    }
+  )
  
  # return label and select tag
  tags$div(id = inputId,
@@ -507,16 +508,21 @@ selectInput <- function(inputId,
  if (multiple)
    selectTag$attribs$multiple <- "multiple"

-  for (i in seq_along(choices)) {
-    choiceName <- names(choices)[i]
-    optionTag <- tags$option(value = choices[[i]], choiceName)
+  # Create tags for each of the options
+  optionTags <- mapply(choices, names(choices),
+    SIMPLIFY = FALSE, USE.NAMES = FALSE,
+    FUN = function(choice, name) {
+      optionTag <- tags$option(value = choice, name)

-    if (choiceName %in% selected)
-      optionTag$attribs$selected = "selected"
+      if (name %in% selected)
+        optionTag$attribs$selected = "selected"
+
+      optionTag
+    }
+  )
+
+  selectTag <- tagSetChildren(selectTag, list = optionTags)

-    selectTag <- tagAppendChild(selectTag, optionTag)
-  }
-  
  # return label and select tag
  tagList(controlLabel(inputId, label), selectTag)
 }
@@ -550,27 +556,28 @@ radioButtons <- function(inputId, label, choices, selected = NULL) {
  if (is.null(selected))
    selected <- names(choices)[[1]]
  
-  # build list of radio button tags
-  inputTags <- list()
-  for (i in seq_along(choices)) {
-    id <- paste(inputId, i, sep="")
-    name <- names(choices)[[i]]
-    value <- choices[[i]]
-    inputTag <- tags$input(type = "radio", 
-                           name = inputId,
-                           id = id,
-                           value = value)
-    if (identical(name, selected))
-      inputTag$attribs$checked = "checked"
+  # Create tags for each of the options
+  ids <- paste0(inputId, seq_along(choices))
+
+  inputTags <- mapply(ids, choices, names(choices),
+    SIMPLIFY = FALSE, USE.NAMES = FALSE,
+    FUN = function(id, value, name) {
+      inputTag <- tags$input(type = "radio",
+                             name = inputId,
+                             id = id,
+                             value = value)
+
+      if (identical(name, selected))
+        inputTag$attribs$checked = "checked"
+
+      # Put the label text in a span
+      tags$label(class = "radio",
+                inputTag,
+                tags$span(name)
+      )
+    }
+  )

-    # Put the label text in a span
-    spanTag <- tags$span(name)
-    labelTag <- tags$label(class = "radio")
-    labelTag <- tagAppendChild(labelTag, inputTag)
-    labelTag <- tagAppendChild(labelTag, spanTag)
-    inputTags[[length(inputTags) + 1]] <- labelTag
-  }
-  
  tags$div(id = inputId,
           class = 'control-group shiny-input-radiogroup',
           tags$label(class = "control-label", `for` = inputId, label),
@@ -1009,6 +1016,8 @@ tabsetPanel <- function(..., id = NULL, selected = NULL) {
      firstTab = FALSE
    }
    
+    divTag$attribs$title <- NULL
+
    # append the elements to our lists
    tabNavList <- tagAppendChild(tabNavList, liTag)
    tabContent <- tagAppendChild(tabContent, divTag)
@@ -1184,6 +1193,16 @@ downloadLink <- function(outputId, label="Download", class=NULL) {
         label)
 }

+#' Validate proper CSS formatting of a unit
+#' 
+#' @param x The unit to validate. Will be treated as a number of pixels if a 
+#' unit is not specified.
+#' @return A properly formatted CSS unit of length, if possible. Otherwise, will
+#' throw an error.
+#' @examples
+#' validateCssUnit("10%")
+#' validateCssUnit(400)  #treated as '400px'
+#' @export
 validateCssUnit <- function(x) {
  if (is.character(x) &&
     !grepl("^(auto|((\\.\\d+)|(\\d+(\\.\\d+)?))(%|in|cm|mm|em|ex|pt|pc|px))$", x)) {
--- a/R/cache.R
+++ b/R/cache.R
@@ -71,7 +71,7 @@ CacheContext <- setRefClass(
 # 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)")
+    return()
  
  if (is.null(filepath) || is.na(filepath))
    .currentCacheContext$cc$forceDirty()
--- a/R/graph.R
+++ b/R/graph.R
@@ -0,0 +1,73 @@
+#' @export
+writeReactLog <- function(file=stdout()) {
+  cat(RJSONIO::toJSON(.graphEnv$log, pretty=TRUE), file=file)
+}
+
+#' @export
+showReactLog <- function() {
+  browseURL(renderReactLog())
+}
+
+renderReactLog <- function() {
+  templateFile <- system.file('www/reactive-graph.html', package='shiny')
+  html <- paste(readLines(templateFile, warn=FALSE), collapse='\r\n')
+  tc <- textConnection(NULL, 'w')
+  on.exit(close(tc))
+  writeReactLog(tc)
+  cat('\n', file=tc)
+  flush(tc)
+  html <- sub('__DATA__', paste(textConnectionValue(tc), collapse='\r\n'), html, fixed=TRUE)
+  file <- tempfile(fileext = '.html')
+  writeLines(html, file)
+  return(file)
+}
+
+.graphAppend <- function(logEntry) {
+  if (isTRUE(getOption('shiny.reactlog', FALSE)))
+    .graphEnv$log <- c(.graphEnv$log, list(logEntry))
+}
+
+.graphDependsOn <- function(id, label) {
+  if (isTRUE(getOption('shiny.reactlog', FALSE)))
+    .graphAppend(list(action='dep', id=id, dependsOn=label))
+}
+
+.graphDependsOnId <- function(id, dependee) {
+  if (isTRUE(getOption('shiny.reactlog', FALSE)))
+    .graphAppend(list(action='depId', id=id, dependsOn=dependee))
+}
+
+.graphCreateContext <- function(id, label, type, prevId) {
+  if (isTRUE(getOption('shiny.reactlog', FALSE)))
+    .graphAppend(list(
+      action='ctx', id=id, label=paste(label, collapse='\n'), type=type, prevId=prevId
+    ))
+}
+
+.graphEnterContext <- function(id) {
+  if (isTRUE(getOption('shiny.reactlog', FALSE)))
+    .graphAppend(list(action='enter', id=id))
+}
+
+.graphExitContext <- function(id) {
+  if (isTRUE(getOption('shiny.reactlog', FALSE)))
+    .graphAppend(list(action='exit', id=id))
+}
+
+.graphValueChange <- function(label, value) {
+  if (isTRUE(getOption('shiny.reactlog', FALSE))) {
+    .graphAppend(list(
+      action = 'valueChange',
+      id = label,
+      value = paste(capture.output(str(value)), collapse='\n')
+    ))
+  }
+}
+
+.graphInvalidate <- function(id) {
+  if (isTRUE(getOption('shiny.reactlog', FALSE)))
+    .graphAppend(list(action='invalidate', id=id))
+}
+
+.graphEnv <- new.env()
+.graphEnv$log <- list()
--- a/R/imageutils.R
+++ b/R/imageutils.R
@@ -11,6 +11,10 @@
 #' output. Notably, plain \code{png} output on Linux and Windows may not
 #' antialias some point shapes, resulting in poor quality output.
 #'
+#' In some cases, \code{Cairo()} provides output that looks worse than
+#' \code{png()}. To disable Cairo output for an app, use
+#' \code{options(shiny.usecairo=FALSE)}.
+#'
 #' @param func A function that generates a plot.
 #' @param filename The name of the output file. Defaults to a temp file with
 #'   extension \code{.png}.
@@ -30,9 +34,8 @@ plotPNG <- function(func, filename=tempfile(fileext='.png'),
  # Finally, if neither quartz nor Cairo, use png().
  if (capabilities("aqua")) {
    pngfun <- png
-  } else if (nchar(system.file(package = "Cairo"))) {
-    require(Cairo)
-
+  } else if (getOption('shiny.usecairo', TRUE) &&
+             nchar(system.file(package = "Cairo"))) {
    # Workaround for issue #140: Cairo ignores res and dpi settings. Need to
    # use regular png function.
    if (res == 72) {
--- a/R/react.R
+++ b/R/react.R
@@ -8,16 +8,19 @@ Context <- setRefClass(
    .flushCallbacks = 'list'
  ),
  methods = list(
-    initialize = function(label='') {
+    initialize = function(label='', type='other', prevId='') {
      id <<- .getReactiveEnvironment()$nextId()
      .invalidated <<- FALSE
      .invalidateCallbacks <<- list()
      .flushCallbacks <<- list()
      .label <<- label
+      .graphCreateContext(id, label, type, prevId)
    },
    run = function(func) {
      "Run the provided function under this context."
      env <- .getReactiveEnvironment()
+      .graphEnterContext(id)
+      on.exit(.graphExitContext(id))
      env$runWith(.self, func)
    },
    invalidate = function() {
@@ -27,6 +30,7 @@ Context <- setRefClass(
        return()
      .invalidated <<- TRUE

+      .graphInvalidate(id)
      lapply(.invalidateCallbacks, function(func) {
        func()
      })
@@ -86,10 +90,11 @@ ReactiveEnvironment <- setRefClass(
      return(as.character(.nextId))
    },
    currentContext = function() {
-      if (is.null(.currentContext))
+      if (is.null(.currentContext)) {
        stop('Operation not allowed without an active reactive context. ',
             '(You tried to do something that can only be done from inside a ',
             'reactive function.)')
+      }
      return(.currentContext)
    },
    runWith = function(ctx, func) {
--- a/R/reactives.R
+++ b/R/reactives.R
@@ -4,13 +4,18 @@ Dependents <- setRefClass(
    .dependents = 'Map'
  ),
  methods = list(
-    register = function() {
+    register = function(depId=NULL, depLabel=NULL) {
      ctx <- .getReactiveEnvironment()$currentContext()
      if (!.dependents$containsKey(ctx$id)) {
        .dependents$set(ctx$id, ctx)
        ctx$onInvalidate(function() {
          .dependents$remove(ctx$id)
        })
+        
+        if (!is.null(depId) && nchar(depId) > 0)
+          .graphDependsOnId(ctx$id, depId)
+        if (!is.null(depLabel))
+          .graphDependsOn(ctx$id, depLabel)
      }
    },
    invalidate = function() {
@@ -31,6 +36,8 @@ Dependents <- setRefClass(
 ReactiveValues <- setRefClass(
  'ReactiveValues',
  fields = list(
+    # For debug purposes
+    .label = 'character',
    .values = 'environment',
    .dependents = 'environment',
    # Dependents for the list of all names, including hidden
@@ -42,6 +49,8 @@ ReactiveValues <- setRefClass(
  ),
  methods = list(
    initialize = function() {
+      .label <<- paste('reactiveValues', runif(1, min=1000, max=9999),
+                       sep="")
      .values <<- new.env(parent=emptyenv())
      .dependents <<- new.env(parent=emptyenv())
    },
@@ -49,6 +58,7 @@ ReactiveValues <- setRefClass(
      ctx <- .getReactiveEnvironment()$currentContext()
      dep.key <- paste(key, ':', ctx$id, sep='')
      if (!exists(dep.key, where=.dependents, inherits=FALSE)) {
+        .graphDependsOn(ctx$id, sprintf('%s$%s', .label, key))
        assign(dep.key, ctx, pos=.dependents, inherits=FALSE)
        ctx$onInvalidate(function() {
          rm(list=dep.key, pos=.dependents, inherits=FALSE)
@@ -76,8 +86,13 @@ ReactiveValues <- setRefClass(
        .allValuesDeps$invalidate()
      else
        .valuesDeps$invalidate()
-      
+
      assign(key, value, pos=.values, inherits=FALSE)
+
+      .graphValueChange(sprintf('names(%s)', .label), ls(.values, all.names=TRUE))
+      .graphValueChange(sprintf('%s (all)', .label), as.list(.values))
+      .graphValueChange(sprintf('%s$%s', .label, key), value)
+
      dep.keys <- objects(
        pos=.dependents,
        pattern=paste('^\\Q', key, ':', '\\E', '\\d+$', sep=''),
@@ -99,16 +114,23 @@ ReactiveValues <- setRefClass(
             })
    },
    names = function() {
+      .graphDependsOn(.getReactiveEnvironment()$currentContext()$id,
+                      sprintf('names(%s)', .label))
      .namesDeps$register()
      return(ls(.values, all.names=TRUE))
    },
    toList = function(all.names=FALSE) {
+      .graphDependsOn(.getReactiveEnvironment()$currentContext()$id,
+                      sprintf('%s (all)', .label))
      if (all.names)
        .allValuesDeps$register()

      .valuesDeps$register()

      return(as.list(.values, all.names=all.names))
+    },
+    .setLabel = function(label) {
+      .label <<- label
    }
  )
 )
@@ -231,6 +253,11 @@ as.list.reactivevalues <- function(x, all.names=FALSE, ...) {
  reactiveValuesToList(x, all.names)
 }

+# For debug purposes
+.setLabel <- function(x, label) {
+  .subset2(x, 'impl')$.setLabel(label)
+}
+
 #' Convert a reactivevalues object to a list
 #'
 #' This function does something similar to what you might \code{\link{as.list}}
@@ -269,7 +296,8 @@ Observable <- setRefClass(
    .running = 'logical',
    .value = 'ANY',
    .visible = 'logical',
-    .execCount = 'integer'
+    .execCount = 'integer',
+    .mostRecentCtxId = 'character'
  ),
  methods = list(
    initialize = function(func, label=deparse(substitute(func))) {
@@ -282,6 +310,7 @@ Observable <- setRefClass(
      .running <<- FALSE
      .label <<- label
      .execCount <<- 0L
+      .mostRecentCtxId <<- ""
    },
    getValue = function() {
      .dependents$register()
@@ -289,6 +318,8 @@ Observable <- setRefClass(
      if (.invalidated || .running) {
        .self$.updateValue()
      }
+
+      .graphDependsOnId(getCurrentContext()$id, .mostRecentCtxId)
      
      if (identical(class(.value), 'try-error'))
        stop(attr(.value, 'condition'))
@@ -299,7 +330,8 @@ Observable <- setRefClass(
        invisible(.value)
    },
    .updateValue = function() {
-      ctx <- Context$new(.label)
+      ctx <- Context$new(.label, type='observable', prevId=.mostRecentCtxId)
+      .mostRecentCtxId <<- ctx$id
      ctx$onInvalidate(function() {
        .invalidated <<- TRUE
        .dependents$invalidate()
@@ -369,7 +401,7 @@ Observable <- setRefClass(
 reactive <- function(x, env = parent.frame(), quoted = FALSE, label = NULL) {
  fun <- exprToFunction(x, env, quoted)
  if (is.null(label))
-    label <- deparse(body(fun))
+    label <- sprintf('reactive(%s)', paste(deparse(body(fun)), collapse='\n'))

  Observable$new(fun, label)$getValue
 }
@@ -395,7 +427,8 @@ Observer <- setRefClass(
    .invalidateCallbacks = 'list',
    .execCount = 'integer',
    .onResume = 'function',
-    .suspended = 'logical'
+    .suspended = 'logical',
+    .prevId = 'character'
  ),
  methods = list(
    initialize = function(func, label, suspended = FALSE, priority = 0) {
@@ -409,12 +442,14 @@ Observer <- setRefClass(
      .execCount <<- 0L
      .suspended <<- suspended
      .onResume <<- function() NULL
+      .prevId <<- ''

      # Defer the first running of this until flushReact is called
      .createContext()$invalidate()
    },
    .createContext = function() {
-      ctx <- Context$new(.label)
+      ctx <- Context$new(.label, type='observer', prevId=.prevId)
+      .prevId <<- ctx$id

      ctx$onInvalidate(function() {
        lapply(.invalidateCallbacks, function(func) {
@@ -443,12 +478,14 @@ Observer <- setRefClass(
      .execCount <<- .execCount + 1L
      ctx$run(.func)
    },
-    onInvalidate = function(func) {
-      "Register a function to run when this observer is invalidated"
-      .invalidateCallbacks <<- c(.invalidateCallbacks, func)
+    onInvalidate = function(callback) {
+      "Register a callback function to run when this observer is invalidated.
+      No arguments will be provided to the callback function when it is
+      invoked."
+      .invalidateCallbacks <<- c(.invalidateCallbacks, callback)
    },
    setPriority = function(priority = 0) {
-      "Change the observer's priority. Note that if the observer is currently
+      "Change this observer's priority. Note that if the observer is currently
      invalidated, then the change in priority will not take effect until the
      next invalidation--unless the observer is also currently suspended, in
      which case the priority change will be effective upon resume."
@@ -458,7 +495,7 @@ Observer <- setRefClass(
      "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
+      called) then that re-execution will still occur, because the flush is
      already scheduled."
      .suspended <<- TRUE
    },
@@ -478,10 +515,12 @@ Observer <- setRefClass(

 #' Create a reactive observer
 #' 
-#' Creates an observer from the given expression An observer is like a reactive
+#' 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 
+#' reactive expressions, 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).
 #' 
@@ -506,6 +545,32 @@ Observer <- setRefClass(
 #'   this observer should be executed. An observer with a given priority level
 #'   will always execute sooner than all observers with a lower priority level. 
 #'   Positive, negative, and zero values are allowed.
+#' @return An observer reference class object. This object has the following 
+#'   methods:
+#'   \describe{
+#'     \item{\code{suspend()}}{
+#'       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 then that re-execution will
+#'       still occur, because the flush is already scheduled.
+#'     }
+#'     \item{\code{resume()}}{
+#'       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.
+#'     }
+#'     \item{\code{setPriority(priority = 0)}}{
+#'       Change this observer's priority. Note that if the observer is currently 
+#'       invalidated, then the change in priority will not take effect until the
+#'       next invalidation--unless the observer is also currently suspended, in 
+#'       which case the priority change will be effective upon resume.
+#'     }
+#'     \item{\code{onInvalidate(callback)}}{
+#'       Register a callback function to run when this observer is invalidated.
+#'       No arguments will be provided to the callback function when it is
+#'       invoked.
+#'     }
+#'   }
 #'
 #' @examples
 #' values <- reactiveValues(A=1)
@@ -531,7 +596,7 @@ observe <- function(x, env=parent.frame(), quoted=FALSE, label=NULL,

  fun <- exprToFunction(x, env, quoted)
  if (is.null(label))
-    label <- deparse(body(fun))
+    label <- sprintf('observe(%s)', paste(deparse(body(fun)), collapse='\n'))

  invisible(Observer$new(
    fun, label=label, suspended=suspended, priority=priority))
@@ -750,8 +815,9 @@ invalidateLater <- function(millis, session) {
 #'
 #' @export
 isolate <- function(expr) {
-  ctx <- Context$new('[isolate]')
+  ctx <- Context$new('[isolate]', type='isolate')
  ctx$run(function() {
    expr
  })
+  ctx$invalidate()
 }
--- a/R/shiny.R
+++ b/R/shiny.R
@@ -1,3 +1,16 @@
+#' Web Application Framework for R
+#' 
+#' 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.
+#' 
+#' The Shiny tutorial at \url{http://rstudio.github.com/shiny/tutorial} explains
+#' the framework in depth, walks you through building a simple application, and
+#' includes extensive annotated examples.
+#' 
+#' @name shiny-package
+#' @aliases shiny
 #' @docType package
 #' @import httpuv caTools RJSONIO xtable digest
 NULL
@@ -27,16 +40,19 @@ ShinySession <- setRefClass(
    .clientData = 'ReactiveValues', # Internal object for other data sent from the client
    .closedCallbacks = 'Callbacks',
    input       = 'reactivevalues', # Externally-usable S3 wrapper object for .input
+    output      = 'ANY',    # Externally-usable S3 wrapper object for .outputs
    clientData  = 'reactivevalues', # Externally-usable S3 wrapper object for .clientData
    token = 'character',  # Used to identify this instance in URLs
    files = 'Map',        # For keeping track of files sent to client
    downloads = 'Map',
    closed = 'logical',
-    session = 'list'      # Object for the server app to access session stuff
+    session = 'list',      # Object for the server app to access session stuff
+    .workerId = 'character'
  ),
  methods = list(
-    initialize = function(websocket) {
+    initialize = function(websocket, workerId) {
      .websocket <<- websocket
+      .workerId <<- workerId
      .invalidatedOutputValues <<- Map$new()
      .invalidatedOutputErrors <<- Map$new()
      .inputMessageQueue <<- list()
@@ -49,7 +65,11 @@ ShinySession <- setRefClass(
      .clientData <<- ReactiveValues$new()

      input      <<- .createReactiveValues(.input,      readonly=TRUE)
+      .setLabel(input, 'input')
      clientData <<- .createReactiveValues(.clientData, readonly=TRUE)
+      .setLabel(clientData, 'clientData')
+      
+      output     <<- .createOutputWriter(.self)
      
      token <<- createUniqueId(16)
      .outputs <<- list()
@@ -59,7 +79,14 @@ ShinySession <- setRefClass(
                       sendCustomMessage = .self$.sendCustomMessage,
                       sendInputMessage  = .self$.sendInputMessage,
                       onSessionEnded    = .self$onSessionEnded,
-                       isClosed          = .self$isClosed)
+                       isClosed          = .self$isClosed,
+                       input             = .self$input,
+                       output            = .self$output)
+      
+      .write(toJSON(list(config = list(
+        workerId = .workerId,
+        sessionId = token
+      ))))
    },
    onSessionEnded = function(callback) {
      "Registers the given callback to be invoked when the session is closed
@@ -123,7 +150,7 @@ ShinySession <- setRefClass(
          }
          else
            .invalidatedOutputValues$set(name, value)
-        }, label=label, suspended=.shouldSuspend(name))
+        }, suspended=.shouldSuspend(name), label=sprintf('output$%s <- %s', name, paste(label, collapse='\n')))
        
        obs$onInvalidate(function() {
          showProgress(name)
@@ -245,7 +272,9 @@ ShinySession <- setRefClass(

      jobId <- .fileUploadContext$createUploadOperation(fileInfos)
      return(list(jobId=jobId,
-                  uploadUrl=paste('session', token, 'upload', jobId, sep='/')))
+                  uploadUrl=paste('session', token, 'upload', 
+                                  paste(jobId, "?w=", .workerId,sep=""), 
+                                  sep='/')))
    },
    `@uploadEnd` = function(jobId, inputId) {
      fileData <- .fileUploadContext$getUploadOperation(jobId)$finish()
@@ -364,9 +393,10 @@ ShinySession <- setRefClass(
      "Creates an entry in the file map for the data, and returns a URL pointing
      to the file."
      files$set(name, list(data=data, contentType=contentType))
-      return(sprintf('session/%s/file/%s?%s',
+      return(sprintf('session/%s/file/%s?w=%s&r=%s',
                     URLencode(token, TRUE),
                     URLencode(name, TRUE),
+                     .workerId,
                     createUniqueId(8)))
    },
    # Send a file to the client
@@ -379,7 +409,7 @@ ShinySession <- setRefClass(
        return(NULL)

      fileData <- readBin(file, 'raw', n=bytes)
-
+      
      if (isTRUE(.clientData$.values$allowDataUriScheme)) {
        b64 <- base64encode(fileData)
        return(paste('data:', contentType, ';base64,', b64, sep=''))
@@ -392,9 +422,10 @@ ShinySession <- setRefClass(
      downloads$set(name, list(filename = filename,
                               contentType = contentType,
                               func = func))
-      return(sprintf('session/%s/download/%s',
+      return(sprintf('session/%s/download/%s?w=%s',
                     URLencode(token, TRUE),
-                     URLencode(name, TRUE)))
+                     URLencode(name, TRUE),
+                     .workerId))
    },
    .getOutputOption = function(outputName, propertyName, defaultValue) {
      opts <- .outputOptions[[outputName]]
@@ -632,6 +663,20 @@ joinHandlers <- function(handlers) {
  }
 }

+reactLogHandler <- function(req) {
+  if (!identical(req$PATH_INFO, '/reactlog'))
+    return(NULL)
+  
+  if (!getOption('shiny.reactlog', FALSE)) {
+    return(NULL)
+  }
+  
+  return(httpResponse(
+    status=200,
+    content=list(file=renderReactLog(), owned=TRUE)
+  ))
+}
+
 sessionHandler <- function(req) {
  path <- req$PATH_INFO
  if (is.null(path))
@@ -910,7 +955,7 @@ file.path.ci <- function(dir, name) {

 # Instantiates the app in the current working directory.
 # port - The TCP port that the application should listen on.
-startAppDir <- function(port=8101L) {
+startAppDir <- function(port=8101L, workerId) {
  globalR <- file.path.ci(getwd(), 'global.R')
  uiR <- file.path.ci(getwd(), 'ui.R')
  serverR <- file.path.ci(getwd(), 'server.R')
@@ -946,11 +991,12 @@ startAppDir <- function(port=8101L) {
  startApp(
    c(dynamicHandler(uiR), wwwDir),
    serverFuncSource,
-    port
+    port,
+    workerId
  )
 }

-startAppObj <- function(ui, serverFunc, port) {
+startAppObj <- function(ui, serverFunc, port, workerId) {
  uiHandler <- function(req) {
    if (!identical(req$REQUEST_METHOD, 'GET'))
      return(NULL)
@@ -968,10 +1014,10 @@ startAppObj <- function(ui, serverFunc, port) {
  
  startApp(uiHandler,
             function() { serverFunc },
-             port)
+             port, workerId)
 }

-startApp <- function(httpHandlers, serverFuncSource, port) {
+startApp <- function(httpHandlers, serverFuncSource, port, workerId) {
  
  sys.www.root <- system.file('www', package='shiny')
  
@@ -1001,9 +1047,10 @@ startApp <- function(httpHandlers, serverFuncSource, port) {
    call = httpServer(c(sessionHandler,
                        httpHandlers,
                        sys.www.root,
-                        resourcePathHandler)),
+                        resourcePathHandler,
+                        reactLogHandler)),
    onWSOpen = function(ws) {
-      shinysession <- ShinySession$new(ws)
+      shinysession <- ShinySession$new(ws, workerId)
      appsByToken$set(shinysession$token, shinysession)
      
      ws$onMessage(function(binary, msg) {
@@ -1154,6 +1201,8 @@ serviceApp <- function(ws_env) {
 #' @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.
+#' @param workerId Can generally be ignored. Exists to help some editions of
+#'   Shiny Server Pro route requests to the correct process.
 #'
 #' @examples
 #' \dontrun{
@@ -1179,12 +1228,13 @@ serviceApp <- function(ws_env) {
 runApp <- function(appDir=getwd(),
                   port=8100L,
                   launch.browser=getOption('shiny.launch.browser',
-                                            interactive())) {
+                                            interactive()), 
+                   workerId="") {

  # Make warnings print immediately
  ops <- options(warn = 1)
  on.exit(options(ops))
-
+  
  if (nzchar(Sys.getenv('SHINY_PORT'))) {
    # If SHINY_PORT is set, we're running under Shiny Server. Check the version
    # to make sure it is compatible. Older versions of Shiny Server don't set
@@ -1203,9 +1253,9 @@ runApp <- function(appDir=getwd(),
    orig.wd <- getwd()
    setwd(appDir)
    on.exit(setwd(orig.wd), add = TRUE)
-    server <- startAppDir(port=port)
+    server <- startAppDir(port=port, workerId)
  } else {
-    server <- startAppObj(appDir$ui, appDir$server, port=port)
+    server <- startAppObj(appDir$ui, appDir$server, port=port, workerId)
  }
  
  on.exit({
@@ -1217,8 +1267,10 @@ runApp <- function(appDir=getwd(),
    utils::browseURL(appUrl)
  }
  
+  .globals$retval <- NULL
+  .globals$stopped <- FALSE
  tryCatch(
-    while (TRUE) {
+    while (!.globals$stopped) {
      serviceApp()
      Sys.sleep(0.001)
    },
@@ -1226,6 +1278,23 @@ runApp <- function(appDir=getwd(),
      timerCallbacks$clear()
    }
  )
+  
+  return(.globals$retval)
+}
+
+#' Stop the currently running Shiny app
+#' 
+#' Stops the currently running Shiny app, returning control to the caller of 
+#' \code{\link{runApp}}.
+#' 
+#' @param returnValue The value that should be returned from
+#'   \code{\link{runApp}}.
+#'   
+#' @export
+stopApp <- function(returnValue = NULL) {
+  .globals$retval <- returnValue
+  .globals$stopped <- TRUE
+  httpuv::interrupt()
 }

 #' Run Shiny Example Applications
--- a/R/shinyui.R
+++ b/R/shinyui.R
@@ -47,6 +47,28 @@ strong <- function(...) tags$strong(...)
 #' @export
 em <- function(...) tags$em(...)

+#' Include Content From a File
+#' 
+#' Include HTML, text, or rendered Markdown into a \link[=shinyUI]{Shiny UI}.
+#' 
+#' These functions provide a convenient way to include an extensive amount of 
+#' HTML, textual, Markdown, CSS, or JavaScript 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.
+#'   
+#' @param 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.
+#'   
+#' @rdname include
 #' @export
 includeHTML <- function(path) {
  dependsOnFile(path)
@@ -54,13 +76,15 @@ includeHTML <- function(path) {
  return(HTML(paste(lines, collapse='\r\n')))
 }

+#' @rdname include
 #' @export
 includeText <- function(path) {
  dependsOnFile(path)
  lines <- readLines(path, warn=FALSE, encoding='UTF-8')
-  return(HTML(paste(lines, collapse='\r\n')))
+  return(paste(lines, collapse='\r\n'))
 }

+#' @rdname include
 #' @export
 includeMarkdown <- function(path) {
  if (!require(markdown))
@@ -72,6 +96,27 @@ includeMarkdown <- function(path) {
  return(HTML(html))
 }

+#' @param ... Any additional attributes to be applied to the generated tag.
+#' @rdname include
+#' @export
+includeCSS <- function(path, ...) {
+  dependsOnFile(path)
+  lines <- readLines(path, warn=FALSE, encoding='UTF-8')
+  args <- list(...)
+  if (is.null(args$type))
+    args$type <- 'text/css'
+  return(do.call(tags$style,
+                 c(list(HTML(paste(lines, collapse='\r\n'))), args)))
+}
+
+#' @rdname include
+#' @export
+includeScript <- function(path, ...) {
+  dependsOnFile(path)
+  lines <- readLines(path, warn=FALSE, encoding='UTF-8')
+  return(tags$script(HTML(paste(lines, collapse='\r\n')), ...))
+}
+

 #' Include Content Only Once
 #' 
--- a/R/shinywrappers.R
+++ b/R/shinywrappers.R
@@ -11,6 +11,9 @@ suppressPackageStartupMessages({
 #' The corresponding HTML output tag should be \code{div} or \code{img} and have
 #' the CSS class name \code{shiny-plot-output}.
 #'
+#' @seealso For more details on how the plots are generated, and how to control
+#'   the output, see \code{\link{plotPNG}}.
+#'
 #' @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. 
@@ -109,6 +112,9 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
 #' The corresponding HTML output tag should be \code{div} or \code{img} and have
 #' the CSS class name \code{shiny-image-output}.
 #'
+#' @seealso For more details on how the images are generated, and how to control
+#'   the output, see \code{\link{plotPNG}}.
+#'
 #' @param expr An expression that returns a list.
 #' @param env The environment in which to evaluate \code{expr}.
 #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
--- a/R/slider.R
+++ b/R/slider.R
@@ -43,7 +43,7 @@ slider <- function(inputId, min, max, value, step = NULL, ...,
    
  # validate numeric inputs
  if (!is.numeric(value) || !is.numeric(min) || !is.numeric(max)) 
-    stop("min, max, amd value must all be numeric values")
+    stop("min, max, and value must all be numeric values")
  else if (min(value) < min) 
    stop(paste("slider initial value", value, 
               "is less than the specified minimum"))
--- a/R/tags.R
+++ b/R/tags.R
@@ -94,70 +94,41 @@ tagAppendChild <- function(tag, child) {
  tag
 }

+#' @export
+tagAppendChildren <- function(tag, ..., list = NULL) {
+  tag$children <- c(tag$children, c(list(...), list))
+  tag
+}
+
+#' @export
+tagSetChildren <- function(tag, ..., list = NULL) {
+  tag$children <- c(list(...), list)
+  tag
+}
+
 #' @export
 tag <- function(`_tag_name`, varArgs) {
-  
-  # create basic tag data structure
-  tag <- list()
-  class(tag) <- "shiny.tag"
-  tag$name <- `_tag_name`
-  tag$attribs <- list()
-  tag$children <- list()
-  
-  # process varArgs
+  # Get arg names; if not a named list, use vector of empty strings
  varArgsNames <- names(varArgs)
  if (is.null(varArgsNames))
    varArgsNames <- character(length=length(varArgs))
+
+  # Named arguments become attribs, dropping NULL values
+  named_idx <- nzchar(varArgsNames)
+  attribs <- dropNulls(varArgs[named_idx])
  
-  if (length(varArgsNames) > 0) {
-    for (i in 1:length(varArgsNames)) {
-      # save name and value
-      name <- varArgsNames[[i]]
-      value <- varArgs[[i]]
-      
-      # process attribs
-      if (nzchar(name))
-        tag$attribs[[name]] <- value
-      
-      # process child tags
-      else if (isTag(value)) {
-        tag$children[[length(tag$children)+1]] <- value
-      }
-      
-      # recursively process lists of children
-      else if (is.list(value)) {
-        
-        tagAppendChildren <- function(tag, children) {
-          for(child in children) {
-            if (isTag(child))
-              tag <- tagAppendChild(tag, child)
-            else if (is.list(child))
-              tag <- tagAppendChildren(tag, child)
-            else if (is.character(child))
-              tag <- tagAppendChild(tag, child)
-            else
-              tag <- tagAppendChild(tag, as.character(child))
-          }
-          return (tag)
-        }
-        
-        tag <- tagAppendChildren(tag, value)
-      }
-      
-      # add text
-      else if (is.character(value)) {
-        tag <- tagAppendChild(tag, value)
-      }
-      
-      # everything else treated as text
-      else {
-        tag <- tagAppendChild(tag, as.character(value))
-      }
-    }
-  }
-  
-  # return the tag
-  return (tag)
+  # Unnamed arguments are flattened and added as children.
+  # Use unname() to remove the names attribute from the list, which would
+  # consist of empty strings anyway.
+  children <- flattenTags(unname(varArgs[!named_idx]))
+
+  # Return tag data structure
+  structure(
+    list(name = `_tag_name`,
+         attribs = attribs,
+         children = children),
+    class = "shiny.tag"
+  )
 }

 tagWrite <- function(tag, textWriter, indent=0, context = NULL, eol = "\n") {
@@ -401,3 +372,31 @@ HTML <- function(text, ...) {
 withTags <- function(code) {
  eval(substitute(code), envir = as.list(tags), enclos = parent.frame())
 }
+
+
+# Given a list of tags, lists, and other items, return a flat list, where the
+# items from the inner, nested lists are pulled to the top level, recursively.
+flattenTags <- function(x) {
+  if (isTag(x)) {
+    # For tags, wrap them into a list (which will be unwrapped by caller)
+    list(x)
+  } else if (is.list(x)) {
+    if (length(x) == 0) {
+      # Empty lists are simply returned
+      x
+    } else {
+      # For items that are lists (but not tags), recurse
+      unlist(lapply(x, flattenTags), recursive = FALSE)
+    }
+
+  } else if (is.character(x)){
+    # This will preserve attributes if x is a character with attribute,
+    # like what HTML() produces
+    list(x)
+
+  } else {
+    # For other items, coerce to character and wrap them into a list (which
+    # will be unwrapped by caller). Note that this will strip attributes.
+    list(as.character(x))
+  }
+}
--- a/R/update-input.R
+++ b/R/update-input.R
@@ -293,17 +293,15 @@ updateCheckboxGroupInput <- function(session, inputId, label = NULL,
  choices = NULL, selected = NULL) {

  choices <- choicesWithNames(choices)
-  options <- list()

-  for (i in seq_along(choices)) {
-    choiceName <- names(choices)[i]
-
-    opt <- list(value = choices[[i]],
-                label = choiceName,
-                checked = choiceName %in% selected)
-
-    options[[i]] <- opt
-  }
+  options <- mapply(choices, names(choices),
+    SIMPLIFY = FALSE, USE.NAMES = FALSE,
+    FUN = function(value, name) {
+      list(value = value,
+           label = name,
+           checked = name %in% selected)
+    }
+  )

  message <- dropNulls(list(label = label, options = options))

@@ -391,17 +389,15 @@ updateSelectInput <- function(session, inputId, label = NULL, choices = NULL,
    selected = NULL) {

  choices <- choicesWithNames(choices)
-  options <- list()

-  for (i in seq_along(choices)) {
-    choiceName <- names(choices)[i]
-
-    opt <- list(value = choices[[i]],
-                label = choiceName,
-                selected = choiceName %in% selected)
-
-    options[[i]] <- opt
-  }
+  options <- mapply(choices, names(choices),
+    SIMPLIFY = FALSE, USE.NAMES = FALSE,
+    FUN = function(value, name) {
+      list(value = value,
+           label = name,
+           selected = name %in% selected)
+    }
+  )

  message <- dropNulls(list(label = label, options = options))

--- a/inst/tests/test-tags.r
+++ b/inst/tests/test-tags.r
@@ -48,3 +48,253 @@ test_that("withTags works", {
  }
  expect_identical(tags$p(100), foo())
 })
+
+
+test_that("HTML escaping in tags", {
+  # Regular text is escaped
+  expect_equivalent(format(div("<a&b>")), "<div>&lt;a&amp;b&gt;</div>")
+
+  # Text in HTML() isn't escaped
+  expect_equivalent(format(div(HTML("<a&b>"))), "<div><a&b></div>")
+
+  # Text in a property is escaped
+  expect_equivalent(format(div(class = "<a&b>", "text")),
+                    '<div class="&lt;a&amp;b&gt;">text</div>')
+
+  # HTML() has no effect in a property like 'class'
+  expect_equivalent(format(div(class = HTML("<a&b>"), "text")),
+                    '<div class="&lt;a&amp;b&gt;">text</div>')
+})
+
+
+test_that("Adding child tags", {
+  tag_list <- list(tags$p("tag1"), tags$b("tag2"), tags$i("tag3"))
+
+  # Creating nested tags by calling the tag$div function and passing a list
+  t1 <- tags$div(class="foo", tag_list)
+  expect_equal(length(t1$children), 3)
+  expect_equal(t1$children[[1]]$name, "p")
+  expect_equal(t1$children[[1]]$children[[1]], "tag1")
+  expect_equal(t1$children[[2]]$name, "b")
+  expect_equal(t1$children[[2]]$children[[1]], "tag2")
+  expect_equal(t1$children[[3]]$name, "i")
+  expect_equal(t1$children[[3]]$children[[1]], "tag3")
+
+
+  # div tag used as starting point for tests below
+  div_tag <- tags$div(class="foo")
+
+  # Appending each child
+  t2 <- tagAppendChild(div_tag, tag_list[[1]])
+  t2 <- tagAppendChild(t2, tag_list[[2]])
+  t2 <- tagAppendChild(t2, tag_list[[3]])
+  expect_identical(t1, t2)
+
+
+  # tagSetChildren, using list argument
+  t2 <- tagSetChildren(div_tag, list = tag_list)
+  expect_identical(t1, t2)
+
+  # tagSetChildren, using ... arguments
+  t2 <- tagSetChildren(div_tag, tag_list[[1]], tag_list[[2]], tag_list[[3]])
+  expect_identical(t1, t2)
+
+  # tagSetChildren, using ... and list arguments
+  t2 <- tagSetChildren(div_tag, tag_list[[1]], list = tag_list[2:3])
+  expect_identical(t1, t2)
+
+  # tagSetChildren overwrites existing children
+  t2 <- tagAppendChild(div_tag, p("should replace this tag"))
+  t2 <- tagSetChildren(div_tag, list = tag_list)
+  expect_identical(t1, t2)
+
+
+  # tagAppendChildren, using list argument
+  t2 <- tagAppendChild(div_tag, tag_list[[1]])
+  t2 <- tagAppendChildren(t2, list = tag_list[2:3])
+  expect_identical(t1, t2)
+
+  # tagAppendChildren, using ... arguments
+  t2 <- tagAppendChild(div_tag, tag_list[[1]])
+  t2 <- tagAppendChildren(t2, tag_list[[2]], tag_list[[3]])
+  expect_identical(t1, t2)
+
+  # tagAppendChildren, using ... and list arguments
+  t2 <- tagAppendChild(div_tag, tag_list[[1]])
+  t2 <- tagAppendChildren(t2, tag_list[[2]], list = list(tag_list[[3]]))
+  expect_identical(t1, t2)
+
+  # tagAppendChildren can start with no children
+  t2 <- tagAppendChildren(div_tag, list = tag_list)
+  expect_identical(t1, t2)
+
+
+  # tagSetChildren preserves attributes
+  x <- tagSetChildren(div(), HTML("text"))
+  expect_identical(attr(x$children[[1]], "html"), TRUE)
+
+  # tagAppendChildren preserves attributes
+  x <- tagAppendChildren(div(), HTML("text"))
+  expect_identical(attr(x$children[[1]], "html"), TRUE)
+})
+
+
+test_that("Creating simple tags", {
+  # Empty tag
+  expect_identical(
+    div(),
+    structure(
+      list(name = "div", attribs = list(), children = list()),
+      .Names = c("name", "attribs", "children"),
+      class = "shiny.tag"
+    )
+  )
+
+  # Tag with text
+  expect_identical(
+    div("text"),
+    structure(
+      list(name = "div", attribs = list(), children = list("text")),
+      .Names = c("name", "attribs", "children"),
+      class = "shiny.tag"
+    )
+  )
+
+  # NULL attributes are dropped
+  expect_identical(
+    div(a = NULL, b = "value"),
+    div(b = "value")
+  )
+
+  # Numbers are coerced to strings
+  expect_identical(
+    div(1234),
+    structure(
+      list(name = "div", attribs = list(), children = list("1234")),
+      .Names = c("name", "attribs", "children"),
+      class = "shiny.tag"
+    )
+  )
+})
+
+
+test_that("Creating nested tags", {
+  # Simple version
+  # Note that the $children list should not have a names attribute
+  expect_identical(
+    div(class="foo", list("a", "b")),
+    structure(
+      list(name = "div",
+           attribs = structure(list(class = "foo"), .Names = "class"),
+           children = list("a", "b")),
+      .Names = c("name", "attribs", "children"),
+      class = "shiny.tag"
+    )
+  )
+
+  # More complex version
+  t1 <- withTags(
+    div(class = "foo",
+      p("child tag"),
+      list(
+        p("in-list child tag 1"),
+        "in-list character string",
+        p(),
+        p("in-list child tag 2")
+      ),
+      "character string",
+      1234
+    )
+  )
+
+  # t1 should be identical to this data structure.
+  # The nested list should be flattened, and non-tag, non-strings should be
+  # converted to strings
+  t1_full <- structure(
+    list(
+      name = "div",
+      attribs = list(class = "foo"),
+      children = list(
+        structure(list(name = "p",
+                       attribs = list(),
+                       children = list("child tag")),
+                  class = "shiny.tag"
+        ),
+        structure(list(name = "p",
+                       attribs = list(),
+                       children = list("in-list child tag 1")),
+                  class = "shiny.tag"
+        ),
+        "in-list character string",
+        structure(list(name = "p",
+                       attribs = list(),
+                       children = list()),
+                  class = "shiny.tag"
+        ),
+        structure(list(name = "p",
+                       attribs = list(),
+                       children = list("in-list child tag 2")),
+                  class = "shiny.tag"
+        ),
+        "character string",
+        "1234"
+      )
+    ),
+    class = "shiny.tag"
+  )
+
+  expect_identical(t1, t1_full)
+})
+
+test_that("Attributes are preserved", {
+  # HTML() adds an attribute to the data structure (note that this is
+  # different from the 'attribs' field in the list)
+  x <- HTML("<tag>&&</tag>")
+  expect_identical(attr(x, "html"), TRUE)
+  expect_equivalent(format(x), "<tag>&&</tag>")
+
+  # Make sure attributes are preserved when wrapped in other tags
+  x <- div(HTML("<tag>&&</tag>"))
+  expect_equivalent(x$children[[1]], "<tag>&&</tag>")
+  expect_identical(attr(x$children[[1]], "html"), TRUE)
+  expect_equivalent(format(x), "<div><tag>&&</tag></div>")
+
+  # Deeper nesting
+  x <- div(p(HTML("<tag>&&</tag>")))
+  expect_equivalent(x$children[[1]]$children[[1]], "<tag>&&</tag>")
+  expect_identical(attr(x$children[[1]]$children[[1]], "html"), TRUE)
+  expect_equivalent(format(x), "<div>\n  <p><tag>&&</tag></p>\n</div>")
+})
+
+
+test_that("Flattening a list of tags", {
+  # Flatten a nested list
+  nested <- list(
+    "a1",
+    list(
+      "b1",
+      list("c1", "c2"),
+      list(),
+      "b2",
+      list("d1", "d2")
+    ),
+    "a2"
+  )
+  flat <- list("a1", "b1", "c1", "c2", "b2", "d1", "d2", "a2")
+  expect_identical(flattenTags(nested), flat)
+
+  # no-op for flat lists
+  expect_identical(flattenTags(list(a="1", "b")), list(a="1", "b"))
+
+  # numbers are coerced to character
+  expect_identical(flattenTags(list(a=1, "b")), list(a="1", "b"))
+
+  # empty list results in empty list
+  expect_identical(flattenTags(list()), list())
+
+  # preserve attributes
+  nested <- list("txt1", list(structure("txt2", prop="prop2")))
+  flat <- list("txt1",
+               structure("txt2", prop="prop2"))
+  expect_identical(flattenTags(nested), flat)
+})
--- a/inst/www/reactive-graph.html
+++ b/inst/www/reactive-graph.html
@@ -0,0 +1,570 @@
+<!DOCTYPE html>
+<html>
+<script src="http://ajax.googleapis.com/ajax/libs/jquery/1.10.1/jquery.min.js"></script>
+<script src="http://d3js.org/d3.v3.min.js" charset="utf-8"></script>
+<link href='http://fonts.googleapis.com/css?family=Source+Sans+Pro:200,400,600' rel='stylesheet' type='text/css'>
+<style type="text/css">
+html, body {
+  font-family: 'Source Sans Pro', sans-serif;
+  font-weight: 400;
+  overflow: hidden;
+  height: 100%;
+  width: 100%;
+  margin: 0;
+  padding: 0;
+}
+div {
+  -moz-user-select: none; 
+  -khtml-user-select: none; 
+  -webkit-user-select: none; 
+  -o-user-select: none;
+  cursor: default;
+}
+#instructions, #ended {
+  position: relative;
+  font-weight: 200;
+  color: #444;
+  top: 20px;
+  font-size: 30px;
+  text-align: center;
+}
+#ended strong {
+  font-weight: 600;
+}
+svg {
+  position: absolute;
+  left: 0;
+  top: 0;
+  width: 100%;
+  height: 100%;
+}
+.node {
+  cursor: pointer;
+}
+.node text {
+  font-family: 'Source Code Pro', monospace;
+  font-weight: normal;
+  text-anchor: start;
+  fill: #999;
+  user-select: none;
+  transition: fill 0.75s ease;
+}
+.node.running text {
+  fill: black;
+}
+.node.changed text {
+  fill: red;
+}
+.node text tspan {
+  white-space: pre;
+}
+.node path {
+  fill: white;
+  stroke: #777;
+  stroke-width: 7.5px;
+  transition: fill 0.75s ease;
+}
+.node.observer path {
+}
+.node.observable path {
+}
+.node.value path {
+}
+.node.invalidated path {
+  fill: #E0E0E0;
+  /*fill: url(#diagonalHatch);*/
+}
+.node.running path {
+  fill: #61B97E;
+}
+#legend {
+  font-size: 22px;
+  position: fixed;
+  bottom: 10px;
+  right: 20px;
+}
+.color {
+  display: inline-block;
+  border: 1px solid #777;
+  height: 14px;
+  width: 14px;
+}
+.color.normal {
+  background-color: #white;
+}
+.color.invalidated {
+  background-color: #E0E0E0;
+}
+.color.running {
+  background-color: #61B97E;
+}
+#triangle {
+  fill: #CCC;
+}
+.link {
+  fill: none;
+  stroke: #CCC;
+  stroke-width: 0.5px;
+}
+#description {
+  position: fixed;
+  width: 300px;
+  left: 630px;
+  top: 36px;
+  height: auto;
+  display: none;
+}
+</style>
+<script>
+var log = [
+  { "action" : "valueChange", "id" : "names(input)", "value" : " chr \"dataset\"" },
+  { "action" : "valueChange", "id" : "input (all)", "value" : "List of 1\n $ dataset: chr \"rock\"" },
+  { "action" : "valueChange", "id" : "input$dataset", "value" : " chr \"rock\"" },
+  { "action" : "valueChange", "id" : "names(input)", "value" : " chr [1:2] \"caption\" \"dataset\"" },
+  { "action" : "valueChange", "id" : "input (all)", "value" : "List of 2\n $ caption: chr \"Data Summary\"\n $ dataset: chr \"rock\"" },
+  { "action" : "valueChange", "id" : "input$caption", "value" : " chr \"Data Summary\"" },
+  { "action" : "valueChange", "id" : "names(input)", "value" : " chr [1:3] \"caption\" \"dataset\" \"obs\"" },
+  { "action" : "valueChange", "id" : "input (all)", "value" : "List of 3\n $ caption: chr \"Data Summary\"\n $ obs    : num 10\n $ dataset: chr \"rock\"" },
+  { "action" : "valueChange", "id" : "input$obs", "value" : " num 10" },
+  { "action" : "valueChange", "id" : "names(clientData)", "value" : " chr \"output_caption_hidden\"" },
+  { "action" : "valueChange", "id" : "clientData (all)", "value" : "List of 1\n $ output_caption_hidden: logi FALSE" },
+  { "action" : "valueChange", "id" : "clientData$output_caption_hidden", "value" : " logi FALSE" },
+  { "action" : "valueChange", "id" : "names(clientData)", "value" : " chr [1:2] \"output_caption_hidden\" \"output_summary_hidden\"" },
+  { "action" : "valueChange", "id" : "clientData (all)", "value" : "List of 2\n $ output_caption_hidden: logi FALSE\n $ output_summary_hidden: logi FALSE" },
+  { "action" : "valueChange", "id" : "clientData$output_summary_hidden", "value" : " logi FALSE" },
+  { "action" : "valueChange", "id" : "names(clientData)", "value" : " chr [1:3] \"output_caption_hidden\" \"output_summary_hidden\" \"output_view_hidden\"" },
+  { "action" : "valueChange", "id" : "clientData (all)", "value" : "List of 3\n $ output_view_hidden   : logi FALSE\n $ output_caption_hidden: logi FALSE\n $ output_summary_hidden: logi FALSE" },
+  { "action" : "valueChange", "id" : "clientData$output_view_hidden", "value" : " logi FALSE" },
+  { "action" : "valueChange", "id" : "names(clientData)", "value" : " chr [1:4] \"output_caption_hidden\" \"output_summary_hidden\" \"output_view_hidden\" ..." },
+  { "action" : "valueChange", "id" : "clientData (all)", "value" : "List of 4\n $ output_view_hidden   : logi FALSE\n $ output_caption_hidden: logi FALSE\n $ pixelratio           : num 2\n $ output_summary_hidden: logi FALSE" },
+  { "action" : "valueChange", "id" : "clientData$pixelratio", "value" : " num 2" },
+  { "action" : "valueChange", "id" : "names(clientData)", "value" : " chr [1:5] \"output_caption_hidden\" \"output_summary_hidden\" \"output_view_hidden\" ..." },
+  { "action" : "valueChange", "id" : "clientData (all)", "value" : "List of 5\n $ output_view_hidden   : logi FALSE\n $ output_caption_hidden: logi FALSE\n $ pixelratio           : num 2\n $ output_summary_hidden: logi FALSE\n $ url_protocol         : chr \"http:\"" },
+  { "action" : "valueChange", "id" : "clientData$url_protocol", "value" : " chr \"http:\"" },
+  { "action" : "valueChange", "id" : "names(clientData)", "value" : " chr [1:6] \"output_caption_hidden\" \"output_summary_hidden\" \"output_view_hidden\" ..." },
+  { "action" : "valueChange", "id" : "clientData (all)", "value" : "List of 6\n $ output_view_hidden   : logi FALSE\n $ output_caption_hidden: logi FALSE\n $ pixelratio           : num 2\n $ url_hostname         : chr \"localhost\"\n $ output_summary_hidden: logi FALSE\n $ url_protocol         : chr \"http:\"" },
+  { "action" : "valueChange", "id" : "clientData$url_hostname", "value" : " chr \"localhost\"" },
+  { "action" : "valueChange", "id" : "names(clientData)", "value" : " chr [1:7] \"output_caption_hidden\" \"output_summary_hidden\" \"output_view_hidden\" ..." },
+  { "action" : "valueChange", "id" : "clientData (all)", "value" : "List of 7\n $ output_view_hidden   : logi FALSE\n $ url_port             : chr \"8100\"\n $ output_caption_hidden: logi FALSE\n $ pixelratio           : num 2\n $ url_hostname         : chr \"localhost\"\n $ output_summary_hidden: logi FALSE\n $ url_protocol         : chr \"http:\"" },
+  { "action" : "valueChange", "id" : "clientData$url_port", "value" : " chr \"8100\"" },
+  { "action" : "valueChange", "id" : "names(clientData)", "value" : " chr [1:8] \"output_caption_hidden\" \"output_summary_hidden\" \"output_view_hidden\" ..." },
+  { "action" : "valueChange", "id" : "clientData (all)", "value" : "List of 8\n $ url_pathname         : chr \"/\"\n $ output_view_hidden   : logi FALSE\n $ url_port             : chr \"8100\"\n $ output_caption_hidden: logi FALSE\n $ pixelratio           : num 2\n $ url_hostname         : chr \"localhost\"\n $ output_summary_hidden: logi FALSE\n $ url_protocol         : chr \"http:\"" },
+  { "action" : "valueChange", "id" : "clientData$url_pathname", "value" : " chr \"/\"" },
+  { "action" : "valueChange", "id" : "names(clientData)", "value" : " chr [1:9] \"output_caption_hidden\" \"output_summary_hidden\" \"output_view_hidden\" ..." },
+  { "action" : "valueChange", "id" : "clientData (all)", "value" : "List of 9\n $ url_pathname         : chr \"/\"\n $ output_view_hidden   : logi FALSE\n $ url_port             : chr \"8100\"\n $ output_caption_hidden: logi FALSE\n $ pixelratio           : num 2\n $ url_hostname         : chr \"localhost\"\n $ output_summary_hidden: logi FALSE\n $ url_search           : chr \"\"\n $ url_protocol         : chr \"http:\"" },
+  { "action" : "valueChange", "id" : "clientData$url_search", "value" : " chr \"\"" },
+  { "action" : "valueChange", "id" : "names(clientData)", "value" : " chr [1:10] \"output_caption_hidden\" \"output_summary_hidden\" \"output_view_hidden\" ..." },
+  { "action" : "valueChange", "id" : "clientData (all)", "value" : "List of 10\n $ url_pathname         : chr \"/\"\n $ output_view_hidden   : logi FALSE\n $ url_port             : chr \"8100\"\n $ output_caption_hidden: logi FALSE\n $ url_hash_initial     : chr \"\"\n $ pixelratio           : num 2\n $ url_hostname         : chr \"localhost\"\n $ output_summary_hidden: logi FALSE\n $ url_search           : chr \"\"\n $ url_protocol         : chr \"http:\"" },
+  { "action" : "valueChange", "id" : "clientData$url_hash_initial", "value" : " chr \"\"" },
+  { "action" : "valueChange", "id" : "names(clientData)", "value" : " chr [1:11] \"allowDataUriScheme\" \"output_caption_hidden\" \"output_summary_hidden\" ..." },
+  { "action" : "valueChange", "id" : "clientData (all)", "value" : "List of 11\n $ allowDataUriScheme   : logi TRUE\n $ url_pathname         : chr \"/\"\n $ output_view_hidden   : logi FALSE\n $ url_port             : chr \"8100\"\n $ output_caption_hidden: logi FALSE\n $ url_hash_initial     : chr \"\"\n $ pixelratio           : num 2\n $ url_hostname         : chr \"localhost\"\n $ output_summary_hidden: logi FALSE\n $ url_search           : chr \"\"\n $ url_protocol         : chr \"http:\"" },
+  { "action" : "valueChange", "id" : "clientData$allowDataUriScheme", "value" : " logi TRUE" },
+  { "action" : "ctx", "id" : "1", "label" : "output$caption <- renderText({ \n    input$caption\n})", "type" : "observer", "prevId" : "" },
+  { "action" : "invalidate", "id" : "1" },
+  { "action" : "ctx", "id" : "2", "label" : "output$summary <- renderPrint({ \n    dataset <- datasetInput()\n    summary(dataset)\n})", "type" : "observer", "prevId" : "" },
+  { "action" : "invalidate", "id" : "2" },
+  { "action" : "ctx", "id" : "3", "label" : "output$view <- renderTable({ \n    head(datasetInput(), n = input$obs)\n})", "type" : "observer", "prevId" : "" },
+  { "action" : "invalidate", "id" : "3" },
+  { "action" : "ctx", "id" : "4", "label" : "output$caption <- renderText({ \n    input$caption\n})", "type" : "observer", "prevId" : "1" },
+  { "action" : "enter", "id" : "4" },
+  { "action" : "dep", "id" : "4", "dependsOn" : "input$caption" },
+  { "action" : "exit", "id" : "4" },
+  { "action" : "ctx", "id" : "5", "label" : "output$summary <- renderPrint({ \n    dataset <- datasetInput()\n    summary(dataset)\n})", "type" : "observer", "prevId" : "2" },
+  { "action" : "enter", "id" : "5" },
+  { "action" : "ctx", "id" : "6", "label" : "reactive({ \n    switch(input$dataset, rock = rock, pressure = pressure, cars = cars)\n})", "type" : "observable", "prevId" : "" },
+  { "action" : "enter", "id" : "6" },
+  { "action" : "dep", "id" : "6", "dependsOn" : "input$dataset" },
+  { "action" : "exit", "id" : "6" },
+  { "action" : "depId", "id" : "5", "dependsOn" : "6" },
+  { "action" : "exit", "id" : "5" },
+  { "action" : "ctx", "id" : "7", "label" : "output$view <- renderTable({ \n    head(datasetInput(), n = input$obs)\n})", "type" : "observer", "prevId" : "3" },
+  { "action" : "enter", "id" : "7" },
+  { "action" : "depId", "id" : "7", "dependsOn" : "6" },
+  { "action" : "dep", "id" : "7", "dependsOn" : "input$obs" },
+  { "action" : "exit", "id" : "7" },
+  { "action" : "valueChange", "id" : "names(input)", "value" : " chr [1:3] \"caption\" \"dataset\" \"obs\"" },
+  { "action" : "valueChange", "id" : "input (all)", "value" : "List of 3\n $ caption: chr \"Pressure Summary\"\n $ obs    : num 10\n $ dataset: chr \"rock\"" },
+  { "action" : "valueChange", "id" : "input$caption", "value" : " chr \"Pressure Summary\"" },
+  { "action" : "invalidate", "id" : "4" },
+  { "action" : "ctx", "id" : "8", "label" : "output$caption <- renderText({ \n    input$caption\n})", "type" : "observer", "prevId" : "4" },
+  { "action" : "enter", "id" : "8" },
+  { "action" : "dep", "id" : "8", "dependsOn" : "input$caption" },
+  { "action" : "exit", "id" : "8" },
+  { "action" : "valueChange", "id" : "names(input)", "value" : " chr [1:3] \"caption\" \"dataset\" \"obs\"" },
+  { "action" : "valueChange", "id" : "input (all)", "value" : "List of 3\n $ caption: chr \"Pressure Summary\"\n $ obs    : num 10\n $ dataset: chr \"pressure\"" },
+  { "action" : "valueChange", "id" : "input$dataset", "value" : " chr \"pressure\"" },
+  { "action" : "invalidate", "id" : "6" },
+  { "action" : "invalidate", "id" : "5" },
+  { "action" : "invalidate", "id" : "7" },
+  { "action" : "ctx", "id" : "9", "label" : "output$summary <- renderPrint({ \n    dataset <- datasetInput()\n    summary(dataset)\n})", "type" : "observer", "prevId" : "5" },
+  { "action" : "enter", "id" : "9" },
+  { "action" : "ctx", "id" : "10", "label" : "reactive({ \n    switch(input$dataset, rock = rock, pressure = pressure, cars = cars)\n})", "type" : "observable", "prevId" : "6" },
+  { "action" : "enter", "id" : "10" },
+  { "action" : "dep", "id" : "10", "dependsOn" : "input$dataset" },
+  { "action" : "exit", "id" : "10" },
+  { "action" : "depId", "id" : "9", "dependsOn" : "10" },
+  { "action" : "exit", "id" : "9" },
+  { "action" : "ctx", "id" : "11", "label" : "output$view <- renderTable({ \n    head(datasetInput(), n = input$obs)\n})", "type" : "observer", "prevId" : "7" },
+  { "action" : "enter", "id" : "11" },
+  { "action" : "depId", "id" : "11", "dependsOn" : "10" },
+  { "action" : "dep", "id" : "11", "dependsOn" : "input$obs" },
+  { "action" : "exit", "id" : "11" },
+  { "action" : "valueChange", "id" : "names(input)", "value" : " chr [1:3] \"caption\" \"dataset\" \"obs\"" },
+  { "action" : "valueChange", "id" : "input (all)", "value" : "List of 3\n $ caption: chr \"Pressure Summary\"\n $ obs    : num 15\n $ dataset: chr \"pressure\"" },
+  { "action" : "valueChange", "id" : "input$obs", "value" : " num 15" },
+  { "action" : "invalidate", "id" : "11" },
+  { "action" : "ctx", "id" : "12", "label" : "output$view <- renderTable({ \n    head(datasetInput(), n = input$obs)\n})", "type" : "observer", "prevId" : "11" },
+  { "action" : "enter", "id" : "12" },
+  { "action" : "depId", "id" : "12", "dependsOn" : "10" },
+  { "action" : "dep", "id" : "12", "dependsOn" : "input$obs" },
+  { "action" : "exit", "id" : "12" }
+];
+try {
+  log = __DATA__;
+} catch (e) {}
+
+var nodes = {};
+var nodeList = [];
+var nodeSelection = null;
+var links = [];
+var linkSelection = null;
+
+var node, link;  // d3 selections
+
+var MAX_LINES = 6;
+
+var force = d3.layout.force()
+    .charge(-100)
+    .nodes(nodeList)
+    .links(links);
+force.on('tick', onTick);
+
+function pathDataForNode(node) {
+/*
+d="m 58,2  c -75,0 -75,100 0,100  l 60,0  l 50,-50  l -50,-50  Z"
+d="m 58,2  c -75,0 -75,100 0,100  l 100,0  l 0,-100 Z"
+d="m 2,0 l 0,100 l 100,0  l 50,-50  l -50,-50  Z"
+*/
+  switch (node.type) {
+    case 'observer':
+      return 'M -25,-50  c -75,0 -75,100 0,100  l 100,0  l 0,-100 Z';
+    case 'observable':
+      return 'M -25,-50  c -75,0 -75,100 0,100  l 60,0  l 50,-50  l -50,-50  Z';
+    case 'value':
+      return 'M -50,-50 l 0,100 l 100,0  l 50,-50  l -50,-50  Z';
+  }
+}
+
+function getSourceCoords(node) {
+  switch (node.type) {
+    case 'observer':
+    case 'observable':
+      return {x: node.x - 5, y: node.y};
+    default:
+      return {x: node.x, y: node.y};
+  }
+}
+
+function getTargetCoords(node) {
+  switch (node.type) {
+    case 'observable':
+      return {x: node.x + 7, y: node.y};
+    case 'value':
+      return {x: node.x + 8, y: node.y};
+    default:
+      return {x: node.x, y: node.y};
+  }
+}
+
+function multilineTextNode(node) {
+  var MAX_LINES = 6;
+  var fade = false;
+  var el = d3.select(this);
+  var lines = el.text().split('\n');
+  if (lines.length > MAX_LINES) {
+    lines.splice(MAX_LINES);
+    fade = true;
+  }
+  el.text('');
+  var tspan = el.selectAll('tspan').data(lines);
+  tspan.enter().append('tspan');
+  tspan
+      .attr('x', 8)
+      .attr('dy', function(line, i) { return i > 0 ? '1em' : 0})
+      .attr('opacity', function(line, i) {
+        if (!fade)
+          return 1;
+        return Math.min(1, (MAX_LINES - i) * 0.25 - 0.15);
+      })
+      .text(function(line) { return line; });
+}
+
+function update() {
+  force.size([document.documentElement.clientWidth / 4,
+              document.documentElement.clientHeight / 4]);
+
+  var layoutDirty = true;
+
+  node = d3.select('#nodes').selectAll('.node').data(nodeList);
+  //layoutDirty = layoutDirty || !node.enter().empty() || !node.exit().empty();
+  var newG = node.enter().append('g')
+      .attr('class', function(n) {return 'node ' + n.type;})
+      .attr('r', 5)
+      // don't show until next tick
+      .style('display', 'none')
+      .on('mousedown', function() {
+        d3.event.stopPropagation();
+      })
+      .on('mouseover', function(n) {
+        $('#description').text(n.label);
+      })
+      .on('mouseout', function(d, i) {
+        $('#description').html('');
+      })
+      .call(force.drag);
+  newG.append('path')
+      .attr('transform', 'scale(0.08)')
+      .attr('stroke', 'black')
+      .attr('stroke-width', 4)
+      .attr('fill', 'white')
+      .attr('d', pathDataForNode);
+  newG.append('text')
+      .attr('x', 3)
+      .attr('y', 0)
+      .attr('font-size', 2.5)
+      .attr('transform', function(n) {
+        if (n.type !== 'observer')
+          return 'translate(1.5, 0)';
+        else
+          return null;
+      })
+  node.exit().remove();
+  node
+      .classed('invalidated', function(n) { return n.invalidated; })
+      .classed('running', function(n) { return n.running; })
+      .classed('changed', function(n) { return n.changed; })
+      .attr('fill', function(n) {
+        if (n.invalidated)
+          return "url(#diagonalHatch)";
+        else
+          return null;
+      });
+  var tspan = node.selectAll('text').filter(function(n) {
+    // This filter is used to disregard all nodes whose labels have
+    // not changed since the last time we updated them.
+    var changed = n.label !== this.label;
+    this.label = n.label;
+    return changed;
+  }).selectAll('tspan')
+    .data(function(n) {
+      var lines = n.label.split('\n');
+      if (lines.length > MAX_LINES) {
+        lines.splice(MAX_LINES);
+      }
+      return lines;
+    });
+  tspan.enter().append('tspan');
+  tspan.exit().remove();
+  tspan
+      .attr('x', 8)
+      .attr('dy', function(line, i) { return i > 0 ? '1em' : 0})
+      .attr('opacity', function(line, i) {
+        return Math.min(1, (MAX_LINES - i) * 0.25 - 0.15);
+      })
+      .text(function(line) { return line; });
+
+  link = d3.select('#links').selectAll('.link').data(links);
+  //layoutDirty = layoutDirty || !link.enter().empty() || !link.exit().empty();
+  link.enter().append('path')
+      .attr('class', 'link')
+      .attr('marker-mid', 'url(#triangle)');
+  link.exit().remove();
+
+  if (layoutDirty) {
+    force
+      .nodes(nodeList.filter(function(n) {return !n.hide;}))
+      .start();
+    layoutDirty = false;
+  }
+}
+
+function onTick() {
+  node
+      .style('display', null)
+      .attr('transform', function(n) {
+        return 'translate(' + n.x + ' ' + n.y + ')';
+      });
+  link
+      .attr('d', function(link) {
+        var source = getSourceCoords(link.source);
+        var target = getTargetCoords(link.target)
+        var mid = {
+          x: (source.x + target.x) / 2,
+          y: (source.y + target.y) / 2
+        }
+        return 'M' + source.x + ',' + source.y +
+          ' L' + mid.x + ',' + mid.y +
+          ' L' + target.x + ',' + target.y;
+      });
+}
+
+function createNode(data) {
+  var node;
+  if (!data.prevId) {
+    node = {
+      label: data.label,
+      type: data.type,
+      hide: data.hide
+    };
+    nodes[data.id] = node;
+    if (!node.hide)
+      nodeList.push(node);
+  } else {
+    node = nodes[data.prevId];
+    delete nodes[data.prevId];
+    nodes[data.id] = node;
+    node.label = data.label;
+    node.invalidated = false;
+  }
+}
+
+var callbacks = {
+  ctx: function(data) {
+    createNode(data);
+    return true;
+  },
+  dep: function(data) {
+    var dependsOn = nodes[data.dependsOn];
+    if (!dependsOn) {
+      createNode({id: data.dependsOn, label: data.dependsOn, type: 'value'});
+      dependsOn = nodes[data.dependsOn];
+    }
+    if (dependsOn.hide) {
+      dependsOn.hide = false;
+      nodeList.push(dependsOn);
+    }
+    links.push({
+      source: nodes[data.id],
+      target: nodes[data.dependsOn]
+    });
+  },
+  depId: function(data) {
+    links.push({
+      source: nodes[data.id],
+      target: nodes[data.dependsOn]
+    });
+  },
+  invalidate: function(data) {
+    var node = nodes[data.id];
+    node.invalidated = true;
+    links = links.filter(function(link) {
+      return link.source !== node;
+    });
+  },
+  valueChange: function(data) {
+    var existed = !!nodes[data.id];
+    createNode({
+      id: data.id,
+      label: data.id + ' = ' + data.value,
+      type: 'value',
+      prevId: nodes[data.id] ? data.id : null,
+      hide: existed ? nodes[data.id].hide : true
+    });
+    if (!existed || nodes[data.id].hide)
+      return true;
+    nodes[data.id].changed = true;
+    executeBeforeNextCommand.push(function() {
+      nodes[data.id].changed = false;
+    });
+  },
+  enter: function(data) {
+    var node = nodes[data.id];
+    node.running = true;
+  },
+  exit: function(data) {
+    var node = nodes[data.id];
+    node.running = false;
+  }
+};
+
+function processMessage(data) {
+  console.log(JSON.stringify(data));
+  if (!callbacks.hasOwnProperty(data.action))
+    throw new Error('Unknown action ' + data.action);
+  var result = callbacks[data.action].call(callbacks, data);
+  update();
+  return result;
+}
+
+var executeBeforeNextCommand = [];
+function doNext() {
+  while (executeBeforeNextCommand.length)
+    executeBeforeNextCommand.shift()();
+  while (log.length)
+    if (!processMessage(log.shift()))
+      break;
+  if (!log.length)
+    $('#ended').fadeIn(1500);
+}
+
+function zoom() {
+  var scale = d3.event.scale;
+  var x = d3.event.translate[0];
+  var y = d3.event.translate[1];
+  d3.select('#viz').attr('transform', 'scale(' + scale + ') translate(' + x/scale + ' ' + y/scale + ')');
+}
+$(function() {
+  d3.select('svg').call(d3.behavior.zoom().scale(4).on('zoom', zoom));
+  $(document.body).on('keydown', function(e) {
+    if (e.which === 39 || e.which === 32)
+      doNext();
+    if (e.which === 35) {
+      while (log.length) {
+        doNext();
+      }
+    }
+  });
+  doNext();
+  executeBeforeNextCommand.push(function() {
+    $('#instructions').fadeOut(1000);
+  });
+});
+</script>
+<body>
+  <svg>
+    <defs>
+      <marker id="triangle"
+              viewBox="0 0 10 10" 
+              refX="5" refY="5"
+              markerWidth="6" 
+              markerHeight="6"
+              orient="auto">
+          <path d="M 10 0 L 0 5 L 10 10 z" />
+      </marker>
+      <pattern id="diagonalHatch" patternUnits="userSpaceOnUse" width="1" height="1">
+        <path stroke="black" stroke-width="0.25" fill="none"
+          d="M-1,1 l2,-2
+             M0,4 l4,-4
+             M3,5 l2,-2" />
+      </pattern>
+    </defs>
+    <g id="viz" transform="scale(4)">
+      <g id="links"></g>
+      <g id="nodes"></g>
+    </g>
+  </svg>
+  <div id="instructions">
+    Press right-arrow to advance
+  </div>
+  <div id="ended" style="display: none;">
+    <strong>You&rsquo;ve reached the end</strong><br/>Reload the page to start over
+  </div>
+  <div id="legend">
+    <div class="color normal"></div> Normal<br/>
+    <div class="color invalidated"></div> Invalidated<br/>
+    <div class="color running"></div> Running<br/>
+  </div>
+  <br/>
+  <pre id="description"><br/></pre>
+</body>
+</html>
--- a/inst/www/shared/shiny.js
+++ b/inst/www/shared/shiny.js
@@ -801,6 +801,10 @@
      this._sendMessagesToHandlers(message, customMessageHandlers,
                                   customMessageHandlerOrder);
    });
+    
+    addMessageHandler('config', function(message) {
+      this.config = message;
+    });

  }).call(ShinyApp.prototype);

@@ -2640,5 +2644,13 @@
      target.removeData('animating');
    }
  });
+  
+  $(document).on('keydown', function(e) {
+    if (e.which !== 114)
+      return;
+    var url = 'reactlog?w=' + Shiny.shinyapp.config.workerId;
+    window.open(url);
+    e.preventDefault();
+  });

 })();
--- a/man/include.Rd
+++ b/man/include.Rd
@@ -1,54 +1,49 @@
 \name{includeHTML}
+\alias{includeCSS}
 \alias{includeHTML}
-\alias{includeText}
 \alias{includeMarkdown}
-
+\alias{includeScript}
+\alias{includeText}
+\title{Include Content From a File}
 \usage{
  includeHTML(path)
+
  includeText(path)
+
  includeMarkdown(path)
+
+  includeCSS(path, ...)
+
+  includeScript(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.
-  }
+  \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.}
+
+  \item{...}{Any additional attributes to be applied to the
+  generated tag.}
 }
 \description{
-  Include HTML, text, or rendered Markdown into a \link[=shinyUI]{Shiny UI}.
+  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
+  These functions provide a convenient way to include an
+  extensive amount of HTML, textual, Markdown, CSS, or
+  JavaScript 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.
+  \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.
+
+  The \code{includeMarkdown} function requires the
+  \code{markdown} package.
 }
-\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))
-}
+
--- a/man/observe.Rd
+++ b/man/observe.Rd
@@ -32,17 +32,41 @@
  sooner than all observers with a lower priority level.
  Positive, negative, and zero values are allowed.}
 }
+\value{
+  An observer reference class object. This object has the
+  following methods: \describe{ \item{\code{suspend()}}{
+  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 then that re-execution will still
+  occur, because the flush is already scheduled.  }
+  \item{\code{resume()}}{ 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.  }
+  \item{\code{setPriority(priority = 0)}}{ Change this
+  observer's priority. Note that if the observer is
+  currently invalidated, then the change in priority will
+  not take effect until the next invalidation--unless the
+  observer is also currently suspended, in which case the
+  priority change will be effective upon resume.  }
+  \item{\code{onInvalidate(callback)}}{ Register a callback
+  function to run when this observer is invalidated.  No
+  arguments will be provided to the callback function when
+  it is invoked.  } }
+}
 \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).
+  Creates an observer from the given expression.
 }
 \details{
+  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 expressions, 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
--- a/man/plotPNG.Rd
+++ b/man/plotPNG.Rd
@@ -39,5 +39,9 @@
  of output. Notably, plain \code{png} output on Linux and
  Windows may not antialias some point shapes, resulting in
  poor quality output.
+
+  In some cases, \code{Cairo()} provides output that looks
+  worse than \code{png()}. To disable Cairo output for an
+  app, use \code{options(shiny.usecairo=FALSE)}.
 }

--- a/man/renderImage.Rd
+++ b/man/renderImage.Rd
@@ -99,4 +99,8 @@ shinyServer(function(input, output, clientData) {

 }
 }
+\seealso{
+  For more details on how the images are generated, and how
+  to control the output, see \code{\link{plotPNG}}.
+}

--- a/man/renderPlot.Rd
+++ b/man/renderPlot.Rd
@@ -51,4 +51,8 @@
  \code{img} and have the CSS class name
  \code{shiny-plot-output}.
 }
+\seealso{
+  For more details on how the plots are generated, and how
+  to control the output, see \code{\link{plotPNG}}.
+}

--- a/man/runApp.Rd
+++ b/man/runApp.Rd
@@ -3,7 +3,8 @@
 \title{Run Shiny Application}
 \usage{
  runApp(appDir = getwd(), port = 8100L,
-    launch.browser = getOption("shiny.launch.browser", interactive()))
+    launch.browser = getOption("shiny.launch.browser", interactive()),
+    workerId = "")
 }
 \arguments{
  \item{appDir}{The directory of the application. Should
@@ -17,6 +18,10 @@
  \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.}
+
+  \item{workerId}{Can generally be ignored. Exists to help
+  some editions of Shiny Server Pro route requests to the
+  correct process.}
 }
 \description{
  Runs a Shiny application. This function normally does not
--- a/man/shiny-package.Rd
+++ b/man/shiny-package.Rd
@@ -1,41 +1,20 @@
-\name{shiny-package}
-\alias{shiny-package}
-\alias{shiny}
 \docType{package}
-\title{
-Web Application Framework for R
-}
+\name{shiny-package}
+\alias{shiny}
+\alias{shiny-package}
+\title{Web Application Framework for R}
 \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.
-    
-    The Shiny tutorial at \url{http://rstudio.github.com/shiny/tutorial}
-    explains the framework in-depth, walks you through
-    building a simple application, and includes extensive annotated 
-    examples.
+  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.
 }
 \details{
-\tabular{ll}{
-Package: \tab shiny\cr
-Type: \tab Package\cr
-Version: \tab 0.1.0\cr
-Date: \tab 2012-07-28\cr
-License: \tab GPL-3\cr
-Depends: \tab R (>= 2.14.1), methods, websockets (>= 1.1.4), caTools, RJSONIO, xtable\cr
-Imports: \tab stats, tools, utils, datasets\cr
-URL: \tab https://github.com/rstudio/shiny, http://rstudio.github.com/shiny/tutorial\cr
-BugReports: \tab https://github.com/rstudio/shiny/issues\cr
+  The Shiny tutorial at
+  \url{http://rstudio.github.com/shiny/tutorial} explains
+  the framework in depth, walks you through building a
+  simple application, and includes extensive annotated
+  examples.
 }

-}
-\author{
-RStudio, Inc.
-
-Maintainer: Joe Cheng <joe@rstudio.org>
-}
-
-
-\keyword{ package }
-
--- a/man/stopApp.Rd
+++ b/man/stopApp.Rd
@@ -0,0 +1,15 @@
+\name{stopApp}
+\alias{stopApp}
+\title{Stop the currently running Shiny app}
+\usage{
+  stopApp(returnValue = NULL)
+}
+\arguments{
+  \item{returnValue}{The value that should be returned from
+  \code{\link{runApp}}.}
+}
+\description{
+  Stops the currently running Shiny app, returning control
+  to the caller of \code{\link{runApp}}.
+}
+
--- a/man/validateCssUnit.Rd
+++ b/man/validateCssUnit.Rd
@@ -0,0 +1,22 @@
+\name{validateCssUnit}
+\alias{validateCssUnit}
+\title{Validate proper CSS formatting of a unit}
+\usage{
+  validateCssUnit(x)
+}
+\arguments{
+  \item{x}{The unit to validate. Will be treated as a
+  number of pixels if a unit is not specified.}
+}
+\value{
+  A properly formatted CSS unit of length, if possible.
+  Otherwise, will throw an error.
+}
+\description{
+  Validate proper CSS formatting of a unit
+}
+\examples{
+validateCssUnit("10\%")
+validateCssUnit(400)  #treated as '400px'
+}
+
Author	SHA1	Message	Date
Joe Cheng	53c05128b3	Firefox compatibility; visual tweaks	2013-07-06 18:14:30 -07:00
Joe Cheng	99013f7998	Launch reactlog from Shiny app with F3	2013-07-03 12:17:36 -07:00
Joe Cheng	fc396800db	reactlog: Automatically run first step	2013-07-03 08:56:28 -07:00
Joe Cheng	6d03ae57ac	reactlog: Show value changes	2013-07-03 00:05:28 -07:00
Joe Cheng	4a0aa57355	reactlog node shapes, visible labels	2013-07-02 17:48:09 -07:00
Joe Cheng	7db737494c	Reverse reactlog arrow orientation	2013-07-02 13:21:39 -07:00
Joe Cheng	b285501c44	reactlog code cleanup	2013-07-02 08:38:24 -07:00
Joe Cheng	2f9b29994f	Add showReactLog function	2013-07-02 03:17:30 -07:00
Joe Cheng	917434cb6b	Introduce shiny.reactlog function	2013-07-02 03:03:29 -07:00
Joe Cheng	28a52bb658	More visual improvements to reactlog	2013-07-02 02:59:37 -07:00
Joe Cheng	82bc19374c	Improve appearance of reactlog	2013-07-02 02:12:07 -07:00
Joe Cheng	0b23f30bb7	Work in progress	2013-07-02 01:29:33 -07:00
Joe Cheng	64a62d7aed	Add doc for workerId param	2013-06-28 13:55:45 -07:00
Joe Cheng	de31cf8e7d	Merge pull request #175 from trestletech/master Add workerID to upload, download, and file URLs.	2013-06-28 13:52:38 -07:00
Winston Chang	3484f9afb3	Merge pull request #179 from wch/faster-tags Faster tags	2013-06-25 09:57:34 -07:00
Winston Chang	81df0ff390	Fix typo	2013-06-25 11:40:54 -05:00
Winston Chang	4268570166	Add tests for escaping in tags	2013-06-20 14:13:11 -05:00
Winston Chang	ead508c0d0	Preserve attributes in child tags	2013-06-20 12:16:51 -05:00
Joe Cheng	f8e1be8565	Update shiny-package	2013-06-19 13:09:48 -07:00
Winston Chang	360f1af32f	Export tagSetChildren and tagAppendChildren	2013-06-19 15:01:45 -05:00
Winston Chang	ba4f3a1553	Speed up input update functions	2013-06-19 00:34:57 -05:00
Winston Chang	6ba9534da4	In tag functions, drop NULL attributes	2013-06-19 00:25:46 -05:00
Winston Chang	c16ef96754	Don't use named list items for selectInput and radioButtons The names aren't used anyway, and this matches previous behavior (Shiny 0.6.0)	2013-06-18 23:53:30 -05:00
Winston Chang	e728491aa2	Refactor checkboxGroupInput	2013-06-18 23:52:41 -05:00
Winston Chang	ce356fa266	Fix handling of empty tags	2013-06-18 23:52:13 -05:00
Winston Chang	5e46323ca3	Refactor tag() This is much faster when there are large lists of children (and the code is much simpler!)	2013-06-18 23:33:28 -05:00
Winston Chang	0a7d047246	Add tests for creating nested tags	2013-06-18 22:40:17 -05:00
Winston Chang	3fa534a3eb	Add tests for adding children	2013-06-18 22:39:34 -05:00
Winston Chang	c6405f70d3	Add tagSetChildren() and tagAppendChildren()	2013-06-18 20:12:04 -05:00
Joe Cheng	acae6c2c49	Expose session$input and session$output This makes it possible for packaged Shiny components to only ask for the session variable to get access to all inputs and outputs (along with the other good stuff on session).	2013-06-18 17:08:48 -07:00
Joe Cheng	141fdc2197	Do away with dependsOnFile error This error is causing more problems than it solves.	2013-06-18 17:07:42 -07:00
Joe Cheng	a7ed8a006f	includeText should be HTML escaped	2013-06-18 17:07:08 -07:00
Joe Cheng	b1a0ebd531	Add includeCSS and includeScript functions	2013-06-18 17:06:34 -07:00
Winston Chang	e8021acccd	Speed up radioButtons when there are many choices	2013-06-17 23:49:50 -05:00
Winston Chang	39b0da2a3f	Speed up selectInput when there are many choices	2013-06-17 23:44:13 -05:00
Joe Cheng	fd3d18f6c5	Add stopApp function, for returning a value from runApp	2013-06-14 22:27:58 -07:00
trestletech	ecc27d1674	Incorporated a worker ID specification. Accept this as a parameter from the runApp() function and pass it through into the shinysession object so that it can be used in file uploads, downloads, and HTTP image fallbacks on non-websocket browsers.	2013-06-13 21:34:10 -07:00
Joe Cheng	7d0514ab36	Merge pull request #172 from wch/cairo-option Add option for not using Cairo	2013-06-12 10:10:14 -07:00
Winston Chang	44c3024c00	Add option for not using Cairo	2013-06-12 10:56:21 -05:00
Winston Chang	253c92bab7	Bump version to 0.6.0.99 for development	2013-06-12 10:53:51 -05:00
Joe Cheng	c10850118d	Merge pull request #170 from hadley/master Fix typo	2013-06-11 13:26:14 -07:00
Joe Cheng	4f017e9173	Remove annoying title="foo" tooltip on all tabset tabs	2013-06-11 09:19:49 -07:00
Joe Cheng	5ed46c82cb	Document observer methods	2013-06-11 09:18:57 -07:00
hadley wickham	64391e906d	Update reactives.R Add newline (guessing that's how it's supposed to be)	2013-06-11 10:37:02 -05:00
Joe Cheng	47b4ee07ab	Merge pull request #165 from trestletech/master Export validateCSSUnit function	2013-06-10 11:32:01 -07:00
trestletech	3000cbf763	Reorder namespace using latest roxygen2 code.	2013-06-07 16:33:19 -05:00
trestletech	76b3d314a8	Exported validateCSSUnit function.	2013-06-05 15:15:54 -05:00