Bump version to 0.6.0

Fix several bugs relating to suspendWhenHidden

.Rbuildignore

@@ -8,3 +8,4 @@
 ^run\.R$
 ^\.gitignore$
 ^res$
+^tools$

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 0.4.1
+Version: 0.6.0
 Date: 2013-01-23
 Author: RStudio, Inc.
 Maintainer: Winston Chang <winston@rstudio.com>
@@ -18,7 +18,7 @@ Imports:
     utils,
     datasets,
     methods,
-    websockets (>= 1.1.6),
+    httpuv (>= 1.0.6.2),
     caTools,
     RJSONIO,
     xtable,
@@ -31,6 +31,7 @@ URL: http://www.rstudio.com/shiny/
 BugReports: https://github.com/rstudio/shiny/issues
 Collate:
     'map.R'
+    'priorityqueue.R'
     'utils.R'
     'tar.R'
     'timer.R'
@@ -45,3 +46,5 @@ Collate:
     'slider.R'
     'bootstrap.R'
     'run-url.R'
+    'imageutils.R'
+    'update-input.R'

NAMESPACE

@@ -21,14 +21,18 @@ S3method(print,shiny.tag)
 S3method(print,shiny.tag.list)
 export(HTML)
 export(a)
+export(actionButton)
 export(addResourcePath)
 export(animationOptions)
+export(basicPage)
 export(bootstrapPage)
 export(br)
 export(checkboxGroupInput)
 export(checkboxInput)
 export(code)
 export(conditionalPanel)
+export(dateInput)
+export(dateRangeInput)
 export(div)
 export(downloadButton)
 export(downloadHandler)
@@ -45,6 +49,7 @@ export(h6)
 export(headerPanel)
 export(helpText)
 export(htmlOutput)
+export(imageOutput)
 export(img)
 export(includeHTML)
 export(includeMarkdown)
@@ -57,7 +62,9 @@ export(observe)
 export(outputOptions)
 export(p)
 export(pageWithSidebar)
+export(parseQueryString)
 export(plotOutput)
+export(plotPNG)
 export(pre)
 export(radioButtons)
 export(reactive)
@@ -69,6 +76,7 @@ export(reactiveTimer)
 export(reactiveUI)
 export(reactiveValues)
 export(reactiveValuesToList)
+export(renderImage)
 export(renderPlot)
 export(renderPrint)
 export(renderTable)
@@ -99,10 +107,21 @@ export(tags)
 export(textInput)
 export(textOutput)
 export(uiOutput)
+export(updateCheckboxGroupInput)
+export(updateCheckboxInput)
+export(updateDateInput)
+export(updateDateRangeInput)
+export(updateNumericInput)
+export(updateRadioButtons)
+export(updateSelectInput)
+export(updateSliderInput)
+export(updateTabsetPanel)
+export(updateTextInput)
 export(verbatimTextOutput)
 export(wellPanel)
+export(withTags)
 import(RJSONIO)
 import(caTools)
 import(digest)
-import(websockets)
+import(httpuv)
 import(xtable)

NEWS

@@ -1,3 +1,63 @@
+shiny 0.6.0
+--------------------------------------------------------------------------------
+
+* `tabsetPanel()` can be directed to start with a specific tab selected.
+
+* Fix bug where multiple file uploads with 3 or more files result in incorrect
+  data.
+
+* Add `withTags()` function.
+
+* Add dateInput and dateRangeInput.
+
+* `shinyServer()` now takes an optional `session` argument, which is used for
+  communication with the session object.
+
+* Add functions to update values of existing inputs on a page, instead of
+  replacing them entirely.
+
+* Allow listening on domain sockets.
+
+* Added `actionButton()` to Shiny.
+
+* The server can now send custom JSON messages to the client. On the client
+  side, functions can be registered to handle these messages.
+
+* Callbacks can be registered to be called at the end of a client session.
+
+* Add ability to set priority of observers and outputs. Each priority level
+  gets its own queue.
+
+* Fix bug where the presence of a submit button would prevent sending of
+  metadata until the button was clicked.
+
+* `reactiveTimer()` and `invalidateLater()` by default no longer invalidate
+  reactive objects after the client session has closed.
+
+* Shiny apps can be run without a server.r and ui.r file.
+
+shiny 0.5.0
+--------------------------------------------------------------------------------
+
+* Switch from websockets package for handling websocket connections to httpuv.
+
+* New method for detecting hidden output objects. Instead of checking that
+  height and width are 0, it checks that the object or any ancestor in the DOM
+  has style display:none.
+
+* Add `clientData` reactive values object, which carries information about the
+  client. This includes the hidden status of output objects, height/width plot
+  output objects, and the URL of the browser.
+
+* Add `parseQueryString()` function.
+
+* Add `renderImage()` function for sending arbitrary image files to the client,
+  and its counterpart, `imageOutput()`.
+
+* Add support for high-resolution (Retina) displays.
+
+* Fix bug #55, where `renderTable()` would throw error with an empty data frame.
+
 shiny 0.4.1
 --------------------------------------------------------------------------------
 

R/bootstrap.R

@@ -4,9 +4,12 @@
 #' \href{http://getbootstrap.com}{Twitter Bootstrap}, and has no content in the
 #' page body (other than what you provide).
 #' 
-#' This function is primarily intended for users who are proficient in HTML/CSS,
-#' and know how to lay out pages in Bootstrap. Most users should use template
-#' functions like \code{\link{pageWithSidebar}}.
+#' These functions are primarily intended for users who are proficient in
+#' HTML/CSS, and know how to lay out pages in Bootstrap. Most users should use
+#' template functions like \code{\link{pageWithSidebar}}.
+#'
+#' \code{basicPage} is the same as \code{bootstrapPage}, with an added
+#' \code{<div class="container-fluid">} wrapper to provide a little padding.
 #' 
 #' @param ... The contents of the document body.
 #' @return A UI defintion that can be passed to the \link{shinyUI} function.
@@ -59,6 +62,12 @@ bootstrapPage <- function(...) {
   )
 }
 
+#' @rdname bootstrapPage
+#' @export
+basicPage <- function(...) {
+  bootstrapPage(div(class="container-fluid", list(...)))
+}
+
 #' Create a page with a sidebar
 #' 
 #' Create a Shiny UI that contains a header with the application title, a 
