Update websockets dependency version

Allows post-processing of HTTP responses

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 0.1.3
-Date: 2012-08-20
+Version: 0.1.5
+Date: 2012-09-14
 Author: RStudio, Inc.
 Maintainer: Joe Cheng <joe@rstudio.org>
 Description: Shiny makes it incredibly easy to build interactive web 
@@ -10,7 +10,7 @@ Description: Shiny makes it incredibly easy to build interactive web
     outputs and extensive pre-built widgets make it possible to build 
     beautiful, responsive, and powerful applications with minimal effort.
 License: GPL-3
-Depends: R (>= 2.14.1), methods, websockets (>= 1.1.4), caTools, RJSONIO, xtable
+Depends: R (>= 2.14.1), methods, websockets (>= 1.1.5), caTools, RJSONIO, xtable
 Imports: stats, tools, utils, datasets
 URL: https://github.com/rstudio/shiny, http://rstudio.github.com/shiny/tutorial
 BugReports: https://github.com/rstudio/shiny/issues
@@ -20,6 +20,7 @@ Collate:
     'tags.R'
     'react.R'
     'reactives.R'
+    'fileupload.R'
     'shiny.R'
     'shinywrappers.R'
     'shinyui.R'

NAMESPACE

@@ -1,10 +1,14 @@
 export(a)
+export(addResourcePath)
 export(animationOptions)
 export(br)
+export(checkboxGroupInput)
 export(checkboxInput)
 export(code)
+export(conditionalPanel)
 export(div)
 export(em)
+export(fileInput)
 export(h1)
 export(h2)
 export(h3)
@@ -30,6 +34,7 @@ export(reactivePrint)
 export(reactiveTable)
 export(reactiveText)
 export(reactiveTimer)
+export(reactiveUI)
 export(runApp)
 export(runExample)
 export(selectInput)
@@ -46,15 +51,19 @@ export(tabPanel)
 export(tabsetPanel)
 export(tag)
 export(tagAppendChild)
+export(tagList)
 export(tags)
 export(textInput)
 export(textOutput)
 export(verbatimTextOutput)
 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)

NEWS

@@ -1,8 +1,43 @@
+shiny 0.1.5
+--------------------------------------------------------------------------------
+
+* BREAKING CHANGE: JS APIs Shiny.bindInput and Shiny.bindOutput removed and
+  replaced with Shiny.bindAll; Shiny.unbindInput and Shiny.unbindOutput removed
+  and replaced with Shiny.unbindAll.
+* Add file upload support (currently only works with Chrome and Firefox). Use
+  a normal HTML file input, or call the `fileInput` UI function.
+* Shiny.unbindOutputs did not work, now it does.
+* Generally improved robustness of dynamic input/output bindings.
+* Add conditionalPanel UI function to allow showing/hiding UI based on a JS
+  expression; for example, whether an input is a particular value. Also works in
+  raw HTML (add the `data-display-if` attribute to the element that should be
+  shown/hidden).
+* htmlOutput (CSS class `shiny-html-output`) can contain inputs and outputs.
+
+
+shiny 0.1.4
+--------------------------------------------------------------------------------
+
+* Allow Bootstrap tabsets to act as reactive inputs; their value indicates which
+  tab is active
+* Upgrade to Bootstrap 2.1
+* Add `checkboxGroupInput` control, which presents a list of checkboxes and
+  returns a vector of the selected values
+* Add `addResourcePath`, intended for reusable component authors to access CSS,
+  JavaScript, image files, etc. from their package directories
+* Add Shiny.bindInputs(scope), .unbindInputs(scope), .bindOutputs(scope), and
+  .unbindOutputs(scope) JS API calls to allow dynamic binding/unbinding of HTML
+  elements
+
+
 shiny 0.1.3
 --------------------------------------------------------------------------------
 
 * Introduce Shiny.inputBindings.register JS API and InputBinding class, for
   creating custom input controls
+* Add `step` parameter to numericInput
+* Read names of input using `names(input)`
+* Access snapshot of input as a list using `as.list(input)` 
 * Fix issue #10: Plots in tabsets not rendered
 
 

R/bootstrap.R

@@ -59,7 +59,7 @@ pageWithSidebar <- function(headerPanel, sidebarPanel, mainPanel) {
     )
   }
   
-  list(
+  tagList(
     # inject bootstrap requirements into head
     importBootstrap(),
     
@@ -88,7 +88,7 @@ pageWithSidebar <- function(headerPanel, sidebarPanel, mainPanel) {
 #' headerPanel("Hello Shiny!")
 #' @export
 headerPanel <- function(title) {    
-  list(
+  tagList(
     tags$head(tags$title(title)),
     div(class="span12", style="padding: 10px 0px;",
       h1(title)
@@ -143,6 +143,52 @@ mainPanel <- function(...) {
   )
 }
 
+#' Conditional Panel
+#' 
+#' Creates a panel that is visible or not, depending on the value of a 
+#' JavaScript expression. The JS expression is evaluated once at startup and 
+#' whenever Shiny detects a relevant change in input/output.
+#' 
+#' In the JS expression, you can refer to \code{input} and \code{output} 
+#' JavaScript objects that contain the current values of input and output. For
+#' example, if you have an input with an id of \code{foo}, then you can use
+#' \code{input.foo} to read its value. (Be sure not to modify the input/output
+#' objects, as this may cause unpredictable behavior.)
+#' 
+#' @param condition A JavaScript expression that will be evaluated repeatedly to
+#'   determine whether the panel should be displayed.
+#' @param ... Elements to include in the panel.
+#' 
+#' @examples
+#' sidebarPanel(
+#'    selectInput(
+#'       "plotType", "Plot Type",
+#'       list(Scatter = "scatter",
+#'            Histogram = "hist")),
+#' 
+#'    # Only show this panel if the plot type is a histogram
+#'    conditionalPanel(
+#'       condition = "input.plotType == 'hist'",
+#'       selectInput(
+#'          "breaks", "Breaks",
+#'          list("Sturges", 
+#'               "Scott",
+#'               "Freedman-Diaconis",
+#'               "[Custom]" = "custom")),
+#'               
+#'       # Only show this panel if Custom is selected
+#'       conditionalPanel(
+#'          condition = "input.breaks == 'custom'",
+#'          sliderInput("breakCount", "Break Count", min=1, max=1000, value=10)
+#'       )
+#'    )
+#' )
+#'   
+#' @export
+conditionalPanel <- function(condition, ...) {
+  div('data-display-if'=condition, ...)
+}
+
 #' Create a text input control
 #' 
 #' Create an input control for entry of unstructured text values
@@ -156,7 +202,7 @@ mainPanel <- function(...) {
 #' textInput("caption", "Caption:", "Data Summary")
 #' @export
 textInput <- function(inputId, label, value = "") {
-  list(
+  tagList(
     tags$label(label),
     tags$input(id = inputId, type="text", value=value)
   )
@@ -189,22 +235,50 @@ numericInput <- function(inputId, label, value, min = NA, max = NA, step = NA) {
   if (!is.na(step))
     inputTag$attribs$step = step
   
-  list(
+  tagList(
     tags$label(label),
     inputTag
   )
 }
 
 
-#' Create a checkbox input control
+#' File Upload Control
 #' 
-#' Create a checkbox that can be used to specify logical values
+#' Create a file upload control that can be used to upload one or more files.
 #' 
-#' @param inputId Input variable to assign the control's value to
-#' @param label Display label for the control
-#' @param value Initial value
+#' @param inputId Input variable to assign the control's value to.
+#' @param label Display label for the control.
+#' @param multiple Whether the user should be allowed to select and upload 
+#'   multiple files at once.
+#' @param accept A character vector of MIME types; gives the browser a hint of 
+#'   what kind of files the server is expecting.
+#'   
+#' @export
+fileInput <- function(inputId, label, multiple = FALSE, accept = NULL) {
+  inputTag <- tags$input(id = inputId, type = "file")
+  if (multiple)
+    inputTag$attribs$multiple <- "multiple"
+  if (length(accept) > 0)
+    inputTag$attribs$accept <- paste(accept, collapse=',')
+  
+  tagList(
+    tags$label(label),
+    inputTag
+  )
+}
+
+
+#' Checkbox Input Control
+#' 
+#' Create a checkbox that can be used to specify logical values.
+#' 
+#' @param inputId Input variable to assign the control's value to.
+#' @param label Display label for the control.
+#' @param value Initial value (\code{TRUE} or \code{FALSE}).
 #' @return A checkbox control that can be added to a UI definition.
 #' 
+#' @seealso \code{\link{checkboxGroupInput}}
+#' 
 #' @examples
 #' checkboxInput("outliers", "Show outliers", FALSE)
 #' @export
@@ -216,6 +290,53 @@ checkboxInput <- function(inputId, label, value = FALSE) {
 }
 
 
+#' Checkbox Group Input Control
+#' 
+#' Create a group of checkboxes that can be used to toggle multiple choices 
+#' independently. The server will receive the input as a character vector of the
+#' selected values.
+#' 
+#' @param inputId Input variable to assign the control's value to.
+#' @param label Display label for the control.
+#' @param choices List of values to show checkboxes for. If elements of the list
+#'   are named then that name rather than the value is displayed to the user.
+#' @param selected Names of items that should be initially selected, if any.
+#' @return A list of HTML elements that can be added to a UI definition.
+#'   
+#' @seealso \code{\link{checkboxInput}}
+#'   
+#' @examples
+#' checkboxGroupInput("variable", "Variable:",
+#'                    list("Cylinders" = "cyl", 
+#'                         "Transmission" = "am", 
+#'                         "Gears" = "gear"))
+#'                  
+#' @export
+checkboxGroupInput <- function(inputId, label, choices, selected = NULL) {
+  # resolve names
+  choices <- choicesWithNames(choices)
+  
+  checkboxes <- list()
+  for (choiceName in names(choices)) {
+    
+    checkbox <- tags$input(name = inputId, type="checkbox",
+                           value = choices[[choiceName]])
+    
+    if (choiceName %in% selected)
+      checkbox$attribs$selected <- 'selected'
+    
+    checkboxes[[length(checkboxes)+1]] <- checkbox
+    checkboxes[[length(checkboxes)+1]] <- choiceName
+    checkboxes[[length(checkboxes)+1]] <- tags$br()
+  } 
+  
+  # return label and select tag
+  tags$div(class='control-group',
+           controlLabel(inputId, label),
+           checkboxes)
+}
+
+
 #' Create a help text element
 #' 
 #' Create help text which can be added to an input form to provide
@@ -300,7 +421,7 @@ selectInput <- function(inputId,
   } 
   
   # return label and select tag
-  list(controlLabel(inputId, label), selectTag)
+  tagList(controlLabel(inputId, label), selectTag)
 }
 
 #' Create radio buttons
@@ -349,8 +470,8 @@ radioButtons <- function(inputId, label, choices, selected = NULL) {
     inputTags[[length(inputTags) + 1]] <- labelTag
   }
   
-  list(tags$label(class = "control-label", label),
-       inputTags)
+  tagList(tags$label(class = "control-label", label),
+          inputTags)
 }
 
 #' Create a submit button
@@ -432,7 +553,7 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
   }
   
   # build slider
-  list(
+  tagList(
     controlLabel(inputId, labelText),  
     slider(inputId, min=min, max=max, value=value, step=step, round=round,
            locale=locale, format=format, ticks=ticks,
@@ -443,12 +564,15 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
 
 #' Create a tab panel
 #' 
-#' Create a tab panel that can be inluded within a \link{tabsetPanel}. 
+#' Create a tab panel that can be included within a \code{\link{tabsetPanel}}.
 #' 
 #' @param title Display title for tab
 #' @param ... UI elements to include within the tab
-#' @return A tab that can be passed to \link{tabsetPanel}
-#' 
+#' @param value The value that should be sent when \code{tabsetPanel} reports 
+#'   that this tab is selected. If omitted and \code{tabsetPanel} has an 
+#'   \code{id}, then the title will be used.
+#' @return A tab that can be passed to \code{\link{tabsetPanel}}
+#'   
 #' @examples
 #' # Show a tabset that includes a plot, summary, and
 #' # table view of the generated distribution
@@ -460,19 +584,22 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
 #'   )
 #' )
 #' @export
-tabPanel <- function(title, ...) {
-  div(class="tab-pane", title=title, ...)
+tabPanel <- function(title, ..., value = NULL) {
+  div(class="tab-pane", title=title, `data-value`=value, ...)
 }
 
 #' Create a tabset panel
 #' 
-#' Create a tabset that contains \link{tabPanel} elements. Tabsets
-#' are useful for dividing output into multiple independently viewable
-#' sections.
-#' 
-#' @param ... \link{tabPanel} elements to include in the tabset
-#' @return A tabset that can be passed to \link{mainPanel}
+#' Create a tabset that contains \code{\link{tabPanel}} elements. Tabsets are
+#' useful for dividing output into multiple independently viewable sections.
 #' 
+#' @param ... \code{\link{tabPanel}} elements to include in the tabset
+#' @param id If provided, you can use \code{input$}\emph{\code{id}} in your server 
+#'   logic to determine which of the current tabs is active. The value will 
+#'   correspond to the \code{value} argument that is passed to 
+#'   \code{\link{tabPanel}}.
+#' @return A tabset that can be passed to \code{\link{mainPanel}}
+#'   
 #' @examples
 #' # Show a tabset that includes a plot, summary, and
 #' # table view of the generated distribution
@@ -484,24 +611,31 @@ tabPanel <- function(title, ...) {
 #'   )
 #' )
 #' @export
-tabsetPanel <- function(...) {
+tabsetPanel <- function(..., id = NULL) {
   
   # build tab-nav and tab-content divs
   tabs <- list(...)
-  tabNavList <- tags$ul(class = "nav nav-tabs")
+  tabNavList <- tags$ul(class = "nav nav-tabs", id = id)
   tabContent <- tags$div(class = "tab-content")
   firstTab <- TRUE
   tabsetId <- as.integer(stats::runif(1, 1, 10000))
   tabId <- 1
   for (divTag in tabs) {
     # compute id and assign it to the div
-    id <- paste("tab", tabsetId, tabId, sep="-")
-    divTag$attribs$id <- id
+    thisId <- paste("tab", tabsetId, tabId, sep="-")
+    divTag$attribs$id <- thisId
     tabId <- tabId + 1
     
+    tabValue <- divTag$attribs$`data-value`
+    if (!is.null(tabValue) && is.null(id)) {
+      stop("tabsetPanel doesn't have an id assigned, but one of its tabPanels ",
+           "has a value. The value won't be sent without an id.")
+    }
+
     # create the li tag
-    liTag <- tags$li(tags$a(href=paste("#", id, sep=""),
+    liTag <- tags$li(tags$a(href=paste("#", thisId, sep=""),
                             `data-toggle` = "tab", 
+                            `data-value` = tabValue,
                             divTag$attribs$title))
     
     # set the first tab as active

R/fileupload.R

@@ -0,0 +1,95 @@
+# For HTML5-capable browsers, file uploads happen through a series of requests.
+# 
+# 1. Client tells server that one or more files are about to be uploaded; the
+#    server responds with a "job ID" that the client should use for the rest of
+#    the upload.
+#    
+# 2. For each file (sequentially):
+#    a. Client tells server the name, size, and type of the file.
+#    b. Client sends server a small-ish blob of data.
+#    c. Repeat 2b until the entire file has been uploaded.
+#    d. Client tells server that the current file is done.
+#    
+# 3. Repeat 2 until all files have been uploaded.
+# 
+# 4. Client tells server that all files have been uploaded, along with the
+#    input ID that this data should be associated with.
+# 
+# Unfortunately this approach will not work for browsers that don't support
+# HTML5 File API, but the fallback approach we would like to use (multipart
+# form upload, i.e. traditional HTTP POST-based file upload) doesn't work with
+# the websockets package's HTTP server at the moment.
+
+FileUploadOperation <- setRefClass(
+  'FileUploadOperation',
+  fields = list(
+    .parent = 'ANY',
+    .id = 'character',
+    .files = 'data.frame',
+    .dir = 'character',
+    .currentFileInfo = 'list',
+    .currentFileData = 'ANY'
+  ),
+  methods = list(
+    initialize = function(parent, id, dir) {
+      .parent <<- parent
+      .id <<- id
+      .dir <<- dir
+    },
+    fileBegin = function(file) {
+      .currentFileInfo <<- file
+
+      filename <- file.path(.dir, as.character(length(.files)))
+      row <- data.frame(name=file$name, size=file$size, type=file$type,
+                        datapath=filename, stringsAsFactors=F)
+      
+      if (length(.files) == 0)
+        .files <<- row
+      else
+        .files <<- rbind(.files, row)
+      
+      .currentFileData <<- file(filename, open='wb')
+    },
+    fileChunk = function(rawdata) {
+      writeBin(rawdata, .currentFileData)
+    },
+    fileEnd = function() {
+      close(.currentFileData)
+    },
+    finish = function() {
+      .parent$onJobFinished(.id)
+      return(.files)
+    }
+  )
+)
+
+FileUploadContext <- setRefClass(
+  'FileUploadContext',
+  fields = list(
+    .basedir = 'character',
+    .operations = 'Map'
+  ),
+  methods = list(
+    initialize = function(dir=tempdir()) {
+      .basedir <<- dir
+    },
+    createUploadOperation = function() {
+      while (T) {
+        id <- paste(as.raw(runif(12, min=0, max=0xFF)), collapse='')
+        dir <- file.path(.basedir, id)
+        if (!dir.create(dir))
+          next
+        
+        op <- FileUploadOperation$new(.self, id, dir)
+        .operations$set(id, op)
+        return(id)
+      }
+    },
+    getUploadOperation = function(jobId) {
+      .operations$get(jobId)
+    },
+    onJobFinished = function(jobId) {
+      .operations$remove(jobId)
+    }
+  )
+)

R/shiny.R

@@ -10,6 +10,7 @@ ShinyApp <- setRefClass(
     .invalidatedOutputValues = 'Map',
     .invalidatedOutputErrors = 'Map',
     .progressKeys = 'character',
+    .fileUploadContext = 'FileUploadContext',
     session = 'Values'
   ),
   methods = list(
@@ -18,6 +19,8 @@ ShinyApp <- setRefClass(
       .invalidatedOutputValues <<- Map$new()
       .invalidatedOutputErrors <<- Map$new()
       .progressKeys <<- character(0)
+      # TODO: Put file upload context in user/app-specific dir if possible
+      .fileUploadContext <<- FileUploadContext$new()
       session <<- Values$new()
     },
     defineOutput = function(name, func) {
@@ -25,6 +28,11 @@ ShinyApp <- setRefClass(
       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
       to also include \\code{...} in your function signature)."
+      
+      # jcheng 08/31/2012: User submitted an example of a dynamically calculated
+      # name not working unless name was eagerly evaluated. Yikes!
+      force(name)
+      
       if (is.function(func)) {
         if (length(formals(func)) != 0) {
           orig <- func
@@ -40,7 +48,7 @@ ShinyApp <- setRefClass(
           .invalidatedOutputErrors$remove(name)
           .invalidatedOutputValues$remove(name)
           
-          if (identical(class(value), 'try-error')) {
+          if (inherits(value, 'try-error')) {
             cond <- attr(value, 'condition')
             .invalidatedOutputErrors$set(
               name, 
@@ -76,10 +84,7 @@ ShinyApp <- setRefClass(
       json <- toJSON(list(errors=as.list(errors),
                           values=as.list(values)))
 
-      if (getOption('shiny.trace', F))
-        message("SEND ", json)
-
-      websocket_write(json, .websocket)
+      .write(json)
     },
     showProgress = function(id) {
       'Send a message to the client that recalculation of the output identified
@@ -93,10 +98,67 @@ ShinyApp <- setRefClass(
       
       json <- toJSON(list(progress=list(id)))
       
-      if (getOption('shiny.trace', F))
-        message("SEND ", json)
+      .write(json)
+    },
+    dispatch = function(msg) {
+      method <- paste('@', msg$method, sep='')
+      func <- try(do.call(`$`, list(.self, method)), silent=T)
+      if (inherits(func, 'try-error')) {
+        .sendErrorResponse(msg, paste('Unknown method', msg$method))
+      }
       
+      value <- try(do.call(func, as.list(append(msg$args, msg$blobs))))
+      if (inherits(value, 'try-error')) {
+        .sendErrorResponse(msg, paste('Error:', as.character(value)))
+      }
+      else {
+        .sendResponse(msg, value)
+      }
+    },
+    .sendResponse = function(requestMsg, value) {
+      if (is.null(requestMsg$tag)) {
+        warning("Tried to send response for untagged message; method: ",
+                requestMsg$method)
+        return()
+      }
+      .write(toJSON(list(response=list(tag=requestMsg$tag, value=value))))
+    },
+    .sendErrorResponse = function(requestMsg, error) {
+      if (is.null(requestMsg$tag))
+        return()
+      .write(toJSON(list(response=list(tag=requestMsg$tag, error=error))))
+    },
+    .write = function(json) {
+      if (getOption('shiny.trace', F))
+        message('SEND ', json)
       websocket_write(json, .websocket)
+    },
+    
+    # Public RPC methods
+    `@uploadInit` = function() {
+      return(list(jobId=.fileUploadContext$createUploadOperation()))
+    },
+    `@uploadFileBegin` = function(jobId, fileName, fileType, fileSize) {
+      .fileUploadContext$getUploadOperation(jobId)$fileBegin(list(
+        name=fileName, type=fileType, size=fileSize
+      ))
+      invisible()
+    },
+    `@uploadFileChunk` = function(jobId, ...) {
+      args <- list(...)
+      if (length(args) != 1)
+        stop("Bad file chunk request")
+      .fileUploadContext$getUploadOperation(jobId)$fileChunk(args[[1]])
+      invisible()
+    },
+    `@uploadFileEnd` = function(jobId) {
+      .fileUploadContext$getUploadOperation(jobId)$fileEnd()
+      invisible()
+    },
+    `@uploadEnd` = function(jobId, inputId) {
+      fileData <- .fileUploadContext$getUploadOperation(jobId)$finish()
+      session$set(inputId, fileData)
+      invisible()
     }
   )
 )
@@ -128,14 +190,32 @@ resolve <- function(dir, relpath) {
   return(abs.path)
 }
 
+httpResponse <- function(status = 200,
+                         content_type = "text/html; charset=UTF-8", 
+                         content = "") {
+  resp <- list(status = status, content_type = content_type, content = content);
+  class(resp) <- 'httpResponse'
+  return(resp)
+}
+
 httpServer <- function(handlers) {
   handler <- joinHandlers(handlers)
+
+  filter <- getOption('shiny.http.response.filter', NULL)
+  if (is.null(filter))
+    filter <- function(ws, header, response) response
+  
   function(ws, header) {
     response <- handler(ws, header)
-    if (!is.null(response))
-      return(response)
-    else
-      return(http_response(ws, 404, content="<h1>Not Found</h1>"))
+    if (is.null(response))
+      response <- httpResponse(404, content="<h1>Not Found</h1>")
+    
+    response <- filter(ws, header, response)
+    
+    return(http_response(ws,
+                         status=response$status,
+                         content_type=response$content_type,
+                         content=response$content))
   }
 }
 
@@ -196,7 +276,7 @@ staticHandler <- function(root) {
     path <- header$RESOURCE
     
     if (is.null(path))
-      return(http_response(ws, 400, content="<h1>Bad Request</h1>"))
+      return(httpResponse(400, content="<h1>Bad Request</h1>"))
     
     if (path == '/')
       path <- '/index.html'
@@ -217,7 +297,7 @@ staticHandler <- function(root) {
                            gif='image/gif',
                            'application/octet-stream')
     response.content <- readBin(abs.path, 'raw', n=file.info(abs.path)$size)
-    return(http_response(ws, 200, content.type, response.content))
+    return(httpResponse(200, content.type, response.content))
   })
 }
 
@@ -243,6 +323,81 @@ registerClient <- function(client) {
   .globals$clients <- append(.globals$clients, client)
 }
 
+
+.globals$resources <- list()
+
+#' Resource Publishing
+#' 
+#' Adds a directory of static resources to Shiny's web server, with the given 
+#' path prefix. Primarily intended for package authors to make supporting 
+#' JavaScript/CSS files available to their components.
+#' 
+#' @param prefix The URL prefix (without slashes). Valid characters are a-z, 
+#'   A-Z, 0-9, hyphen, and underscore; and must begin with a-z or A-Z. For 
+#'   example, a value of 'foo' means that any request paths that begin with 
+#'   '/foo' will be mapped to the given directory.
+#' @param directoryPath The directory that contains the static resources to be 
+#'   served.
+#'   
+#' @details You can call \code{addResourcePath} multiple times for a given 
+#'   \code{prefix}; only the most recent value will be retained. If the 
+#'   normalized \code{directoryPath} is different than the directory that's 
+#'   currently mapped to the \code{prefix}, a warning will be issued.
+#'   
+#' @seealso \code{\link{singleton}}
+#' 
+#' @examples
+#' addResourcePath('datasets', system.file('data', package='datasets'))
+#'   
+#' @export
+addResourcePath <- function(prefix, directoryPath) {
+  prefix <- prefix[1]
+  if (!grepl('^[a-z][a-z0-9\\-_]*$', prefix, ignore.case=T, perl=T)) {
+    stop("addResourcePath called with invalid prefix; please see documentation")
+  }
+  
+  if (prefix %in% c('shared')) {
+    stop("addResourcePath called with the reserved prefix '", prefix, "'; ",
+         "please use a different prefix")
+  }
+  
+  directoryPath <- normalizePath(directoryPath, mustWork=T)
+  
+  existing <- .globals$resources[[prefix]]
+  
+  if (!is.null(existing)) {
+    if (existing$directoryPath != directoryPath) {
+      warning("Overriding existing prefix ", prefix, " => ",
+              existing$directoryPath)
+    }
+  }
+  
+  message('Shiny URLs starting with /', prefix, ' will mapped to ', directoryPath)
+  
+  .globals$resources[[prefix]] <- list(directoryPath=directoryPath,
+                                       func=staticHandler(directoryPath))
+}
+
+resourcePathHandler <- function(ws, header) {
+  path <- header$RESOURCE
+  
+  match <- regexpr('^/([^/]+)/', path, perl=T)
+  if (match == -1)
+    return(NULL)
+  len <- attr(match, 'capture.length')
+  prefix <- substr(path, 2, 2 + len - 1)
+  
+  resInfo <- .globals$resources[[prefix]]
+  if (is.null(resInfo))
+    return(NULL)
+  
+  suffix <- substr(path, 2 + len, nchar(path))
+  
+  header$RESOURCE <- suffix
+  
+  return(resInfo$func(ws, header))
+}
+
 .globals$server <- NULL
 #' Define Server Functionality
 #' 
@@ -281,6 +436,31 @@ shinyServer <- function(func) {
   invisible()
 }
 
+decodeMessage <- function(data) {
+  readInt <- function(pos) {
+    packBits(rawToBits(data[pos:(pos+3)]), type='integer')
+  }
+  
+  if (readInt(1) != 0x01020202L)
+    return(fromJSON(rawToChar(data), asText=T, simplify=F))
+  
+  i <- 5
+  parts <- list()
+  while (i <= length(data)) {
+    length <- readInt(i)
+    i <- i + 4
+    if (length != 0)
+      parts <- append(parts, list(data[i:(i+length-1)]))
+    else
+      parts <- append(parts, list(raw(0)))
+    i <- i + length
+  }
+  
+  mainMessage <- decodeMessage(parts[[1]])
+  mainMessage$blobs <- parts[2:length(parts)]
+  return(mainMessage)
+}
+
 # Instantiates the app in the current working directory.
 # port - The TCP port that the application should listen on.
 startApp <- function(port=8101L) {
@@ -312,7 +492,10 @@ startApp <- function(port=8101L) {
   
   ws_env <- create_server(
     port=port,
-    webpage=httpServer(c(dynamicHandler(uiR), wwwDir, sys.www.root)))
+    webpage=httpServer(c(dynamicHandler(uiR),
+                         wwwDir,
+                         sys.www.root,
+                         resourcePathHandler)))
   
   set_callback('established', function(WS, ...) {
     shinyapp <- ShinyApp$new(WS)
@@ -324,16 +507,20 @@ startApp <- function(port=8101L) {
   }, ws_env)
   
   set_callback('receive', function(DATA, WS, ...) {
-    if (getOption('shiny.trace', F))
-      message("RECV ", rawToChar(DATA))
+    if (getOption('shiny.trace', F)) {
+      if (as.raw(0) %in% DATA)
+        message("RECV ", '$$binary data$$')
+      else
+        message("RECV ", rawToChar(DATA))
+    }
     
     if (identical(charToRaw("\003\xe9"), DATA))
       return()
     
     shinyapp <- apps$get(wsToKey(WS))
     
-    msg <- fromJSON(rawToChar(DATA), asText=T, simplify=F)
-    
+    msg <- decodeMessage(DATA)
+
     # Do our own list simplifying here. sapply/simplify2array give names to
     # character vectors, which is rarely what we want.
     if (!is.null(msg$data)) {
@@ -371,7 +558,9 @@ startApp <- function(port=8101L) {
       },
       update = {
         shinyapp$session$mset(msg$data)
-      })
+      },
+      shinyapp$dispatch(msg)
+    )
     flushReact()
     shinyapp$flushOutput()
   }, ws_env)
@@ -423,6 +612,10 @@ runApp <- function(appDir=getwd(),
                    launch.browser=getOption('shiny.launch.browser',
                                             interactive())) {
 
+  # Make warnings print immediately
+  ops <- options(warn = 1)
+  on.exit(options(ops))
+  
   orig.wd <- getwd()
   setwd(appDir)
   on.exit(setwd(orig.wd))

R/shinyui.R

@@ -170,7 +170,7 @@ shinyUI <- function(ui, path='/') {
       
       renderPage(ui, textConn)
       html <- paste(textConnectionValue(textConn), collapse='\n')
-      return(http_response(ws, 200, content=html))
+      return(httpResponse(200, content=html))
     }
   })
 }

R/shinywrappers.R

@@ -69,6 +69,10 @@ reactiveTable <- function(func, ...) {
   reactive(function() {
     classNames <- getOption('shiny.table.class', 'data table table-bordered table-condensed')
     data <- func()
+
+    if (is.null(data) || is.na(data))
+      return("")
+    
     return(paste(
       capture.output(
         print(xtable(data, ...), 
@@ -124,4 +128,35 @@ reactiveText <- function(func) {
   reactive(function() {
     return(paste(capture.output(cat(func())), collapse="\n"))
   })
-}
+}
+
+#' UI Output
+#' 
+#' Makes a reactive version of a function that generates HTML using the Shiny UI
+#' library.
+#' 
+#' The corresponding HTML output tag should be \code{div} and have the CSS class
+#' name \code{shiny-html-output} (or use \code{\link{htmlOutput}}).
+#' 
+#' @param func A function that returns a Shiny tag object, \code{\link{HTML}}, 
+#'   or a list of such objects.
+#'   
+#' @seealso conditionalPanel
+#'   
+#' @export
+#' @examples
+#' \dontrun{
+#'   output$moreControls <- reactiveUI(function() {
+#'     list(
+#'       
+#'     )
+#'   })
+#' }
+reactiveUI <- function(func) {
+  reactive(function() {
+    result <- func()
+    if (is.null(result) || length(result) == 0)
+      return(NULL)
+    return(as.character(result))
+  })
+}

R/tags.R

@@ -64,6 +64,15 @@ as.character.shiny.tag <- function(x, ...) {
   return(HTML(paste(readLines(f), collapse='\n')))
 }
 
+#' @S3method print shiny.tag.list
+print.shiny.tag.list <- print.shiny.tag
+
+#' @S3method format shiny.tag.list
+format.shiny.tag.list <- format.shiny.tag
+
+#' @S3method as.character shiny.tag.list
+as.character.shiny.tag.list <- as.character.shiny.tag
+
 normalizeText <- function(text) {
   if (!is.null(attr(text, "html")))
     text
@@ -72,6 +81,13 @@ normalizeText <- function(text) {
   
 }
 
+#' @export
+tagList <- function(...) {
+  lst <- list(...)
+  class(lst) <- c("shiny.tag.list", "list")
+  return(lst)
+}
+
 #' @export
 tagAppendChild <- function(tag, child) {
   tag$children[[length(tag$children)+1]] <- child

inst/examples/09_upload/server.R

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

inst/examples/09_upload/ui.R

@@ -0,0 +1,24 @@
+library(shiny)
+
+shinyUI(pageWithSidebar(
+  headerPanel("CSV Viewer"),
+  sidebarPanel(
+    fileInput('file1', 'Choose CSV File',
+              accept=c('text/csv', 'text/comma-separated-values,text/plain')),
+    tags$hr(),
+    checkboxInput('header', 'Header', TRUE),
+    radioButtons('sep', 'Separator',
+                 list(Comma=',',
+                      Semicolon=';',
+                      Tab='\t'),
+                 'Comma'),
+    radioButtons('quote', 'Quote',
+                 list(None='',
+                      'Double Quote'='"',
+                      'Single Quote'="'"),
+                 'Double Quote')
+  ),
+  mainPanel(
+    tableOutput('contents')
+  )
+))

inst/www/shared/bootstrap/js/bootstrap.js

@@ -1,5 +1,5 @@
 /* ===================================================
- * bootstrap-transition.js v2.0.4
+ * bootstrap-transition.js v2.1.0
  * http://twitter.github.com/bootstrap/javascript.html#transitions
  * ===================================================
  * Copyright 2012 Twitter, Inc.
@@ -36,8 +36,7 @@
           , transEndEventNames = {
                'WebkitTransition' : 'webkitTransitionEnd'
             ,  'MozTransition'    : 'transitionend'
-            ,  'OTransition'      : 'oTransitionEnd'
-            ,  'msTransition'     : 'MSTransitionEnd'
+            ,  'OTransition'      : 'oTransitionEnd otransitionend'
             ,  'transition'       : 'transitionend'
             }
           , name
@@ -59,7 +58,7 @@
   })
 
 }(window.jQuery);/* ==========================================================
- * bootstrap-alert.js v2.0.4
+ * bootstrap-alert.js v2.1.0
  * http://twitter.github.com/bootstrap/javascript.html#alerts
  * ==========================================================
  * Copyright 2012 Twitter, Inc.
@@ -148,7 +147,7 @@
   })
 
 }(window.jQuery);/* ============================================================
- * bootstrap-button.js v2.0.4
+ * bootstrap-button.js v2.1.0
  * http://twitter.github.com/bootstrap/javascript.html#buttons
  * ============================================================
  * Copyright 2012 Twitter, Inc.
@@ -243,7 +242,7 @@
   })
 
 }(window.jQuery);/* ==========================================================
- * bootstrap-carousel.js v2.0.4
+ * bootstrap-carousel.js v2.1.0
  * http://twitter.github.com/bootstrap/javascript.html#carousel
  * ==========================================================
  * Copyright 2012 Twitter, Inc.
@@ -290,7 +289,7 @@
     }
 
   , to: function (pos) {
-      var $active = this.$element.find('.active')
+      var $active = this.$element.find('.item.active')
         , children = $active.parent().children()
         , activePos = children.index($active)
         , that = this
@@ -312,6 +311,10 @@
 
   , pause: function (e) {
       if (!e) this.paused = true
+      if (this.$element.find('.next, .prev').length && $.support.transition.end) {
+        this.$element.trigger($.support.transition.end)
+        this.cycle()
+      }
       clearInterval(this.interval)
       this.interval = null
       return this
@@ -328,13 +331,15 @@
     }
 
   , slide: function (type, next) {
-      var $active = this.$element.find('.active')
+      var $active = this.$element.find('.item.active')
         , $next = next || $active[type]()
         , isCycling = this.interval
         , direction = type == 'next' ? 'left' : 'right'
         , fallback  = type == 'next' ? 'first' : 'last'
         , that = this
-        , e = $.Event('slide')
+        , e = $.Event('slide', {
+            relatedTarget: $next[0]
+          })
 
       this.sliding = true
 
@@ -382,9 +387,10 @@
       var $this = $(this)
         , data = $this.data('carousel')
         , options = $.extend({}, $.fn.carousel.defaults, typeof option == 'object' && option)
+        , action = typeof option == 'string' ? option : options.slide
       if (!data) $this.data('carousel', (data = new Carousel(this, options)))
       if (typeof option == 'number') data.to(option)
-      else if (typeof option == 'string' || (option = options.slide)) data[option]()
+      else if (action) data[action]()
       else if (options.interval) data.cycle()
     })
   }
@@ -411,7 +417,7 @@
   })
 
 }(window.jQuery);/* =============================================================
- * bootstrap-collapse.js v2.0.4
+ * bootstrap-collapse.js v2.1.0
  * http://twitter.github.com/bootstrap/javascript.html#collapse
  * =============================================================
  * Copyright 2012 Twitter, Inc.
@@ -479,7 +485,7 @@
 
       this.$element[dimension](0)
       this.transition('addClass', $.Event('show'), 'shown')
-      this.$element[dimension](this.$element[0][scroll])
+      $.support.transition && this.$element[dimension](this.$element[0][scroll])
     }
 
   , hide: function () {
@@ -556,18 +562,19 @@
   * ==================== */
 
   $(function () {
-    $('body').on('click.collapse.data-api', '[data-toggle=collapse]', function ( e ) {
+    $('body').on('click.collapse.data-api', '[data-toggle=collapse]', function (e) {
       var $this = $(this), href
         , target = $this.attr('data-target')
           || e.preventDefault()
           || (href = $this.attr('href')) && href.replace(/.*(?=#[^\s]+$)/, '') //strip for ie7
         , option = $(target).data('collapse') ? 'toggle' : $this.data()
+      $this[$(target).hasClass('in') ? 'addClass' : 'removeClass']('collapsed')
       $(target).collapse(option)
     })
   })
 
 }(window.jQuery);/* ============================================================
- * bootstrap-dropdown.js v2.0.4
+ * bootstrap-dropdown.js v2.1.0
  * http://twitter.github.com/bootstrap/javascript.html#dropdowns
  * ============================================================
  * Copyright 2012 Twitter, Inc.
@@ -594,7 +601,7 @@
  /* DROPDOWN CLASS DEFINITION
   * ========================= */
 
-  var toggle = '[data-toggle="dropdown"]'
+  var toggle = '[data-toggle=dropdown]'
     , Dropdown = function (element) {
         var $el = $(element).on('click.dropdown.data-api', this.toggle)
         $('html').on('click.dropdown.data-api', function () {
@@ -609,34 +616,82 @@
   , toggle: function (e) {
       var $this = $(this)
         , $parent
-        , selector
         , isActive
 
       if ($this.is('.disabled, :disabled')) return
 
-      selector = $this.attr('data-target')
-
-      if (!selector) {
-        selector = $this.attr('href')
-        selector = selector && selector.replace(/.*(?=#[^\s]*$)/, '') //strip for ie7
-      }
-
-      $parent = $(selector)
-      $parent.length || ($parent = $this.parent())
+      $parent = getParent($this)
 
       isActive = $parent.hasClass('open')
 
       clearMenus()
 
-      if (!isActive) $parent.toggleClass('open')
+      if (!isActive) {
+        $parent.toggleClass('open')
+        $this.focus()
+      }
 
       return false
     }
 
+  , keydown: function (e) {
+      var $this
+        , $items
+        , $active
+        , $parent
+        , isActive
+        , index
+
+      if (!/(38|40|27)/.test(e.keyCode)) return
+
+      $this = $(this)
+
+      e.preventDefault()
+      e.stopPropagation()
+
+      if ($this.is('.disabled, :disabled')) return
+
+      $parent = getParent($this)
+
+      isActive = $parent.hasClass('open')
+
+      if (!isActive || (isActive && e.keyCode == 27)) return $this.click()
+
+      $items = $('[role=menu] li:not(.divider) a', $parent)
+
+      if (!$items.length) return
+
+      index = $items.index($items.filter(':focus'))
+
+      if (e.keyCode == 38 && index > 0) index--                                        // up
+      if (e.keyCode == 40 && index < $items.length - 1) index++                        // down
+      if (!~index) index = 0
+
+      $items
+        .eq(index)
+        .focus()
+    }
+
   }
 
   function clearMenus() {
-    $(toggle).parent().removeClass('open')
+    getParent($(toggle))
+      .removeClass('open')
+  }
+
+  function getParent($this) {
+    var selector = $this.attr('data-target')
+      , $parent
+
+    if (!selector) {
+      selector = $this.attr('href')
+      selector = selector && selector.replace(/.*(?=#[^\s]*$)/, '') //strip for ie7
+    }
+
+    $parent = $(selector)
+    $parent.length || ($parent = $this.parent())
+
+    return $parent
   }
 
 
@@ -659,14 +714,16 @@
    * =================================== */
 
   $(function () {
-    $('html').on('click.dropdown.data-api', clearMenus)
+    $('html')
+      .on('click.dropdown.data-api touchstart.dropdown.data-api', clearMenus)
     $('body')
-      .on('click.dropdown', '.dropdown form', function (e) { e.stopPropagation() })
-      .on('click.dropdown.data-api', toggle, Dropdown.prototype.toggle)
+      .on('click.dropdown touchstart.dropdown.data-api', '.dropdown', function (e) { e.stopPropagation() })
+      .on('click.dropdown.data-api touchstart.dropdown.data-api'  , toggle, Dropdown.prototype.toggle)
+      .on('keydown.dropdown.data-api touchstart.dropdown.data-api', toggle + ', [role=menu]' , Dropdown.prototype.keydown)
   })
 
 }(window.jQuery);/* =========================================================
- * bootstrap-modal.js v2.0.4
+ * bootstrap-modal.js v2.1.0
  * http://twitter.github.com/bootstrap/javascript.html#modals
  * =========================================================
  * Copyright 2012 Twitter, Inc.
@@ -693,10 +750,11 @@
  /* MODAL CLASS DEFINITION
   * ====================== */
 
-  var Modal = function (content, options) {
+  var Modal = function (element, options) {
     this.options = options
-    this.$element = $(content)
+    this.$element = $(element)
       .delegate('[data-dismiss="modal"]', 'click.dismiss.modal', $.proxy(this.hide, this))
+    this.options.remote && this.$element.find('.modal-body').load(this.options.remote)
   }
 
   Modal.prototype = {
@@ -719,8 +777,9 @@
 
         this.isShown = true
 
-        escape.call(this)
-        backdrop.call(this, function () {
+        this.escape()
+
+        this.backdrop(function () {
           var transition = $.support.transition && that.$element.hasClass('fade')
 
           if (!that.$element.parent().length) {
@@ -734,7 +793,12 @@
             that.$element[0].offsetWidth // force reflow
           }
 
-          that.$element.addClass('in')
+          that.$element
+            .addClass('in')
+            .attr('aria-hidden', false)
+            .focus()
+
+          that.enforceFocus()
 
           transition ?
             that.$element.one($.support.transition.end, function () { that.$element.trigger('shown') }) :
@@ -758,90 +822,98 @@
 
         $('body').removeClass('modal-open')
 
-        escape.call(this)
+        this.escape()
 
-        this.$element.removeClass('in')
+        $(document).off('focusin.modal')
+
+        this.$element
+          .removeClass('in')
+          .attr('aria-hidden', true)
 
         $.support.transition && this.$element.hasClass('fade') ?
-          hideWithTransition.call(this) :
-          hideModal.call(this)
+          this.hideWithTransition() :
+          this.hideModal()
       }
 
-  }
-
-
- /* MODAL PRIVATE METHODS
-  * ===================== */
-
-  function hideWithTransition() {
-    var that = this
-      , timeout = setTimeout(function () {
-          that.$element.off($.support.transition.end)
-          hideModal.call(that)
-        }, 500)
-
-    this.$element.one($.support.transition.end, function () {
-      clearTimeout(timeout)
-      hideModal.call(that)
-    })
-  }
-
-  function hideModal(that) {
-    this.$element
-      .hide()
-      .trigger('hidden')
-
-    backdrop.call(this)
-  }
-
-  function backdrop(callback) {
-    var that = this
-      , animate = this.$element.hasClass('fade') ? 'fade' : ''
-
-    if (this.isShown && this.options.backdrop) {
-      var doAnimate = $.support.transition && animate
-
-      this.$backdrop = $('<div class="modal-backdrop ' + animate + '" />')
-        .appendTo(document.body)
-
-      if (this.options.backdrop != 'static') {
-        this.$backdrop.click($.proxy(this.hide, this))
+    , enforceFocus: function () {
+        var that = this
+        $(document).on('focusin.modal', function (e) {
+          if (that.$element[0] !== e.target && !that.$element.has(e.target).length) {
+            that.$element.focus()
+          }
+        })
       }
 
-      if (doAnimate) this.$backdrop[0].offsetWidth // force reflow
+    , escape: function () {
+        var that = this
+        if (this.isShown && this.options.keyboard) {
+          this.$element.on('keyup.dismiss.modal', function ( e ) {
+            e.which == 27 && that.hide()
+          })
+        } else if (!this.isShown) {
+          this.$element.off('keyup.dismiss.modal')
+        }
+      }
 
-      this.$backdrop.addClass('in')
+    , hideWithTransition: function () {
+        var that = this
+          , timeout = setTimeout(function () {
+              that.$element.off($.support.transition.end)
+              that.hideModal()
+            }, 500)
 
-      doAnimate ?
-        this.$backdrop.one($.support.transition.end, callback) :
-        callback()
+        this.$element.one($.support.transition.end, function () {
+          clearTimeout(timeout)
+          that.hideModal()
+        })
+      }
 
-    } else if (!this.isShown && this.$backdrop) {
-      this.$backdrop.removeClass('in')
+    , hideModal: function (that) {
+        this.$element
+          .hide()
+          .trigger('hidden')
 
-      $.support.transition && this.$element.hasClass('fade')?
-        this.$backdrop.one($.support.transition.end, $.proxy(removeBackdrop, this)) :
-        removeBackdrop.call(this)
+        this.backdrop()
+      }
 
-    } else if (callback) {
-      callback()
-    }
-  }
+    , removeBackdrop: function () {
+        this.$backdrop.remove()
+        this.$backdrop = null
+      }
 
-  function removeBackdrop() {
-    this.$backdrop.remove()
-    this.$backdrop = null
-  }
+    , backdrop: function (callback) {
+        var that = this
+          , animate = this.$element.hasClass('fade') ? 'fade' : ''
 
-  function escape() {
-    var that = this
-    if (this.isShown && this.options.keyboard) {
-      $(document).on('keyup.dismiss.modal', function ( e ) {
-        e.which == 27 && that.hide()
-      })
-    } else if (!this.isShown) {
-      $(document).off('keyup.dismiss.modal')
-    }
+        if (this.isShown && this.options.backdrop) {
+          var doAnimate = $.support.transition && animate
+
+          this.$backdrop = $('<div class="modal-backdrop ' + animate + '" />')
+            .appendTo(document.body)
+
+          if (this.options.backdrop != 'static') {
+            this.$backdrop.click($.proxy(this.hide, this))
+          }
+
+          if (doAnimate) this.$backdrop[0].offsetWidth // force reflow
+
+          this.$backdrop.addClass('in')
+
+          doAnimate ?
+            this.$backdrop.one($.support.transition.end, callback) :
+            callback()
+
+        } else if (!this.isShown && this.$backdrop) {
+          this.$backdrop.removeClass('in')
+
+          $.support.transition && this.$element.hasClass('fade')?
+            this.$backdrop.one($.support.transition.end, $.proxy(this.removeBackdrop, this)) :
+            this.removeBackdrop()
+
+        } else if (callback) {
+          callback()
+        }
+      }
   }
 
 
@@ -873,17 +945,23 @@
 
   $(function () {
     $('body').on('click.modal.data-api', '[data-toggle="modal"]', function ( e ) {
-      var $this = $(this), href
-        , $target = $($this.attr('data-target') || (href = $this.attr('href')) && href.replace(/.*(?=#[^\s]+$)/, '')) //strip for ie7
-        , option = $target.data('modal') ? 'toggle' : $.extend({}, $target.data(), $this.data())
+      var $this = $(this)
+        , href = $this.attr('href')
+        , $target = $($this.attr('data-target') || (href && href.replace(/.*(?=#[^\s]+$)/, ''))) //strip for ie7
+        , option = $target.data('modal') ? 'toggle' : $.extend({ remote: !/#/.test(href) && href }, $target.data(), $this.data())
 
       e.preventDefault()
-      $target.modal(option)
+
+      $target
+        .modal(option)
+        .one('hide', function () {
+          $this.focus()
+        })
     })
   })
 
 }(window.jQuery);/* ===========================================================
- * bootstrap-tooltip.js v2.0.4
+ * bootstrap-tooltip.js v2.1.0
  * http://twitter.github.com/bootstrap/javascript.html#tooltips
  * Inspired by the original jQuery.tipsy by Jason Frame
  * ===========================================================
@@ -928,11 +1006,13 @@
       this.options = this.getOptions(options)
       this.enabled = true
 
-      if (this.options.trigger != 'manual') {
-        eventIn  = this.options.trigger == 'hover' ? 'mouseenter' : 'focus'
+      if (this.options.trigger == 'click') {
+        this.$element.on('click.' + this.type, this.options.selector, $.proxy(this.toggle, this))
+      } else if (this.options.trigger != 'manual') {
+        eventIn = this.options.trigger == 'hover' ? 'mouseenter' : 'focus'
         eventOut = this.options.trigger == 'hover' ? 'mouseleave' : 'blur'
-        this.$element.on(eventIn, this.options.selector, $.proxy(this.enter, this))
-        this.$element.on(eventOut, this.options.selector, $.proxy(this.leave, this))
+        this.$element.on(eventIn + '.' + this.type, this.options.selector, $.proxy(this.enter, this))
+        this.$element.on(eventOut + '.' + this.type, this.options.selector, $.proxy(this.leave, this))
       }
 
       this.options.selector ?
@@ -1032,20 +1112,11 @@
       }
     }
 
-  , isHTML: function(text) {
-      // html string detection logic adapted from jQuery
-      return typeof text != 'string'
-        || ( text.charAt(0) === "<"
-          && text.charAt( text.length - 1 ) === ">"
-          && text.length >= 3
-        ) || /^(?:[^<]*<[\w\W]+>[^>]*$)/.exec(text)
-    }
-
   , setContent: function () {
       var $tip = this.tip()
         , title = this.getTitle()
 
-      $tip.find('.tooltip-inner')[this.isHTML(title) ? 'html' : 'text'](title)
+      $tip.find('.tooltip-inner')[this.options.html ? 'html' : 'text'](title)
       $tip.removeClass('fade in top bottom left right')
     }
 
@@ -1069,6 +1140,8 @@
       $.support.transition && this.$tip.hasClass('fade') ?
         removeWithAnimation() :
         $tip.remove()
+
+      return this
     }
 
   , fixTitle: function () {
@@ -1128,6 +1201,10 @@
       this[this.tip().hasClass('in') ? 'hide' : 'show']()
     }
 
+  , destroy: function () {
+      this.hide().$element.off('.' + this.type).removeData(this.type)
+    }
+
   }
 
 
@@ -1154,11 +1231,12 @@
   , trigger: 'hover'
   , title: ''
   , delay: 0
+  , html: true
   }
 
 }(window.jQuery);
 /* ===========================================================
- * bootstrap-popover.js v2.0.4
+ * bootstrap-popover.js v2.1.0
  * http://twitter.github.com/bootstrap/javascript.html#popovers
  * ===========================================================
  * Copyright 2012 Twitter, Inc.
@@ -1185,7 +1263,7 @@
  /* POPOVER PUBLIC CLASS DEFINITION
   * =============================== */
 
-  var Popover = function ( element, options ) {
+  var Popover = function (element, options) {
     this.init('popover', element, options)
   }
 
@@ -1202,8 +1280,8 @@
         , title = this.getTitle()
         , content = this.getContent()
 
-      $tip.find('.popover-title')[this.isHTML(title) ? 'html' : 'text'](title)
-      $tip.find('.popover-content > *')[this.isHTML(content) ? 'html' : 'text'](content)
+      $tip.find('.popover-title')[this.options.html ? 'html' : 'text'](title)
+      $tip.find('.popover-content > *')[this.options.html ? 'html' : 'text'](content)
 
       $tip.removeClass('fade top bottom left right in')
     }
@@ -1230,6 +1308,10 @@
       return this.$tip
     }
 
+  , destroy: function () {
+      this.hide().$element.off('.' + this.type).removeData(this.type)
+    }
+
   })
 
 
@@ -1250,12 +1332,13 @@
 
   $.fn.popover.defaults = $.extend({} , $.fn.tooltip.defaults, {
     placement: 'right'
+  , trigger: 'click'
   , content: ''
   , template: '<div class="popover"><div class="arrow"></div><div class="popover-inner"><h3 class="popover-title"></h3><div class="popover-content"><p></p></div></div></div>'
   })
 
 }(window.jQuery);/* =============================================================
- * bootstrap-scrollspy.js v2.0.4
+ * bootstrap-scrollspy.js v2.1.0
  * http://twitter.github.com/bootstrap/javascript.html#scrollspy
  * =============================================================
  * Copyright 2012 Twitter, Inc.
@@ -1279,15 +1362,15 @@
   "use strict"; // jshint ;_;
 
 
-  /* SCROLLSPY CLASS DEFINITION
-   * ========================== */
+ /* SCROLLSPY CLASS DEFINITION
+  * ========================== */
 
-  function ScrollSpy( element, options) {
+  function ScrollSpy(element, options) {
     var process = $.proxy(this.process, this)
       , $element = $(element).is('body') ? $(window) : $(element)
       , href
     this.options = $.extend({}, $.fn.scrollspy.defaults, options)
-    this.$scrollElement = $element.on('scroll.scroll.data-api', process)
+    this.$scrollElement = $element.on('scroll.scroll-spy.data-api', process)
     this.selector = (this.options.target
       || ((href = $(element).attr('href')) && href.replace(/.*(?=#[^\s]+$)/, '')) //strip for ie7
       || '') + ' .nav li > a'
@@ -1314,7 +1397,7 @@
               , href = $el.data('target') || $el.attr('href')
               , $href = /^#\w/.test(href) && $(href)
             return ( $href
-              && href.length
+              && $href.length
               && [[ $href.position().top, href ]] ) || null
           })
           .sort(function (a, b) { return a[0] - b[0] })
@@ -1364,7 +1447,7 @@
           .parent('li')
           .addClass('active')
 
-        if (active.parent('.dropdown-menu'))  {
+        if (active.parent('.dropdown-menu').length)  {
           active = active.closest('li.dropdown').addClass('active')
         }
 
@@ -1377,7 +1460,7 @@
  /* SCROLLSPY PLUGIN DEFINITION
   * =========================== */
 
-  $.fn.scrollspy = function ( option ) {
+  $.fn.scrollspy = function (option) {
     return this.each(function () {
       var $this = $(this)
         , data = $this.data('scrollspy')
@@ -1397,7 +1480,7 @@
  /* SCROLLSPY DATA-API
   * ================== */
 
-  $(function () {
+  $(window).on('load', function () {
     $('[data-spy="scroll"]').each(function () {
       var $spy = $(this)
       $spy.scrollspy($spy.data())
@@ -1405,7 +1488,7 @@
   })
 
 }(window.jQuery);/* ========================================================
- * bootstrap-tab.js v2.0.4
+ * bootstrap-tab.js v2.1.0
  * http://twitter.github.com/bootstrap/javascript.html#tabs
  * ========================================================
  * Copyright 2012 Twitter, Inc.
@@ -1432,7 +1515,7 @@
  /* TAB CLASS DEFINITION
   * ==================== */
 
-  var Tab = function ( element ) {
+  var Tab = function (element) {
     this.element = $(element)
   }
 
@@ -1539,7 +1622,7 @@
   })
 
 }(window.jQuery);/* =============================================================
- * bootstrap-typeahead.js v2.0.4
+ * bootstrap-typeahead.js v2.1.0
  * http://twitter.github.com/bootstrap/javascript.html#typeahead
  * =============================================================
  * Copyright 2012 Twitter, Inc.
@@ -1617,17 +1700,23 @@
     }
 
   , lookup: function (event) {
-      var that = this
-        , items
-        , q
+      var items
 
       this.query = this.$element.val()
 
-      if (!this.query) {
+      if (!this.query || this.query.length < this.options.minLength) {
         return this.shown ? this.hide() : this
       }
 
-      items = $.grep(this.source, function (item) {
+      items = $.isFunction(this.source) ? this.source(this.query, $.proxy(this.process, this)) : this.source
+
+      return items ? this.process(items) : this
+    }
+
+  , process: function (items) {
+      var that = this
+
+      items = $.grep(items, function (item) {
         return that.matcher(item)
       })
 
@@ -1709,7 +1798,7 @@
         .on('keyup',    $.proxy(this.keyup, this))
 
       if ($.browser.webkit || $.browser.msie) {
-        this.$element.on('keydown', $.proxy(this.keypress, this))
+        this.$element.on('keydown', $.proxy(this.keydown, this))
       }
 
       this.$menu
@@ -1717,6 +1806,40 @@
         .on('mouseenter', 'li', $.proxy(this.mouseenter, this))
     }
 
+  , move: function (e) {
+      if (!this.shown) return
+
+      switch(e.keyCode) {
+        case 9: // tab
+        case 13: // enter
+        case 27: // escape
+          e.preventDefault()
+          break
+
+        case 38: // up arrow
+          e.preventDefault()
+          this.prev()
+          break
+
+        case 40: // down arrow
+          e.preventDefault()
+          this.next()
+          break
+      }
+
+      e.stopPropagation()
+    }
+
+  , keydown: function (e) {
+      this.suppressKeyPressRepeat = !~$.inArray(e.keyCode, [40,38,9,13,27])
+      this.move(e)
+    }
+
+  , keypress: function (e) {
+      if (this.suppressKeyPressRepeat) return
+      this.move(e)
+    }
+
   , keyup: function (e) {
       switch(e.keyCode) {
         case 40: // down arrow
@@ -1742,32 +1865,6 @@
       e.preventDefault()
   }
 
-  , keypress: function (e) {
-      if (!this.shown) return
-
-      switch(e.keyCode) {
-        case 9: // tab
-        case 13: // enter
-        case 27: // escape
-          e.preventDefault()
-          break
-
-        case 38: // up arrow
-          if (e.type != 'keydown') break
-          e.preventDefault()
-          this.prev()
-          break
-
-        case 40: // down arrow
-          if (e.type != 'keydown') break
-          e.preventDefault()
-          this.next()
-          break
-      }
-
-      e.stopPropagation()
-    }
-
   , blur: function (e) {
       var that = this
       setTimeout(function () { that.hide() }, 150)
@@ -1805,12 +1902,13 @@
   , items: 8
   , menu: '<ul class="typeahead dropdown-menu"></ul>'
   , item: '<li><a href="#"></a></li>'
+  , minLength: 1
   }
 
   $.fn.typeahead.Constructor = Typeahead
 
 
- /* TYPEAHEAD DATA-API
+ /*   TYPEAHEAD DATA-API
   * ================== */
 
   $(function () {
@@ -1822,4 +1920,108 @@
     })
   })
 
+}(window.jQuery);
+/* ==========================================================
+ * bootstrap-affix.js v2.1.0
+ * http://twitter.github.com/bootstrap/javascript.html#affix
+ * ==========================================================
+ * Copyright 2012 Twitter, Inc.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ * ========================================================== */
+
+
+!function ($) {
+
+  "use strict"; // jshint ;_;
+
+
+ /* AFFIX CLASS DEFINITION
+  * ====================== */
+
+  var Affix = function (element, options) {
+    this.options = $.extend({}, $.fn.affix.defaults, options)
+    this.$window = $(window).on('scroll.affix.data-api', $.proxy(this.checkPosition, this))
+    this.$element = $(element)
+    this.checkPosition()
+  }
+
+  Affix.prototype.checkPosition = function () {
+    if (!this.$element.is(':visible')) return
+
+    var scrollHeight = $(document).height()
+      , scrollTop = this.$window.scrollTop()
+      , position = this.$element.offset()
+      , offset = this.options.offset
+      , offsetBottom = offset.bottom
+      , offsetTop = offset.top
+      , reset = 'affix affix-top affix-bottom'
+      , affix
+
+    if (typeof offset != 'object') offsetBottom = offsetTop = offset
+    if (typeof offsetTop == 'function') offsetTop = offset.top()
+    if (typeof offsetBottom == 'function') offsetBottom = offset.bottom()
+
+    affix = this.unpin != null && (scrollTop + this.unpin <= position.top) ?
+      false    : offsetBottom != null && (position.top + this.$element.height() >= scrollHeight - offsetBottom) ?
+      'bottom' : offsetTop != null && scrollTop <= offsetTop ?
+      'top'    : false
+
+    if (this.affixed === affix) return
+
+    this.affixed = affix
+    this.unpin = affix == 'bottom' ? position.top - scrollTop : null
+
+    this.$element.removeClass(reset).addClass('affix' + (affix ? '-' + affix : ''))
+  }
+
+
+ /* AFFIX PLUGIN DEFINITION
+  * ======================= */
+
+  $.fn.affix = function (option) {
+    return this.each(function () {
+      var $this = $(this)
+        , data = $this.data('affix')
+        , options = typeof option == 'object' && option
+      if (!data) $this.data('affix', (data = new Affix(this, options)))
+      if (typeof option == 'string') data[option]()
+    })
+  }
+
+  $.fn.affix.Constructor = Affix
+
+  $.fn.affix.defaults = {
+    offset: 0
+  }
+
+
+ /* AFFIX DATA-API
+  * ============== */
+
+  $(window).on('load', function () {
+    $('[data-spy="affix"]').each(function () {
+      var $spy = $(this)
+        , data = $spy.data()
+
+      data.offset = data.offset || {}
+
+      data.offsetBottom && (data.offset.bottom = data.offsetBottom)
+      data.offsetTop && (data.offset.top = data.offsetTop)
+
+      $spy.affix(data)
+    })
+  })
+
+
 }(window.jQuery);

inst/www/shared/shiny.js

@@ -4,6 +4,68 @@
 
   var exports = window.Shiny = window.Shiny || {};
 
+  function randomId() {
+    return Math.floor(0x100000000 + (Math.random() * 0xF00000000)).toString(16);
+  }
+
+  function slice(blob, start, end) {
+    if (blob.slice)
+      return blob.slice(start, end);
+    if (blob.mozSlice)
+      return blob.mozSlice(start, end);
+    if (blob.webkitSlice)
+      return blob.webkitSlice(start, end);
+    throw "Blob doesn't support slice";
+  }
+
+  var _BlobBuilder = window.BlobBuilder || window.WebKitBlobBuilder || 
+      window.MozBlobBuilder || window.MSBlobBuilder;
+
+  function makeBlob(parts) {
+
+    // Browser compatibility is a mess right now. The code as written works in
+    // a variety of modern browsers, but sadly gives a deprecation warning
+    // message on the console in current versions (as of this writing) of
+    // Chrome.
+
+    // Safari 6.0 (8536.25) on Mac OS X 10.8.1:
+    // Has Blob constructor but it doesn't work with ArrayBufferView args
+
+    // Google Chrome 21.0.1180.81 on Xubuntu 12.04:
+    // Has Blob constructor, accepts ArrayBufferView args, accepts ArrayBuffer
+    // but with a deprecation warning message
+
+    // Firefox 15.0 on Xubuntu 12.04:
+    // Has Blob constructor, accepts both ArrayBuffer and ArrayBufferView args
+
+    // Chromium 18.0.1025.168 (Developer Build 134367 Linux) on Xubuntu 12.04:
+    // No Blob constructor. Has WebKitBlobBuilder.
+
+    try {
+      return new Blob(parts);
+    }
+    catch (e) {
+      var blobBuilder = new _BlobBuilder();
+      $.each(parts, function(i, part) {
+        blobBuilder.append(part);
+      });
+      return blobBuilder.getBlob();
+    }
+  }
+
+
+  // Takes a string expression and returns a function that takes an argument.
+  // 
+  // When the function is executed, it will evaluate that expression using
+  // "with" on the argument value, and return the result.
+  function scopeExprToFunc(expr) {
+    var func = new Function("with (this) {return (" + expr + ");}");
+    return function(scope) {
+      return func.call(scope);
+    };
+  }
+
+
   var Invoker = function(target, func) {
     this.target = target;
     this.func = func;
@@ -288,12 +350,12 @@
     }
 
     // Don't mutate list argument
-    list = list.slice(0);
+    list = slice(list, 0);
 
     for (var chunkSize = 1; chunkSize < list.length; chunkSize *= 2) {
       for (var i = 0; i < list.length; i += chunkSize * 2) {
-        var listA = list.slice(i, i + chunkSize);
-        var listB = list.slice(i + chunkSize, i + chunkSize * 2);
+        var listA = slice(list, i, i + chunkSize);
+        var listB = slice(list, i + chunkSize, i + chunkSize * 2);
         var merged = merge(sortfunc, listA, listB);
         var args = [i, merged.length];
         Array.prototype.push.apply(args, merged);
@@ -307,9 +369,23 @@
 
   var ShinyApp = function() {
     this.$socket = null;
+
+    // Cached input values
+    this.$inputValues = {};
+
+    // Output bindings
     this.$bindings = {};
+
+    // Cached values/errors
     this.$values = {};
+    this.$errors = {};
+
+    // Conditional bindings (show/hide element based on expression)
+    this.$conditionals = {};
+
     this.$pendingMessages = [];
+    this.$activeRequests = {};
+    this.$nextRequestId = 0;
   };
 
   (function() {
@@ -320,12 +396,25 @@
 
       this.$socket = this.createSocket();
       this.$initialInput = initialInput;
+      $.extend(this.$inputValues, initialInput);
+
+      this.$updateConditionals();
+    };
+
+    this.isConnected = function() {
+      return !!this.$socket;
     };
 
     this.createSocket = function () {
       var self = this;
 
-      var socket = new WebSocket('ws://' + window.location.host, 'shiny');
+      var createSocketFunc = exports.createSocket || function() {
+        var ws = new WebSocket('ws://' + window.location.host, 'shiny');
+        ws.binaryType = 'arraybuffer';
+        return ws;
+      };
+
+      var socket = createSocketFunc();
       socket.onopen = function() {
         socket.send(JSON.stringify({
           method: 'init',
@@ -352,7 +441,87 @@
         data: values
       });
 
-      if (this.$socket.readyState == WebSocket.CONNECTING) {
+      this.$sendMsg(msg);
+
+      $.extend(this.$inputValues, values);
+      this.$updateConditionals();
+    };
+
+    // NB: Including blobs will cause IE to break!
+    // TODO: Make blobs work with Internet Explorer
+    //
+    // Websocket messages are normally one-way--i.e. the client passes a
+    // message to the server but there is no way for the server to provide
+    // a response to that specific message. makeRequest provides a way to
+    // do asynchronous RPC over websocket. Each request has a method name
+    // and arguments, plus optionally one or more binary blobs can be
+    // included as well. The request is tagged with a unique number that
+    // the server will use to label the corresponding response.
+    //
+    // @param method A string that tells the server what logic to run.
+    // @param args An array of objects that should also be passed to the
+    //   server in JSON-ified form.
+    // @param onSuccess A function that will be called back if the server
+    //   responds with success. If the server provides a value in the
+    //   response, the function will be called with it as the only argument.
+    // @param onError A function that will be called back if the server
+    //   responds with error, or if the request fails for any other reason.
+    //   The parameter to onError will be an error object or message (format
+    //   TBD).
+    // @param blobs Optionally, an array of Blob, ArrayBuffer, or string
+    //   objects that will be made available to the server as part of the
+    //   request. Strings will be encoded using UTF-8.
+    this.makeRequest = function(method, args, onSuccess, onError, blobs) {
+      var requestId = this.$nextRequestId;
+      while (this.$activeRequests[requestId]) {
+        requestId = (requestId + 1) % 1000000000;
+      }
+      this.$nextRequestId = requestId + 1;
+
+      this.$activeRequests[requestId] = {
+        onSuccess: onSuccess,
+        onError: onError
+      };
+
+      var msg = JSON.stringify({
+        method: method,
+        args: args,
+        tag: requestId
+      });
+
+      if (blobs) {
+        // We have binary data to transfer; form a different kind of packet.
+        // Start with a 4-byte signature, then for each blob, emit 4 bytes for
+        // the length followed by the blob. The json payload is UTF-8 encoded
+        // and used as the first blob.
+
+        function uint32_to_buf(val) {
+          var buffer = new ArrayBuffer(4);
+          var view = new DataView(buffer);
+          view.setUint32(0, val, true); // little-endian
+          return buffer;
+        }
+
+        var payload = [];
+        payload.push(uint32_to_buf(0x01020202)); // signature
+
+        var jsonBuf = makeBlob([msg]);
+        payload.push(uint32_to_buf(jsonBuf.size));
+        payload.push(jsonBuf);
+
+        for (var i = 0; i < blobs.length; i++) {
+          payload.push(uint32_to_buf(blobs[i].byteLength || blobs[i].size || 0));
+          payload.push(blobs[i]);
+        }
+
+        msg = makeBlob(payload);
+      }
+
+      this.$sendMsg(msg);
+    };
+
+    this.$sendMsg = function(msg) {
+      if (!this.$socket.readyState) {
         this.$pendingMessages.push(msg);
       }
       else {
@@ -361,7 +530,11 @@
     };
 
     this.receiveError = function(name, error) {
-      this.$values[name] = null;
+      if (this.$errors[name] === error)
+        return;
+
+      this.$errors[name] = error;
+      delete this.$values[name];
 
       var binding = this.$bindings[name];
       if (binding && binding.onValueError) {
@@ -370,11 +543,12 @@
     }
 
     this.receiveOutput = function(name, value) {
-      var oldValue = this.$values[name];
-      this.$values[name] = value;
-      if (oldValue === value)
+      if (this.$values[name] === value)
         return;
 
+      this.$values[name] = value;
+      delete this.$errors[name];
+
       var binding = this.$bindings[name];
       if (binding) {
         binding.onValueChange(value);
@@ -404,6 +578,20 @@
           }
         }
       }
+      if (msgObj.response) {
+        var resp = msgObj.response;
+        var requestId = resp.tag;
+        var request = this.$activeRequests[requestId];
+        if (request) {
+          delete this.$activeRequests[requestId];
+          if ('value' in resp)
+            request.onSuccess(resp.value);
+          else
+            request.onError(resp.error);
+        }
+      };
+
+      this.$updateConditionals();
     };
 
     this.bindOutput = function(id, binding) {
@@ -412,11 +600,188 @@
       if (this.$bindings[id])
         throw "Duplicate binding for ID " + id;
       this.$bindings[id] = binding;
+
+      if (this.$values[id] !== undefined)
+        binding.onValueChange(this.$values[id]);
+      else if (this.$errors[id] !== undefined)
+        binding.onValueError(this.$errors[id]);
+
       return binding;
     };
+    this.unbindOutput = function(id, binding) {
+      if (this.$bindings[id] === binding) {
+        delete this.$bindings[id];
+        return true;
+      }
+      else {
+        return false;
+      }
+    };
+
+    this.$updateConditionals = function() {
+      var scope = {input: this.$inputValues, output: this.$values};
+
+      var conditionals = $(document).find('[data-display-if]');
+      for (var i = 0; i < conditionals.length; i++) {
+        var el = $(conditionals[i]);
+        var condFunc = el.data('data-display-if-func');
+
+        if (!condFunc) {
+          var condExpr = el.attr('data-display-if');
+          condFunc = scopeExprToFunc(condExpr);
+          el.data('data-display-if-func', condFunc);
+        }
+
+        if (condFunc(scope)) {
+          el.trigger('show');
+          el.show(function() {
+            $(this).trigger('shown');
+          });
+        }
+        else {
+          el.trigger('hide');
+          el.hide(function() {
+            $(this).trigger('hidden');
+          });
+        }
+      }
+    };
   }).call(ShinyApp.prototype);
 
 
+  // Generic driver class for doing chunk-wise asynchronous processing of a
+  // FileList object. Subclass/clone it and override the `on*` functions to
+  // make it do something useful.
+  var FileProcessor = function(files) {
+    this.files = files;
+    this.fileReader = new FileReader();
+    this.fileIndex = -1;
+    this.pos = 0;
+    // Currently need to use small chunk size because R-Websockets can't
+    // handle continuation frames
+    this.chunkSize = 4096;
+    this.aborted = false;
+    this.completed = false;
+    
+    var self = this;
+    $(this.fileReader).on('load', function(evt) {
+      self.$endReadChunk();
+    });
+    // TODO: Register error/abort callbacks
+    
+    this.$run();
+  };
+  (function() {
+    // Begin callbacks. Subclassers/cloners may override any or all of these.
+    this.onBegin = function(files, cont) {
+      setTimeout(cont, 0);
+    };
+    this.onFileBegin = function(file, cont) {
+      setTimeout(cont, 0);
+    };
+    this.onFileChunk = function(file, offset, blob, cont) {
+      setTimeout(cont, 0);
+    };
+    this.onFileEnd = function(file, cont) {
+      setTimeout(cont, 0);
+    };
+    this.onComplete = function() {
+    };
+    this.onAbort = function() {
+    };
+    // End callbacks
+    
+    // Aborts processing, unless it's already completed
+    this.abort = function() {
+      if (this.completed || this.aborted)
+        return;
+      
+      this.aborted = true;
+      this.onAbort();
+    };
+    
+    // Returns a bound function that will call this.$run one time.
+    this.$getRun = function() {
+      var self = this;
+      var called = false;
+      return function() {
+        if (called)
+          return;
+        called = true;
+        self.$run();
+      };
+    };
+    
+    // This function will be called multiple times to advance the process.
+    // It relies on the state of the object's fields to know what to do next.
+    this.$run = function() {
+      
+      var self = this;
+
+      if (this.aborted || this.completed)
+        return;
+      
+      if (this.fileIndex < 0) {
+        // Haven't started yet--begin
+        this.fileIndex = 0;
+        this.onBegin(this.files, this.$getRun());
+        return;
+      }
+      
+      if (this.fileIndex == this.files.length) {
+        // Just ended
+        this.completed = true;
+        this.onComplete();
+        return;
+      }
+      
+      // If we got here, then we have a file to process, or we are
+      // in the middle of processing a file, or have just finished
+      // processing a file.
+      
+      var file = this.files[this.fileIndex];
+      if (this.pos >= file.size) {
+        // We've read past the end of this file--it's done
+        this.fileIndex++;
+        this.pos = 0;
+        this.onFileEnd(file, this.$getRun());
+      }
+      else if (this.pos == 0) {
+        // We're just starting with this file, need to call onFileBegin
+        // before we actually start reading
+        var called = false;
+        this.onFileBegin(file, function() {
+          if (called)
+            return;
+          called = true;
+          self.$beginReadChunk();
+        });
+      }
+      else {
+        // We're neither starting nor ending--just start the next chunk
+        this.$beginReadChunk();
+      }
+    };
+    
+    // Starts asynchronous read of the current chunk of the current file
+    this.$beginReadChunk = function() {
+      var file = this.files[this.fileIndex];
+      var blob = slice(file, this.pos, this.pos + this.chunkSize);
+      this.fileReader.readAsArrayBuffer(blob);
+    };
+    
+    // Called when a chunk has been successfully read
+    this.$endReadChunk = function() {
+      var file = this.files[this.fileIndex];
+      var offset = this.pos;
+      var data = this.fileReader.result;
+      this.pos = this.pos + this.chunkSize;
+      this.onFileChunk(file, offset, makeBlob([data]),
+                       this.$getRun());
+    };
+  }).call(FileProcessor.prototype);
+
+
   var BindingRegistry = function() {
     this.bindings = [];
     this.bindingNames = {};
@@ -467,7 +832,7 @@
     };
 
     this.onValueChange = function(el, data) {
-      this.clearError();
+      this.clearError(el);
       this.renderValue(el, data);
     };
     this.onValueError = function(el, err) {
@@ -522,7 +887,9 @@
       return $(scope).find('.shiny-html-output');
     },
     renderValue: function(el, data) {
+      exports.unbindAll(el);
       $(el).html(data);
+      exports.bindAll(el);
     }
   });
   outputBindings.register(htmlOutputBinding, 'shiny.htmlOutput');
@@ -542,7 +909,7 @@
     };
   
     this.getValue = function(el) { throw "Not implemented"; };
-    this.subscribe = function(el) { };
+    this.subscribe = function(el, callback) { };
     this.unsubscribe = function(el) { };
     
     this.getRatePolicy = function() { return null; };
@@ -567,12 +934,11 @@
       el.value = value;
     },
     subscribe: function(el, callback) {
-      var self = this;
       $(el).on('keyup.textInputBinding input.textInputBinding', function(event) {
-        callback(self, el, true);
+        callback(true);
       });
       $(el).on('change.textInputBinding', function(event) {
-        callback(self, el, false);
+        callback(false);
       });
     },
     unsubscribe: function(el) {
@@ -638,9 +1004,8 @@
       // TODO: implement
     },
     subscribe: function(el, callback) {
-      var self = this;
       $(el).on('change.inputBinding', function(event) {
-        callback(self, el, !$(el).data('animating'));
+        callback(!$(el).data('animating'));
       });
     },
     unsubscribe: function(el) {
@@ -672,9 +1037,8 @@
       $(el).val(value);
     },
     subscribe: function(el, callback) {
-      var self = this;
       $(el).on('change.selectInputBinding', function(event) {
-        callback(self, el);
+        callback();
       });
     },
     unsubscribe: function(el) {
@@ -683,7 +1047,166 @@
   });
   inputBindings.register(selectInputBinding, 'shiny.selectInput');
 
+
+  var bootstrapTabInputBinding = new InputBinding();
+  $.extend(bootstrapTabInputBinding, {
+    find: function(scope) {
+      return scope.find('ul.nav.nav-tabs');
+    },
+    getValue: function(el) {
+      var anchor = $(el).children('li.active').children('a');
+      if (anchor.length == 1)
+        return this.$getTabName(anchor);
+      return null;
+    },
+    setValue: function(el, value) {
+      var self = this;
+      var anchors = $(el).children('li').children('a');
+      anchors.each(function() {
+        if (self.$getTabName($(this)) === value) {
+          $(this).tab('show');
+          return false;
+        }
+      });
+    },
+    subscribe: function(el, callback) {
+      $(el).on('shown.bootstrapTabInputBinding', function(event) {
+        callback();
+      });
+    },
+    unsubscribe: function(el) {
+      $(el).off('.bootstrapTabInputBinding');
+    },
+    $getTabName: function(anchor) {
+      return anchor.attr('data-value') || anchor.text();
+    }
+  });
+  inputBindings.register(bootstrapTabInputBinding, 'shiny.bootstrapTabInput');
+
+
+  var FileUploader = function(shinyapp, id, files) {
+    this.shinyapp = shinyapp;
+    this.id = id;
+    FileProcessor.call(this, files);
+  };
+  $.extend(FileUploader.prototype, FileProcessor.prototype);
+  (function() {
+    this.makeRequest = function(method, args, onSuccess, onFailure, blobs) {
+      this.shinyapp.makeRequest(method, args, onSuccess, onFailure, blobs);
+    };
+    this.onBegin = function(files, cont) {
+      var self = this;
+      this.makeRequest(
+        'uploadInit', [],
+        function(response) {
+          self.jobId = response.jobId;
+          cont();
+        },
+        function(error) {
+        });
+    };
+    this.onFileBegin = function(file, cont) {
+      this.onProgress(file, 0);
+      
+      this.makeRequest(
+        'uploadFileBegin', [this.jobId, file.name, file.type, file.size],
+        function(response) {
+          cont();
+        },
+        function(error) {
+        });
+    };
+    this.onFileChunk = function(file, offset, blob, cont) {
+      this.onProgress(file, (offset + blob.size) / file.size);
+
+      this.makeRequest(
+        'uploadFileChunk', [this.jobId],
+        function(response) {
+          cont();
+        },
+        function(error) {
+        },
+        [blob]);
+    };
+    this.onFileEnd = function(file, cont) {
+      this.makeRequest(
+        'uploadFileEnd', [this.jobId],
+        function(response) {
+          cont();
+        },
+        function(error) {
+        });
+    };
+    this.onComplete = function() {
+      this.makeRequest(
+        'uploadEnd', [this.jobId, this.id], 
+        function(response) {
+        },
+        function(error) {
+        });
+    };
+    this.onAbort = function() {
+    };
+    this.onProgress = function(file, completed) {
+      console.log('file: ' + file.name + ' [' + Math.round(completed*100) + '%]');
+    };
+  }).call(FileUploader.prototype);
+
+
+  function uploadFiles(evt) {
+    // If previously selected files are uploading, abort that.
+    var el = $(evt.target);
+    var uploader = el.data('currentUploader');
+    if (uploader)
+      uploader.abort();
+
+    var files = evt.target.files;
+    var id = fileInputBinding.getId(evt.target);
+
+    // Start the new upload and put the uploader in 'currentUploader'.
+    el.data('currentUploader', new FileUploader(exports.shinyapp, id, files));
+  };
+
+  var fileInputBinding = new InputBinding();
+  $.extend(fileInputBinding, {
+    find: function(scope) {
+      return scope.find('input[type="file"]');
+    },
+    getId: function(el) {
+      return InputBinding.prototype.getId.call(this, el) || el.name;
+    },
+    getValue: function(el) {
+      return null;
+    },
+    setValue: function(el, value) {
+      // Not implemented
+    },
+    subscribe: function(el, callback) {
+      $(el).on('change.fileInputBinding', uploadFiles);
+    },
+    unsubscribe: function(el) {
+      $(el).off('.fileInputBinding');
+    }
+  })
+  inputBindings.register(fileInputBinding, 'shiny.fileInputBinding');
+
   
+  var OutputBindingAdapter = function(el, binding) {
+    this.el = el;
+    this.binding = binding;
+  };
+  (function() {
+    this.onValueChange = function(data) {
+      this.binding.onValueChange(this.el, data);
+    };
+    this.onValueError = function(err) {
+      this.binding.onValueError(this.el, err);
+    };
+    this.showProgress = function(show) {
+      this.binding.showProgress(this.el, show);
+    };
+  }).call(OutputBindingAdapter.prototype);
+
 
   function initShiny() {
 
@@ -691,21 +1214,8 @@
 
     function bindOutputs(scope) {
 
-      var OutputBindingAdapter = function(el, binding) {
-        this.el = el;
-        this.binding = binding;
-      };
-      $.extend(OutputBindingAdapter.prototype, {
-        onValueChange: function(data) {
-          this.binding.onValueChange(this.el, data);
-        },
-        onValueError: function(err) {
-          this.binding.onValueError(this.el, err);
-        },
-        showProgress: function(show) {
-          this.binding.showProgress(this.el, show);
-        }
-      });
+      if (scope == undefined)
+        scope = document;
 
       scope = $(scope);
 
@@ -722,9 +1232,30 @@
           if (!id)
             continue;
 
-          shinyapp.bindOutput(id, new OutputBindingAdapter(el, binding));
+          var bindingAdapter = new OutputBindingAdapter(el, binding);
+          shinyapp.bindOutput(id, bindingAdapter);
+          $(el).data('shiny-output-binding', bindingAdapter);
+          $(el).addClass('shiny-bound-output');
         }
       }
+
+      // Send later in case DOM layout isn't final yet.
+      setTimeout(sendPlotSize, 0);
+    }
+
+    function unbindOutputs(scope) {
+      if (scope == undefined)
+        scope = document;
+
+      var outputs = $(scope).find('.shiny-bound-output');
+      for (var i = 0; i < outputs.length; i++) {
+        var bindingAdapter = $(outputs[i]).data('shiny-output-binding');
+        if (!bindingAdapter)
+          continue;
+        var id = bindingAdapter.binding.getId(outputs[i]);
+        shinyapp.unbindOutput(id, bindingAdapter);
+        $(outputs[i]).removeClass('shiny-bound-output');
+      }
     }
 
     function elementToValue(el) {
@@ -761,6 +1292,9 @@
     }
     
     function bindInputs(scope) {
+
+      if (scope == undefined)
+        scope = document;
       
       scope = $(scope);
 
@@ -780,7 +1314,18 @@
             continue;
     
           currentValues[id] = binding.getValue(el);
-          binding.subscribe(el, valueChangeCallback);
+
+          var thisCallback = (function() {
+            var thisBinding = binding;
+            var thisEl = el;
+            return function(allowDeferred) {
+              valueChangeCallback(thisBinding, thisEl, allowDeferred);
+            };
+          })();
+
+          binding.subscribe(el, thisCallback);
+          $(el).data('shiny-input-binding', binding);
+          $(el).addClass('shiny-bound-input');
           var ratePolicy = binding.getRatePolicy();
           if (ratePolicy != null) {
             inputsRate.setRatePolicy(
@@ -793,14 +1338,45 @@
             binding: binding,
             node: el
           };
+
+          if (shinyapp.isConnected()) {
+            valueChangeCallback(binding, el, false);
+          }
         }
       }
     
       return currentValues;
     }
-    
-    bindOutputs(document);
-    initialValues = bindInputs(document);
+
+    function unbindInputs(scope) {
+      if (scope == undefined)
+        scope = document;
+
+      var inputs = $(scope).find('.shiny-bound-input');
+      for (var i = 0; i < inputs.length; i++) {
+        var binding = $(inputs[i]).data('shiny-input-binding');
+        if (!binding)
+          continue;
+        var id = binding.getId(inputs[i]);
+        $(inputs[i]).removeClass('shiny-bound-input');
+        delete boundInputs[id];
+        binding.unsubscribe(inputs[i]);
+      }
+    }
+
+
+    function bindAll(scope) {
+      bindOutputs(scope);
+      return bindInputs(scope);
+    }
+    function unbindAll(scope) {
+      unbindInputs(scope);
+      unbindOutputs(scope);
+    }
+    exports.bindAll = bindAll;
+    exports.unbindAll = unbindAll;
+
+    var initialValues = bindAll(document);
 
     function getMultiValue(input, exclusiveValue) {
       if (!input.name)
@@ -869,8 +1445,7 @@
     // of 0x0). It's OK to over-report sizes because the input pipeline will
     // filter out values that haven't changed.
     $(window).resize(debounce(500, sendPlotSize));
-    $(window).on(
-      'shown', '[data-toggle="tab"], [data-toggle="pill"]', sendPlotSize);
+    $('body').on('shown.sendPlotSize hidden.sendPlotSize', '*', sendPlotSize);
 
     // We've collected all the initial values--start the server process!
     shinyapp.connect(initialValues);

man/addResourcePath.Rd

@@ -0,0 +1,36 @@
+\name{addResourcePath}
+\alias{addResourcePath}
+\title{Resource Publishing}
+\usage{
+  addResourcePath(prefix, directoryPath)
+}
+\arguments{
+  \item{prefix}{The URL prefix (without slashes). Valid
+  characters are a-z, A-Z, 0-9, hyphen, and underscore; and
+  must begin with a-z or A-Z. For example, a value of 'foo'
+  means that any request paths that begin with '/foo' will
+  be mapped to the given directory.}
+
+  \item{directoryPath}{The directory that contains the
+  static resources to be served.}
+}
+\description{
+  Adds a directory of static resources to Shiny's web
+  server, with the given path prefix. Primarily intended
+  for package authors to make supporting JavaScript/CSS
+  files available to their components.
+}
+\details{
+  You can call \code{addResourcePath} multiple times for a
+  given \code{prefix}; only the most recent value will be
+  retained. If the normalized \code{directoryPath} is
+  different than the directory that's currently mapped to
+  the \code{prefix}, a warning will be issued.
+}
+\examples{
+addResourcePath('datasets', system.file('data', package='datasets'))
+}
+\seealso{
+  \code{\link{singleton}}
+}
+

man/checkboxGroupInput.Rd

@@ -0,0 +1,39 @@
+\name{checkboxGroupInput}
+\alias{checkboxGroupInput}
+\title{Checkbox Group Input Control}
+\usage{
+  checkboxGroupInput(inputId, label, choices,
+    selected = NULL)
+}
+\arguments{
+  \item{inputId}{Input variable to assign the control's
+  value to.}
+
+  \item{label}{Display label for the control.}
+
+  \item{choices}{List of values to show checkboxes for. If
+  elements of the list are named then that name rather than
+  the value is displayed to the user.}
+
+  \item{selected}{Names of items that should be initially
+  selected, if any.}
+}
+\value{
+  A list of HTML elements that can be added to a UI
+  definition.
+}
+\description{
+  Create a group of checkboxes that can be used to toggle
+  multiple choices independently. The server will receive
+  the input as a character vector of the selected values.
+}
+\examples{
+checkboxGroupInput("variable", "Variable:",
+                   list("Cylinders" = "cyl",
+                        "Transmission" = "am",
+                        "Gears" = "gear"))
+}
+\seealso{
+  \code{\link{checkboxInput}}
+}
+

man/checkboxInput.Rd

@@ -1,25 +1,29 @@
 \name{checkboxInput}
 \alias{checkboxInput}
-\title{Create a checkbox input control}
+\title{Checkbox Input Control}
 \usage{
   checkboxInput(inputId, label, value = FALSE)
 }
 \arguments{
   \item{inputId}{Input variable to assign the control's
-  value to}
+  value to.}
 
-  \item{label}{Display label for the control}
+  \item{label}{Display label for the control.}
 
-  \item{value}{Initial value}
+  \item{value}{Initial value (\code{TRUE} or
+  \code{FALSE}).}
 }
 \value{
   A checkbox control that can be added to a UI definition.
 }
 \description{
   Create a checkbox that can be used to specify logical
-  values
+  values.
 }
 \examples{
 checkboxInput("outliers", "Show outliers", FALSE)
 }
+\seealso{
+  \code{\link{checkboxGroupInput}}
+}
 

man/conditionalPanel.Rd

@@ -0,0 +1,54 @@
+\name{conditionalPanel}
+\alias{conditionalPanel}
+\title{Conditional Panel}
+\usage{
+  conditionalPanel(condition, ...)
+}
+\arguments{
+  \item{condition}{A JavaScript expression that will be
+  evaluated repeatedly to determine whether the panel
+  should be displayed.}
+
+  \item{...}{Elements to include in the panel.}
+}
+\description{
+  Creates a panel that is visible or not, depending on the
+  value of a JavaScript expression. The JS expression is
+  evaluated once at startup and whenever Shiny detects a
+  relevant change in input/output.
+}
+\details{
+  In the JS expression, you can refer to \code{input} and
+  \code{output} JavaScript objects that contain the current
+  values of input and output. For example, if you have an
+  input with an id of \code{foo}, then you can use
+  \code{input.foo} to read its value. (Be sure not to
+  modify the input/output objects, as this may cause
+  unpredictable behavior.)
+}
+\examples{
+sidebarPanel(
+   selectInput(
+      "plotType", "Plot Type",
+      list(Scatter = "scatter",
+           Histogram = "hist")),
+
+   # Only show this panel if the plot type is a histogram
+   conditionalPanel(
+      condition = "input.plotType == 'hist'",
+      selectInput(
+         "breaks", "Breaks",
+         list("Sturges",
+              "Scott",
+              "Freedman-Diaconis",
+              "[Custom]" = "custom")),
+
+      # Only show this panel if Custom is selected
+      conditionalPanel(
+         condition = "input.breaks == 'custom'",
+         sliderInput("breakCount", "Break Count", min=1, max=1000, value=10)
+      )
+   )
+)
+}
+

man/fileInput.Rd

@@ -0,0 +1,25 @@
+\name{fileInput}
+\alias{fileInput}
+\title{File Upload Control}
+\usage{
+  fileInput(inputId, label, multiple = FALSE,
+    accept = NULL)
+}
+\arguments{
+  \item{inputId}{Input variable to assign the control's
+  value to.}
+
+  \item{label}{Display label for the control.}
+
+  \item{multiple}{Whether the user should be allowed to
+  select and upload multiple files at once.}
+
+  \item{accept}{A character vector of MIME types; gives the
+  browser a hint of what kind of files the server is
+  expecting.}
+}
+\description{
+  Create a file upload control that can be used to upload
+  one or more files.
+}
+

man/reactiveUI.Rd

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

man/tabPanel.Rd

@@ -2,19 +2,24 @@
 \alias{tabPanel}
 \title{Create a tab panel}
 \usage{
-  tabPanel(title, ...)
+  tabPanel(title, ..., value = NULL)
 }
 \arguments{
   \item{title}{Display title for tab}
 
   \item{...}{UI elements to include within the tab}
+
+  \item{value}{The value that should be sent when
+  \code{tabsetPanel} reports that this tab is selected. If
+  omitted and \code{tabsetPanel} has an \code{id}, then the
+  title will be used.}
 }
 \value{
-  A tab that can be passed to \link{tabsetPanel}
+  A tab that can be passed to \code{\link{tabsetPanel}}
 }
 \description{
-  Create a tab panel that can be inluded within a
-  \link{tabsetPanel}.
+  Create a tab panel that can be included within a
+  \code{\link{tabsetPanel}}.
 }
 \examples{
 # Show a tabset that includes a plot, summary, and

man/tabsetPanel.Rd

@@ -2,19 +2,25 @@
 \alias{tabsetPanel}
 \title{Create a tabset panel}
 \usage{
-  tabsetPanel(...)
+  tabsetPanel(..., id = NULL)
 }
 \arguments{
-  \item{...}{\link{tabPanel} elements to include in the
-  tabset}
+  \item{...}{\code{\link{tabPanel}} elements to include in
+  the tabset}
+
+  \item{id}{If provided, you can use
+  \code{input$}\emph{\code{id}} in your server logic to
+  determine which of the current tabs is active. The value
+  will correspond to the \code{value} argument that is
+  passed to \code{\link{tabPanel}}.}
 }
 \value{
-  A tabset that can be passed to \link{mainPanel}
+  A tabset that can be passed to \code{\link{mainPanel}}
 }
 \description{
-  Create a tabset that contains \link{tabPanel} elements.
-  Tabsets are useful for dividing output into multiple
-  independently viewable sections.
+  Create a tabset that contains \code{\link{tabPanel}}
+  elements. Tabsets are useful for dividing output into
+  multiple independently viewable sections.
 }
 \examples{
 # Show a tabset that includes a plot, summary, and

man/tag.Rd

@@ -1,15 +1,22 @@
 \name{tag}
 \alias{tag}
 \alias{tagAppendChild}
+\alias{tagList}
 \title{
 HTML Tag Object
 }
 \description{
-Create an HTML tag definition. Note that all of the valid HTML5 tags are already defined in the \link{tags} environment so these functions should only be used to generate additional tags.
+\code{tag} creates an HTML tag definition. Note that all of the valid HTML5 tags
+are already defined in the \link{tags} environment so these functions should
+only be used to generate additional tags. \code{tagAppendChild} and
+\code{tagList} are for supporting package authors who wish to create their own
+sets of tags; see the contents of bootstrap.R for examples.
 
 \code{tag(_tag_name, varArgs)}
 
 \code{tagAppendChild(tag, child)}
+
+\code{tagList(...)}
 }
 
 \arguments{
@@ -18,7 +25,7 @@ Create an HTML tag definition. Note that all of the valid HTML5 tags are already
 }
   \item{varArgs}{
     List of attributes and children of the element. Named list items
-    become attributes, and other items become children. Valid
+    become attributes, and unnamed list items become children. Valid
     children are tags, single-character character vectors (which become
     text nodes), and raw HTML (see \code{\link{HTML}}). You can also
     pass lists that contain tags, text nodes, and HTML.
@@ -28,6 +35,9 @@ Create an HTML tag definition. Note that all of the valid HTML5 tags are already
 }
   \item{child}{
     A child element to append to a parent tag.
+}
+  \item{...}{
+    Unnamed items that comprise this list of tags.
 }
 }