@@ -246,12 +255,14 @@ conditionalPanel <- function(condition, ...) {
 #' @param value Initial value
 #' @return A text input control that can be added to a UI definition.
 #' 
+#' @seealso \code{\link{updateTextInput}}
+#'
 #' @examples
 #' textInput("caption", "Caption:", "Data Summary")
 #' @export
 textInput <- function(inputId, label, value = "") {
   tagList(
-    tags$label(label),
+    tags$label(label, `for` = inputId),
     tags$input(id = inputId, type="text", value=value)
   )
 }
@@ -267,6 +278,8 @@ textInput <- function(inputId, label, value = "") {
 #' @param max Maximum allowed value
 #' @param step Interval to use when stepping between min and max
 #' @return A numeric input control that can be added to a UI definition.
+#'
+#' @seealso \code{\link{updateNumericInput}}
 #' 
 #' @examples
 #' numericInput("obs", "Observations:", 10, 
@@ -284,7 +297,7 @@ numericInput <- function(inputId, label, value, min = NA, max = NA, step = NA) {
     inputTag$attribs$step = step
   
   tagList(
-    tags$label(label),
+    tags$label(label, `for` = inputId),
     inputTag
   )
 }
@@ -293,8 +306,25 @@ numericInput <- function(inputId, label, value, min = NA, max = NA, step = NA) {
 #' File Upload Control
 #' 
 #' Create a file upload control that can be used to upload one or more files. 
-#' \bold{Experimental feature. Only works in some browsers (primarily tested on
-#' Chrome and Firefox).}
+#' \bold{Does not work on older browsers, including Internet Explorer 9 and
+#' earlier.}
+#' 
+#' Whenever a file upload completes, the corresponding input variable is set
+#' to a dataframe. This dataframe contains one row for each selected file, and
+#' the following columns:
+#' \describe{
+#'   \item{\code{name}}{The filename provided by the web browser. This is
+#'   \strong{not} the path to read to get at the actual data that was uploaded
+#'   (see
+#'   \code{datapath} column).}
+#'   \item{\code{size}}{The size of the uploaded data, in
+#'   bytes.}
+#'   \item{\code{type}}{The MIME type reported by the browser (for example, 
+#'   \code{text/plain}), or empty string if the browser didn't know.}
+#'   \item{\code{datapath}}{The path to a temp file that contains the data that was
+#'   uploaded. This file may be deleted if the user performs another upload
+#'   operation.}
+#' }
 #' 
 #' @param inputId Input variable to assign the control's value to.
 #' @param label Display label for the control.
@@ -313,7 +343,13 @@ fileInput <- function(inputId, label, multiple = FALSE, accept = NULL) {
   
   tagList(
     tags$label(label),
-    inputTag
+    inputTag,
+    tags$div(
+      id=paste(inputId, "_progress", sep=""),
+      class="progress progress-striped active shiny-file-input-progress",
+      tags$div(class="bar"),
+      tags$label()
+    )
   )
 }
 
@@ -327,7 +363,7 @@ fileInput <- function(inputId, label, multiple = FALSE, accept = NULL) {
 #' @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}}
+#' @seealso \code{\link{checkboxGroupInput}}, \code{\link{updateCheckboxInput}}
 #' 
 #' @examples
 #' checkboxInput("outliers", "Show outliers", FALSE)
@@ -336,7 +372,7 @@ checkboxInput <- function(inputId, label, value = FALSE) {
   inputTag <- tags$input(id = inputId, type="checkbox")
   if (!is.null(value) && value)
     inputTag$attribs$checked <- "checked"
-  tags$label(class = "checkbox", inputTag, label)
+  tags$label(class = "checkbox", `for` = inputId, inputTag, tags$span(label))
 }
 
 
@@ -353,7 +389,7 @@ checkboxInput <- function(inputId, label, value = FALSE) {
 #' @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}}
+#' @seealso \code{\link{checkboxInput}}, \code{\link{updateCheckboxGroupInput}}
 #'   
 #' @examples
 #' checkboxGroupInput("variable", "Variable:",
@@ -367,21 +403,27 @@ checkboxGroupInput <- function(inputId, label, choices, selected = NULL) {
   choices <- choicesWithNames(choices)
   
   checkboxes <- list()
-  for (choiceName in names(choices)) {
-    
-    checkbox <- tags$input(name = inputId, type="checkbox",
-                           value = choices[[choiceName]])
-    
+  for (i in seq_along(choices)) {
+    choiceName <- names(choices)[i]
+
+    inputTag <- tags$input(type = "checkbox",
+                           name = inputId,
+                           id = paste(inputId, i, sep=""),
+                           value = choices[[i]])
+
     if (choiceName %in% selected)
-      checkbox$attribs$checked <- 'checked'
+      inputTag$attribs$checked <- "checked"
+
+    checkbox <- tags$label(class = "checkbox",
+                           inputTag,
+                           tags$span(choiceName))
     
-    checkboxes[[length(checkboxes)+1]] <- checkbox
-    checkboxes[[length(checkboxes)+1]] <- choiceName
-    checkboxes[[length(checkboxes)+1]] <- tags$br()
+    checkboxes[[i]] <- checkbox
   } 
   
   # return label and select tag
-  tags$div(class='control-group',
+  tags$div(id = inputId,
+           class = "control-group shiny-input-checkboxgroup",
            controlLabel(inputId, label),
            checkboxes)
 }
@@ -408,6 +450,8 @@ controlLabel <- function(controlName, label) {
   tags$label(class = "control-label", `for` = controlName, label)
 }
 
+# Takes a vector or list, and adds names (same as the value) to any entries
+# without names.
 choicesWithNames <- function(choices) {
   # get choice names
   choiceNames <- names(choices)
@@ -438,6 +482,8 @@ choicesWithNames <- function(choices) {
 #' @param multiple Is selection of multiple items allowed?
 #' @return A select list control that can be added to a UI definition.
 #' 
+#' @seealso \code{\link{updateSelectInput}}
+#'
 #' @examples
 #' selectInput("variable", "Variable:",
 #'             c("Cylinders" = "cyl",
@@ -460,12 +506,16 @@ selectInput <- function(inputId,
   selectTag <- tags$select(id = inputId)
   if (multiple)
     selectTag$attribs$multiple <- "multiple"
-  for (choiceName in names(choices)) {
-    optionTag <- tags$option(value = choices[[choiceName]], choiceName)
+
+  for (i in seq_along(choices)) {
+    choiceName <- names(choices)[i]
+    optionTag <- tags$option(value = choices[[i]], choiceName)
+
     if (choiceName %in% selected)
       optionTag$attribs$selected = "selected"
+
     selectTag <- tagAppendChild(selectTag, optionTag)
-  } 
+  }
   
   # return label and select tag
   tagList(controlLabel(inputId, label), selectTag)
@@ -482,6 +532,8 @@ selectInput <- function(inputId,
 #' @param selected Name of initially selected item (if not specified then
 #' defaults to the first item)
 #' @return A set of radio buttons that can be added to a UI definition.
+#'
+#' @seealso \code{\link{updateRadioButtons}}
 #' 
 #' @examples
 #' radioButtons("dist", "Distribution type:",
@@ -500,7 +552,7 @@ radioButtons <- function(inputId, label, choices, selected = NULL) {
   
   # build list of radio button tags
   inputTags <- list()
-  for (i in 1:length(choices)) {
+  for (i in seq_along(choices)) {
     id <- paste(inputId, i, sep="")
     name <- names(choices)[[i]]
     value <- choices[[i]]
@@ -510,15 +562,19 @@ radioButtons <- function(inputId, label, choices, selected = NULL) {
                            value = value)
     if (identical(name, selected))
       inputTag$attribs$checked = "checked"
-    
+
+    # Put the label text in a span
+    spanTag <- tags$span(name)
     labelTag <- tags$label(class = "radio")
     labelTag <- tagAppendChild(labelTag, inputTag)
-    labelTag <- tagAppendChild(labelTag, name)
+    labelTag <- tagAppendChild(labelTag, spanTag)
     inputTags[[length(inputTags) + 1]] <- labelTag
   }
   
-  tagList(tags$label(class = "control-label", label),
-          inputTags)
+  tags$div(id = inputId,
+           class = 'control-group shiny-input-radiogroup',
+           tags$label(class = "control-label", `for` = inputId, label),
+           inputTags)
 }
 
 #' Create a submit button
@@ -539,6 +595,21 @@ submitButton <- function(text = "Apply Changes") {
   )
 }
 
+#' Action button
+#'
+#' Creates an action button whose value is initially zero, and increments by one
+#' each time it is pressed.
+#'
+#' @param inputId Specifies the input slot that will be used to access the
+#'   value.
+#' @param label The contents of the button--usually a text label, but you could
+#'   also use any other HTML, like an image.
+#'
+#' @export
+actionButton <- function(inputId, label) {
+  tags$button(id=inputId, type="button", class="btn action-button", label)
+}
+
 #' Slider Input Widget
 #' 
 #' Constructs a slider widget to select a numeric value from a range.
@@ -566,6 +637,8 @@ submitButton <- function(text = "Apply Changes") {
 #' @param animate \code{TRUE} to show simple animation controls with default 
 #'   settings; \code{FALSE} not to; or a custom settings list, such as those 
 #'   created using \code{\link{animationOptions}}.
+#'
+#' @seealso \code{\link{updateSliderInput}}
 #'   
 #' @details
 #' 
@@ -600,11 +673,243 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
   }
   
   # build slider
+  tags$div(
+    tagList(
+      controlLabel(inputId, labelText),
+      slider(inputId, min=min, max=max, value=value, step=step, round=round,
+             locale=locale, format=format, ticks=ticks,
+             animate=animate)
+    )
+  )
+}
+
+
+#' Create date input
+#'
+#' Creates a text input which, when clicked on, brings up a calendar that
+#' the user can click on to select dates.
+#'
+#' The date \code{format} string specifies how the date will be displayed in
+#' the browser. It allows the following values:
+#'
+#' \itemize{
+#'   \item \code{yy} Year without century (12)
+#'   \item \code{yyyy} Year with century (2012)
+#'   \item \code{mm} Month number, with leading zero (01-12)
+#'   \item \code{m} Month number, without leading zero (01-12)
+#'   \item \code{M} Abbreviated month name
+#'   \item \code{MM} Full month name
+#'   \item \code{dd} Day of month with leading zero
+#'   \item \code{d} Day of month without leading zero
+#'   \item \code{D} Abbreviated weekday name
+#'   \item \code{DD} Full weekday name
+#' }
+#'
+#' @param inputId Input variable to assign the control's value to.
+#' @param label Display label for the control.
+#' @param value The starting date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format. If NULL (the default), will use the current
+#'   date in the client's time zone.
+#' @param min The minimum allowed date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#' @param max The maximum allowed date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#' @param format The format of the date to display in the browser. Defaults to
+#'   \code{"yyyy-mm-dd"}.
+#' @param startview The date range shown when the input object is first
+#'   clicked. Can be "month" (the default), "year", or "decade".
+#' @param weekstart Which day is the start of the week. Should be an integer
+#'   from 0 (Sunday) to 6 (Saturday).
+#' @param language The language used for month and day names. Default is "en".
+#'   Other valid values include "bg", "ca", "cs", "da", "de", "el", "es", "fi",
+#'   "fr", "he", "hr", "hu", "id", "is", "it", "ja", "kr", "lt", "lv", "ms",
+#'   "nb", "nl", "pl", "pt", "pt", "ro", "rs", "rs-latin", "ru", "sk", "sl",
+#'   "sv", "sw", "th", "tr", "uk", "zh-CN", and "zh-TW".
+#'
+#' @seealso \code{\link{dateRangeInput}}, \code{\link{updateDateInput}}
+#'
+#' @examples
+#' dateInput("date", "Date:", value = "2012-02-29")
+#'
+#' # Default value is the date in client's time zone
+#' dateInput("date", "Date:")
+#'
+#' # value is always yyyy-mm-dd, even if the display format is different
+#' dateInput("date", "Date:", value = "2012-02-29", format = "mm/dd/yy")
+#'
+#' # Pass in a Date object
+#' dateInput("date", "Date:", value = Sys.Date()-10)
+#'
+#' # Use different language and different first day of week
+#' dateInput("date", "Date:",
+#'           language = "de",
+#'           weekstart = 1)
+#'
+#' # Start with decade view instead of default month view
+#' dateInput("date", "Date:",
+#'           startview = "decade")
+#'
+#' @export
+dateInput <- function(inputId, label, value = NULL, min = NULL, max = NULL,
+    format = "yyyy-mm-dd", startview = "month", weekstart = 0, language = "en") {
+
+  # If value is a date object, convert it to a string with yyyy-mm-dd format
+  # Same for min and max
+  if (inherits(value, "Date"))  value <- format(value, "%Y-%m-%d")
+  if (inherits(min,   "Date"))  min   <- format(min,   "%Y-%m-%d")
+  if (inherits(max,   "Date"))  max   <- format(max,   "%Y-%m-%d")
+
   tagList(
-    controlLabel(inputId, labelText),  
-    slider(inputId, min=min, max=max, value=value, step=step, round=round,
-           locale=locale, format=format, ticks=ticks,
-           animate=animate)
+    singleton(tags$head(
+      tags$script(src = "shared/datepicker/js/bootstrap-datepicker.min.js"),
+      tags$link(rel = "stylesheet", type = "text/css",
+                href = 'shared/datepicker/css/datepicker.css')
+    )),
+    tags$div(id = inputId,
+             class = "shiny-date-input",
+
+      controlLabel(inputId, label),
+      tags$input(type = "text",
+                 # datepicker class necessary for dropdown to display correctly
+                 class = "input-medium datepicker",
+                 `data-date-language` = language,
+                 `data-date-weekstart` = weekstart,
+                 `data-date-format` = format,
+                 `data-date-start-view` = startview,
+                 `data-min-date` = min,
+                 `data-max-date` = max,
+                 `data-initial-date` = value
+      )
+    )
+  )
+}
+
+
+#' Create date range input
+#'
+#' Creates a pair of text inputs which, when clicked on, bring up calendars that
+#' the user can click on to select dates.
+#'
+#' The date \code{format} string specifies how the date will be displayed in
+#' the browser. It allows the following values:
+#'
+#' \itemize{
+#'   \item \code{yy} Year without century (12)
+#'   \item \code{yyyy} Year with century (2012)
+#'   \item \code{mm} Month number, with leading zero (01-12)
+#'   \item \code{m} Month number, without leading zero (01-12)
+#'   \item \code{M} Abbreviated month name
+#'   \item \code{MM} Full month name
+#'   \item \code{dd} Day of month with leading zero
+#'   \item \code{d} Day of month without leading zero
+#'   \item \code{D} Abbreviated weekday name
+#'   \item \code{DD} Full weekday name
+#' }
+#'
+#' @param inputId Input variable to assign the control's value to.
+#' @param label Display label for the control.
+#' @param start The initial start date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format. If NULL (the default), will use the current
+#'   date in the client's time zone.
+#' @param end The initial end date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format. If NULL (the default), will use the current
+#'   date in the client's time zone.
+#' @param min The minimum allowed date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#' @param max The maximum allowed date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#' @param format The format of the date to display in the browser. Defaults to
+#'   \code{"yyyy-mm-dd"}.
+#' @param startview The date range shown when the input object is first
+#'   clicked. Can be "month" (the default), "year", or "decade".
+#' @param weekstart Which day is the start of the week. Should be an integer
+#'   from 0 (Sunday) to 6 (Saturday).
+#' @param language The language used for month and day names. Default is "en".
+#'   Other valid values include "bg", "ca", "cs", "da", "de", "el", "es", "fi",
+#'   "fr", "he", "hr", "hu", "id", "is", "it", "ja", "kr", "lt", "lv", "ms",
+#'   "nb", "nl", "pl", "pt", "pt", "ro", "rs", "rs-latin", "ru", "sk", "sl",
+#'   "sv", "sw", "th", "tr", "uk", "zh-CN", and "zh-TW".
+#' @param separator String to display between the start and end input boxes.
+#'
+#' @seealso \code{\link{dateInput}}, \code{\link{updateDateRangeInput}}
+#'
+#' @examples
+#' dateRangeInput("daterange", "Date range:",
+#'                start = "2001-01-01",
+#'                end   = "2010-12-31")
+#'
+#' # Default start and end is the current date in the client's time zone
+#' dateRangeInput("daterange", "Date range:")
+#'
+#' # start and end are always specified in yyyy-mm-dd, even if the display
+#' # format is different
+#' dateRangeInput("daterange", "Date range:",
+#'                start  = "2001-01-01",
+#'                end    = "2010-12-31",
+#'                min    = "2001-01-01",
+#'                max    = "2012-12-21",
+#'                format = "mm/dd/yy",
+#'                separator = " - ")
+#'
+#' # Pass in Date objects
+#' dateRangeInput("daterange", "Date range:",
+#'                start = Sys.Date()-10,
+#'                end = Sys.Date()+10)
+#'
+#' # Use different language and different first day of week
+#' dateRangeInput("daterange", "Date range:",
+#'                language = "de",
+#'                weekstart = 1)
+#'
+#' # Start with decade view instead of default month view
+#' dateRangeInput("daterange", "Date range:",
+#'                startview = "decade")
+#'
+#' @export
+dateRangeInput <- function(inputId, label, start = NULL, end = NULL,
+    min = NULL, max = NULL, format = "yyyy-mm-dd", startview = "month",
+    weekstart = 0, language = "en", separator = " to ") {
+
+  # If start and end are date objects, convert to a string with yyyy-mm-dd format
+  # Same for min and max
+  if (inherits(start, "Date"))  start <- format(start, "%Y-%m-%d")
+  if (inherits(end,   "Date"))  end   <- format(end,   "%Y-%m-%d")
+  if (inherits(min,   "Date"))  min   <- format(min,   "%Y-%m-%d")
+  if (inherits(max,   "Date"))  max   <- format(max,   "%Y-%m-%d")
+
+  tagList(
+    singleton(tags$head(
+      tags$script(src = "shared/datepicker/js/bootstrap-datepicker.min.js"),
+      tags$link(rel = "stylesheet", type = "text/css",
+                href = 'shared/datepicker/css/datepicker.css')
+    )),
+    tags$div(id = inputId,
+             # input-daterange class is needed for dropdown behavior
+             class = "shiny-date-range-input input-daterange",
+
+      controlLabel(inputId, label),
+      tags$input(class = "input-small",
+                 type = "text",
+                 `data-date-language` = language,
+                 `data-date-weekstart` = weekstart,
+                 `data-date-format` = format,
+                 `data-date-start-view` = startview,
+                 `data-min-date` = min,
+                 `data-max-date` = max,
+                 `data-initial-date` = start
+                 ),
+      HTML(separator),
+      tags$input(class = "input-small",
+                 type = "text",
+                 `data-date-language` = language,
+                 `data-date-weekstart` = weekstart,
+                 `data-date-format` = format,
+                 `data-date-start-view` = startview,
+                 `data-min-date` = min,
+                 `data-max-date` = max,
+                 `data-initial-date` = end
+                 )
+    )
   )
 }
 
@@ -619,6 +924,8 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
 #'   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}}
+#'
+#' @seealso \code{\link{tabsetPanel}}
 #'   
 #' @examples
 #' # Show a tabset that includes a plot, summary, and
@@ -645,8 +952,13 @@ tabPanel <- function(title, ..., value = NULL) {
 #'   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}}.
+#' @param selected The \code{value} (or, if none was supplied, the \code{title})
+#'   of the tab that should be selected by default. If \code{NULL}, the first
+#'   tab will be selected.
 #' @return A tabset that can be passed to \code{\link{mainPanel}}
 #'   
+#' @seealso \code{\link{tabPanel}}, \code{\link{updateTabsetPanel}}
+#'
 #' @examples
 #' # Show a tabset that includes a plot, summary, and
 #' # table view of the generated distribution
@@ -658,7 +970,7 @@ tabPanel <- function(title, ..., value = NULL) {
 #'   )
 #' )
 #' @export
-tabsetPanel <- function(..., id = NULL) {
+tabsetPanel <- function(..., id = NULL, selected = NULL) {
   
   # build tab-nav and tab-content divs
   tabs <- list(...)
@@ -685,8 +997,13 @@ tabsetPanel <- function(..., id = NULL) {
                             `data-value` = tabValue,
                             divTag$attribs$title))
     
-    # set the first tab as active
-    if (firstTab) {
+    if (is.null(tabValue)) {
+      tabValue <- divTag$attribs$title
+    }
+
+    # If appropriate, make this the selected tab
+    if ((firstTab && is.null(selected)) ||
+        (!is.null(selected) && identical(selected, tabValue))) {
       liTag$attribs$class <- "active"
       divTag$attribs$class <- "tab-pane active"
       firstTab = FALSE
@@ -738,7 +1055,28 @@ verbatimTextOutput <- function(outputId) {
   pre(id = outputId, class =  "shiny-text-output")
 }
 
-#' Create a plot output element
+#' Create a image output element
+#' 
+#' Render a \link{renderImage} within an application page.
+#' @param outputId output variable to read the image from
+#' @param width Image width. Must be a valid CSS unit (like \code{"100\%"},
+#'   \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
+#'   string and have \code{"px"} appended.
+#' @param height Image height
+#' @return An image output element that can be included in a panel
+#' @examples
+#' # Show an image
+#' mainPanel(
+#'   imageOutput("dataImage")
+#' )
+#' @export
+imageOutput <- function(outputId, width = "100%", height="400px") {
+  style <- paste("width:", validateCssUnit(width), ";",
+    "height:", validateCssUnit(height))
+  div(id = outputId, class = "shiny-image-output", style = style)
+}
+
+#' Create an plot output element
 #' 
 #' Render a \link{renderPlot} within an application page.
 #' @param outputId output variable to read the plot from
@@ -756,7 +1094,7 @@ verbatimTextOutput <- function(outputId) {
 plotOutput <- function(outputId, width = "100%", height="400px") {
   style <- paste("width:", validateCssUnit(width), ";",
     "height:", validateCssUnit(height))
-  div(id = outputId, class="shiny-plot-output", style = style)
+  div(id = outputId, class = "shiny-plot-output", style = style)
 }
 
 #' Create a table output element

R/fileupload.R

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

R/imageutils.R

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

R/priorityqueue.R

@@ -0,0 +1,110 @@
+# "...like a regular queue or stack data structure, but where additionally each
+# element has a "priority" associated with it. In a priority queue, an element
+# with high priority is served before an element with low priority. If two
+# elements have the same priority, they are served according to their order in
+# the queue." (http://en.wikipedia.org/wiki/Priority_queue)
+
+PriorityQueue <- setRefClass(
+  'PriorityQueue',
+  fields = list(
+    # Keys are priorities, values are subqueues (implemented as list)
+    .itemsByPriority = 'Map',
+    # Sorted vector (largest first)
+    .priorities = 'numeric'  
+  ),
+  methods = list(
+    # Enqueue an item, with the given priority level (must be integer). Higher 
+    # priority numbers are dequeued earlier than lower.
+    enqueue = function(item, priority) {
+      priority <- normalizePriority(priority)
+      
+      if (!(priority %in% .priorities)) {
+        .priorities <<- c(.priorities, priority)
+        .priorities <<- sort(.priorities, decreasing=TRUE)
+        .itemsByPriority$set(.key(priority), list(item))
+      } else {
+        .itemsByPriority$set(
+          .key(priority),
+          c(.itemsByPriority$get(.key(priority)), item)
+        )
+      }
+      return(invisible())
+    },
+    # Retrieve a single item by 1) priority number (highest first) and then 2) 
+    # insertion order (first in, first out). If there are no items to be 
+    # dequeued, then NULL is returned. If it is necessary to distinguish between
+    # a NULL value and the empty case, call isEmpty() before dequeue().
+    dequeue = function() {
+      if (length(.priorities) == 0)
+        return(NULL)
+      
+      maxPriority <- .priorities[[1]]
+      items <- .itemsByPriority$get(.key(maxPriority))
+      firstItem <- items[[1]]
+      if (length(items) == 1) {
+        # This is the last item at this priority. Remove both the list and the
+        # priority level.
+        .itemsByPriority$remove(.key(maxPriority))
+        .priorities <<- .priorities[-1]
+      } else {
+        # There are still items at this priority. Remove the current item from
+        # the list, and save it.
+        items <- items[-1]
+        .itemsByPriority$set(.key(maxPriority), items)
+      }
+      return(firstItem)
+    },
+    # Returns TRUE if no items are in the queue, otherwise FALSE.
+    isEmpty = function() {
+      length(.priorities) == 0
+    },
+    # Translates a priority integer to a character that is suitable for using as
+    # a key.
+    .key = function(priority) {
+      sprintf('%a', priority)
+    }
+  )
+)
+
+normalizePriority <- function(priority) {
+  
+  if (is.null(priority))
+    priority <- 0
+  
+  # Cast integers to numeric to prevent any inconsistencies
+  if (is.integer(priority))
+    priority <- as.numeric(priority)
+  
+  if (!is.numeric(priority))
+    stop('priority must be an integer or numeric')
+  
+  # Check length
+  if (length(priority) == 0) {
+    warning('Zero-length priority vector was passed; using 0')
+    priority <- 0
+  } else if (length(priority) > 1) {
+    warning('Priority has length > 1 and only the first element will be used')
+    priority <- priority[1]
+  }
+  
+  # NA == 0
+  if (is.na(priority))
+    priority <- 0
+
+  return(priority)
+}
+
+# pq <- PriorityQueue$new()
+# pq$enqueue('a', 1)
+# pq$enqueue('b', 1L)
+# pq$enqueue('c', 1)
+# pq$enqueue('A', 2)
+# pq$enqueue('B', 2L)
+# pq$enqueue('C', 2)
+# pq$enqueue('d', 1)
+# pq$enqueue('e', 1L)
+# pq$enqueue('f', 1)
+# pq$enqueue('D', 2)
+# pq$enqueue('E', 2L)
+# pq$enqueue('F', 2)
+# # Expect ABCDEFabcdef

R/react.R

@@ -42,10 +42,10 @@ Context <- setRefClass(
         .invalidateCallbacks <<- c(.invalidateCallbacks, func)
       NULL
     },
-    addPendingFlush = function() {
+    addPendingFlush = function(priority) {
       "Tell the reactive environment that this context should be flushed the
         next time flushReact() called."
-      .getReactiveEnvironment()$addPendingFlush(.self)
+      .getReactiveEnvironment()$addPendingFlush(.self, priority)
     },
     onFlush = function(func) {
       "Register a function to be called when this context is flushed."
@@ -71,14 +71,14 @@ ReactiveEnvironment <- setRefClass(
   fields = list(
     .currentContext = 'ANY',
     .nextId = 'integer',
-    .pendingFlush = 'list',
+    .pendingFlush = 'PriorityQueue',
     .inFlush = 'logical'
   ),
   methods = list(
     initialize = function() {
       .currentContext <<- NULL
       .nextId <<- 0L
-      .pendingFlush <<- list()
+      .pendingFlush <<- PriorityQueue$new()
       .inFlush <<- FALSE
     },
     nextId = function() {
@@ -98,8 +98,8 @@ ReactiveEnvironment <- setRefClass(
       on.exit(.currentContext <<- old.ctx)
       func()
     },
-    addPendingFlush = function(ctx) {
-      .pendingFlush <<- c(ctx, .pendingFlush)
+    addPendingFlush = function(ctx, priority) {
+      .pendingFlush$enqueue(ctx, priority)
     },
     flush = function() {
       # If already in a flush, don't start another one
@@ -107,9 +107,8 @@ ReactiveEnvironment <- setRefClass(
       .inFlush <<- TRUE
       on.exit(.inFlush <<- FALSE)
 
-      while (length(.pendingFlush) > 0) {
-        ctx <- .pendingFlush[[1]]
-        .pendingFlush <<- .pendingFlush[-1]
+      while (!.pendingFlush$isEmpty()) {
+        ctx <- .pendingFlush$dequeue()
         ctx$executeFlushCallbacks()
       }
     }

R/reactives.R

@@ -166,6 +166,9 @@ reactiveValues <- function(...) {
   values
 }
 
+# Register the S3 class so that it can be used for a field in a Reference Class
+setOldClass("reactivevalues")
+
 # Create a reactivevalues object
 #
 # @param values A ReactiveValues object
@@ -388,19 +391,21 @@ Observer <- setRefClass(
   fields = list(
     .func = 'function',
     .label = 'character',
+    .priority = 'numeric',
     .invalidateCallbacks = 'list',
     .execCount = 'integer',
     .onResume = 'function',
     .suspended = 'logical'
   ),
   methods = list(
-    initialize = function(func, label, suspended = FALSE) {
+    initialize = function(func, label, suspended = FALSE, priority = 0) {
       if (length(formals(func)) > 0)
         stop("Can't make an observer from a function that takes parameters; ",
              "only functions without parameters can be reactive.")
 
       .func <<- func
       .label <<- label
+      .priority <<- normalizePriority(priority)
       .execCount <<- 0L
       .suspended <<- suspended
       .onResume <<- function() NULL
@@ -418,7 +423,7 @@ Observer <- setRefClass(
         })
 
         continue <- function() {
-          ctx$addPendingFlush()
+          ctx$addPendingFlush(.priority)
         }
         
         if (.suspended == FALSE)
@@ -442,6 +447,13 @@ Observer <- setRefClass(
       "Register a function to run when this observer is invalidated"
       .invalidateCallbacks <<- c(.invalidateCallbacks, func)
     },
+    setPriority = function(priority = 0) {
+      "Change the observer's priority. Note that if the observer is currently
+      invalidated, then the change in priority will not take effect until the
+      next invalidation--unless the observer is also currently suspended, in
+      which case the priority change will be effective upon resume."
+      .priority <<- normalizePriority(priority)
+    },
     suspend = function() {
       "Causes this observer to stop scheduling flushes (re-executions) in
       response to invalidations. If the observer was invalidated prior to this
@@ -490,6 +502,10 @@ Observer <- setRefClass(
 #' @param label A label for the observer, useful for debugging.
 #' @param suspended If \code{TRUE}, start the observer in a suspended state.
 #'   If \code{FALSE} (the default), start in a non-suspended state.
+#' @param priority An integer or numeric that controls the priority with which
+#'   this observer should be executed. An observer with a given priority level
+#'   will always execute sooner than all observers with a lower priority level. 
+#'   Positive, negative, and zero values are allowed.
 #'
 #' @examples
 #' values <- reactiveValues(A=1)
@@ -511,13 +527,14 @@ Observer <- setRefClass(
 #'
 #' @export
 observe <- function(x, env=parent.frame(), quoted=FALSE, label=NULL,
-                    suspended=FALSE) {
+                    suspended=FALSE, priority=0) {
 
   fun <- exprToFunction(x, env, quoted)
   if (is.null(label))
     label <- deparse(body(fun))
 
-  invisible(Observer$new(fun, label=label, suspended=suspended))
+  invisible(Observer$new(
+    fun, label=label, suspended=suspended, priority=priority))
 }
 
 # ---------------------------------------------------------------------------
@@ -536,15 +553,58 @@ observe <- function(x, env=parent.frame(), quoted=FALSE, label=NULL,
 #' See \code{\link{invalidateLater}} as a safer and simpler alternative.
 #' 
 #' @param intervalMs How often to fire, in milliseconds
+#' @param session A session object. This is needed to cancel any scheduled
+#'   invalidations after a user has ended the session. If \code{NULL}, then
+#'   this invalidation will not be tied to any session, and so it will still
+#'   occur.
 #' @return A no-parameter function that can be called from a reactive context, 
 #'   in order to cause that context to be invalidated the next time the timer 
 #'   interval elapses. Calling the returned function also happens to yield the 
 #'   current time (as in \code{\link{Sys.time}}).
 #' @seealso invalidateLater
+#'
+#' @examples
+#' \dontrun{
+#' shinyServer(function(input, output, session) {
+#'
+#'   # Anything that calls autoInvalidate will automatically invalidate
+#'   # every 2 seconds.
+#'   autoInvalidate <- reactiveTimer(2000, session)
+#'
+#'   observe({
+#'     # Invalidate and re-execute this reactive expression every time the
+#'     # timer fires.
+#'     autoInvalidate()
+#'
+#'     # Do something each time this is invalidated.
+#'     # The isolate() makes this observer _not_ get invalidated and re-executed
+#'     # when input$n changes.
+#'     print(paste("The value of input$n is", isolate(input$n)))
+#'   })
+#'
+#'   # Generate a new histogram each time the timer fires, but not when
+#'   # input$n changes.
+#'   output$plot <- renderPlot({
+#'     autoInvalidate()
+#'     hist(isolate(input$n))
+#'   })
+#' })
+#' }
+#'
 #' @export
-reactiveTimer <- function(intervalMs=1000) {
+reactiveTimer <- function(intervalMs=1000, session) {
+  if (missing(session)) {
+    warning("reactiveTimer should be passed a session object or NULL")
+    session <- NULL
+  }
+
   dependents <- Map$new()
   timerCallbacks$schedule(intervalMs, function() {
+    # Quit if the session is closed
+    if (!is.null(session) && session$isClosed()) {
+      return(invisible())
+    }
+
     timerCallbacks$schedule(intervalMs, sys.function())
     lapply(
       dependents$values(),
@@ -571,10 +631,48 @@ reactiveTimer <- function(intervalMs=1000) {
 #' of milliseconds.
 #' @param millis Approximate milliseconds to wait before invalidating the
 #'   current reactive context.
+#' @param session A session object. This is needed to cancel any scheduled
+#'   invalidations after a user has ended the session. If \code{NULL}, then
+#'   this invalidation will not be tied to any session, and so it will still
+#'   occur.
+#'
+#' @examples
+#' \dontrun{
+#' shinyServer(function(input, output, session) {
+#'
+#'   observe({
+#'     # Re-execute this reactive expression after 1000 milliseconds
+#'     invalidateLater(1000, session)
+#'
+#'     # Do something each time this is invalidated.
+#'     # The isolate() makes this observer _not_ get invalidated and re-executed
+#'     # when input$n changes.
+#'     print(paste("The value of input$n is", isolate(input$n)))
+#'   })
+#'
+#'   # Generate a new histogram at timed intervals, but not when
+#'   # input$n changes.
+#'   output$plot <- renderPlot({
+#'     # Re-execute this reactive expression after 2000 milliseconds
+#'     invalidateLater(2000, session)
+#'     hist(isolate(input$n))
+#'   })
+#' })
+#' }
+#'
 #' @export
-invalidateLater <- function(millis) {
+invalidateLater <- function(millis, session) {
+  if (missing(session)) {
+    warning("invalidateLater should be passed a session object or NULL")
+    session <- NULL
+  }
+
   ctx <- .getReactiveEnvironment()$currentContext()
   timerCallbacks$schedule(millis, function() {
+    # Quit if the session is closed
+    if (!is.null(session) && session$isClosed()) {
+      return(invisible())
+    }
     ctx$invalidate()
   })
   invisible()

R/shinyui.R

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

R/shinywrappers.R

@@ -11,12 +11,6 @@ suppressPackageStartupMessages({
 #' The corresponding HTML output tag should be \code{div} or \code{img} and have
 #' the CSS class name \code{shiny-plot-output}.
 #'
-#' For output, it will try to use the following devices, in this order:
-#' quartz (via \code{\link[grDevices]{png}}), then \code{\link[Cairo]{CairoPNG}},
-#' and finally \code{\link[grDevices]{png}}. This is in order of quality of
-#' output. Notably, plain \code{png} output on Linux and Windows may not
-#' antialias some point shapes, resulting in poor quality output.
-#' 
 #' @param expr An expression that generates a plot.
 #' @param width The width of the rendered plot, in pixels; or \code{'auto'} to 
 #'   use the \code{offsetWidth} of the HTML element that is bound to this plot. 
@@ -28,6 +22,9 @@ suppressPackageStartupMessages({
 #'   You can also pass in a function that returns the width in pixels or 
 #'   \code{'auto'}; in the body of the function you may reference reactive 
 #'   values and functions.
+#' @param res Resolution of resulting plot, in pixels per inch. This value is
+#'   passed to \code{\link{png}}. Note that this affects the resolution of PNG
+#'   rendering in R; it won't change the actual ppi of the browser.
 #' @param ... Arguments to be passed through to \code{\link[grDevices]{png}}. 
 #'   These can be used to set the width, height, background color, etc.
 #' @param env The environment in which to evaluate \code{expr}.
@@ -37,7 +34,7 @@ suppressPackageStartupMessages({
 #'   instead).
 #'   
 #' @export
-renderPlot <- function(expr, width='auto', height='auto', ...,
+renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
                        env=parent.frame(), quoted=FALSE, func=NULL) {
   if (!is.null(func)) {
     shinyDeprecated(msg="renderPlot: argument 'func' is deprecated. Please use 'expr' instead.")
@@ -58,9 +55,7 @@ renderPlot <- function(expr, width='auto', height='auto', ...,
   else
     heightWrapper <- NULL
 
-  return(function(shinyapp, name, ...) {
-    png.file <- tempfile(fileext='.png')
-    
+  return(function(shinysession, name, ...) {
     if (!is.null(widthWrapper))
       width <- widthWrapper()
     if (!is.null(heightWrapper))
@@ -69,49 +64,145 @@ renderPlot <- function(expr, width='auto', height='auto', ...,
     # Note that these are reactive calls. A change to the width and height
     # will inherently cause a reactive plot to redraw (unless width and 
     # height were explicitly specified).
-    prefix <- '.shinyout_'
+    prefix <- 'output_'
     if (width == 'auto')
-      width <- shinyapp$session$get(paste(prefix, name, '_width', sep=''));
+      width <- shinysession$clientData[[paste(prefix, name, '_width', sep='')]];
     if (height == 'auto')
-      height <- shinyapp$session$get(paste(prefix, name, '_height', sep=''));
+      height <- shinysession$clientData[[paste(prefix, name, '_height', sep='')]];
     
-    if (width <= 0 || height <= 0)
+    if (is.null(width) || is.null(height) || width <= 0 || height <= 0)
       return(NULL)
 
-    # If quartz is available, use png() (which will default to quartz).
-    # Otherwise, if the Cairo package is installed, use CairoPNG().
-    # Finally, if neither quartz nor Cairo, use png().
-    if (capabilities("aqua")) {
-      pngfun <- png
-    } else if (nchar(system.file(package = "Cairo"))) {
-      require(Cairo)
-      pngfun <- CairoPNG
-    } else {
-      pngfun <- png
-    }
+    # Resolution multiplier
+    pixelratio <- shinysession$clientData$pixelratio
+    if (is.null(pixelratio))
+      pixelratio <- 1
 
-    do.call(pngfun, c(args, filename=png.file, width=width, height=height))
-    on.exit(unlink(png.file))
-    tryCatch(
-      func(),
-      finally=dev.off())
+    outfile <- do.call(plotPNG, c(func, width=width*pixelratio,
+                                  height=height*pixelratio, res=res*pixelratio, args))
+    on.exit(unlink(outfile))
     
-    bytes <- file.info(png.file)$size
-    if (is.na(bytes))
-      return(NULL)
-    
-    pngData <- readBin(png.file, 'raw', n=bytes)
-    if (shinyapp$allowDataUriScheme) {
-      b64 <- base64encode(pngData)
-      return(paste("data:image/png;base64,", b64, sep=''))
-    }
-    else {
-      imageUrl <- shinyapp$savePlot(name, pngData, 'image/png')
-      return(imageUrl)
-    }
+    # Return a list of attributes for the img
+    return(list(
+      src=shinysession$fileUrl(name, outfile, contentType='image/png'),
+      width=width, height=height))
   })
 }
 
+#' Image file output
+#'
+#' Renders a reactive image that is suitable for assigning to an \code{output} 
+#' slot.
+#'
+#' The expression \code{expr} must return a list containing the attributes for
+#' the \code{img} object on the client web page. For the image to display,
+#' properly, the list must have at least one entry, \code{src}, which is the
+#' path to the image file. It may also useful to have a \code{contentType}
+#' entry specifying the MIME type of the image. If one is not provided,
+#' \code{renderImage} will try to autodetect the type, based on the file
+#' extension.
+#'
+#' Other elements such as \code{width}, \code{height}, \code{class}, and
+#' \code{alt}, can also be added to the list, and they will be used as
+#' attributes in the \code{img} object.
+#'
+#' The corresponding HTML output tag should be \code{div} or \code{img} and have
+#' the CSS class name \code{shiny-image-output}.
+#'
+#' @param expr An expression that returns a list.
+#' @param env The environment in which to evaluate \code{expr}.
+#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
+#'   is useful if you want to save an expression in a variable.
+#' @param deleteFile Should the file in \code{func()$src} be deleted after
+#'   it is sent to the client browser? Genrrally speaking, if the image is a
+#'   temp file generated within \code{func}, then this should be \code{TRUE};
+#'   if the image is not a temp file, this should be \code{FALSE}.
+#'
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#'
+#' shinyServer(function(input, output, clientData) {
+#'
+#'   # A plot of fixed size
+#'   output$plot1 <- renderImage({
+#'     # A temp file to save the output. It will be deleted after renderImage
+#'     # sends it, because deleteFile=TRUE.
+#'     outfile <- tempfile(fileext='.png')
+#'
+#'     # Generate a png
+#'     png(outfile, width=400, height=400)
+#'     hist(rnorm(input$n))
+#'     dev.off()
+#'
+#'     # Return a list
+#'     list(src = outfile,
+#'          alt = "This is alternate text")
+#'   }, deleteFile = TRUE)
+#'
+#'   # A dynamically-sized plot
+#'   output$plot2 <- renderImage({
+#'     # Read plot2's width and height. These are reactive values, so this
+#'     # expression will re-run whenever these values change.
+#'     width  <- clientData$output_plot2_width
+#'     height <- clientData$output_plot2_height
+#'
+#'     # A temp file to save the output.
+#'     outfile <- tempfile(fileext='.png')
+#'
+#'     png(outfile, width=width, height=height)
+#'     hist(rnorm(input$obs))
+#'     dev.off()
+#'
+#'     # Return a list containing the filename
+#'     list(src = outfile,
+#'          width = width,
+#'          height = height,
+#'          alt = "This is alternate text")
+#'   }, deleteFile = TRUE)
+#'
+#'   # Send a pre-rendered image, and don't delete the image after sending it
+#'   output$plot3 <- renderImage({
+#'     # When input$n is 1, filename is ./images/image1.jpeg
+#'     filename <- normalizePath(file.path('./images',
+#'                               paste('image', input$n, '.jpeg', sep='')))
+#'
+#'     # Return a list containing the filename
+#'     list(src = filename)
+#'   }, deleteFile = FALSE)
+#' })
+#'
+#' }
+renderImage <- function(expr, env=parent.frame(), quoted=FALSE,
+                        deleteFile=TRUE) {
+  func <- exprToFunction(expr, env, quoted)
+
+  return(function(shinysession, name, ...) {
+    imageinfo <- func()
+    # Should the file be deleted after being sent? If .deleteFile not set or if
+    # TRUE, then delete; otherwise don't delete.
+    if (deleteFile) {
+      on.exit(unlink(imageinfo$src))
+    }
+
+    # If contentType not specified, autodetect based on extension
+    if (is.null(imageinfo$contentType)) {
+      contentType <- getContentType(sub('^.*\\.', '', basename(imageinfo$src)))
+    } else {
+      contentType <- imageinfo$contentType
+    }
+
+    # Extra values are everything in imageinfo except 'src' and 'contentType'
+    extra_attr <- imageinfo[!names(imageinfo) %in% c('src', 'contentType')]
+
+    # Return a list with src, and other img attributes
+    c(src = shinysession$fileUrl(name, file=imageinfo$src, contentType=contentType),
+      extra_attr)
+  })
+}
+
+
 #' Table Output
 #' 
 #' Creates a reactive table that is suitable for assigning to an \code{output} 
@@ -142,7 +233,7 @@ renderTable <- function(expr, ..., env=parent.frame(), quoted=FALSE, func=NULL)
     classNames <- getOption('shiny.table.class', 'data table table-bordered table-condensed')
     data <- func()
 
-    if (is.null(data))
+    if (is.null(data) || identical(data, data.frame()))
       return("")
     
     return(paste(
@@ -329,8 +420,8 @@ renderUI <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
 #' 
 #' @export
 downloadHandler <- function(filename, content, contentType=NA) {
-  return(function(shinyapp, name, ...) {
-    shinyapp$registerDownload(name, filename, contentType, content)
+  return(function(shinysession, name, ...) {
+    shinysession$registerDownload(name, filename, contentType, content)
   })
 }
 

R/tags.R

@@ -231,117 +231,118 @@ tagWrite <- function(tag, textWriter, indent=0, context = NULL, eol = "\n") {
 
 # environment used to store all available tags
 #' @export
-tags <- new.env()
-tags$a <- function(...) tag("a", list(...))
-tags$abbr <- function(...) tag("abbr", list(...))
-tags$address <- function(...) tag("address", list(...))
-tags$area <- function(...) tag("area", list(...))
-tags$article <- function(...) tag("article", list(...))
-tags$aside <- function(...) tag("aside", list(...))
-tags$audio <- function(...) tag("audio", list(...))
-tags$b <- function(...) tag("b", list(...))
-tags$base <- function(...) tag("base", list(...))
-tags$bdi <- function(...) tag("bdi", list(...))
-tags$bdo <- function(...) tag("bdo", list(...))
-tags$blockquote <- function(...) tag("blockquote", list(...))
-tags$body <- function(...) tag("body", list(...))
-tags$br <- function(...) tag("br", list(...))
-tags$button <- function(...) tag("button", list(...))
-tags$canvas <- function(...) tag("canvas", list(...))
-tags$caption <- function(...) tag("caption", list(...))
-tags$cite <- function(...) tag("cite", list(...))
-tags$code <- function(...) tag("code", list(...))
-tags$col <- function(...) tag("col", list(...))
-tags$colgroup <- function(...) tag("colgroup", list(...))
-tags$command <- function(...) tag("command", list(...))
-tags$data <- function(...) tag("data", list(...))
-tags$datalist <- function(...) tag("datalist", list(...))
-tags$dd <- function(...) tag("dd", list(...))
-tags$del <- function(...) tag("del", list(...))
-tags$details <- function(...) tag("details", list(...))
-tags$dfn <- function(...) tag("dfn", list(...))
-tags$div <- function(...) tag("div", list(...))
-tags$dl <- function(...) tag("dl", list(...))
-tags$dt <- function(...) tag("dt", list(...))
-tags$em <- function(...) tag("em", list(...))
-tags$embed <- function(...) tag("embed", list(...))
-tags$eventsource <- function(...) tag("eventsource", list(...))
-tags$fieldset <- function(...) tag("fieldset", list(...))
-tags$figcaption <- function(...) tag("figcaption", list(...))
-tags$figure <- function(...) tag("figure", list(...))
-tags$footer <- function(...) tag("footer", list(...))
-tags$form <- function(...) tag("form", list(...))
-tags$h1 <- function(...) tag("h1", list(...))
-tags$h2 <- function(...) tag("h2", list(...))
-tags$h3 <- function(...) tag("h3", list(...))
-tags$h4 <- function(...) tag("h4", list(...))
-tags$h5 <- function(...) tag("h5", list(...))
-tags$h6 <- function(...) tag("h6", list(...))
-tags$head <- function(...) tag("head", list(...))
-tags$header <- function(...) tag("header", list(...))
-tags$hgroup <- function(...) tag("hgroup", list(...))
-tags$hr <- function(...) tag("hr", list(...))
-tags$html <- function(...) tag("html", list(...))
-tags$i <- function(...) tag("i", list(...))
-tags$iframe <- function(...) tag("iframe", list(...))
-tags$img <- function(...) tag("img", list(...))
-tags$input <- function(...) tag("input", list(...))
-tags$ins <- function(...) tag("ins", list(...))
-tags$kbd <- function(...) tag("kbd", list(...))
-tags$keygen <- function(...) tag("keygen", list(...))
-tags$label <- function(...) tag("label", list(...))
-tags$legend <- function(...) tag("legend", list(...))
-tags$li <- function(...) tag("li", list(...))
-tags$link <- function(...) tag("link", list(...))
-tags$mark <- function(...) tag("mark", list(...))
-tags$map <- function(...) tag("map", list(...))
-tags$menu <- function(...) tag("menu", list(...))
-tags$meta <- function(...) tag("meta", list(...))
-tags$meter <- function(...) tag("meter", list(...))
-tags$nav <- function(...) tag("nav", list(...))
-tags$noscript <- function(...) tag("noscript", list(...))
-tags$object <- function(...) tag("object", list(...))
-tags$ol <- function(...) tag("ol", list(...))
-tags$optgroup <- function(...) tag("optgroup", list(...))
-tags$option <- function(...) tag("option", list(...))
-tags$output <- function(...) tag("output", list(...))
-tags$p <- function(...) tag("p", list(...))
-tags$param <- function(...) tag("param", list(...))
-tags$pre <- function(...) tag("pre", list(...))
-tags$progress <- function(...) tag("progress", list(...))
-tags$q <- function(...) tag("q", list(...))
-tags$ruby <- function(...) tag("ruby", list(...))
-tags$rp <- function(...) tag("rp", list(...))
-tags$rt <- function(...) tag("rt", list(...))
-tags$s <- function(...) tag("s", list(...))
-tags$samp <- function(...) tag("samp", list(...))
-tags$script <- function(...) tag("script", list(...))
-tags$section <- function(...) tag("section", list(...))
-tags$select <- function(...) tag("select", list(...))
-tags$small <- function(...) tag("small", list(...))
-tags$source <- function(...) tag("source", list(...))
-tags$span <- function(...) tag("span", list(...))
-tags$strong <- function(...) tag("strong", list(...))
-tags$style <- function(...) tag("style", list(...))
-tags$sub <- function(...) tag("sub", list(...))
-tags$summary <- function(...) tag("summary", list(...))
-tags$sup <- function(...) tag("sup", list(...))
-tags$table <- function(...) tag("table", list(...))
-tags$tbody <- function(...) tag("tbody", list(...))
-tags$td <- function(...) tag("td", list(...))
-tags$textarea <- function(...) tag("textarea", list(...))
-tags$tfoot <- function(...) tag("tfoot", list(...))
-tags$th <- function(...) tag("th", list(...))
-tags$thead <- function(...) tag("thead", list(...))
-tags$time <- function(...) tag("time", list(...))
-tags$title <- function(...) tag("title", list(...))
-tags$tr <- function(...) tag("tr", list(...))
-tags$track <- function(...) tag("track", list(...))
-tags$u <- function(...) tag("u", list(...))
-tags$ul <- function(...) tag("ul", list(...))
-tags$var <- function(...) tag("var", list(...))
-tags$video <- function(...) tag("video", list(...))
-tags$wbr <- function(...) tag("wbr", list(...))
+tags <- list(
+  a = function(...) tag("a", list(...)),
+  abbr = function(...) tag("abbr", list(...)),
+  address = function(...) tag("address", list(...)),
+  area = function(...) tag("area", list(...)),
+  article = function(...) tag("article", list(...)),
+  aside = function(...) tag("aside", list(...)),
+  audio = function(...) tag("audio", list(...)),
+  b = function(...) tag("b", list(...)),
+  base = function(...) tag("base", list(...)),
+  bdi = function(...) tag("bdi", list(...)),
+  bdo = function(...) tag("bdo", list(...)),
+  blockquote = function(...) tag("blockquote", list(...)),
+  body = function(...) tag("body", list(...)),
+  br = function(...) tag("br", list(...)),
+  button = function(...) tag("button", list(...)),
+  canvas = function(...) tag("canvas", list(...)),
+  caption = function(...) tag("caption", list(...)),
+  cite = function(...) tag("cite", list(...)),
+  code = function(...) tag("code", list(...)),
+  col = function(...) tag("col", list(...)),
+  colgroup = function(...) tag("colgroup", list(...)),
+  command = function(...) tag("command", list(...)),
+  data = function(...) tag("data", list(...)),
+  datalist = function(...) tag("datalist", list(...)),
+  dd = function(...) tag("dd", list(...)),
+  del = function(...) tag("del", list(...)),
+  details = function(...) tag("details", list(...)),
+  dfn = function(...) tag("dfn", list(...)),
+  div = function(...) tag("div", list(...)),
+  dl = function(...) tag("dl", list(...)),
+  dt = function(...) tag("dt", list(...)),
+  em = function(...) tag("em", list(...)),
+  embed = function(...) tag("embed", list(...)),
+  eventsource = function(...) tag("eventsource", list(...)),
+  fieldset = function(...) tag("fieldset", list(...)),
+  figcaption = function(...) tag("figcaption", list(...)),
+  figure = function(...) tag("figure", list(...)),
+  footer = function(...) tag("footer", list(...)),
+  form = function(...) tag("form", list(...)),
+  h1 = function(...) tag("h1", list(...)),
+  h2 = function(...) tag("h2", list(...)),
+  h3 = function(...) tag("h3", list(...)),
+  h4 = function(...) tag("h4", list(...)),
+  h5 = function(...) tag("h5", list(...)),
+  h6 = function(...) tag("h6", list(...)),
+  head = function(...) tag("head", list(...)),
+  header = function(...) tag("header", list(...)),
+  hgroup = function(...) tag("hgroup", list(...)),
+  hr = function(...) tag("hr", list(...)),
+  html = function(...) tag("html", list(...)),
+  i = function(...) tag("i", list(...)),
+  iframe = function(...) tag("iframe", list(...)),
+  img = function(...) tag("img", list(...)),
+  input = function(...) tag("input", list(...)),
+  ins = function(...) tag("ins", list(...)),
+  kbd = function(...) tag("kbd", list(...)),
+  keygen = function(...) tag("keygen", list(...)),
+  label = function(...) tag("label", list(...)),
+  legend = function(...) tag("legend", list(...)),
+  li = function(...) tag("li", list(...)),
+  link = function(...) tag("link", list(...)),
+  mark = function(...) tag("mark", list(...)),
+  map = function(...) tag("map", list(...)),
+  menu = function(...) tag("menu", list(...)),
+  meta = function(...) tag("meta", list(...)),
+  meter = function(...) tag("meter", list(...)),
+  nav = function(...) tag("nav", list(...)),
+  noscript = function(...) tag("noscript", list(...)),
+  object = function(...) tag("object", list(...)),
+  ol = function(...) tag("ol", list(...)),
+  optgroup = function(...) tag("optgroup", list(...)),
+  option = function(...) tag("option", list(...)),
+  output = function(...) tag("output", list(...)),
+  p = function(...) tag("p", list(...)),
+  param = function(...) tag("param", list(...)),
+  pre = function(...) tag("pre", list(...)),
+  progress = function(...) tag("progress", list(...)),
+  q = function(...) tag("q", list(...)),
+  ruby = function(...) tag("ruby", list(...)),
+  rp = function(...) tag("rp", list(...)),
+  rt = function(...) tag("rt", list(...)),
+  s = function(...) tag("s", list(...)),
+  samp = function(...) tag("samp", list(...)),
+  script = function(...) tag("script", list(...)),
+  section = function(...) tag("section", list(...)),
+  select = function(...) tag("select", list(...)),
+  small = function(...) tag("small", list(...)),
+  source = function(...) tag("source", list(...)),
+  span = function(...) tag("span", list(...)),
+  strong = function(...) tag("strong", list(...)),
+  style = function(...) tag("style", list(...)),
+  sub = function(...) tag("sub", list(...)),
+  summary = function(...) tag("summary", list(...)),
+  sup = function(...) tag("sup", list(...)),
+  table = function(...) tag("table", list(...)),
+  tbody = function(...) tag("tbody", list(...)),
+  td = function(...) tag("td", list(...)),
+  textarea = function(...) tag("textarea", list(...)),
+  tfoot = function(...) tag("tfoot", list(...)),
+  th = function(...) tag("th", list(...)),
+  thead = function(...) tag("thead", list(...)),
+  time = function(...) tag("time", list(...)),
+  title = function(...) tag("title", list(...)),
+  tr = function(...) tag("tr", list(...)),
+  track = function(...) tag("track", list(...)),
+  u = function(...) tag("u", list(...)),
+  ul = function(...) tag("ul", list(...)),
+  var = function(...) tag("var", list(...)),
+  video = function(...) tag("video", list(...)),
+  wbr = function(...) tag("wbr", list(...))
+)
 
 #' Mark Characters as HTML
 #' 
@@ -365,4 +366,38 @@ HTML <- function(text, ...) {
   htmlText
 }
 
-
+#' Evaluate an expression using the \code{tags}
+#'
+#' This function makes it simpler to write HTML-generating code. Instead of
+#' needing to specify \code{tags} each time a tag function is used, as in
+#' \code{tags$div()} and \code{tags$p()}, code inside \code{withTags} is
+#' evaluated with \code{tags} searched first, so you can simply use
+#' \code{div()} and \code{p()}.
+#'
+#' If your code uses an object which happens to have the same name as an
+#' HTML tag function, such as \code{source()} or \code{summary()}, it will call
+#' the tag function. To call the intended (non-tags function), specify the
+#' namespace, as in \code{base::source()} or \code{base::summary()}.
+#'
+#' @param code A set of tags.
+#'
+#' @examples
+#' # Using tags$ each time
+#' tags$div(class = "myclass",
+#'   tags$h3("header"),
+#'   tags$p("text")
+#' )
+#'
+#' # Equivalent to above, but using withTags
+#' withTags(
+#'   div(class = "myclass",
+#'     h3("header"),
+#'     p("text")
+#'   )
+#' )
+#'
+#'
+#' @export
+withTags <- function(code) {
+  eval(substitute(code), envir = as.list(tags), enclos = parent.frame())
+}

R/update-input.R

@@ -0,0 +1,409 @@
+#' Change the value of a text input on the client
+#'
+#' @template update-input
+#' @param value The value to set for the input object.
+#'
+#' @seealso \code{\link{textInput}}
+#'
+#' @examples
+#' \dontrun{
+#' shinyServer(function(input, output, session) {
+#'
+#'   observe({
+#'     # We'll use the input$controller variable multiple times, so save it as x
+#'     # for convenience.
+#'     x <- input$controller
+#'
+#'     # This will change the value of input$inText, based on x
+#'     updateTextInput(session, "inText", value = paste("New text", x))
+#'
+#'     # Can also set the label, this time for input$inText2
+#'     updateTextInput(session, "inText2",
+#'       label = paste("New label", x),
+#'       value = paste("New text", x))
+#'   })
+#' })
+#' }
+#' @export
+updateTextInput <- function(session, inputId, label = NULL, value = NULL) {
+  message <- dropNulls(list(label=label, value=value))
+  session$sendInputMessage(inputId, message)
+}
+
+
+#' Change the value of a checkbox input on the client
+#'
+#' @template update-input
+#' @param value The value to set for the input object.
+#'
+#' @seealso \code{\link{checkboxInput}}
+#'
+#' @examples
+#' \dontrun{
+#' shinyServer(function(input, output, session) {
+#'
+#'   observe({
+#'     # TRUE if input$controller is even, FALSE otherwise.
+#'     x_even <- input$controller %% 2 == 0
+#'
+#'     updateCheckboxInput(session, "inCheckbox", value = x_even)
+#'   })
+#' })
+#' }
+#' @export
+updateCheckboxInput <- updateTextInput
+
+
+#' Change the value of a slider input on the client
+#'
+#' @template update-input
+#' @param value The value to set for the input object.
+#'
+#' @seealso \code{\link{sliderInput}}
+#'
+#' @examples
+#' \dontrun{
+#' shinyServer(function(input, output, session) {
+#'
+#'   observe({
+#'     # We'll use the input$controller variable multiple times, so save it as x
+#'     # for convenience.
+#'     x <- input$controller
+#'
+#'     # Similar to number and text. only label and value can be set for slider
+#'     updateSliderInput(session, "inSlider",
+#'       label = paste("Slider label", x),
+#'       value = x)
+#'
+#'     # For sliders that pick out a range, pass in a vector of 2 values.
+#'     updateSliderInput(session, "inSlider2", value = c(x-1, x+1))
+#'
+#'     # An NA means to not change that value (the low or high one)
+#'     updateSliderInput(session, "inSlider3", value = c(NA, x+2))
+#'   })
+#' })
+#' }
+#' @export
+updateSliderInput <- updateTextInput
+
+#' Change the value of a date input on the client
+#'
+#' @template update-input
+#' @param value The desired date value. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#' @param min The minimum allowed date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#' @param max The maximum allowed date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#'
+#' @seealso \code{\link{dateInput}}
+#'
+#' @examples
+#' \dontrun{
+#' shinyServer(function(input, output, session) {
+#'
+#'   observe({
+#'     # We'll use the input$controller variable multiple times, so save it as x
+#'     # for convenience.
+#'     x <- input$controller
+#'
+#'     updateDateInput(session, "inDate",
+#'       label = paste("Date label", x),
+#'       value = paste("2013-04-", x, sep=""),
+#'       min   = paste("2013-04-", x-1, sep=""),
+#'       max   = paste("2013-04-", x+1, sep="")
+#'     )
+#'   })
+#' })
+#' }
+#' @export
+updateDateInput <- function(session, inputId, label = NULL, value = NULL,
+    min = NULL, max = NULL) {
+
+  # If value is a date object, convert it to a string with yyyy-mm-dd format
+  # Same for min and max
+  if (inherits(value, "Date"))  value <- format(value, "%Y-%m-%d")
+  if (inherits(min, "Date"))    min   <- format(min,   "%Y-%m-%d")
+  if (inherits(max, "Date"))    max   <- format(max,   "%Y-%m-%d")
+
+  message <- dropNulls(list(label=label, value=value, min=min, max=max))
+  session$sendInputMessage(inputId, message)
+}
+
+
+#' Change the start and end values of a date range input on the client
+#'
+#' @template update-input
+#' @param start The start date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#' @param end The end date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#' @param min The minimum allowed date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#' @param max The maximum allowed date. Either a Date object, or a string in
+#'   \code{yyyy-mm-dd} format.
+#'
+#' @seealso \code{\link{dateRangeInput}}
+#'
+#' @examples
+#' \dontrun{
+#' shinyServer(function(input, output, session) {
+#'
+#'   observe({
+#'     # We'll use the input$controller variable multiple times, so save it as x
+#'     # for convenience.
+#'     x <- input$controller
+#'
+#'     updateDateRangeInput(session, "inDateRange",
+#'       label = paste("Date range label", x),
+#'       start = paste("2013-01-", x, sep=""))
+#'       end = paste("2013-12-", x, sep=""))
+#'   })
+#' })
+#' }
+#' @export
+updateDateRangeInput <- function(session, inputId, label = NULL,
+    start = NULL, end = NULL, min = NULL, max = NULL) {
+
+  # Make sure start and end are strings, not date objects. This is for
+  # consistency across different locales.
+  if (inherits(start, "Date"))  start <- format(start, '%Y-%m-%d')
+  if (inherits(end, "Date"))    end <- format(end, '%Y-%m-%d')
+  if (inherits(min, "Date"))    min <- format(min, '%Y-%m-%d')
+  if (inherits(max, "Date"))    max <- format(max, '%Y-%m-%d')
+
+  message <- dropNulls(list(
+    label = label,
+    value = c(start, end),
+    min = min,
+    max = max
+  ))
+
+  session$sendInputMessage(inputId, message)
+}
+
+#' Change the selected tab on the client
+#'
+#' @param session The \code{session} object passed to function given to
+#'   \code{shinyServer}.
+#' @param inputId The id of the tabset panel object.
+#' @param selected The name of the tab to make active.
+#'
+#' @seealso \code{\link{tabsetPanel}}
+#'
+#' @examples
+#' \dontrun{
+#' shinyServer(function(input, output, session) {
+#'
+#'   observe({
+#'     # TRUE if input$controller is even, FALSE otherwise.
+#'     x_even <- input$controller %% 2 == 0
+#'
+#'     # Change the selected tab.
+#'     # Note that the tabsetPanel must have been created with an 'id' argument
+#'     if (x_even) {
+#'       updateTabsetPanel(session, "inTabset", selected = "panel2")
+#'     } else {
+#'       updateTabsetPanel(session, "inTabset", selected = "panel1")
+#'     }
+#'   })
+#' })
+#' }
+#' @export
+updateTabsetPanel <- function(session, inputId, selected = NULL) {
+  message <- dropNulls(list(value = selected))
+  session$sendInputMessage(inputId, message)
+}
+
+
+#' Change the value of a number input on the client
+#'
+#' @template update-input
+#' @param value The value to set for the input object.
+#' @param min Minimum value.
+#' @param max Maximum value.
+#' @param step Step size.
+#'
+#' @seealso \code{\link{numericInput}}
+#'
+#' @examples
+#' \dontrun{
+#' shinyServer(function(input, output, session) {
+#'
+#'   observe({
+#'     # We'll use the input$controller variable multiple times, so save it as x
+#'     # for convenience.
+#'     x <- input$controller
+#'
+#'     updateNumericInput(session, "inNumber", value = x)
+#'
+#'     updateNumericInput(session, "inNumber2",
+#'       label = paste("Number label ", x),
+#'       value = x, min = x-10, max = x+10, step = 5)
+#'   })
+#' })
+#' }
+#' @export
+updateNumericInput <- function(session, inputId, label = NULL, value = NULL,
+    min = NULL, max = NULL, step = NULL) {
+
+  message <- dropNulls(list(label=label, value=value, min=min, max=max, step=step))
+  session$sendInputMessage(inputId, message)
+}
+
+
+#' Change the value of a checkbox group input on the client
+#'
+#' @template update-input
+#' @param choices A named vector or named list of options. For each item, the
+#'   name will be used as the label, and the value will be used as the value.
+#' @param selected A vector or list of options which will be selected.
+#'
+#' @seealso \code{\link{checkboxGroupInput}}
+#'
+#' @examples
+#' \dontrun{
+#' shinyServer(function(input, output, session) {
+#'
+#'   observe({
+#'     # We'll use the input$controller variable multiple times, so save it as x
+#'     # for convenience.
+#'     x <- input$controller
+#'
+#'     # Create a list of new options, where the name of the items is something
+#'     # like 'option label x 1', and the values are 'option-x-1'.
+#'     cb_options <- list()
+#'     cb_options[[sprintf("option label %d 1", x)]] <- sprintf("option-%d-1", x)
+#'     cb_options[[sprintf("option label %d 2", x)]] <- sprintf("option-%d-2", x)
+#'
+#'     # Change values for input$inCheckboxGroup
+#'     updateCheckboxGroupInput(session, "inCheckboxGroup", choices = cb_options)
+#'
+#'     # Can also set the label and select items
+#'     updateCheckboxGroupInput(session, "inCheckboxGroup2",
+#'       label = paste("checkboxgroup label", x),
+#'       choices = cb_options,
+#'       selected = sprintf("option label %d 2", x)
+#'     )
+#'   })
+#' })
+#' }
+#' @export
+updateCheckboxGroupInput <- function(session, inputId, label = NULL,
+  choices = NULL, selected = NULL) {
+
+  choices <- choicesWithNames(choices)
+  options <- list()
+
+  for (i in seq_along(choices)) {
+    choiceName <- names(choices)[i]
+
+    opt <- list(value = choices[[i]],
+                label = choiceName,
+                checked = choiceName %in% selected)
+
+    options[[i]] <- opt
+  }
+
+  message <- dropNulls(list(label = label, options = options))
+
+  session$sendInputMessage(inputId, message)
+}
+
+
+#' Change the value of a radio input on the client
+#'
+#' @template update-input
+#' @param choices A named vector or named list of options. For each item, the
+#'   name will be used as the label, and the value will be used as the value.
+#' @param selected A vector or list of options which will be selected.
+#'
+#' @seealso \code{\link{radioButtons}}
+#'
+#' @examples
+#' \dontrun{
+#' shinyServer(function(input, output, session) {
+#'
+#'   observe({
+#'     # We'll use the input$controller variable multiple times, so save it as x
+#'     # for convenience.
+#'     x <- input$controller
+#'
+#'     r_options <- list()
+#'     r_options[[sprintf("option label %d 1", x)]] <- sprintf("option-%d-1", x)
+#'     r_options[[sprintf("option label %d 2", x)]] <- sprintf("option-%d-2", x)
+#'
+#'     # Change values for input$inRadio
+#'     updateRadioButtons(session, "inRadio", choices = r_options)
+#'
+#'     # Can also set the label and select an item
+#'     updateRadioButtons(session, "inRadio2",
+#'       label = paste("Radio label", x),
+#'       choices = r_options,
+#'       selected = sprintf("option label %d 2", x)
+#'     )
+#'   })
+#' })
+#' }
+#' @export
+updateRadioButtons <- updateCheckboxGroupInput
+
+
+#' Change the value of a select input on the client
+#'
+#' @template update-input
+#' @param choices A named vector or named list of options. For each item, the
+#'   name will be used as the label, and the value will be used as the value.
+#' @param selected A vector or list of options which will be selected.
+#'
+#' @seealso \code{\link{selectInput}}
+#'
+#' @examples
+#' \dontrun{
+#' shinyServer(function(input, output, session) {
+#'
+#'   observe({
+#'     # We'll use the input$controller variable multiple times, so save it as x
+#'     # for convenience.
+#'     x <- input$controller
+#'
+#'     # Create a list of new options, where the name of the items is something
+#'     # like 'option label x 1', and the values are 'option-x-1'.
+#'     s_options <- list()
+#'     s_options[[sprintf("option label %d 1", x)]] <- sprintf("option-%d-1", x)
+#'     s_options[[sprintf("option label %d 2", x)]] <- sprintf("option-%d-2", x)
+#'
+#'     # Change values for input$inSelect
+#'     updateSelectInput(session, "inSelect", choices = s_options)
+#'
+#'     # Can also set the label and select an item (or more than one if it's a
+#'     # multi-select)
+#'     updateSelectInput(session, "inSelect2",
+#'       label = paste("Select label", x),
+#'       choices = s_options,
+#'       selected = sprintf("option label %d 2", x)
+#'     )
+#'   })
+#' })
+#' }
+#' @export
+updateSelectInput <- function(session, inputId, label = NULL, choices = NULL,
+    selected = NULL) {
+
+  choices <- choicesWithNames(choices)
+  options <- list()
+
+  for (i in seq_along(choices)) {
+    choiceName <- names(choices)[i]
+
+    opt <- list(value = choices[[i]],
+                label = choiceName,
+                selected = choiceName %in% selected)
+
+    options[[i]] <- opt
+  }
+
+  message <- dropNulls(list(label = label, options = options))
+
+  session$sendInputMessage(inputId, message)
+}

R/utils.R

@@ -55,6 +55,11 @@ repeatable <- function(rngfunc, seed = runif(1, 0, .Machine$integer.max)) {
   paste(x, y, sep='')
 }
 
+# Given a vector or list, drop all the NULL items in it
+dropNulls <- function(x) {
+  x[!vapply(x, is.null, FUN.VALUE=logical(1))]
+}
+
 knownContentTypes <- Map$new()
 knownContentTypes$mset(
   html='text/html; charset=UTF-8',
@@ -188,6 +193,62 @@ exprToFunction <- function(expr, env=parent.frame(2), quoted=FALSE) {
   }
 }
 
+#' Parse a GET query string from a URL
+#'
+#' Returns a named character vector of key-value pairs.
+#'
+#' @param str The query string. It can have a leading \code{"?"} or not.
+#' @export
+#' @examples
+#' parseQueryString("?foo=1&bar=b%20a%20r")
+#'
+#' \dontrun{
+#' # Example of usage within a Shiny app
+#' shinyServer(function(input, output, clientData) {
+#'
+#'   output$queryText <- renderText({
+#'     query <- parseQueryString(clientData$url_search)
+#'
+#'     # Ways of accessing the values
+#'     if (as.numeric(query$foo) == 1) {
+#'       # Do something
+#'     }
+#'     if (query[["bar"]] == "targetstring") {
+#'       # Do something else
+#'     }
+#'
+#'     # Return a string with key-value pairs
+#'     paste(names(query), query, sep = "=", collapse=", ")
+#'   })
+#' })
+#' }
+#'
+parseQueryString <- function(str) {
+  if (is.null(str) || nchar(str) == 0)
+    return(list())
+
+  # Remove leading ?
+  if (substr(str, 1, 1) == '?')
+    str <- substr(str, 2, nchar(str))
+
+  pairs <- strsplit(str, '&', fixed = TRUE)[[1]]
+  pairs <- strsplit(pairs, '=', fixed = TRUE)
+
+  keys   <- vapply(pairs, function(x) x[1], FUN.VALUE = character(1))
+  values <- vapply(pairs, function(x) x[2], FUN.VALUE = character(1))
+  # Replace NA with '', so they don't get converted to 'NA' by URLdecode
+  values[is.na(values)] <- ''
+
+  # Convert "+" to " ", since URLdecode doesn't do it
+  keys   <- gsub('+', ' ', keys,   fixed = TRUE)
+  values <- gsub('+', ' ', values, fixed = TRUE)
+
+  keys   <- vapply(keys,   function(x) URLdecode(x), FUN.VALUE = character(1))
+  values <- vapply(values, function(x) URLdecode(x), FUN.VALUE = character(1))
+
+  setNames(as.list(values), keys)
+}
+
 #' Print message for deprecated functions in Shiny
 #'
 #' To disable these messages, use \code{options(shiny.deprecation.messages=FALSE)}.
@@ -210,3 +271,40 @@ shinyDeprecated <- function(new=NULL, msg=NULL,
   # Similar to .Deprecated(), but print a message instead of warning
   message(msg)
 }
+
+Callbacks <- setRefClass(
+  'Callbacks',
+  fields = list(
+    .nextId = 'integer',
+    .callbacks = 'Map'
+  ),
+  methods = list(
+    initialize = function() {
+      .nextId <<- as.integer(.Machine$integer.max)
+    },
+    register = function(callback) {
+      id <- as.character(.nextId)
+      .nextId <<- .nextId - 1L
+      .callbacks$set(id, callback)
+      return(function() {
+        .callbacks$remove(id)
+      })
+    },
+    invoke = function(..., onError=NULL) {
+      for (callback in .callbacks$values()) {
+        tryCatch(
+          do.call(callback, list(...)),
+          error = function(e) {
+            if (is.null(onError))
+              stop(e)
+            else
+              onError(e)
+          }
+        )
+      }
+    },
+    count = function() {
+      .callbacks$size()
+    }
+  )
+)

inst/NOTICE

@@ -4,6 +4,7 @@ these components are included below):
 
 - jQuery
 - Bootstrap
+- bootstrap-datepicker, from https://github.com/eternicode/bootstrap-datepicker
 - jslider
 
 
@@ -33,7 +34,7 @@ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
 WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 
-Bootstrap License
+Bootstrap and bootstrap-datepicker License
 ----------------------------------------------------------------------   
 
                                  Apache License

inst/examples/09_upload/server.R

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

inst/examples/09_upload/ui.R

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

inst/examples/11_timer/server.R

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

inst/examples/11_timer/ui.R

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

inst/tests-js/SpecRunner.html

@@ -0,0 +1,95 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
+  "http://www.w3.org/TR/html4/loose.dtd">
+<html>
+<head>
+  <title>Jasmine Spec Runner</title>
+
+  <link rel="shortcut icon" type="image/png" href="lib/jasmine-1.3.1/jasmine_favicon.png">
+  <link rel="stylesheet" type="text/css" href="lib/jasmine-1.3.1/jasmine.css">
+  <script type="text/javascript" src="lib/jasmine-1.3.1/jasmine.js"></script>
+  <script type="text/javascript" src="lib/jasmine-1.3.1/jasmine-html.js"></script>
+
+  <!-- include source files here... -->
+
+  <!-- All of these includes are copied out of the HTML file generated by
+  shinyUI() -->
+  <script src="../www/shared/jquery.js" type="text/javascript"></script>
+  <script src="../www/shared/shiny.js" type="text/javascript"></script>
+  <link rel="stylesheet" type="text/css" href="../www/shared/shiny.css"/>
+  <link rel="stylesheet" type="text/css" href="../www/shared/slider/css/jquery.slider.min.css"/>
+  <script src="../www/shared/slider/js/jquery.slider.min.js"></script>
+  <link rel="stylesheet" type="text/css" href="../www/shared/bootstrap/css/bootstrap.min.css"/>
+  <script src="../www/shared/bootstrap/js/bootstrap.min.js"></script>
+  <!-- <meta name="viewport" content="width=device-width, initial-scale=1.0"/> -->
+  <link rel="stylesheet" type="text/css" href="../www/shared/bootstrap/css/bootstrap-responsive.min.css"/>
+
+  <script src="../www/shared/datepicker/js/bootstrap-datepicker.min.js"></script>
+  <link rel="stylesheet" type="text/css" href="../www/shared/datepicker/css/datepicker.css"/>
+
+  <script src="../www/shared/bootstrap-daterangepicker/date.js"></script>
+  <script src="../www/shared/bootstrap-daterangepicker/daterangepicker.js"></script>
+  <link rel="stylesheet" type="text/css" href="../www/shared/bootstrap-daterangepicker/daterangepicker.css"/>
+
+  <!-- include spec files here... -->
+ <!-- <script type="text/javascript" src="spec/SpecHelper.js"></script>
+  <script type="text/javascript" src="spec/PlayerSpec.js"></script>
+ -->
+  <script type="text/javascript" src="spec/inputBindingSpec.js"></script>
+
+  <script type="text/javascript">
+    (function() {
+      var jasmineEnv = jasmine.getEnv();
+      jasmineEnv.updateInterval = 1000;
+
+      var htmlReporter = new jasmine.HtmlReporter();
+
+      jasmineEnv.addReporter(htmlReporter);
+
+      jasmineEnv.specFilter = function(spec) {
+        return htmlReporter.specFilter(spec);
+      };
+
+      // var currentWindowOnload = window.onload;
+
+      // window.onload = function() {
+      //   if (currentWindowOnload) {
+      //     currentWindowOnload();
+      //   }
+      //   execJasmine();
+      // };
+
+      // Add a slight delay before running tests, so that Shiny has time to
+      // do setup stuff.
+      $(document).ready(function() {
+        setTimeout(function() {
+            execJasmine();
+          },
+          50
+        )
+      });
+
+
+      function execJasmine() {
+        jasmineEnv.execute();
+      }
+
+    })();
+
+
+    // Clear the Shiny disconnected gray screen shortly after loading
+    $(document).ready(function() {
+      setTimeout(function() {
+          $('body').removeClass('disconnected');
+        },
+        100
+      )
+    });
+
+  </script>
+
+</head>
+
+<body>
+
+</body>
+</html>

inst/tests-js/fixtures/textInputBinding.html

@@ -0,0 +1,2 @@
+<label>Text input:</label>
+<input id="in_text" type="text" value="starting value"/>

inst/tests-js/lib/jasmine-1.3.1/MIT.LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2008-2011 Pivotal Labs
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

inst/tests-js/lib/jasmine-1.3.1/jasmine-html.js

@@ -0,0 +1,681 @@
+jasmine.HtmlReporterHelpers = {};
+
+jasmine.HtmlReporterHelpers.createDom = function(type, attrs, childrenVarArgs) {
+  var el = document.createElement(type);
+
+  for (var i = 2; i < arguments.length; i++) {
+    var child = arguments[i];
+
+    if (typeof child === 'string') {
+      el.appendChild(document.createTextNode(child));
+    } else {
+      if (child) {
+        el.appendChild(child);
+      }
+    }
+  }
+
+  for (var attr in attrs) {
+    if (attr == "className") {
+      el[attr] = attrs[attr];
+    } else {
+      el.setAttribute(attr, attrs[attr]);
+    }
+  }
+
+  return el;
+};
+
+jasmine.HtmlReporterHelpers.getSpecStatus = function(child) {
+  var results = child.results();
+  var status = results.passed() ? 'passed' : 'failed';
+  if (results.skipped) {
+    status = 'skipped';
+  }
+
+  return status;
+};
+
+jasmine.HtmlReporterHelpers.appendToSummary = function(child, childElement) {
+  var parentDiv = this.dom.summary;
+  var parentSuite = (typeof child.parentSuite == 'undefined') ? 'suite' : 'parentSuite';
+  var parent = child[parentSuite];
+
+  if (parent) {
+    if (typeof this.views.suites[parent.id] == 'undefined') {
+      this.views.suites[parent.id] = new jasmine.HtmlReporter.SuiteView(parent, this.dom, this.views);
+    }
+    parentDiv = this.views.suites[parent.id].element;
+  }
+
+  parentDiv.appendChild(childElement);
+};
+
+
+jasmine.HtmlReporterHelpers.addHelpers = function(ctor) {
+  for(var fn in jasmine.HtmlReporterHelpers) {
+    ctor.prototype[fn] = jasmine.HtmlReporterHelpers[fn];
+  }
+};
+
+jasmine.HtmlReporter = function(_doc) {
+  var self = this;
+  var doc = _doc || window.document;
+
+  var reporterView;
+
+  var dom = {};
+
+  // Jasmine Reporter Public Interface
+  self.logRunningSpecs = false;
+
+  self.reportRunnerStarting = function(runner) {
+    var specs = runner.specs() || [];
+
+    if (specs.length == 0) {
+      return;
+    }
+
+    createReporterDom(runner.env.versionString());
+    doc.body.appendChild(dom.reporter);
+    setExceptionHandling();
+
+    reporterView = new jasmine.HtmlReporter.ReporterView(dom);
+    reporterView.addSpecs(specs, self.specFilter);
+  };
+
+  self.reportRunnerResults = function(runner) {
+    reporterView && reporterView.complete();
+  };
+
+  self.reportSuiteResults = function(suite) {
+    reporterView.suiteComplete(suite);
+  };
+
+  self.reportSpecStarting = function(spec) {
+    if (self.logRunningSpecs) {
+      self.log('>> Jasmine Running ' + spec.suite.description + ' ' + spec.description + '...');
+    }
+  };
+
+  self.reportSpecResults = function(spec) {
+    reporterView.specComplete(spec);
+  };
+
+  self.log = function() {
+    var console = jasmine.getGlobal().console;
+    if (console && console.log) {
+      if (console.log.apply) {
+        console.log.apply(console, arguments);
+      } else {
+        console.log(arguments); // ie fix: console.log.apply doesn't exist on ie
+      }
+    }
+  };
+
+  self.specFilter = function(spec) {
+    if (!focusedSpecName()) {
+      return true;
+    }
+
+    return spec.getFullName().indexOf(focusedSpecName()) === 0;
+  };
+
+  return self;
+
+  function focusedSpecName() {
+    var specName;
+
+    (function memoizeFocusedSpec() {
+      if (specName) {
+        return;
+      }
+
+      var paramMap = [];
+      var params = jasmine.HtmlReporter.parameters(doc);
+
+      for (var i = 0; i < params.length; i++) {
+        var p = params[i].split('=');
+        paramMap[decodeURIComponent(p[0])] = decodeURIComponent(p[1]);
+      }
+
+      specName = paramMap.spec;
+    })();
+
+    return specName;
+  }
+
+  function createReporterDom(version) {
+    dom.reporter = self.createDom('div', { id: 'HTMLReporter', className: 'jasmine_reporter' },
+      dom.banner = self.createDom('div', { className: 'banner' },
+        self.createDom('span', { className: 'title' }, "Jasmine "),
+        self.createDom('span', { className: 'version' }, version)),
+
+      dom.symbolSummary = self.createDom('ul', {className: 'symbolSummary'}),
+      dom.alert = self.createDom('div', {className: 'alert'},
+        self.createDom('span', { className: 'exceptions' },
+          self.createDom('label', { className: 'label', 'for': 'no_try_catch' }, 'No try/catch'),
+          self.createDom('input', { id: 'no_try_catch', type: 'checkbox' }))),
+      dom.results = self.createDom('div', {className: 'results'},
+        dom.summary = self.createDom('div', { className: 'summary' }),
+        dom.details = self.createDom('div', { id: 'details' }))
+    );
+  }
+
+  function noTryCatch() {
+    return window.location.search.match(/catch=false/);
+  }
+
+  function searchWithCatch() {
+    var params = jasmine.HtmlReporter.parameters(window.document);
+    var removed = false;
+    var i = 0;
+
+    while (!removed && i < params.length) {
+      if (params[i].match(/catch=/)) {
+        params.splice(i, 1);
+        removed = true;
+      }
+      i++;
+    }
+    if (jasmine.CATCH_EXCEPTIONS) {
+      params.push("catch=false");
+    }
+
+    return params.join("&");
+  }
+
+  function setExceptionHandling() {
+    var chxCatch = document.getElementById('no_try_catch');
+
+    if (noTryCatch()) {
+      chxCatch.setAttribute('checked', true);
+      jasmine.CATCH_EXCEPTIONS = false;
+    }
+    chxCatch.onclick = function() {
+      window.location.search = searchWithCatch();
+    };
+  }
+};
+jasmine.HtmlReporter.parameters = function(doc) {
+  var paramStr = doc.location.search.substring(1);
+  var params = [];
+
+  if (paramStr.length > 0) {
+    params = paramStr.split('&');
+  }
+  return params;
+}
+jasmine.HtmlReporter.sectionLink = function(sectionName) {
+  var link = '?';
+  var params = [];
+
+  if (sectionName) {
+    params.push('spec=' + encodeURIComponent(sectionName));
+  }
+  if (!jasmine.CATCH_EXCEPTIONS) {
+    params.push("catch=false");
+  }
+  if (params.length > 0) {
+    link += params.join("&");
+  }
+
+  return link;
+};
+jasmine.HtmlReporterHelpers.addHelpers(jasmine.HtmlReporter);
+jasmine.HtmlReporter.ReporterView = function(dom) {
+  this.startedAt = new Date();
+  this.runningSpecCount = 0;
+  this.completeSpecCount = 0;
+  this.passedCount = 0;
+  this.failedCount = 0;
+  this.skippedCount = 0;
+
+  this.createResultsMenu = function() {
+    this.resultsMenu = this.createDom('span', {className: 'resultsMenu bar'},
+      this.summaryMenuItem = this.createDom('a', {className: 'summaryMenuItem', href: "#"}, '0 specs'),
+      ' | ',
+      this.detailsMenuItem = this.createDom('a', {className: 'detailsMenuItem', href: "#"}, '0 failing'));
+
+    this.summaryMenuItem.onclick = function() {
+      dom.reporter.className = dom.reporter.className.replace(/ showDetails/g, '');
+    };
+
+    this.detailsMenuItem.onclick = function() {
+      showDetails();
+    };
+  };
+
+  this.addSpecs = function(specs, specFilter) {
+    this.totalSpecCount = specs.length;
+
+    this.views = {
+      specs: {},
+      suites: {}
+    };
+
+    for (var i = 0; i < specs.length; i++) {
+      var spec = specs[i];
+      this.views.specs[spec.id] = new jasmine.HtmlReporter.SpecView(spec, dom, this.views);
+      if (specFilter(spec)) {
+        this.runningSpecCount++;
+      }
+    }
+  };
+
+  this.specComplete = function(spec) {
+    this.completeSpecCount++;
+
+    if (isUndefined(this.views.specs[spec.id])) {
+      this.views.specs[spec.id] = new jasmine.HtmlReporter.SpecView(spec, dom);
+    }
+
+    var specView = this.views.specs[spec.id];
+
+    switch (specView.status()) {
+      case 'passed':
+        this.passedCount++;
+        break;
+
+      case 'failed':
+        this.failedCount++;
+        break;
+
+      case 'skipped':
+        this.skippedCount++;
+        break;
+    }
+
+    specView.refresh();
+    this.refresh();
+  };
+
+  this.suiteComplete = function(suite) {
+    var suiteView = this.views.suites[suite.id];
+    if (isUndefined(suiteView)) {
+      return;
+    }
+    suiteView.refresh();
+  };
+
+  this.refresh = function() {
+
+    if (isUndefined(this.resultsMenu)) {
+      this.createResultsMenu();
+    }
+
+    // currently running UI
+    if (isUndefined(this.runningAlert)) {
+      this.runningAlert = this.createDom('a', { href: jasmine.HtmlReporter.sectionLink(), className: "runningAlert bar" });
+      dom.alert.appendChild(this.runningAlert);
+    }
+    this.runningAlert.innerHTML = "Running " + this.completeSpecCount + " of " + specPluralizedFor(this.totalSpecCount);
+
+    // skipped specs UI
+    if (isUndefined(this.skippedAlert)) {
+      this.skippedAlert = this.createDom('a', { href: jasmine.HtmlReporter.sectionLink(), className: "skippedAlert bar" });
+    }
+
+    this.skippedAlert.innerHTML = "Skipping " + this.skippedCount + " of " + specPluralizedFor(this.totalSpecCount) + " - run all";
+
+    if (this.skippedCount === 1 && isDefined(dom.alert)) {
+      dom.alert.appendChild(this.skippedAlert);
+    }
+
+    // passing specs UI
+    if (isUndefined(this.passedAlert)) {
+      this.passedAlert = this.createDom('span', { href: jasmine.HtmlReporter.sectionLink(), className: "passingAlert bar" });
+    }
+    this.passedAlert.innerHTML = "Passing " + specPluralizedFor(this.passedCount);
+
+    // failing specs UI
+    if (isUndefined(this.failedAlert)) {
+      this.failedAlert = this.createDom('span', {href: "?", className: "failingAlert bar"});
+    }
+    this.failedAlert.innerHTML = "Failing " + specPluralizedFor(this.failedCount);
+
+    if (this.failedCount === 1 && isDefined(dom.alert)) {
+      dom.alert.appendChild(this.failedAlert);
+      dom.alert.appendChild(this.resultsMenu);
+    }
+
+    // summary info
+    this.summaryMenuItem.innerHTML = "" + specPluralizedFor(this.runningSpecCount);
+    this.detailsMenuItem.innerHTML = "" + this.failedCount + " failing";
+  };
+
+  this.complete = function() {
+    dom.alert.removeChild(this.runningAlert);
+
+    this.skippedAlert.innerHTML = "Ran " + this.runningSpecCount + " of " + specPluralizedFor(this.totalSpecCount) + " - run all";
+
+    if (this.failedCount === 0) {
+      dom.alert.appendChild(this.createDom('span', {className: 'passingAlert bar'}, "Passing " + specPluralizedFor(this.passedCount)));
+    } else {
+      showDetails();
+    }
+
+    dom.banner.appendChild(this.createDom('span', {className: 'duration'}, "finished in " + ((new Date().getTime() - this.startedAt.getTime()) / 1000) + "s"));
+  };
+
+  return this;
+
+  function showDetails() {
+    if (dom.reporter.className.search(/showDetails/) === -1) {
+      dom.reporter.className += " showDetails";
+    }
+  }
+
+  function isUndefined(obj) {
+    return typeof obj === 'undefined';
+  }
+
+  function isDefined(obj) {
+    return !isUndefined(obj);
+  }
+
+  function specPluralizedFor(count) {
+    var str = count + " spec";
+    if (count > 1) {
+      str += "s"
+    }
+    return str;
+  }
+
+};
+
+jasmine.HtmlReporterHelpers.addHelpers(jasmine.HtmlReporter.ReporterView);
+
+
+jasmine.HtmlReporter.SpecView = function(spec, dom, views) {
+  this.spec = spec;
+  this.dom = dom;
+  this.views = views;
+
+  this.symbol = this.createDom('li', { className: 'pending' });
+  this.dom.symbolSummary.appendChild(this.symbol);
+
+  this.summary = this.createDom('div', { className: 'specSummary' },
+    this.createDom('a', {
+      className: 'description',
+      href: jasmine.HtmlReporter.sectionLink(this.spec.getFullName()),
+      title: this.spec.getFullName()
+    }, this.spec.description)
+  );
+
+  this.detail = this.createDom('div', { className: 'specDetail' },
+      this.createDom('a', {
+        className: 'description',
+        href: '?spec=' + encodeURIComponent(this.spec.getFullName()),
+        title: this.spec.getFullName()
+      }, this.spec.getFullName())
+  );
+};
+
+jasmine.HtmlReporter.SpecView.prototype.status = function() {
+  return this.getSpecStatus(this.spec);
+};
+
+jasmine.HtmlReporter.SpecView.prototype.refresh = function() {
+  this.symbol.className = this.status();
+
+  switch (this.status()) {
+    case 'skipped':
+      break;
+
+    case 'passed':
+      this.appendSummaryToSuiteDiv();
+      break;
+
+    case 'failed':
+      this.appendSummaryToSuiteDiv();
+      this.appendFailureDetail();
+      break;
+  }
+};
+
+jasmine.HtmlReporter.SpecView.prototype.appendSummaryToSuiteDiv = function() {
+  this.summary.className += ' ' + this.status();
+  this.appendToSummary(this.spec, this.summary);
+};
+
+jasmine.HtmlReporter.SpecView.prototype.appendFailureDetail = function() {
+  this.detail.className += ' ' + this.status();
+
+  var resultItems = this.spec.results().getItems();
+  var messagesDiv = this.createDom('div', { className: 'messages' });
+
+  for (var i = 0; i < resultItems.length; i++) {
+    var result = resultItems[i];
+
+    if (result.type == 'log') {
+      messagesDiv.appendChild(this.createDom('div', {className: 'resultMessage log'}, result.toString()));
+    } else if (result.type == 'expect' && result.passed && !result.passed()) {
+      messagesDiv.appendChild(this.createDom('div', {className: 'resultMessage fail'}, result.message));
+
+      if (result.trace.stack) {
+        messagesDiv.appendChild(this.createDom('div', {className: 'stackTrace'}, result.trace.stack));
+      }
+    }
+  }
+
+  if (messagesDiv.childNodes.length > 0) {
+    this.detail.appendChild(messagesDiv);
+    this.dom.details.appendChild(this.detail);
+  }
+};
+
+jasmine.HtmlReporterHelpers.addHelpers(jasmine.HtmlReporter.SpecView);jasmine.HtmlReporter.SuiteView = function(suite, dom, views) {
+  this.suite = suite;
+  this.dom = dom;
+  this.views = views;
+
+  this.element = this.createDom('div', { className: 'suite' },
+    this.createDom('a', { className: 'description', href: jasmine.HtmlReporter.sectionLink(this.suite.getFullName()) }, this.suite.description)
+  );
+
+  this.appendToSummary(this.suite, this.element);
+};
+
+jasmine.HtmlReporter.SuiteView.prototype.status = function() {
+  return this.getSpecStatus(this.suite);
+};
+
+jasmine.HtmlReporter.SuiteView.prototype.refresh = function() {
+  this.element.className += " " + this.status();
+};
+
+jasmine.HtmlReporterHelpers.addHelpers(jasmine.HtmlReporter.SuiteView);
+
+/* @deprecated Use jasmine.HtmlReporter instead
+ */
+jasmine.TrivialReporter = function(doc) {
+  this.document = doc || document;
+  this.suiteDivs = {};
+  this.logRunningSpecs = false;
+};
+
+jasmine.TrivialReporter.prototype.createDom = function(type, attrs, childrenVarArgs) {
+  var el = document.createElement(type);
+
+  for (var i = 2; i < arguments.length; i++) {
+    var child = arguments[i];
+
+    if (typeof child === 'string') {
+      el.appendChild(document.createTextNode(child));
+    } else {
+      if (child) { el.appendChild(child); }
+    }
+  }
+
+  for (var attr in attrs) {
+    if (attr == "className") {
+      el[attr] = attrs[attr];
+    } else {
+      el.setAttribute(attr, attrs[attr]);
+    }
+  }
+
+  return el;
+};
+
+jasmine.TrivialReporter.prototype.reportRunnerStarting = function(runner) {
+  var showPassed, showSkipped;
+
+  this.outerDiv = this.createDom('div', { id: 'TrivialReporter', className: 'jasmine_reporter' },
+      this.createDom('div', { className: 'banner' },
+        this.createDom('div', { className: 'logo' },
+            this.createDom('span', { className: 'title' }, "Jasmine"),
+            this.createDom('span', { className: 'version' }, runner.env.versionString())),
+        this.createDom('div', { className: 'options' },
+            "Show ",
+            showPassed = this.createDom('input', { id: "__jasmine_TrivialReporter_showPassed__", type: 'checkbox' }),
+            this.createDom('label', { "for": "__jasmine_TrivialReporter_showPassed__" }, " passed "),
+            showSkipped = this.createDom('input', { id: "__jasmine_TrivialReporter_showSkipped__", type: 'checkbox' }),
+            this.createDom('label', { "for": "__jasmine_TrivialReporter_showSkipped__" }, " skipped")
+            )
+          ),
+
+      this.runnerDiv = this.createDom('div', { className: 'runner running' },
+          this.createDom('a', { className: 'run_spec', href: '?' }, "run all"),
+          this.runnerMessageSpan = this.createDom('span', {}, "Running..."),
+          this.finishedAtSpan = this.createDom('span', { className: 'finished-at' }, ""))
+      );
+
+  this.document.body.appendChild(this.outerDiv);
+
+  var suites = runner.suites();
+  for (var i = 0; i < suites.length; i++) {
+    var suite = suites[i];
+    var suiteDiv = this.createDom('div', { className: 'suite' },
+        this.createDom('a', { className: 'run_spec', href: '?spec=' + encodeURIComponent(suite.getFullName()) }, "run"),
+        this.createDom('a', { className: 'description', href: '?spec=' + encodeURIComponent(suite.getFullName()) }, suite.description));
+    this.suiteDivs[suite.id] = suiteDiv;
+    var parentDiv = this.outerDiv;
+    if (suite.parentSuite) {
+      parentDiv = this.suiteDivs[suite.parentSuite.id];
+    }
+    parentDiv.appendChild(suiteDiv);
+  }
+
+  this.startedAt = new Date();
+
+  var self = this;
+  showPassed.onclick = function(evt) {
+    if (showPassed.checked) {
+      self.outerDiv.className += ' show-passed';
+    } else {
+      self.outerDiv.className = self.outerDiv.className.replace(/ show-passed/, '');
+    }
+  };
+
+  showSkipped.onclick = function(evt) {
+    if (showSkipped.checked) {
+      self.outerDiv.className += ' show-skipped';
+    } else {
+      self.outerDiv.className = self.outerDiv.className.replace(/ show-skipped/, '');
+    }
+  };
+};
+
+jasmine.TrivialReporter.prototype.reportRunnerResults = function(runner) {
+  var results = runner.results();
+  var className = (results.failedCount > 0) ? "runner failed" : "runner passed";
+  this.runnerDiv.setAttribute("class", className);
+  //do it twice for IE
+  this.runnerDiv.setAttribute("className", className);
+  var specs = runner.specs();
+  var specCount = 0;
+  for (var i = 0; i < specs.length; i++) {
+    if (this.specFilter(specs[i])) {
+      specCount++;
+    }
+  }
+  var message = "" + specCount + " spec" + (specCount == 1 ? "" : "s" ) + ", " + results.failedCount + " failure" + ((results.failedCount == 1) ? "" : "s");
+  message += " in " + ((new Date().getTime() - this.startedAt.getTime()) / 1000) + "s";
+  this.runnerMessageSpan.replaceChild(this.createDom('a', { className: 'description', href: '?'}, message), this.runnerMessageSpan.firstChild);
+
+  this.finishedAtSpan.appendChild(document.createTextNode("Finished at " + new Date().toString()));
+};
+
+jasmine.TrivialReporter.prototype.reportSuiteResults = function(suite) {
+  var results = suite.results();
+  var status = results.passed() ? 'passed' : 'failed';
+  if (results.totalCount === 0) { // todo: change this to check results.skipped
+    status = 'skipped';
+  }
+  this.suiteDivs[suite.id].className += " " + status;
+};
+
+jasmine.TrivialReporter.prototype.reportSpecStarting = function(spec) {
+  if (this.logRunningSpecs) {
+    this.log('>> Jasmine Running ' + spec.suite.description + ' ' + spec.description + '...');
+  }
+};
+
+jasmine.TrivialReporter.prototype.reportSpecResults = function(spec) {
+  var results = spec.results();
+  var status = results.passed() ? 'passed' : 'failed';
+  if (results.skipped) {
+    status = 'skipped';
+  }
+  var specDiv = this.createDom('div', { className: 'spec '  + status },
+      this.createDom('a', { className: 'run_spec', href: '?spec=' + encodeURIComponent(spec.getFullName()) }, "run"),
+      this.createDom('a', {
+        className: 'description',
+        href: '?spec=' + encodeURIComponent(spec.getFullName()),
+        title: spec.getFullName()
+      }, spec.description));
+
+
+  var resultItems = results.getItems();
+  var messagesDiv = this.createDom('div', { className: 'messages' });
+  for (var i = 0; i < resultItems.length; i++) {
+    var result = resultItems[i];
+
+    if (result.type == 'log') {
+      messagesDiv.appendChild(this.createDom('div', {className: 'resultMessage log'}, result.toString()));
+    } else if (result.type == 'expect' && result.passed && !result.passed()) {
+      messagesDiv.appendChild(this.createDom('div', {className: 'resultMessage fail'}, result.message));
+
+      if (result.trace.stack) {
+        messagesDiv.appendChild(this.createDom('div', {className: 'stackTrace'}, result.trace.stack));
+      }
+    }
+  }
+
+  if (messagesDiv.childNodes.length > 0) {
+    specDiv.appendChild(messagesDiv);
+  }
+
+  this.suiteDivs[spec.suite.id].appendChild(specDiv);
+};
+
+jasmine.TrivialReporter.prototype.log = function() {
+  var console = jasmine.getGlobal().console;
+  if (console && console.log) {
+    if (console.log.apply) {
+      console.log.apply(console, arguments);
+    } else {
+      console.log(arguments); // ie fix: console.log.apply doesn't exist on ie
+    }
+  }
+};
+
+jasmine.TrivialReporter.prototype.getLocation = function() {
+  return this.document.location;
+};
+
+jasmine.TrivialReporter.prototype.specFilter = function(spec) {
+  var paramMap = {};
+  var params = this.getLocation().search.substring(1).split('&');
+  for (var i = 0; i < params.length; i++) {
+    var p = params[i].split('=');
+    paramMap[decodeURIComponent(p[0])] = decodeURIComponent(p[1]);
+  }
+
+  if (!paramMap.spec) {
+    return true;
+  }
+  return spec.getFullName().indexOf(paramMap.spec) === 0;
+};

inst/tests-js/lib/jasmine-1.3.1/jasmine.css

@@ -0,0 +1,82 @@
+body { background-color: #eeeeee; padding: 0; margin: 5px; overflow-y: scroll; }
+
+#HTMLReporter { font-size: 11px; font-family: Monaco, "Lucida Console", monospace; line-height: 14px; color: #333333; }
+#HTMLReporter a { text-decoration: none; }
+#HTMLReporter a:hover { text-decoration: underline; }
+#HTMLReporter p, #HTMLReporter h1, #HTMLReporter h2, #HTMLReporter h3, #HTMLReporter h4, #HTMLReporter h5, #HTMLReporter h6 { margin: 0; line-height: 14px; }
+#HTMLReporter .banner, #HTMLReporter .symbolSummary, #HTMLReporter .summary, #HTMLReporter .resultMessage, #HTMLReporter .specDetail .description, #HTMLReporter .alert .bar, #HTMLReporter .stackTrace { padding-left: 9px; padding-right: 9px; }
+#HTMLReporter #jasmine_content { position: fixed; right: 100%; }
+#HTMLReporter .version { color: #aaaaaa; }
+#HTMLReporter .banner { margin-top: 14px; }
+#HTMLReporter .duration { color: #aaaaaa; float: right; }
+#HTMLReporter .symbolSummary { overflow: hidden; *zoom: 1; margin: 14px 0; }
+#HTMLReporter .symbolSummary li { display: block; float: left; height: 7px; width: 14px; margin-bottom: 7px; font-size: 16px; }
+#HTMLReporter .symbolSummary li.passed { font-size: 14px; }
+#HTMLReporter .symbolSummary li.passed:before { color: #5e7d00; content: "\02022"; }
+#HTMLReporter .symbolSummary li.failed { line-height: 9px; }
+#HTMLReporter .symbolSummary li.failed:before { color: #b03911; content: "x"; font-weight: bold; margin-left: -1px; }
+#HTMLReporter .symbolSummary li.skipped { font-size: 14px; }
+#HTMLReporter .symbolSummary li.skipped:before { color: #bababa; content: "\02022"; }
+#HTMLReporter .symbolSummary li.pending { line-height: 11px; }
+#HTMLReporter .symbolSummary li.pending:before { color: #aaaaaa; content: "-"; }
+#HTMLReporter .exceptions { color: #fff; float: right; margin-top: 5px; margin-right: 5px; }
+#HTMLReporter .bar { line-height: 28px; font-size: 14px; display: block; color: #eee; }
+#HTMLReporter .runningAlert { background-color: #666666; }
+#HTMLReporter .skippedAlert { background-color: #aaaaaa; }
+#HTMLReporter .skippedAlert:first-child { background-color: #333333; }
+#HTMLReporter .skippedAlert:hover { text-decoration: none; color: white; text-decoration: underline; }
+#HTMLReporter .passingAlert { background-color: #a6b779; }
+#HTMLReporter .passingAlert:first-child { background-color: #5e7d00; }
+#HTMLReporter .failingAlert { background-color: #cf867e; }
+#HTMLReporter .failingAlert:first-child { background-color: #b03911; }
+#HTMLReporter .results { margin-top: 14px; }
+#HTMLReporter #details { display: none; }
+#HTMLReporter .resultsMenu, #HTMLReporter .resultsMenu a { background-color: #fff; color: #333333; }
+#HTMLReporter.showDetails .summaryMenuItem { font-weight: normal; text-decoration: inherit; }
+#HTMLReporter.showDetails .summaryMenuItem:hover { text-decoration: underline; }
+#HTMLReporter.showDetails .detailsMenuItem { font-weight: bold; text-decoration: underline; }
+#HTMLReporter.showDetails .summary { display: none; }
+#HTMLReporter.showDetails #details { display: block; }
+#HTMLReporter .summaryMenuItem { font-weight: bold; text-decoration: underline; }
+#HTMLReporter .summary { margin-top: 14px; }
+#HTMLReporter .summary .suite .suite, #HTMLReporter .summary .specSummary { margin-left: 14px; }
+#HTMLReporter .summary .specSummary.passed a { color: #5e7d00; }
+#HTMLReporter .summary .specSummary.failed a { color: #b03911; }
+#HTMLReporter .description + .suite { margin-top: 0; }
+#HTMLReporter .suite { margin-top: 14px; }
+#HTMLReporter .suite a { color: #333333; }
+#HTMLReporter #details .specDetail { margin-bottom: 28px; }
+#HTMLReporter #details .specDetail .description { display: block; color: white; background-color: #b03911; }
+#HTMLReporter .resultMessage { padding-top: 14px; color: #333333; }
+#HTMLReporter .resultMessage span.result { display: block; }
+#HTMLReporter .stackTrace { margin: 5px 0 0 0; max-height: 224px; overflow: auto; line-height: 18px; color: #666666; border: 1px solid #ddd; background: white; white-space: pre; }
+
+#TrivialReporter { padding: 8px 13px; position: absolute; top: 0; bottom: 0; left: 0; right: 0; overflow-y: scroll; background-color: white; font-family: "Helvetica Neue Light", "Lucida Grande", "Calibri", "Arial", sans-serif; /*.resultMessage {*/ /*white-space: pre;*/ /*}*/ }
+#TrivialReporter a:visited, #TrivialReporter a { color: #303; }
+#TrivialReporter a:hover, #TrivialReporter a:active { color: blue; }
+#TrivialReporter .run_spec { float: right; padding-right: 5px; font-size: .8em; text-decoration: none; }
+#TrivialReporter .banner { color: #303; background-color: #fef; padding: 5px; }
+#TrivialReporter .logo { float: left; font-size: 1.1em; padding-left: 5px; }
+#TrivialReporter .logo .version { font-size: .6em; padding-left: 1em; }
+#TrivialReporter .runner.running { background-color: yellow; }
+#TrivialReporter .options { text-align: right; font-size: .8em; }
+#TrivialReporter .suite { border: 1px outset gray; margin: 5px 0; padding-left: 1em; }
+#TrivialReporter .suite .suite { margin: 5px; }
+#TrivialReporter .suite.passed { background-color: #dfd; }
+#TrivialReporter .suite.failed { background-color: #fdd; }
+#TrivialReporter .spec { margin: 5px; padding-left: 1em; clear: both; }
+#TrivialReporter .spec.failed, #TrivialReporter .spec.passed, #TrivialReporter .spec.skipped { padding-bottom: 5px; border: 1px solid gray; }
+#TrivialReporter .spec.failed { background-color: #fbb; border-color: red; }
+#TrivialReporter .spec.passed { background-color: #bfb; border-color: green; }
+#TrivialReporter .spec.skipped { background-color: #bbb; }
+#TrivialReporter .messages { border-left: 1px dashed gray; padding-left: 1em; padding-right: 1em; }
+#TrivialReporter .passed { background-color: #cfc; display: none; }
+#TrivialReporter .failed { background-color: #fbb; }
+#TrivialReporter .skipped { color: #777; background-color: #eee; display: none; }
+#TrivialReporter .resultMessage span.result { display: block; line-height: 2em; color: black; }
+#TrivialReporter .resultMessage .mismatch { color: black; }
+#TrivialReporter .stackTrace { white-space: pre; font-size: .8em; margin-left: 10px; max-height: 5em; overflow: auto; border: 1px inset red; padding: 1em; background: #eef; }
+#TrivialReporter .finished-at { padding-left: 1em; font-size: .6em; }
+#TrivialReporter.show-passed .passed, #TrivialReporter.show-skipped .skipped { display: block; }
+#TrivialReporter #jasmine_content { position: fixed; right: 100%; }
+#TrivialReporter .runner { border: 1px solid gray; display: block; margin: 5px 0; padding: 2px 0 2px 10px; }

inst/tests/test-bootstrap.r

@@ -15,3 +15,46 @@ test_that("CSS unit validation", {
   # Numbers should return string with "px"
   expect_equal(validateCssUnit(100), "100px")
 })
+
+
+test_that("Repeated names for selectInput and radioButtons choices", {
+  # These test might be a bit too closely tied to the exact structure of the
+  # tag object, but they get the job done for now.
+
+  # Select input
+  x <- selectInput('id','label', choices = c(a='x1', a='x2', b='x3'))
+  choices <- x[[2]]$children
+
+  expect_equal(choices[[1]]$children[[1]], 'a')
+  expect_equal(choices[[1]]$attribs$value, 'x1')
+  expect_equal(choices[[1]]$attribs$selected, 'selected')
+
+  expect_equal(choices[[2]]$children[[1]], 'a')
+  expect_equal(choices[[2]]$attribs$value, 'x2')
+  # This one actually should be NULL, but with the syntax of selectInput, it
+  # must be 'selected'.
+  expect_equal(choices[[2]]$attribs$selected, 'selected')
+
+  expect_equal(choices[[3]]$children[[1]], 'b')
+  expect_equal(choices[[3]]$attribs$value, 'x3')
+  expect_equal(choices[[3]]$attribs$selected, NULL)
+
+
+  # Radio buttons
+  x <- radioButtons('id','label', choices = c(a='x1', a='x2', b='x3'))
+  choices <- x$children
+
+  expect_equal(choices[[2]]$children[[2]]$children[[1]], 'a')
+  expect_equal(choices[[2]]$children[[1]]$attribs$value, 'x1')
+  expect_equal(choices[[2]]$children[[1]]$attribs$checked, 'checked')
+
+  expect_equal(choices[[3]]$children[[2]]$children[[1]], 'a')
+  expect_equal(choices[[3]]$children[[1]]$attribs$value, 'x2')
+  # This one actually should be NULL, but with the syntax of radioButtons, it
+  # must be 'checked'.
+  expect_equal(choices[[3]]$children[[1]]$attribs$checked, 'checked')
+
+  expect_equal(choices[[4]]$children[[2]]$children[[1]], 'b')
+  expect_equal(choices[[4]]$children[[1]]$attribs$value, 'x3')
+  expect_equal(choices[[4]]$children[[1]]$attribs$checked, NULL)
+})

inst/tests/test-reactivity.r

@@ -650,3 +650,16 @@ test_that("observe() accepts quoted and unquoted expressions", {
   flushReact()
   expect_identical(parent.env(inside_env), this_env)
 })
+
+test_that("Observer priorities are respected", {
+  results <- c()
+  observe(results <<- c(results, 10), priority=10)
+  observe(results <<- c(results, 30), priority=30)
+  observe(results <<- c(results, 20), priority=20L)
+  observe(results <<- c(results, 21), priority=20)
+  observe(results <<- c(results, 22), priority=20L)
+  
+  flushReact()
+  
+  expect_identical(results, c(30, 20, 21, 22, 10))
+})

inst/tests/test-tags.r

@@ -21,3 +21,30 @@ test_that("Basic tag writing works", {
     as.character(tagList(tags$br(), "one")),
     HTML("<br/>\none"))
 })
+
+
+test_that("withTags works", {
+  output_tags <- tags$div(class = "myclass",
+    tags$h3("header"),
+    tags$p("text here")
+  )
+  output_withhtml <- withTags(
+    div(class = "myclass",
+      h3("header"),
+      p("text here")
+    )
+  )
+  expect_identical(output_tags, output_withhtml)
+
+
+  # Check that current environment is searched
+  x <- 100
+  expect_identical(tags$p(x), withTags(p(x)))
+
+  # Just to make sure, run it in a function, which has its own environment
+  foo <- function() {
+    y <- 100
+    withTags(p(y))
+  }
+  expect_identical(tags$p(100), foo())
+})

inst/tests/test-url.R

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

inst/www/shared/datepicker/css/datepicker.css

@@ -0,0 +1,442 @@
+/*!
+ * Datepicker for Bootstrap
+ *
+ * Copyright 2012 Stefan Petre
+ * Improvements by Andrew Rowls
+ * Licensed under the Apache License v2.0
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ */
+.datepicker {
+  padding: 4px;
+  -webkit-border-radius: 4px;
+  -moz-border-radius: 4px;
+  border-radius: 4px;
+  direction: ltr;
+  /*.dow {
+		border-top: 1px solid #ddd !important;
+	}*/
+
+}
+.datepicker-inline {
+  width: 220px;
+}
+.datepicker.datepicker-rtl {
+  direction: rtl;
+}
+.datepicker.datepicker-rtl table tr td span {
+  float: right;
+}
+.datepicker-dropdown {
+  top: 0;
+  left: 0;
+}
+.datepicker-dropdown:before {
+  content: '';
+  display: inline-block;
+  border-left: 7px solid transparent;
+  border-right: 7px solid transparent;
+  border-bottom: 7px solid #ccc;
+  border-bottom-color: rgba(0, 0, 0, 0.2);
+  position: absolute;
+  top: -7px;
+  left: 6px;
+}
+.datepicker-dropdown:after {
+  content: '';
+  display: inline-block;
+  border-left: 6px solid transparent;
+  border-right: 6px solid transparent;
+  border-bottom: 6px solid #ffffff;
+  position: absolute;
+  top: -6px;
+  left: 7px;
+}
+.datepicker > div {
+  display: none;
+}
+.datepicker.days div.datepicker-days {
+  display: block;
+}
+.datepicker.months div.datepicker-months {
+  display: block;
+}
+.datepicker.years div.datepicker-years {
+  display: block;
+}
+.datepicker table {
+  margin: 0;
+}
+.datepicker td,
+.datepicker th {
+  text-align: center;
+  width: 20px;
+  height: 20px;
+  -webkit-border-radius: 4px;
+  -moz-border-radius: 4px;
+  border-radius: 4px;
+  border: none;
+}
+.table-striped .datepicker table tr td,
+.table-striped .datepicker table tr th {
+  background-color: transparent;
+}
+.datepicker table tr td.day:hover {
+  background: #eeeeee;
+  cursor: pointer;
+}
+.datepicker table tr td.old,
+.datepicker table tr td.new {
+  color: #999999;
+}
+.datepicker table tr td.disabled,
+.datepicker table tr td.disabled:hover {
+  background: none;
+  color: #999999;
+  cursor: default;
+}
+.datepicker table tr td.today,
+.datepicker table tr td.today:hover,
+.datepicker table tr td.today.disabled,
+.datepicker table tr td.today.disabled:hover {
+  background-color: #fde19a;
+  background-image: -moz-linear-gradient(top, #fdd49a, #fdf59a);
+  background-image: -ms-linear-gradient(top, #fdd49a, #fdf59a);
+  background-image: -webkit-gradient(linear, 0 0, 0 100%, from(#fdd49a), to(#fdf59a));
+  background-image: -webkit-linear-gradient(top, #fdd49a, #fdf59a);
+  background-image: -o-linear-gradient(top, #fdd49a, #fdf59a);
+  background-image: linear-gradient(top, #fdd49a, #fdf59a);
+  background-repeat: repeat-x;
+  filter: progid:DXImageTransform.Microsoft.gradient(startColorstr='#fdd49a', endColorstr='#fdf59a', GradientType=0);
+  border-color: #fdf59a #fdf59a #fbed50;
+  border-color: rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);
+  filter: progid:DXImageTransform.Microsoft.gradient(enabled=false);
+  color: #000 !important;
+}
+.datepicker table tr td.today:hover,
+.datepicker table tr td.today:hover:hover,
+.datepicker table tr td.today.disabled:hover,
+.datepicker table tr td.today.disabled:hover:hover,
+.datepicker table tr td.today:active,
+.datepicker table tr td.today:hover:active,
+.datepicker table tr td.today.disabled:active,
+.datepicker table tr td.today.disabled:hover:active,
+.datepicker table tr td.today.active,
+.datepicker table tr td.today:hover.active,
+.datepicker table tr td.today.disabled.active,
+.datepicker table tr td.today.disabled:hover.active,
+.datepicker table tr td.today.disabled,
+.datepicker table tr td.today:hover.disabled,
+.datepicker table tr td.today.disabled.disabled,
+.datepicker table tr td.today.disabled:hover.disabled,
+.datepicker table tr td.today[disabled],
+.datepicker table tr td.today:hover[disabled],
+.datepicker table tr td.today.disabled[disabled],
+.datepicker table tr td.today.disabled:hover[disabled] {
+  background-color: #fdf59a;
+}
+.datepicker table tr td.today:active,
+.datepicker table tr td.today:hover:active,
+.datepicker table tr td.today.disabled:active,
+.datepicker table tr td.today.disabled:hover:active,
+.datepicker table tr td.today.active,
+.datepicker table tr td.today:hover.active,
+.datepicker table tr td.today.disabled.active,
+.datepicker table tr td.today.disabled:hover.active {
+  background-color: #fbf069 \9;
+}
+.datepicker table tr td.range,
+.datepicker table tr td.range:hover,
+.datepicker table tr td.range.disabled,
+.datepicker table tr td.range.disabled:hover {
+  background: #eeeeee;
+  -webkit-border-radius: 0;
+  -moz-border-radius: 0;
+  border-radius: 0;
+}
+.datepicker table tr td.range.today,
+.datepicker table tr td.range.today:hover,
+.datepicker table tr td.range.today.disabled,
+.datepicker table tr td.range.today.disabled:hover {
+  background-color: #f3d17a;
+  background-image: -moz-linear-gradient(top, #f3c17a, #f3e97a);
+  background-image: -ms-linear-gradient(top, #f3c17a, #f3e97a);
+  background-image: -webkit-gradient(linear, 0 0, 0 100%, from(#f3c17a), to(#f3e97a));
+  background-image: -webkit-linear-gradient(top, #f3c17a, #f3e97a);
+  background-image: -o-linear-gradient(top, #f3c17a, #f3e97a);
+  background-image: linear-gradient(top, #f3c17a, #f3e97a);
+  background-repeat: repeat-x;
+  filter: progid:DXImageTransform.Microsoft.gradient(startColorstr='#f3c17a', endColorstr='#f3e97a', GradientType=0);
+  border-color: #f3e97a #f3e97a #edde34;
+  border-color: rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);
+  filter: progid:DXImageTransform.Microsoft.gradient(enabled=false);
+  -webkit-border-radius: 0;
+  -moz-border-radius: 0;
+  border-radius: 0;
+}
+.datepicker table tr td.range.today:hover,
+.datepicker table tr td.range.today:hover:hover,
+.datepicker table tr td.range.today.disabled:hover,
+.datepicker table tr td.range.today.disabled:hover:hover,
+.datepicker table tr td.range.today:active,
+.datepicker table tr td.range.today:hover:active,
+.datepicker table tr td.range.today.disabled:active,
+.datepicker table tr td.range.today.disabled:hover:active,
+.datepicker table tr td.range.today.active,
+.datepicker table tr td.range.today:hover.active,
+.datepicker table tr td.range.today.disabled.active,
+.datepicker table tr td.range.today.disabled:hover.active,
+.datepicker table tr td.range.today.disabled,
+.datepicker table tr td.range.today:hover.disabled,
+.datepicker table tr td.range.today.disabled.disabled,
+.datepicker table tr td.range.today.disabled:hover.disabled,
+.datepicker table tr td.range.today[disabled],
+.datepicker table tr td.range.today:hover[disabled],
+.datepicker table tr td.range.today.disabled[disabled],
+.datepicker table tr td.range.today.disabled:hover[disabled] {
+  background-color: #f3e97a;
+}
+.datepicker table tr td.range.today:active,
+.datepicker table tr td.range.today:hover:active,
+.datepicker table tr td.range.today.disabled:active,
+.datepicker table tr td.range.today.disabled:hover:active,
+.datepicker table tr td.range.today.active,
+.datepicker table tr td.range.today:hover.active,
+.datepicker table tr td.range.today.disabled.active,
+.datepicker table tr td.range.today.disabled:hover.active {
+  background-color: #efe24b \9;
+}
+.datepicker table tr td.selected,
+.datepicker table tr td.selected:hover,
+.datepicker table tr td.selected.disabled,
+.datepicker table tr td.selected.disabled:hover {
+  background-color: #9e9e9e;
+  background-image: -moz-linear-gradient(top, #b3b3b3, #808080);
+  background-image: -ms-linear-gradient(top, #b3b3b3, #808080);
+  background-image: -webkit-gradient(linear, 0 0, 0 100%, from(#b3b3b3), to(#808080));
+  background-image: -webkit-linear-gradient(top, #b3b3b3, #808080);
+  background-image: -o-linear-gradient(top, #b3b3b3, #808080);
+  background-image: linear-gradient(top, #b3b3b3, #808080);
+  background-repeat: repeat-x;
+  filter: progid:DXImageTransform.Microsoft.gradient(startColorstr='#b3b3b3', endColorstr='#808080', GradientType=0);
+  border-color: #808080 #808080 #595959;
+  border-color: rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);
+  filter: progid:DXImageTransform.Microsoft.gradient(enabled=false);
+  color: #fff;
+  text-shadow: 0 -1px 0 rgba(0, 0, 0, 0.25);
+}
+.datepicker table tr td.selected:hover,
+.datepicker table tr td.selected:hover:hover,
+.datepicker table tr td.selected.disabled:hover,
+.datepicker table tr td.selected.disabled:hover:hover,
+.datepicker table tr td.selected:active,
+.datepicker table tr td.selected:hover:active,
+.datepicker table tr td.selected.disabled:active,
+.datepicker table tr td.selected.disabled:hover:active,
+.datepicker table tr td.selected.active,
+.datepicker table tr td.selected:hover.active,
+.datepicker table tr td.selected.disabled.active,
+.datepicker table tr td.selected.disabled:hover.active,
+.datepicker table tr td.selected.disabled,
+.datepicker table tr td.selected:hover.disabled,
+.datepicker table tr td.selected.disabled.disabled,
+.datepicker table tr td.selected.disabled:hover.disabled,
+.datepicker table tr td.selected[disabled],
+.datepicker table tr td.selected:hover[disabled],
+.datepicker table tr td.selected.disabled[disabled],
+.datepicker table tr td.selected.disabled:hover[disabled] {
+  background-color: #808080;
+}
+.datepicker table tr td.selected:active,
+.datepicker table tr td.selected:hover:active,
+.datepicker table tr td.selected.disabled:active,
+.datepicker table tr td.selected.disabled:hover:active,
+.datepicker table tr td.selected.active,
+.datepicker table tr td.selected:hover.active,
+.datepicker table tr td.selected.disabled.active,
+.datepicker table tr td.selected.disabled:hover.active {
+  background-color: #666666 \9;
+}
+.datepicker table tr td.active,
+.datepicker table tr td.active:hover,
+.datepicker table tr td.active.disabled,
+.datepicker table tr td.active.disabled:hover {
+  background-color: #006dcc;
+  background-image: -moz-linear-gradient(top, #0088cc, #0044cc);
+  background-image: -ms-linear-gradient(top, #0088cc, #0044cc);
+  background-image: -webkit-gradient(linear, 0 0, 0 100%, from(#0088cc), to(#0044cc));
+  background-image: -webkit-linear-gradient(top, #0088cc, #0044cc);
+  background-image: -o-linear-gradient(top, #0088cc, #0044cc);
+  background-image: linear-gradient(top, #0088cc, #0044cc);
+  background-repeat: repeat-x;
+  filter: progid:DXImageTransform.Microsoft.gradient(startColorstr='#0088cc', endColorstr='#0044cc', GradientType=0);
+  border-color: #0044cc #0044cc #002a80;
+  border-color: rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);
+  filter: progid:DXImageTransform.Microsoft.gradient(enabled=false);
+  color: #fff;
+  text-shadow: 0 -1px 0 rgba(0, 0, 0, 0.25);
+}
+.datepicker table tr td.active:hover,
+.datepicker table tr td.active:hover:hover,
+.datepicker table tr td.active.disabled:hover,
+.datepicker table tr td.active.disabled:hover:hover,
+.datepicker table tr td.active:active,
+.datepicker table tr td.active:hover:active,
+.datepicker table tr td.active.disabled:active,
+.datepicker table tr td.active.disabled:hover:active,
+.datepicker table tr td.active.active,
+.datepicker table tr td.active:hover.active,
+.datepicker table tr td.active.disabled.active,
+.datepicker table tr td.active.disabled:hover.active,
+.datepicker table tr td.active.disabled,
+.datepicker table tr td.active:hover.disabled,
+.datepicker table tr td.active.disabled.disabled,
+.datepicker table tr td.active.disabled:hover.disabled,
+.datepicker table tr td.active[disabled],
+.datepicker table tr td.active:hover[disabled],
+.datepicker table tr td.active.disabled[disabled],
+.datepicker table tr td.active.disabled:hover[disabled] {
+  background-color: #0044cc;
+}
+.datepicker table tr td.active:active,
+.datepicker table tr td.active:hover:active,
+.datepicker table tr td.active.disabled:active,
+.datepicker table tr td.active.disabled:hover:active,
+.datepicker table tr td.active.active,
+.datepicker table tr td.active:hover.active,
+.datepicker table tr td.active.disabled.active,
+.datepicker table tr td.active.disabled:hover.active {
+  background-color: #003399 \9;
+}
+.datepicker table tr td span {
+  display: block;
+  width: 23%;
+  height: 54px;
+  line-height: 54px;
+  float: left;
+  margin: 1%;
+  cursor: pointer;
+  -webkit-border-radius: 4px;
+  -moz-border-radius: 4px;
+  border-radius: 4px;
+}
+.datepicker table tr td span:hover {
+  background: #eeeeee;
+}
+.datepicker table tr td span.disabled,
+.datepicker table tr td span.disabled:hover {
+  background: none;
+  color: #999999;
+  cursor: default;
+}
+.datepicker table tr td span.active,
+.datepicker table tr td span.active:hover,
+.datepicker table tr td span.active.disabled,
+.datepicker table tr td span.active.disabled:hover {
+  background-color: #006dcc;
+  background-image: -moz-linear-gradient(top, #0088cc, #0044cc);
+  background-image: -ms-linear-gradient(top, #0088cc, #0044cc);
+  background-image: -webkit-gradient(linear, 0 0, 0 100%, from(#0088cc), to(#0044cc));
+  background-image: -webkit-linear-gradient(top, #0088cc, #0044cc);
+  background-image: -o-linear-gradient(top, #0088cc, #0044cc);
+  background-image: linear-gradient(top, #0088cc, #0044cc);
+  background-repeat: repeat-x;
+  filter: progid:DXImageTransform.Microsoft.gradient(startColorstr='#0088cc', endColorstr='#0044cc', GradientType=0);
+  border-color: #0044cc #0044cc #002a80;
+  border-color: rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.1) rgba(0, 0, 0, 0.25);
+  filter: progid:DXImageTransform.Microsoft.gradient(enabled=false);
+  color: #fff;
+  text-shadow: 0 -1px 0 rgba(0, 0, 0, 0.25);
+}
+.datepicker table tr td span.active:hover,
+.datepicker table tr td span.active:hover:hover,
+.datepicker table tr td span.active.disabled:hover,
+.datepicker table tr td span.active.disabled:hover:hover,
+.datepicker table tr td span.active:active,
+.datepicker table tr td span.active:hover:active,
+.datepicker table tr td span.active.disabled:active,
+.datepicker table tr td span.active.disabled:hover:active,
+.datepicker table tr td span.active.active,
+.datepicker table tr td span.active:hover.active,
+.datepicker table tr td span.active.disabled.active,
+.datepicker table tr td span.active.disabled:hover.active,
+.datepicker table tr td span.active.disabled,
+.datepicker table tr td span.active:hover.disabled,
+.datepicker table tr td span.active.disabled.disabled,
+.datepicker table tr td span.active.disabled:hover.disabled,
+.datepicker table tr td span.active[disabled],
+.datepicker table tr td span.active:hover[disabled],
+.datepicker table tr td span.active.disabled[disabled],
+.datepicker table tr td span.active.disabled:hover[disabled] {
+  background-color: #0044cc;
+}
+.datepicker table tr td span.active:active,
+.datepicker table tr td span.active:hover:active,
+.datepicker table tr td span.active.disabled:active,
+.datepicker table tr td span.active.disabled:hover:active,
+.datepicker table tr td span.active.active,
+.datepicker table tr td span.active:hover.active,
+.datepicker table tr td span.active.disabled.active,
+.datepicker table tr td span.active.disabled:hover.active {
+  background-color: #003399 \9;
+}
+.datepicker table tr td span.old {
+  color: #999999;
+}
+.datepicker th.datepicker-switch {
+  width: 145px;
+}
+.datepicker thead tr:first-child th,
+.datepicker tfoot tr:first-child th {
+  cursor: pointer;
+}
+.datepicker thead tr:first-child th:hover,
+.datepicker tfoot tr:first-child th:hover {
+  background: #eeeeee;
+}
+.datepicker .cw {
+  font-size: 10px;
+  width: 12px;
+  padding: 0 2px 0 5px;
+  vertical-align: middle;
+}
+.datepicker thead tr:first-child th.cw {
+  cursor: default;
+  background-color: transparent;
+}
+.input-append.date .add-on i,
+.input-prepend.date .add-on i {
+  display: block;
+  cursor: pointer;
+  width: 16px;
+  height: 16px;
+}
+.input-daterange input {
+  text-align: center;
+}
+.input-daterange input:first-child {
+  -webkit-border-radius: 3px 0 0 3px;
+  -moz-border-radius: 3px 0 0 3px;
+  border-radius: 3px 0 0 3px;
+}
+.input-daterange input:last-child {
+  -webkit-border-radius: 0 3px 3px 0;
+  -moz-border-radius: 0 3px 3px 0;
+  border-radius: 0 3px 3px 0;
+}
+.input-daterange .add-on {
+  display: inline-block;
+  width: auto;
+  min-width: 16px;
+  height: 18px;
+  padding: 4px 5px;
+  font-weight: normal;
+  line-height: 18px;
+  text-align: center;
+  text-shadow: 0 1px 0 #ffffff;
+  vertical-align: middle;
+  background-color: #eeeeee;
+  border: 1px solid #ccc;
+  margin-left: -5px;
+  margin-right: -5px;
+}

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.bg.js

@@ -0,0 +1,14 @@
+/**
+ * Bulgarian translation for bootstrap-datepicker
+ * Apostol Apostolov <apostol.s.apostolov@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['bg'] = {
+		days: ["Неделя", "Понеделник", "Вторник", "Сряда", "Четвъртък", "Петък", "Събота", "Неделя"],
+		daysShort: ["Нед", "Пон", "Вто", "Сря", "Чет", "Пет", "Съб", "Нед"],
+		daysMin: ["Н", "П", "В", "С", "Ч", "П", "С", "Н"],
+		months: ["Януари", "Февруари", "Март", "Април", "Май", "Юни", "Юли", "Август", "Септември", "Октомври", "Ноември", "Декември"],
+		monthsShort: ["Ян", "Фев", "Мар", "Апр", "Май", "Юни", "Юли", "Авг", "Сеп", "Окт", "Ное", "Дек"],
+		today: "днес"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.ca.js

@@ -0,0 +1,14 @@
+/**
+ * Catalan translation for bootstrap-datepicker
+ * J. Garcia <jogaco.en@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['ca'] = {
+		days: ["Diumenge", "Dilluns", "Dimarts", "Dimecres", "Dijous", "Divendres", "Dissabte", "Diumenge"],
+		daysShort: ["Diu",  "Dil", "Dmt", "Dmc", "Dij", "Div", "Dis", "Diu"],
+		daysMin: ["dg", "dl", "dt", "dc", "dj", "dv", "ds", "dg"],
+		months: ["Gener", "Febrer", "Març", "Abril", "Maig", "Juny", "Juliol", "Agost", "Setembre", "Octubre", "Novembre", "Desembre"],
+		monthsShort: ["Gen", "Feb", "Mar", "Abr", "Mai", "Jun", "Jul", "Ago", "Set", "Oct", "Nov", "Des"],
+		today: "Avui"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.cs.js

@@ -0,0 +1,15 @@
+/**
+ * Czech translation for bootstrap-datepicker
+ * Matěj Koubík <matej@koubik.name>
+ * Fixes by Michal Remiš <michal.remis@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['cs'] = {
+		days: ["Neděle", "Pondělí", "Úterý", "Středa", "Čtvrtek", "Pátek", "Sobota", "Neděle"],
+		daysShort: ["Ned", "Pon", "Úte", "Stř", "Čtv", "Pát", "Sob", "Ned"],
+		daysMin: ["Ne", "Po", "Út", "St", "Čt", "Pá", "So", "Ne"],
+		months: ["Leden", "Únor", "Březen", "Duben", "Květen", "Červen", "Červenec", "Srpen", "Září", "Říjen", "Listopad", "Prosinec"],
+		monthsShort: ["Led", "Úno", "Bře", "Dub", "Kvě", "Čer", "Čnc", "Srp", "Zář", "Říj", "Lis", "Pro"],
+		today: "Dnes"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.da.js

@@ -0,0 +1,14 @@
+/**
+ * Danish translation for bootstrap-datepicker
+ * Christian Pedersen <http://github.com/chripede>
+ */
+;(function($){
+	$.fn.datepicker.dates['da'] = {
+		days: ["Søndag", "Mandag", "Tirsdag", "Onsdag", "Torsdag", "Fredag", "Lørdag", "Søndag"],
+		daysShort: ["Søn", "Man", "Tir", "Ons", "Tor", "Fre", "Lør", "Søn"],
+		daysMin: ["Sø", "Ma", "Ti", "On", "To", "Fr", "Lø", "Sø"],
+		months: ["Januar", "Februar", "Marts", "April", "Maj", "Juni", "Juli", "August", "September", "Oktober", "November", "December"],
+		monthsShort: ["Jan", "Feb", "Mar", "Apr", "Maj", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dec"],
+		today: "I Dag"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.de.js

@@ -0,0 +1,16 @@
+/**
+ * German translation for bootstrap-datepicker
+ * Sam Zurcher <sam@orelias.ch>
+ */
+;(function($){
+	$.fn.datepicker.dates['de'] = {
+		days: ["Sonntag", "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag", "Sonntag"],
+		daysShort: ["Son", "Mon", "Die", "Mit", "Don", "Fre", "Sam", "Son"],
+		daysMin: ["So", "Mo", "Di", "Mi", "Do", "Fr", "Sa", "So"],
+		months: ["Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember"],
+		monthsShort: ["Jan", "Feb", "Mär", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dez"],
+		today: "Heute",
+		weekStart: 1,
+		format: "dd.mm.yyyy"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.el.js

@@ -0,0 +1,13 @@
+/**
+* Greek translation for bootstrap-datepicker
+*/
+;(function($){
+  $.fn.datepicker.dates['el'] = {
+    days: ["Κυριακή", "Δευτέρα", "Τρίτη", "Τετάρτη", "Πέμπτη", "Παρασκευή", "Σάββατο", "Κυριακή"],
+    daysShort: ["Κυρ", "Δευ", "Τρι", "Τετ", "Πεμ", "Παρ", "Σαβ", "Κυρ"],
+    daysMin: ["Κυ", "Δε", "Τρ", "Τε", "Πε", "Πα", "Σα", "Κυ"],
+    months: ["Ιανουάριος", "Φεβρουάριος", "Μάρτιος", "Απρίλιος", "Μάιος", "Ιούνιος", "Ιούλιος", "Αύγουστος", "Σεπτέμβριος", "Οκτώβριος", "Νοέμβριος", "Δεκέμβριος"],
+    monthsShort: ["Ιαν", "Φεβ", "Μαρ", "Απρ", "Μάι", "Ιουν", "Ιουλ", "Αυγ", "Σεπ", "Οκτ", "Νοε", "Δεκ"],
+    today: "Σήμερα"
+  };
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.es.js

@@ -0,0 +1,14 @@
+/**
+ * Spanish translation for bootstrap-datepicker
+ * Bruno Bonamin <bruno.bonamin@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['es'] = {
+		days: ["Domingo", "Lunes", "Martes", "Miércoles", "Jueves", "Viernes", "Sábado", "Domingo"],
+		daysShort: ["Dom", "Lun", "Mar", "Mié", "Jue", "Vie", "Sáb", "Dom"],
+		daysMin: ["Do", "Lu", "Ma", "Mi", "Ju", "Vi", "Sa", "Do"],
+		months: ["Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio", "Julio", "Agosto", "Septiembre", "Octubre", "Noviembre", "Diciembre"],
+		monthsShort: ["Ene", "Feb", "Mar", "Abr", "May", "Jun", "Jul", "Ago", "Sep", "Oct", "Nov", "Dic"],
+		today: "Hoy"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.fi.js

@@ -0,0 +1,14 @@
+/**
+ * Finnish translation for bootstrap-datepicker
+ * Jaakko Salonen <https://github.com/jsalonen>
+ */
+;(function($){
+	$.fn.datepicker.dates['fi'] = {
+		days: ["sunnuntai", "maanantai", "tiistai", "keskiviikko", "torstai", "perjantai", "lauantai", "sunnuntai"],
+		daysShort: ["sun", "maa", "tii", "kes", "tor", "per", "lau", "sun"],
+		daysMin: ["su", "ma", "ti", "ke", "to", "pe", "la", "su"],
+		months: ["tammikuu", "helmikuu", "maaliskuu", "huhtikuu", "toukokuu", "kesäkuu", "heinäkuu", "elokuu", "syyskuu", "lokakuu", "marraskuu", "joulukuu"],
+		monthsShort: ["tam", "hel", "maa", "huh", "tou", "kes", "hei", "elo", "syy", "lok", "mar", "jou"],
+		today: "tänään"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.fr.js

@@ -0,0 +1,16 @@
+/**
+ * French translation for bootstrap-datepicker
+ * Nico Mollet <nico.mollet@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['fr'] = {
+		days: ["Dimanche", "Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche"],
+		daysShort: ["Dim", "Lun", "Mar", "Mer", "Jeu", "Ven", "Sam", "Dim"],
+		daysMin: ["D", "L", "Ma", "Me", "J", "V", "S", "D"],
+		months: ["Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre"],
+		monthsShort: ["Jan", "Fev", "Mar", "Avr", "Mai", "Jui", "Jul", "Aou", "Sep", "Oct", "Nov", "Dec"],
+		today: "Aujourd'hui",
+		weekStart: 1,
+		format: "dd/mm/yyyy"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.he.js

@@ -0,0 +1,15 @@
+/**
+ * Hebrew translation for bootstrap-datepicker
+ * Sagie Maoz <sagie@maoz.info>
+ */
+;(function($){
+  $.fn.datepicker.dates['he'] = {
+      days: ["ראשון", "שני", "שלישי", "רביעי", "חמישי", "שישי", "שבת", "ראשון"],
+      daysShort: ["א", "ב", "ג", "ד", "ה", "ו", "ש", "א"],
+      daysMin: ["א", "ב", "ג", "ד", "ה", "ו", "ש", "א"],
+      months: ["ינואר", "פברואר", "מרץ", "אפריל", "מאי", "יוני", "יולי", "אוגוסט", "ספטמבר", "אוקטובר", "נובמבר", "דצמבר"],
+      monthsShort: ["ינו", "פבר", "מרץ", "אפר", "מאי", "יונ", "יול", "אוג", "ספט", "אוק", "נוב", "דצמ"],
+      today: "היום",
+      rtl: true
+  };
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.hr.js

@@ -0,0 +1,13 @@
+/**
+ * Croatian localisation
+ */
+;(function($){
+	$.fn.datepicker.dates['hr'] = {
+		days: ["Nedjelja", "Ponedjelja", "Utorak", "Srijeda", "Četrtak", "Petak", "Subota", "Nedjelja"],
+		daysShort: ["Ned", "Pon", "Uto", "Srr", "Čet", "Pet", "Sub", "Ned"],
+		daysMin: ["Ne", "Po", "Ut", "Sr", "Če", "Pe", "Su", "Ne"],
+		months: ["Siječanj", "Veljača", "Ožujak", "Travanj", "Svibanj", "Lipanj", "Srpanj", "Kolovoz", "Rujan", "Listopad", "Studeni", "Prosinac"],
+		monthsShort: ["Sije", "Velj", "Ožu", "Tra", "Svi", "Lip", "Jul", "Kol", "Ruj", "Lis", "Stu", "Pro"],
+		today: "Danas"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.hu.js

@@ -0,0 +1,16 @@
+/**
+ * Hungarian translation for bootstrap-datepicker
+ * Sotus László <lacisan@gmail.com>
+ */
+;(function($){
+  $.fn.datepicker.dates['hu'] = {
+		days: ["Vasárnap", "Hétfő", "Kedd", "Szerda", "Csütörtök", "Péntek", "Szombat", "Vasárnap"],
+		daysShort: ["Vas", "Hét", "Ked", "Sze", "Csü", "Pén", "Szo", "Vas"],
+		daysMin: ["Va", "Hé", "Ke", "Sz", "Cs", "Pé", "Sz", "Va"],
+		months: ["Január", "Február", "Március", "Április", "Május", "Június", "Július", "Augusztus", "Szeptember", "Október", "November", "December"],
+		monthsShort: ["Jan", "Feb", "Már", "Ápr", "Máj", "Jún", "Júl", "Aug", "Sze", "Okt", "Nov", "Dec"],
+		today: "Ma",
+		weekStart: 1,
+		format: "yyyy.mm.dd"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.id.js

@@ -0,0 +1,13 @@
+/**
+ * Bahasa translation for bootstrap-datepicker
+ * Azwar Akbar <azwar.akbar@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['id'] = {
+		days: ["Minggu", "Senin", "Selasa", "Rabu", "Kamis", "Jumat", "Sabtu", "Minggu"],
+		daysShort: ["Mgu", "Sen", "Sel", "Rab", "Kam", "Jum", "Sab", "Mgu"],
+		daysMin: ["Mg", "Sn", "Sl", "Ra", "Ka", "Ju", "Sa", "Mg"],
+		months: ["Januari", "Februari", "Maret", "April", "Mei", "Juni", "Juli", "Agustus", "September", "Oktober", "November", "Desember"],
+		monthsShort: ["Jan", "Feb", "Mar", "Apr", "Mei", "Jun", "Jul", "Ags", "Sep", "Okt", "Nov", "Des"]
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.is.js

@@ -0,0 +1,14 @@
+/**
+ * Icelandic translation for bootstrap-datepicker
+ * Hinrik Örn Sigurðsson <hinrik.sig@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['is'] = {
+		days: ["Sunnudagur", "Mánudagur", "Þriðjudagur", "Miðvikudagur", "Fimmtudagur", "Föstudagur", "Laugardagur", "Sunnudagur"],
+		daysShort: ["Sun", "Mán", "Þri", "Mið", "Fim", "Fös", "Lau", "Sun"],
+		daysMin: ["Su", "Má", "Þr", "Mi", "Fi", "Fö", "La", "Su"],
+		months: ["Janúar", "Febrúar", "Mars", "Apríl", "Maí", "Júní", "Júlí", "Ágúst", "September", "Október", "Nóvember", "Desember"],
+		monthsShort: ["Jan", "Feb", "Mar", "Apr", "Maí", "Jún", "Júl", "Ágú", "Sep", "Okt", "Nóv", "Des"],
+		today: "Í Dag"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.it.js

@@ -0,0 +1,16 @@
+/**
+ * Italian translation for bootstrap-datepicker
+ * Enrico Rubboli <rubboli@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['it'] = {
+		days: ["Domenica", "Lunedì", "Martedì", "Mercoledì", "Giovedì", "Venerdì", "Sabato", "Domenica"],
+		daysShort: ["Dom", "Lun", "Mar", "Mer", "Gio", "Ven", "Sab", "Dom"],
+		daysMin: ["Do", "Lu", "Ma", "Me", "Gi", "Ve", "Sa", "Do"],
+		months: ["Gennaio", "Febbraio", "Marzo", "Aprile", "Maggio", "Giugno", "Luglio", "Agosto", "Settembre", "Ottobre", "Novembre", "Dicembre"],
+		monthsShort: ["Gen", "Feb", "Mar", "Apr", "Mag", "Giu", "Lug", "Ago", "Set", "Ott", "Nov", "Dic"],
+		today: "Oggi",
+		weekStart: 1,
+		format: "dd/mm/yyyy"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.ja.js

@@ -0,0 +1,15 @@
+/**
+ * Japanese translation for bootstrap-datepicker
+ * Norio Suzuki <https://github.com/suzuki/>
+ */
+;(function($){
+	$.fn.datepicker.dates['ja'] = {
+		days: ["日曜", "月曜", "火曜", "水曜", "木曜", "金曜", "土曜", "日曜"],
+		daysShort: ["日", "月", "火", "水", "木", "金", "土", "日"],
+		daysMin: ["日", "月", "火", "水", "木", "金", "土", "日"],
+		months: ["1月", "2月", "3月", "4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月"],
+		monthsShort: ["1月", "2月", "3月", "4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月"],
+		today: "今日",
+		format: "yyyy/mm/dd"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.kr.js

@@ -0,0 +1,13 @@
+/**
+ * Korean translation for bootstrap-datepicker
+ * Gu Youn <http://github.com/guyoun>
+ */
+;(function($){
+	$.fn.datepicker.dates['kr'] = {
+		days: ["일요일", "월요일", "화요일", "수요일", "목요일", "금요일", "토요일", "일요일"],
+		daysShort: ["일", "월", "화", "수", "목", "금", "토", "일"],
+		daysMin: ["일", "월", "화", "수", "목", "금", "토", "일"],
+		months: ["1월", "2월", "3월", "4월", "5월", "6월", "7월", "8월", "9월", "10월", "11월", "12월"],
+		monthsShort: ["1월", "2월", "3월", "4월", "5월", "6월", "7월", "8월", "9월", "10월", "11월", "12월"]
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.lt.js

@@ -0,0 +1,16 @@
+/**
+ * Lithuanian translation for bootstrap-datepicker
+ * Šarūnas Gliebus <ssharunas@yahoo.co.uk>
+ */
+
+;(function($){
+    $.fn.datepicker.dates['lt'] = {
+        days: ["Sekmadienis", "Pirmadienis", "Antradienis", "Trečiadienis", "Ketvirtadienis", "Penktadienis", "Šeštadienis", "Sekmadienis"],
+        daysShort: ["S", "Pr", "A", "T", "K", "Pn", "Š", "S"],
+        daysMin: ["Sk", "Pr", "An", "Tr", "Ke", "Pn", "Št", "Sk"],
+        months: ["Sausis", "Vasaris", "Kovas", "Balandis", "Gegužė", "Birželis", "Liepa", "Rugpjūtis", "Rugsėjis", "Spalis", "Lapkritis", "Gruodis"],
+        monthsShort: ["Sau", "Vas", "Kov", "Bal", "Geg", "Bir", "Lie", "Rugp", "Rugs", "Spa", "Lap", "Gru"],
+        today: "Šiandien",
+        weekStart: 1
+    };
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.lv.js

@@ -0,0 +1,16 @@
+/**
+ * Latvian translation for bootstrap-datepicker
+ * Artis Avotins <artis@apit.lv>
+ */
+
+;(function($){
+    $.fn.datepicker.dates['lv'] = {
+        days: ["Svētdiena", "Pirmdiena", "Otrdiena", "Trešdiena", "Ceturtdiena", "Piektdiena", "Sestdiena", "Svētdiena"],
+        daysShort: ["Sv", "P", "O", "T", "C", "Pk", "S", "Sv"],
+        daysMin: ["Sv", "Pr", "Ot", "Tr", "Ce", "Pk", "St", "Sv"],
+        months: ["Janvāris", "Februāris", "Marts", "Aprīlis", "Maijs", "Jūnijs", "Jūlijs", "Augusts", "Septembris", "Oktobris", "Novembris", "Decembris"],
+        monthsShort: ["Jan", "Feb", "Mar", "Apr", "Mai", "Jūn", "Jūl", "Aug", "Sep", "Okt", "Nov", "Dec."],
+        today: "Šodien",
+        weekStart: 1
+    };
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.ms.js

@@ -0,0 +1,14 @@
+/**
+ * Malay translation for bootstrap-datepicker
+ * Ateman Faiz <noorulfaiz@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['ms'] = {
+		days: ["Ahad", "Isnin", "Selasa", "Rabu", "Khamis", "Jumaat", "Sabtu", "Ahad"],
+		daysShort: ["Aha", "Isn", "Sel", "Rab", "Kha", "Jum", "Sab", "Aha"],
+		daysMin: ["Ah", "Is", "Se", "Ra", "Kh", "Ju", "Sa", "Ah"],
+		months: ["Januari", "Februari", "Mac", "April", "Mei", "Jun", "Julai", "Ogos", "September", "Oktober", "November", "Disember"],
+		monthsShort: ["Jan", "Feb", "Mar", "Apr", "Mei", "Jun", "Jul", "Ogo", "Sep", "Okt", "Nov", "Dis"],
+		today: "Hari Ini"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.nb.js

@@ -0,0 +1,14 @@
+/**
+ * Norwegian (bokmål) translation for bootstrap-datepicker
+ * Fredrik Sundmyhr <http://github.com/fsundmyhr>
+ */
+;(function($){
+	$.fn.datepicker.dates['nb'] = {
+		days: ["Søndag", "Mandag", "Tirsdag", "Onsdag", "Torsdag", "Fredag", "Lørdag", "Søndag"],
+		daysShort: ["Søn", "Man", "Tir", "Ons", "Tor", "Fre", "Lør", "Søn"],
+		daysMin: ["Sø", "Ma", "Ti", "On", "To", "Fr", "Lø", "Sø"],
+		months: ["Januar", "Februar", "Mars", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Desember"],
+		monthsShort: ["Jan", "Feb", "Mar", "Apr", "Mai", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Des"],
+		today: "I Dag"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.nl.js

@@ -0,0 +1,14 @@
+/**
+ * Dutch translation for bootstrap-datepicker
+ * Reinier Goltstein <mrgoltstein@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['nl'] = {
+		days: ["Zondag", "Maandag", "Dinsdag", "Woensdag", "Donderdag", "Vrijdag", "Zaterdag", "Zondag"],
+		daysShort: ["Zo", "Ma", "Di", "Wo", "Do", "Vr", "Za", "Zo"],
+		daysMin: ["Zo", "Ma", "Di", "Wo", "Do", "Vr", "Za", "Zo"],
+		months: ["Januari", "Februari", "Maart", "April", "Mei", "Juni", "Juli", "Augustus", "September", "Oktober", "November", "December"],
+		monthsShort: ["Jan", "Feb", "Mrt", "Apr", "Mei", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dec"],
+		today: "Vandaag"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.pl.js

@@ -0,0 +1,15 @@
+/**
+ * Polish translation for bootstrap-datepicker
+ * Robert <rtpm@gazeta.pl>
+ */
+;(function($){
+        $.fn.datepicker.dates['pl'] = {
+                days: ["Niedziela", "Poniedziałek", "Wtorek", "Środa", "Czwartek", "Piątek", "Sobota", "Niedziela"],
+                daysShort: ["Nie", "Pn", "Wt", "Śr", "Czw", "Pt", "So", "Nie"],
+                daysMin: ["N", "Pn", "Wt", "Śr", "Cz", "Pt", "So", "N"],
+                months: ["Styczeń", "Luty", "Marzec", "Kwiecień", "Maj", "Czerwiec", "Lipiec", "Sierpień", "Wrzesień", "Październik", "Listopad", "Grudzień"],
+                monthsShort: ["Sty", "Lu", "Mar", "Kw", "Maj", "Cze", "Lip", "Sie", "Wrz", "Pa", "Lis", "Gru"],
+                today: "Dzisiaj",
+                weekStart: 1
+        };
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.pt-BR.js

@@ -0,0 +1,14 @@
+/**
+ * Brazilian translation for bootstrap-datepicker
+ * Cauan Cabral <cauan@radig.com.br>
+ */
+;(function($){
+	$.fn.datepicker.dates['pt-BR'] = {
+		days: ["Domingo", "Segunda", "Terça", "Quarta", "Quinta", "Sexta", "Sábado", "Domingo"],
+		daysShort: ["Dom", "Seg", "Ter", "Qua", "Qui", "Sex", "Sáb", "Dom"],
+		daysMin: ["Do", "Se", "Te", "Qu", "Qu", "Se", "Sa", "Do"],
+		months: ["Janeiro", "Fevereiro", "Março", "Abril", "Maio", "Junho", "Julho", "Agosto", "Setembro", "Outubro", "Novembro", "Dezembro"],
+		monthsShort: ["Jan", "Fev", "Mar", "Abr", "Mai", "Jun", "Jul", "Ago", "Set", "Out", "Nov", "Dez"],
+		today: "Hoje"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.pt.js

@@ -0,0 +1,14 @@
+/**
+ * Portuguese translation for bootstrap-datepicker
+ * Original code: Cauan Cabral <cauan@radig.com.br>
+ * Tiago Melo <tiago.blackcode@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['pt'] = {
+		days: ["Domingo", "Segunda", "Terça", "Quarta", "Quinta", "Sexta", "Sábado", "Domingo"],
+		daysShort: ["Dom", "Seg", "Ter", "Qua", "Qui", "Sex", "Sáb", "Dom"],
+		daysMin: ["Do", "Se", "Te", "Qu", "Qu", "Se", "Sa", "Do"],
+		months: ["Janeiro", "Fevereiro", "Março", "Abril", "Maio", "Junho", "Julho", "Agosto", "Setembro", "Outubro", "Novembro", "Dezembro"],
+		monthsShort: ["Jan", "Fev", "Mar", "Abr", "Mai", "Jun", "Jul", "Ago", "Set", "Out", "Nov", "Dez"]
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.ro.js

@@ -0,0 +1,15 @@
+/**
+ * Romanian translation for bootstrap-datepicker
+ * Cristian Vasile <cristi.mie@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['ro'] = {
+		days: ["Duminică", "Luni", "Marţi", "Miercuri", "Joi", "Vineri", "Sâmbătă", "Duminică"],
+		daysShort: ["Dum", "Lun", "Mar", "Mie", "Joi", "Vin", "Sâm", "Dum"],
+		daysMin: ["Du", "Lu", "Ma", "Mi", "Jo", "Vi", "Sâ", "Du"],
+		months: ["Ianuarie", "Februarie", "Martie", "Aprilie", "Mai", "Iunie", "Iulie", "August", "Septembrie", "Octombrie", "Noiembrie", "Decembrie"],
+		monthsShort: ["Ian", "Feb", "Mar", "Apr", "Mai", "Iun", "Iul", "Aug", "Sep", "Oct", "Nov", "Dec"],
+		today: "Astăzi",
+		weekStart: 1
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.rs-latin.js

@@ -0,0 +1,14 @@
+/**
+ * Serbian latin translation for bootstrap-datepicker
+ * Bojan Milosavlević <milboj@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['rs'] = {
+		days: ["Nedelja","Ponedeljak", "Utorak", "Sreda", "Četvrtak", "Petak", "Subota", "Nedelja"],
+		daysShort: ["Ned", "Pon", "Uto", "Sre", "Čet", "Pet", "Sub", "Ned"],
+		daysMin: ["N", "Po", "U", "Sr", "Č", "Pe", "Su", "N"],
+		months: ["Januar", "Februar", "Mart", "April", "Maj", "Jun", "Jul", "Avgust", "Septembar", "Oktobar", "Novembar", "Decembar"],
+		monthsShort: ["Jan", "Feb", "Mar", "Apr", "Maj", "Jun", "Jul", "Avg", "Sep", "Okt", "Nov", "Dec"],
+		today: "Danas"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.rs.js

@@ -0,0 +1,14 @@
+/**
+ * Serbian cyrillic translation for bootstrap-datepicker
+ * Bojan Milosavlević <milboj@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['rs'] = {
+		days: ["Недеља","Понедељак", "Уторак", "Среда", "Четвртак", "Петак", "Субота", "Недеља"],
+		daysShort: ["Нед", "Пон", "Уто", "Сре", "Чет", "Пет", "Суб", "Нед"],
+		daysMin: ["Н", "По", "У", "Ср", "Ч", "Пе", "Су", "Н"],
+		months: ["Јануар", "Фебруар", "Март", "Април", "Мај", "Јун", "Јул", "Август", "Септембар", "Октобар", "Новембар", "Децембар"],
+		monthsShort: ["Јан", "Феб", "Мар", "Апр", "Мај", "Јун", "Јул", "Авг", "Сеп", "Окт", "Нов", "Дец"],
+		today: "Данас"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.ru.js

@@ -0,0 +1,14 @@
+/**
+ * Russian translation for bootstrap-datepicker
+ * Victor Taranenko <darwin@snowdale.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['ru'] = {
+		days: ["Воскресенье", "Понедельник", "Вторник", "Среда", "Четверг", "Пятница", "Суббота", "Воскресенье"],
+		daysShort: ["Вск", "Пнд", "Втр", "Срд", "Чтв", "Птн", "Суб", "Вск"],
+		daysMin: ["Вс", "Пн", "Вт", "Ср", "Чт", "Пт", "Сб", "Вс"],
+		months: ["Январь", "Февраль", "Март", "Апрель", "Май", "Июнь", "Июль", "Август", "Сентябрь", "Октябрь", "Ноябрь", "Декабрь"],
+		monthsShort: ["Янв", "Фев", "Мар", "Апр", "Май", "Июн", "Июл", "Авг", "Сен", "Окт", "Ноя", "Дек"],
+		today: "Сегодня"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.sk.js

@@ -0,0 +1,15 @@
+/**
+ * Slovak translation for bootstrap-datepicker
+ * Marek Lichtner <marek@licht.sk>
+ * Fixes by Michal Remiš <michal.remis@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates["sk"] = {
+		days: ["Nedeľa", "Pondelok", "Utorok", "Streda", "Štvrtok", "Piatok", "Sobota", "Nedeľa"],
+		daysShort: ["Ned", "Pon", "Uto", "Str", "Štv", "Pia", "Sob", "Ned"],
+		daysMin: ["Ne", "Po", "Ut", "St", "Št", "Pia", "So", "Ne"],
+		months: ["Január", "Február", "Marec", "Apríl", "Máj", "Jún", "Júl", "August", "September", "Október", "November", "December"],
+		monthsShort: ["Jan", "Feb", "Mar", "Apr", "Máj", "Jún", "Júl", "Aug", "Sep", "Okt", "Nov", "Dec"],
+		today: "Dnes"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.sl.js

@@ -0,0 +1,14 @@
+/**
+ * Slovene translation for bootstrap-datepicker
+ * Gregor Rudolf <gregor.rudolf@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['sl'] = {
+		days: ["Nedelja", "Ponedeljek", "Torek", "Sreda", "Četrtek", "Petek", "Sobota", "Nedelja"],
+		daysShort: ["Ned", "Pon", "Tor", "Sre", "Čet", "Pet", "Sob", "Ned"],
+		daysMin: ["Ne", "Po", "To", "Sr", "Če", "Pe", "So", "Ne"],
+		months: ["Januar", "Februar", "Marec", "April", "Maj", "Junij", "Julij", "Avgust", "September", "Oktober", "November", "December"],
+		monthsShort: ["Jan", "Feb", "Mar", "Apr", "Maj", "Jun", "Jul", "Avg", "Sep", "Okt", "Nov", "Dec"],
+		today: "Danes"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.sv.js

@@ -0,0 +1,14 @@
+/**
+ * Swedish translation for bootstrap-datepicker
+ * Patrik Ragnarsson <patrik@starkast.net>
+ */
+;(function($){
+	$.fn.datepicker.dates['sv'] = {
+		days: ["Söndag", "Måndag", "Tisdag", "Onsdag", "Torsdag", "Fredag", "Lördag", "Söndag"],
+		daysShort: ["Sön", "Mån", "Tis", "Ons", "Tor", "Fre", "Lör", "Sön"],
+		daysMin: ["Sö", "Må", "Ti", "On", "To", "Fr", "Lö", "Sö"],
+		months: ["Januari", "Februari", "Mars", "April", "Maj", "Juni", "Juli", "Augusti", "September", "Oktober", "November", "December"],
+		monthsShort: ["Jan", "Feb", "Mar", "Apr", "Maj", "Jun", "Jul", "Aug", "Sep", "Okt", "Nov", "Dec"],
+		today: "I Dag"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.sw.js

@@ -0,0 +1,15 @@
+/**
+ * Swahili translation for bootstrap-datepicker
+ * Edwin Mugendi <https://github.com/edwinmugendi>
+ * Source: http://scriptsource.org/cms/scripts/page.php?item_id=entry_detail&uid=xnfaqyzcku
+ */
+;(function($){
+    $.fn.datepicker.dates['sw'] = {
+        days: ["Jumapili", "Jumatatu", "Jumanne", "Jumatano", "Alhamisi", "Ijumaa", "Jumamosi", "Jumapili"],
+        daysShort: ["J2", "J3", "J4", "J5", "Alh", "Ij", "J1", "J2"],
+        daysMin: ["2", "3", "4", "5", "A", "I", "1", "2"],
+        months: ["Januari", "Februari", "Machi", "Aprili", "Mei", "Juni", "Julai", "Agosti", "Septemba", "Oktoba", "Novemba", "Desemba"],
+        monthsShort: ["Jan", "Feb", "Mac", "Apr", "Mei", "Jun", "Jul", "Ago", "Sep", "Okt", "Nov", "Des"],
+        today: "Leo"
+    };
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.th.js

@@ -0,0 +1,14 @@
+/**
+ * Thai translation for bootstrap-datepicker
+ * Suchau Jiraprapot <seroz24@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['th'] = {
+		days: ["อาทิตย์", "จันทร์", "อังคาร", "พุธ", "พฤหัส", "ศุกร์", "เสาร์", "อาทิตย์"],
+		daysShort: ["อา", "จ", "อ", "พ", "พฤ", "ศ", "ส", "อา"],
+		daysMin: ["อา", "จ", "อ", "พ", "พฤ", "ศ", "ส", "อา"],
+		months: ["มกราคม", "กุมภาพันธ์", "มีนาคม", "เมษายน", "พฤษภาคม", "มิถุนายน", "กรกฎาคม", "สิงหาคม", "กันยายน", "ตุลาคม", "พฤศจิกายน", "ธันวาคม"],
+		monthsShort: ["ม.ค.", "ก.พ.", "มี.ค.", "เม.ย.", "พ.ค.", "มิ.ย.", "ก.ค.", "ส.ค.", "ก.ย.", "ต.ค.", "พ.ย.", "ธ.ค."],
+		today: "วันนี้"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.tr.js

@@ -0,0 +1,15 @@
+/**
+ * Turkish translation for bootstrap-datepicker
+ * Serkan Algur <kaisercrazy_2@hotmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['tr'] = {
+		days: ["Pazar", "Pazartesi", "Salı", "Çarşamba", "Perşembe", "Cuma", "Cumartesi", "Pazar"],
+		daysShort: ["Pz", "Pzt", "Sal", "Çrş", "Prş", "Cu", "Cts", "Pz"],
+		daysMin: ["Pz", "Pzt", "Sa", "Çr", "Pr", "Cu", "Ct", "Pz"],
+		months: ["Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", "Eylül", "Ekim", "Kasım", "Aralık"],
+		monthsShort: ["Oca", "Şub", "Mar", "Nis", "May", "Haz", "Tem", "Ağu", "Eyl", "Eki", "Kas", "Ara"],
+		today: "Bugün"
+	};
+}(jQuery));
+

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.uk.js

@@ -0,0 +1,14 @@
+/**
+ * Ukrainian translation for bootstrap-datepicker
+ * Andrey Vityuk <andrey [dot] vityuk [at] gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['uk'] = {
+		days: ["Неділя", "Понеділок", "Вівторок", "Середа", "Четвер", "П'ятниця", "Субота", "Неділя"],
+		daysShort: ["Нед", "Пнд", "Втр", "Срд", "Чтв", "Птн", "Суб", "Нед"],
+		daysMin: ["Нд", "Пн", "Вт", "Ср", "Чт", "Пт", "Сб", "Нд"],
+		months: ["Січень", "Лютий", "Березень", "Квітень", "Травень", "Червень", "Липень", "Серпень", "Вересень", "Жовтень", "Листопад", "Грудень"],
+		monthsShort: ["Січ", "Лют", "Бер", "Кві", "Тра", "Чер", "Лип", "Сер", "Вер", "Жов", "Лис", "Гру"],
+		today: "Сьогодні"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.zh-CN.js

@@ -0,0 +1,14 @@
+/**
+ * Simplified Chinese translation for bootstrap-datepicker
+ * Yuan Cheung <advanimal@gmail.com>
+ */
+;(function($){
+	$.fn.datepicker.dates['zh-CN'] = {
+				days: ["星期日", "星期一", "星期二", "星期三", "星期四", "星期五", "星期六", "星期日"],
+			daysShort: ["周日", "周一", "周二", "周三", "周四", "周五", "周六", "周日"],
+			daysMin:  ["日", "一", "二", "三", "四", "五", "六", "日"],
+			months: ["一月", "二月", "三月", "四月", "五月", "六月", "七月", "八月", "九月", "十月", "十一月", "十二月"],
+			monthsShort: ["一月", "二月", "三月", "四月", "五月", "六月", "七月", "八月", "九月", "十月", "十一月", "十二月"],
+			today: "今日"
+	};
+}(jQuery));

inst/www/shared/datepicker/js/locales/bootstrap-datepicker.zh-TW.js

@@ -0,0 +1,13 @@
+/**
+ * Traditional Chinese translation for bootstrap-datepicker
+ * Rung-Sheng Jang <daniel@i-trend.co.cc>
+ */
+;(function($){
+	$.fn.datepicker.dates['zh-TW'] = {
+				days: ["星期日", "星期一", "星期二", "星期三", "星期四", "星期五", "星期六", "星期日"],
+			daysShort: ["周日", "周一", "周二", "周三", "周四", "周五", "周六", "周日"],
+			daysMin:  ["日", "一", "二", "三", "四", "五", "六", "日"],
+			months: ["一月", "二月", "三月", "四月", "五月", "六月", "七月", "八月", "九月", "十月", "十一月", "十二月"],
+			monthsShort: ["一月", "二月", "三月", "四月", "五月", "六月", "七月", "八月", "九月", "十月", "十一月", "十二月"]
+	};
+}(jQuery));

inst/www/shared/datepicker/less/datepicker.less

@@ -0,0 +1,230 @@
+/*!
+ * Datepicker for Bootstrap
+ *
+ * Copyright 2012 Stefan Petre
+ * Improvements by Andrew Rowls
+ * Licensed under the Apache License v2.0
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ */
+
+.datepicker {
+	padding: 4px;
+	.border-radius(4px);
+	&-inline {
+		width: 220px;
+	}
+	direction: ltr;
+	&&-rtl {
+		direction: rtl;
+		table tr td span {
+			float: right;
+		}
+	}
+	&-dropdown {
+		top: 0;
+		left: 0;
+		&:before {
+			content: '';
+			display: inline-block;
+			border-left:   7px solid transparent;
+			border-right:  7px solid transparent;
+			border-bottom: 7px solid #ccc;
+			border-bottom-color: rgba(0,0,0,.2);
+			position: absolute;
+			top: -7px;
+			left: 6px;
+		}
+		&:after {
+			content: '';
+			display: inline-block;
+			border-left:   6px solid transparent;
+			border-right:  6px solid transparent;
+			border-bottom: 6px solid @white;
+			position: absolute;
+			top: -6px;
+			left: 7px;
+		}
+	}
+	>div {
+		display: none;
+	}
+	&.days div.datepicker-days {
+		display: block;
+	}
+	&.months div.datepicker-months {
+		display: block;
+	}
+	&.years div.datepicker-years {
+		display: block;
+	}
+	table{
+		margin: 0;
+	}
+	td,
+	th{
+		text-align: center;
+		width: 20px;
+		height: 20px;
+		.border-radius(4px);
+
+		border: none;
+	}
+	// Inline display inside a table presents some problems with
+	// border and background colors.
+	.table-striped & table tr {
+		td, th {
+			background-color:transparent;
+		}
+	}
+	table tr td {
+		&.day:hover {
+			background: @grayLighter;
+			cursor: pointer;
+		}
+		&.old,
+		&.new {
+			color: @grayLight;
+		}
+		&.disabled,
+		&.disabled:hover {
+			background: none;
+			color: @grayLight;
+			cursor: default;
+		}
+		&.today,
+		&.today:hover,
+		&.today.disabled,
+		&.today.disabled:hover {
+			@todayBackground: lighten(@orange, 30%);
+			.buttonBackground(@todayBackground, spin(@todayBackground, 20));
+			color: #000 !important;
+		}
+		&.range,
+		&.range:hover,
+		&.range.disabled,
+		&.range.disabled:hover {
+			background:@grayLighter;
+			.border-radius(0);
+		}
+		&.range.today,
+		&.range.today:hover,
+		&.range.today.disabled,
+		&.range.today.disabled:hover {
+			@todayBackground: mix(@orange, @grayLighter);
+			.buttonBackground(@todayBackground, spin(@todayBackground, 20));
+			.border-radius(0);
+		}
+		&.selected,
+		&.selected:hover,
+		&.selected.disabled,
+		&.selected.disabled:hover {
+			.buttonBackground(lighten(@grayLight, 10), darken(@grayLight, 10));
+			color: #fff;
+			text-shadow: 0 -1px 0 rgba(0,0,0,.25);
+		}
+		&.active,
+		&.active:hover,
+		&.active.disabled,
+		&.active.disabled:hover {
+			.buttonBackground(@btnPrimaryBackground, spin(@btnPrimaryBackground, 20));
+			color: #fff;
+			text-shadow: 0 -1px 0 rgba(0,0,0,.25);
+		}
+		span {
+			display: block;
+			width: 23%;
+			height: 54px;
+			line-height: 54px;
+			float: left;
+			margin: 1%;
+			cursor: pointer;
+			.border-radius(4px);
+			&:hover {
+				background: @grayLighter;
+			}
+			&.disabled,
+			&.disabled:hover {
+				background:none;
+				color: @grayLight;
+				cursor: default;
+			}
+			&.active,
+			&.active:hover,
+			&.active.disabled,
+			&.active.disabled:hover {
+				.buttonBackground(@btnPrimaryBackground, spin(@btnPrimaryBackground, 20));
+				color: #fff;
+				text-shadow: 0 -1px 0 rgba(0,0,0,.25);
+			}
+			&.old {
+				color: @grayLight;
+			}
+		}
+	}
+
+	th.datepicker-switch {
+		width: 145px;
+	}
+
+	thead tr:first-child th,
+	tfoot tr:first-child th {
+		cursor: pointer;
+		&:hover{
+			background: @grayLighter;
+		}
+	}
+	/*.dow {
+		border-top: 1px solid #ddd !important;
+	}*/
+
+	// Basic styling for calendar-week cells
+	.cw {
+		font-size: 10px;
+		width: 12px;
+		padding: 0 2px 0 5px;
+		vertical-align: middle;
+	}
+	thead tr:first-child th.cw {
+		cursor: default;
+		background-color: transparent;
+	}
+}
+.input-append,
+.input-prepend {
+	&.date {
+		.add-on i {
+			display: block;
+			cursor: pointer;
+			width: 16px;
+			height: 16px;
+		}
+	}
+}
+.input-daterange {
+	input {
+		text-align:center;
+	}
+	input:first-child {
+		.border-radius(3px 0 0 3px);
+	}
+	input:last-child {
+		.border-radius(0 3px 3px 0);
+	}
+	.add-on {
+		display: inline-block;
+		width: auto;
+		min-width: 16px;
+		height: @baseLineHeight;
+		padding: 4px 5px;
+		font-weight: normal;
+		line-height: @baseLineHeight;
+		text-align: center;
+		text-shadow: 0 1px 0 @white;
+		vertical-align: middle;
+		background-color: @grayLighter;
+		border: 1px solid #ccc;
+		margin-left:-5px;
+		margin-right:-5px;
+	}
+}

inst/www/shared/shiny.css

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

man-roxygen/update-input.R

@@ -0,0 +1,16 @@
+#' @details
+#' The input updater functions send a message to the client, telling it to
+#' change the settings of an input object. The messages are collected and sent
+#' after all the observers (including outputs) have finished running.
+#'
+#' The syntax of these functions is similar to the functions that created the
+#' inputs in the first place. For example, \code{\link{numericInput}()} and
+#' \code{updateNumericInput()} take a similar set of arguments.
+#'
+#' Any arguments with NULL values will be ignored; they will not result in any
+#' changes to the input object on the client.
+#'
+#' @param session The \code{session} object passed to function given to
+#'   \code{shinyServer}.
+#' @param inputId The id of the input object.
+#' @param label The label to set for the input object.

man/actionButton.Rd

@@ -0,0 +1,19 @@
+\name{actionButton}
+\alias{actionButton}
+\title{Action button}
+\usage{
+  actionButton(inputId, label)
+}
+\arguments{
+  \item{inputId}{Specifies the input slot that will be used
+  to access the value.}
+
+  \item{label}{The contents of the button--usually a text
+  label, but you could also use any other HTML, like an
+  image.}
+}
+\description{
+  Creates an action button whose value is initially zero,
+  and increments by one each time it is pressed.
+}
+

man/bootstrapPage.Rd

@@ -1,8 +1,11 @@
 \name{bootstrapPage}
+\alias{basicPage}
 \alias{bootstrapPage}
 \title{Create a Twitter Bootstrap page}
 \usage{
   bootstrapPage(...)
+
+  basicPage(...)
 }
 \arguments{
   \item{...}{The contents of the document body.}
@@ -18,9 +21,13 @@
   provide).
 }
 \details{
-  This function is primarily intended for users who are
+  These functions are primarily intended for users who are
   proficient in HTML/CSS, and know how to lay out pages in
   Bootstrap. Most users should use template functions like
   \code{\link{pageWithSidebar}}.
+
+  \code{basicPage} is the same as \code{bootstrapPage},
+  with an added \code{<div class="container-fluid">}
+  wrapper to provide a little padding.
 }
 

man/checkboxGroupInput.Rd

@@ -34,6 +34,7 @@ checkboxGroupInput("variable", "Variable:",
                      "Gears" = "gear"))
 }
 \seealso{
-  \code{\link{checkboxInput}}
+  \code{\link{checkboxInput}},
+  \code{\link{updateCheckboxGroupInput}}
 }
 

man/checkboxInput.Rd

@@ -24,6 +24,7 @@
 checkboxInput("outliers", "Show outliers", FALSE)
 }
 \seealso{
-  \code{\link{checkboxGroupInput}}
+  \code{\link{checkboxGroupInput}},
+  \code{\link{updateCheckboxInput}}
 }
 

man/dateInput.Rd

@@ -0,0 +1,88 @@
+\name{dateInput}
+\alias{dateInput}
+\title{Create date input}
+\usage{
+  dateInput(inputId, label, value = NULL, min = NULL,
+    max = NULL, format = "yyyy-mm-dd", startview = "month",
+    weekstart = 0, language = "en")
+}
+\arguments{
+  \item{inputId}{Input variable to assign the control's
+  value to.}
+
+  \item{label}{Display label for the control.}
+
+  \item{value}{The starting date. Either a Date object, or
+  a string in \code{yyyy-mm-dd} format. If NULL (the
+  default), will use the current date in the client's time
+  zone.}
+
+  \item{min}{The minimum allowed date. Either a Date
+  object, or a string in \code{yyyy-mm-dd} format.}
+
+  \item{max}{The maximum allowed date. Either a Date
+  object, or a string in \code{yyyy-mm-dd} format.}
+
+  \item{format}{The format of the date to display in the
+  browser. Defaults to \code{"yyyy-mm-dd"}.}
+
+  \item{startview}{The date range shown when the input
+  object is first clicked. Can be "month" (the default),
+  "year", or "decade".}
+
+  \item{weekstart}{Which day is the start of the week.
+  Should be an integer from 0 (Sunday) to 6 (Saturday).}
+
+  \item{language}{The language used for month and day
+  names. Default is "en".  Other valid values include "bg",
+  "ca", "cs", "da", "de", "el", "es", "fi", "fr", "he",
+  "hr", "hu", "id", "is", "it", "ja", "kr", "lt", "lv",
+  "ms", "nb", "nl", "pl", "pt", "pt", "ro", "rs",
+  "rs-latin", "ru", "sk", "sl", "sv", "sw", "th", "tr",
+  "uk", "zh-CN", and "zh-TW".}
+}
+\description{
+  Creates a text input which, when clicked on, brings up a
+  calendar that the user can click on to select dates.
+}
+\details{
+  The date \code{format} string specifies how the date will
+  be displayed in the browser. It allows the following
+  values:
+
+  \itemize{ \item \code{yy} Year without century (12) \item
+  \code{yyyy} Year with century (2012) \item \code{mm}
+  Month number, with leading zero (01-12) \item \code{m}
+  Month number, without leading zero (01-12) \item \code{M}
+  Abbreviated month name \item \code{MM} Full month name
+  \item \code{dd} Day of month with leading zero \item
+  \code{d} Day of month without leading zero \item \code{D}
+  Abbreviated weekday name \item \code{DD} Full weekday
+  name }
+}
+\examples{
+dateInput("date", "Date:", value = "2012-02-29")
+
+# Default value is the date in client's time zone
+dateInput("date", "Date:")
+
+# value is always yyyy-mm-dd, even if the display format is different
+dateInput("date", "Date:", value = "2012-02-29", format = "mm/dd/yy")
+
+# Pass in a Date object
+dateInput("date", "Date:", value = Sys.Date()-10)
+
+# Use different language and different first day of week
+dateInput("date", "Date:",
+          language = "de",
+          weekstart = 1)
+
+# Start with decade view instead of default month view
+dateInput("date", "Date:",
+          startview = "decade")
+}
+\seealso{
+  \code{\link{dateRangeInput}},
+  \code{\link{updateDateInput}}
+}
+

man/dateRangeInput.Rd

@@ -0,0 +1,109 @@
+\name{dateRangeInput}
+\alias{dateRangeInput}
+\title{Create date range input}
+\usage{
+  dateRangeInput(inputId, label, start = NULL, end = NULL,
+    min = NULL, max = NULL, format = "yyyy-mm-dd",
+    startview = "month", weekstart = 0, language = "en",
+    separator = " to ")
+}
+\arguments{
+  \item{inputId}{Input variable to assign the control's
+  value to.}
+
+  \item{label}{Display label for the control.}
+
+  \item{start}{The initial start date. Either a Date
+  object, or a string in \code{yyyy-mm-dd} format. If NULL
+  (the default), will use the current date in the client's
+  time zone.}
+
+  \item{end}{The initial end date. Either a Date object, or
+  a string in \code{yyyy-mm-dd} format. If NULL (the
+  default), will use the current date in the client's time
+  zone.}
+
+  \item{min}{The minimum allowed date. Either a Date
+  object, or a string in \code{yyyy-mm-dd} format.}
+
+  \item{max}{The maximum allowed date. Either a Date
+  object, or a string in \code{yyyy-mm-dd} format.}
+
+  \item{format}{The format of the date to display in the
+  browser. Defaults to \code{"yyyy-mm-dd"}.}
+
+  \item{startview}{The date range shown when the input
+  object is first clicked. Can be "month" (the default),
+  "year", or "decade".}
+
+  \item{weekstart}{Which day is the start of the week.
+  Should be an integer from 0 (Sunday) to 6 (Saturday).}
+
+  \item{language}{The language used for month and day
+  names. Default is "en".  Other valid values include "bg",
+  "ca", "cs", "da", "de", "el", "es", "fi", "fr", "he",
+  "hr", "hu", "id", "is", "it", "ja", "kr", "lt", "lv",
+  "ms", "nb", "nl", "pl", "pt", "pt", "ro", "rs",
+  "rs-latin", "ru", "sk", "sl", "sv", "sw", "th", "tr",
+  "uk", "zh-CN", and "zh-TW".}
+
+  \item{separator}{String to display between the start and
+  end input boxes.}
+}
+\description{
+  Creates a pair of text inputs which, when clicked on,
+  bring up calendars that the user can click on to select
+  dates.
+}
+\details{
+  The date \code{format} string specifies how the date will
+  be displayed in the browser. It allows the following
+  values:
+
+  \itemize{ \item \code{yy} Year without century (12) \item
+  \code{yyyy} Year with century (2012) \item \code{mm}
+  Month number, with leading zero (01-12) \item \code{m}
+  Month number, without leading zero (01-12) \item \code{M}
+  Abbreviated month name \item \code{MM} Full month name
+  \item \code{dd} Day of month with leading zero \item
+  \code{d} Day of month without leading zero \item \code{D}
+  Abbreviated weekday name \item \code{DD} Full weekday
+  name }
+}
+\examples{
+dateRangeInput("daterange", "Date range:",
+               start = "2001-01-01",
+               end   = "2010-12-31")
+
+# Default start and end is the current date in the client's time zone
+dateRangeInput("daterange", "Date range:")
+
+# start and end are always specified in yyyy-mm-dd, even if the display
+# format is different
+dateRangeInput("daterange", "Date range:",
+               start  = "2001-01-01",
+               end    = "2010-12-31",
+               min    = "2001-01-01",
+               max    = "2012-12-21",
+               format = "mm/dd/yy",
+               separator = " - ")
+
+# Pass in Date objects
+dateRangeInput("daterange", "Date range:",
+               start = Sys.Date()-10,
+               end = Sys.Date()+10)
+
+# Use different language and different first day of week
+dateRangeInput("daterange", "Date range:",
+               language = "de",
+               weekstart = 1)
+
+# Start with decade view instead of default month view
+dateRangeInput("daterange", "Date range:",
+               startview = "decade")
+}
+\seealso{
+  \code{\link{dateInput}},
+  \code{\link{updateDateRangeInput}}
+}
+

man/fileInput.Rd

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

man/imageOutput.Rd

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

man/invalidateLater.Rd

@@ -2,14 +2,43 @@
 \alias{invalidateLater}
 \title{Scheduled Invalidation}
 \usage{
-  invalidateLater(millis)
+  invalidateLater(millis, session)
 }
 \arguments{
   \item{millis}{Approximate milliseconds to wait before
   invalidating the current reactive context.}
+
+  \item{session}{A session object. This is needed to cancel
+  any scheduled invalidations after a user has ended the
+  session. If \code{NULL}, then this invalidation will not
+  be tied to any session, and so it will still occur.}
 }
 \description{
   Schedules the current reactive context to be invalidated
   in the given number of milliseconds.
 }
+\examples{
+\dontrun{
+shinyServer(function(input, output, session) {
+
+  observe({
+    # Re-execute this reactive expression after 1000 milliseconds
+    invalidateLater(1000, session)
+
+    # Do something each time this is invalidated.
+    # The isolate() makes this observer _not_ get invalidated and re-executed
+    # when input$n changes.
+    print(paste("The value of input$n is", isolate(input$n)))
+  })
+
+  # Generate a new histogram at timed intervals, but not when
+  # input$n changes.
+  output$plot <- renderPlot({
+    # Re-execute this reactive expression after 2000 milliseconds
+    invalidateLater(2000, session)
+    hist(isolate(input$n))
+  })
+})
+}
+}
 

man/numericInput.Rd

@@ -31,4 +31,7 @@
 numericInput("obs", "Observations:", 10,
              min = 1, max = 100)
 }
+\seealso{
+  \code{\link{updateNumericInput}}
+}
 

man/observe.Rd

@@ -3,7 +3,7 @@
 \title{Create a reactive observer}
 \usage{
   observe(x, env = parent.frame(), quoted = FALSE,
-    label = NULL, suspended = FALSE)
+    label = NULL, suspended = FALSE, priority = 0)
 }
 \arguments{
   \item{x}{An expression (quoted or unquoted). Any return
@@ -25,6 +25,12 @@
   \item{suspended}{If \code{TRUE}, start the observer in a
   suspended state.  If \code{FALSE} (the default), start in
   a non-suspended state.}
+
+  \item{priority}{An integer or numeric that controls the
+  priority with which this observer should be executed. An
+  observer with a given priority level will always execute
+  sooner than all observers with a lower priority level.
+  Positive, negative, and zero values are allowed.}
 }
 \description{
   Creates an observer from the given expression An observer

man/outputOptions.Rd

@@ -19,7 +19,10 @@
   execute) when it is hidden on the web page. When
   \code{FALSE}, the output object will not suspend when
   hidden, and if it was already hidden and suspended, then
-  it will resume immediately. }
+  it will resume immediately.  \item priority. The priority
+  level of the output object. Queued outputs with higher
+  priority values will execute before those with lower
+  values. }
 }
 \examples{
 \dontrun{
@@ -29,6 +32,9 @@ outputOptions(output)
 # Disable suspend for output$myplot
 outputOptions(output, "myplot", suspendWhenHidden = FALSE)
 
+# Change priority for output$myplot
+outputOptions(output, "myplot", priority = 10)
+
 # Get the list of options for output$myplot
 outputOptions(output, "myplot")
 }

man/parseQueryString.Rd

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

man/plotOutput.Rd

@@ -1,6 +1,6 @@
 \name{plotOutput}
 \alias{plotOutput}
-\title{Create a plot output element}
+\title{Create an plot output element}
 \usage{
   plotOutput(outputId, width = "100\%", height = "400px")
 }

man/plotPNG.Rd

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

man/radioButtons.Rd

@@ -32,4 +32,7 @@ radioButtons("dist", "Distribution type:",
                "Log-normal" = "lnorm",
                "Exponential" = "exp"))
 }
+\seealso{
+  \code{\link{updateRadioButtons}}
+}
 

man/reactiveTimer.Rd

@@ -2,10 +2,15 @@
 \alias{reactiveTimer}
 \title{Timer}
 \usage{
-  reactiveTimer(intervalMs = 1000)
+  reactiveTimer(intervalMs = 1000, session)
 }
 \arguments{
   \item{intervalMs}{How often to fire, in milliseconds}
+
+  \item{session}{A session object. This is needed to cancel
+  any scheduled invalidations after a user has ended the
+  session. If \code{NULL}, then this invalidation will not
+  be tied to any session, and so it will still occur.}
 }
 \value{
   A no-parameter function that can be called from a
@@ -29,6 +34,34 @@
   See \code{\link{invalidateLater}} as a safer and simpler
   alternative.
 }
+\examples{
+\dontrun{
+shinyServer(function(input, output, session) {
+
+  # Anything that calls autoInvalidate will automatically invalidate
+  # every 2 seconds.
+  autoInvalidate <- reactiveTimer(2000, session)
+
+  observe({
+    # Invalidate and re-execute this reactive expression every time the
+    # timer fires.
+    autoInvalidate()
+
+    # Do something each time this is invalidated.
+    # The isolate() makes this observer _not_ get invalidated and re-executed
+    # when input$n changes.
+    print(paste("The value of input$n is", isolate(input$n)))
+  })
+
+  # Generate a new histogram each time the timer fires, but not when
+  # input$n changes.
+  output$plot <- renderPlot({
+    autoInvalidate()
+    hist(isolate(input$n))
+  })
+})
+}
+}
 \seealso{
   invalidateLater
 }

man/renderImage.Rd

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