Bump version to 0.10.1

Add custom version of selectize.js to work around Firefox bug

.Rbuildignore

@@ -10,3 +10,4 @@
 ^man-roxygen$
 ^\.travis\.yml$
 ^staticdocs$
+^tools$

.gitattributes

@@ -0,0 +1 @@
+/NEWS merge=union

.travis.yml

@@ -10,12 +10,13 @@ install:
   - sudo apt-add-repository -y "deb http://cran.rstudio.com/bin/linux/ubuntu `lsb_release -cs`/"
   - sudo apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E084DAB9
   - sudo apt-add-repository -y ppa:marutter/c2d4u
-  - sudo apt-get update
-  - sudo apt-get install r-base-dev r-cran-shiny r-cran-cairo r-cran-markdown
+  - sudo apt-get -qq update
+  - sudo apt-get -qq install r-base r-cran-shiny r-cran-cairo r-cran-markdown r-cran-knitr
   - "[ ! -d ~/R ] && mkdir ~/R"
-  - Rscript -e "install.packages(c('xtable'), repos = 'http://cran.rstudio.org')"
-  - Rscript -e "install.packages('knitr', repos = c('http://rforge.net', 'http://cran.rstudio.org'))"
-  - Rscript -e "install.packages('$R_MY_PKG', dep = TRUE, repos = 'http://cran.rstudio.org')"
+  - echo "options(repos = c(CRAN = 'http://cran.rstudio.com'))" > ~/.Rprofile
+  - Rscript -e "install.packages(c('xtable'), quiet = TRUE)"
+  - Rscript -e "update.packages(instlib = '~/R', ask = FALSE, quiet = TRUE)"
+  - Rscript -e "install.packages('$R_MY_PKG', dep = TRUE, quiet = TRUE)"
 
 # run tests
 script:

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 0.9.1.9008
-Date: 2014-03-19
+Version: 0.10.1
+Date: 2014-06-13
 Author: RStudio, Inc.
 Maintainer: Winston Chang <winston@rstudio.com>
 Description: Shiny makes it incredibly easy to build interactive web
@@ -20,13 +20,14 @@ Imports:
     caTools,
     RJSONIO,
     xtable,
-    digest
+    digest,
+    htmltools (>= 0.2.4)
 Suggests:
     datasets,
-    markdown,
     Cairo (>= 1.5-5),
     testthat,
-    knitr
+    knitr (>= 1.6),
+    markdown
 URL: http://www.rstudio.com/shiny/
 BugReports: https://github.com/rstudio/shiny/issues
 Roxygen: list(wrap = FALSE)
@@ -36,13 +37,13 @@ Collate:
     'map.R'
     'globals.R'
     'utils.R'
-    'htmltools.R'
     'bootstrap.R'
     'cache.R'
     'fileupload.R'
     'graph.R'
     'hooks.R'
     'html-deps.R'
+    'htmltools.R'
     'imageutils.R'
     'jqueryui.R'
     'middleware-shiny.R'
@@ -58,7 +59,6 @@ Collate:
     'shinywrappers.R'
     'showcase.R'
     'slider.R'
-    'tags.R'
     'tar.R'
     'timer.R'
     'update-input.R'

NAMESPACE

@@ -1,4 +1,4 @@
-# Generated by roxygen2 (4.0.0): do not edit by hand
+# Generated by roxygen2 (4.0.1): do not edit by hand
 
 S3method("$",reactivevalues)
 S3method("$",shinyoutput)
@@ -13,21 +13,15 @@ S3method("[[",shinyoutput)
 S3method("[[<-",reactivevalues)
 S3method("[[<-",shinyoutput)
 S3method("names<-",reactivevalues)
-S3method(as.character,shiny.tag)
-S3method(as.character,shiny.tag.list)
 S3method(as.list,reactivevalues)
 S3method(as.shiny.appobj,character)
 S3method(as.shiny.appobj,list)
 S3method(as.shiny.appobj,shiny.appobj)
-S3method(format,html)
-S3method(format,shiny.tag)
-S3method(format,shiny.tag.list)
+S3method(as.tags,shiny.appobj)
+S3method(as.tags,shiny.render.function)
 S3method(names,reactivevalues)
-S3method(print,html)
 S3method(print,reactive)
 S3method(print,shiny.appobj)
-S3method(print,shiny.tag)
-S3method(print,shiny.tag.list)
 S3method(str,reactivevalues)
 export(HTML)
 export(a)
@@ -62,7 +56,6 @@ export(flowLayout)
 export(fluidPage)
 export(fluidRow)
 export(getDefaultReactiveDomain)
-export(getProvidedHtmlDependencies)
 export(h1)
 export(h2)
 export(h3)
@@ -86,7 +79,9 @@ export(installExprFunction)
 export(invalidateLater)
 export(is.reactive)
 export(is.reactivevalues)
+export(is.singleton)
 export(isolate)
+export(knit_print.html)
 export(knit_print.shiny.appobj)
 export(knit_print.shiny.render.function)
 export(knit_print.shiny.tag)
@@ -138,6 +133,7 @@ export(runGitHub)
 export(runUrl)
 export(selectInput)
 export(selectizeInput)
+export(serverInfo)
 export(shinyApp)
 export(shinyAppDir)
 export(shinyServer)
@@ -185,9 +181,10 @@ export(wellPanel)
 export(withMathJax)
 export(withReactiveDomain)
 export(withTags)
-import(RJSONIO)
 import(caTools)
 import(digest)
+import(htmltools)
 import(httpuv)
 import(methods)
 import(xtable)
+importFrom(RJSONIO,fromJSON)

NEWS

@@ -1,9 +1,45 @@
-shiny 0.9.1.9XXX
+shiny 0.10.1
+--------------------------------------------------------------------------------
+
+* Added Unicode support for Windows. Shiny apps running on Windows must use the
+  UTF-8 encoding for ui.R and server.R (also the optional global.R) if they
+  contain non-ASCII characters. See this article for details and examples:
+  http://shiny.rstudio.com/gallery/unicode-characters.html (#516)
+
+* `runGitHub()` also allows the 'username/repo' syntax now, which is equivalent
+  to `runGitHub('repo', 'username')`. (#427)
+
+* `navbarPage()` now accepts a `windowTitle` parameter to set the web browser
+  page title to something other than the title displayed in the navbar.
+
+* Added an `inline` argument to `textOutput()`, `imageOutput()`, `plotOutput()`,
+  and `htmlOutput()`. When `inline = TRUE`, these outputs will be put in
+  `span()` instead of the default `div()`. This occurs automatically when these
+  outputs are created via the inline expressions (e.g. `r textOutput(expr)`) in
+  R Markdown documents. See an R Markdown example at
+  http://shiny.rstudio.com/gallery/inline-output.html (#512)
+
+* Added support for option groups in the select/selectize inputs. When the
+  `choices` argument for `selectInput()`/`selectizeInput()` is a list of
+  sub-lists and any sub-list is of length greater than 1, the HTML tag
+  `<optgroup>` will be used. See an example at
+  http://shiny.rstudio.com/gallery/option-groups-for-selectize-input.html (#542)
+
+shiny 0.10.0
 --------------------------------------------------------------------------------
 
 * BREAKING CHANGE: By default, observers now terminate themselves if they were
   created during a session and that session ends. See ?domains for more details.
 
+* Shiny can now be used in R Markdown v2 documents, to create "Shiny Docs":
+  reports and presentations that combine narrative, statically computed output,
+  and fully dynamic inputs and outputs. For more info, including examples, see
+  http://rmarkdown.rstudio.com/authoring_shiny.html.
+
+* The `session` object that can be passed into a server function (e.g.
+  shinyServer(function(input, output, session) {...})) is now documented: see
+  `?session`.
+
 * Most inputs can now accept `NULL` label values to omit the label altogether.
 
 * New `actionLink` input control; like `actionButton`, but with the appearance
@@ -12,20 +48,39 @@ shiny 0.9.1.9XXX
 * `renderPlot` now calls `print` on its result if it's visible (i.e. no more
   explicit `print()` required for ggplot2).
 
+* Introduced Shiny app objects (see `?shinyApp`). These essentially replace the
+  little-advertised ability for `runApp` to take a `list(ui=..., server=...)`
+  as the first argument instead of a directory (though that ability remains for
+  backward compatibility). Unlike those lists, Shiny app objects are tagged with
+  class `shiny.appobj` so they can be run simply by printing them.
+
 * Added `maskReactiveContext` function. It blocks the current reactive context,
   to evaluate expressions that shouldn't use reactive sources directly. (This
   should not be commonly needed.)
 
 * Added `flowLayout`, `splitLayout`, and `inputPanel` functions for putting UI
-  elements side by side. `flowPanel` lays out its children in a left-to-right,
+  elements side by side. `flowLayout` lays out its children in a left-to-right,
   top-to-bottom arrangement. `splitLayout` evenly divides its horizontal space
   among its children (or unevenly divides if `cellWidths` argument is provided).
   `inputPanel` is like `flowPanel`, but with a light grey background, and is
   intended to be used to encapsulate small input controls wherever vertical
   space is at a premium.
 
+* Added `serverInfo` to obtain info about the Shiny Server if the app is served
+  through it.
+
+* Added an `inline` argument (TRUE/FALSE) in `checkboxGroupInput()` and
+  `radioButtons()` to allow the horizontal layout (inline = TRUE) of checkboxes
+  or radio buttons. (Thanks, @saurfang, #481)
+
 * `sliderInput` and `selectizeInput`/`selectInput` now use a standard horizontal
-  size instead of filling up all available horizontal space.
+  size instead of filling up all available horizontal space. Pass `width="100%"`
+  explicitly for the old behavior.
+
+* Added the `updateSelectizeInput()` function to make it possible to process
+  searching on the server side (i.e. using R), which can be much faster than the
+  client side processing (i.e. using HTML and JavaScript). See the article at
+  http://shiny.rstudio.com/articles/selectize.html for a detailed introduction.
 
 * Fixed a bug of renderDataTable() when the data object only has 1 row and 1
   column. (Thanks, ZJ Dai, #429)
@@ -36,6 +91,10 @@ shiny 0.9.1.9XXX
 * Fixed #220: the zip file for a directory created by some programs may not have
   the directory name as its first entry, in which case runUrl() can fail. (#220)
 
+* `runGitHub()` can also take a value of the form "username/repo" in its first
+  argument, e.g. both runGitHub("shiny_example", "rstudio") and
+  runGitHub("rstudio/shiny_example") are valid ways to run the GitHub repo.
+
 shiny 0.9.1
 --------------------------------------------------------------------------------
 

R/app.R

@@ -69,7 +69,7 @@ shinyApp <- function(ui, server, onStart=NULL, options=list(), uiPattern="/") {
 
     renderPage(uiValue, textConn)
     html <- paste(textConnectionValue(textConn), collapse='\n')
-    return(httpResponse(200, content=html))
+    return(httpResponse(200, content=enc2utf8(html)))
   }
 
   serverFuncSource <- function() {
@@ -112,9 +112,7 @@ shinyAppDir <- function(appDir, options=list()) {
         # If not, then take the last expression that's returned from ui.R.
         .globals$ui <- NULL
         on.exit(.globals$ui <- NULL, add = FALSE)
-        ui <- source(uiR,
-          local = new.env(parent = globalenv()),
-          keep.source = TRUE)$value
+        ui <- sourceUTF8(uiR, local = new.env(parent = globalenv()))$value
         if (!is.null(.globals$ui)) {
           ui <- .globals$ui[[1]]
         }
@@ -137,11 +135,7 @@ shinyAppDir <- function(appDir, options=list()) {
       # server.R.
       .globals$server <- NULL
       on.exit(.globals$server <- NULL, add = TRUE)
-      result <- source(
-        serverR,
-        local = new.env(parent = globalenv()),
-        keep.source = TRUE
-      )$value
+      result <- sourceUTF8(serverR, local = new.env(parent = globalenv()))$value
       if (!is.null(.globals$server)) {
         result <- .globals$server[[1]]
       }
@@ -169,7 +163,7 @@ shinyAppDir <- function(appDir, options=list()) {
     oldwd <<- getwd()
     setwd(appDir)
     if (file.exists(file.path.ci(appDir, "global.R")))
-      source(file.path.ci(appDir, "global.R"), keep.source = TRUE)
+      sourceUTF8(file.path.ci(appDir, "global.R"))
   }
   onEnd <- function() {
     setwd(oldwd)
@@ -224,6 +218,21 @@ print.shiny.appobj <- function(x, ...) {
   do.call(runApp, args)
 }
 
+#' @rdname shinyApp
+#' @method as.tags shiny.appobj
+#' @export
+as.tags.shiny.appobj <- function(x, ...) {
+  # jcheng 06/06/2014: Unfortunate copy/paste between this function and
+  # knit_print.shiny.appobj, but I am trying to make the most conservative
+  # change possible due to upcoming release.
+  opts <- x$options %OR% list()
+  width <- if (is.null(opts$width)) "100%" else opts$width
+  height <- if (is.null(opts$height)) "400" else opts$height
+
+  path <- addSubApp(x)
+  tags$iframe(src=path, width=width, height=height, class="shiny-frame")
+}
+
 #' Knitr S3 methods
 #'
 #' These S3 methods are necessary to help Shiny applications and UI chunks embed
@@ -234,26 +243,33 @@ print.shiny.appobj <- function(x, ...) {
 #' @param ... Additional knit_print arguments
 NULL
 
+# If there's an R Markdown runtime option set but it isn't set to Shiny, then
+# return a warning indicating the runtime is inappropriate for this object.
+# Returns NULL in all other cases.
+shiny_rmd_warning <- function() {
+  runtime <- knitr::opts_knit$get("rmarkdown.runtime")
+  if (!is.null(runtime) && runtime != "shiny")
+    # note that the RStudio IDE checks for this specific string to detect Shiny
+    # applications in static document
+    list(structure(
+      "Shiny application in a static R Markdown document",
+      class = "rmd_warning"))
+  else
+    NULL
+}
+
 #' @rdname knitr_methods
 #' @export
 knit_print.shiny.appobj <- function(x, ...) {
   opts <- x$options %OR% list()
   width <- if (is.null(opts$width)) "100%" else opts$width
   height <- if (is.null(opts$height)) "400" else opts$height
-  shiny_warning <- NULL
-  # if there's an R Markdown runtime option set but it isn't set to Shiny, then
-  # emit a warning indicating the runtime is inappropriate for this object
+
   runtime <- knitr::opts_knit$get("rmarkdown.runtime")
   if (!is.null(runtime) && runtime != "shiny") {
-    # note that the RStudio IDE checks for this specific string to detect Shiny
-    # applications in static document
-    shiny_warning <- list(structure(
-      "Shiny application in a static R Markdown document",
-      class = "rmd_warning"))
-
-    # create a box exactly the same dimensions as the Shiny app would have had
-    # (so the document continues to flow as it would have with the app), and
-    # display a diagnostic message
+    # If not rendering to a Shiny document, create a box exactly the same
+    # dimensions as the Shiny app would have had (so the document continues to
+    # flow as it would have with the app), and display a diagnostic message
     width <- validateCssUnit(width)
     height <- validateCssUnit(height)
     output <- tags$div(
@@ -273,51 +289,20 @@ knit_print.shiny.appobj <- function(x, ...) {
   # need to grab those and put them in meta, like in knit_print.shiny.tag. But
   # for now it's not an issue, so just return the HTML and warning.
 
-  knitr::asis_output(html_preserve(format(output, indent=FALSE)),
-                     meta = shiny_warning, cacheable = FALSE)
+  knitr::asis_output(htmlPreserve(format(output, indent=FALSE)),
+                     meta = shiny_rmd_warning(), cacheable = FALSE)
 }
 
-#' @rdname knitr_methods
-#' @export
-knit_print.shiny.tag <- function(x, ...) {
-  output <- surroundSingletons(x)
-  deps <- getNewestDeps(findDependencies(x))
-  content <- takeHeads(output)
-  head_content <- doRenderTags(tagList(content$head))
-
-  meta <- if (length(head_content) > 1 || head_content != "") {
-    list(structure(head_content, class = "shiny_head"))
-  }
-  meta <- c(meta, deps)
-
-  knitr::asis_output(html_preserve(format(content$ui, indent=FALSE)), meta = meta)
-}
-
-knit_print.html <- function(x, ...) {
-  deps <- getNewestDeps(findDependencies(x))
-  knitr::asis_output(html_preserve(as.character(x)),
-                     meta = if (length(deps)) list(deps))
-}
-
-#' @rdname knitr_methods
-#' @export
-knit_print.shiny.tag.list <- knit_print.shiny.tag
-
-
-# Lets us use a nicer syntax in knitr chunks than literally
+# Let us use a nicer syntax in knitr chunks than literally
 # calling output$value <- renderFoo(...) and fooOutput().
 #' @rdname knitr_methods
+#' @param inline Whether the object is printed inline.
 #' @export
-knit_print.shiny.render.function <- function(x, ...) {
+knit_print.shiny.render.function <- function(x, ..., inline = FALSE) {
+  x <- htmltools::as.tags(x, inline = inline)
   output <- knitr::knit_print(tagList(x))
   attr(output, "knit_cacheable") <- FALSE
+  attr(output, "knit_meta") <- append(attr(output, "knit_meta"),
+                                      shiny_rmd_warning())
   output
 }
-
-html_preserve <- function(x) {
-  x <- paste(x, collapse = "\r\n")
-  if (nzchar(x))
-    sprintf("<!--html_preserve-->%s<!--/html_preserve-->", x)
-  else
-    x
-}

R/bootstrap-layout.R

@@ -320,7 +320,7 @@ verticalLayout <- function(..., fluid = TRUE) {
 #'
 #' @seealso \code{\link{verticalLayout}}
 #'
-#' #' @examples
+#' @examples
 #' flowLayout(
 #'   numericInput("rows", "How many rows?", 5),
 #'   selectInput("letter", "Which letter?", LETTERS),
@@ -370,7 +370,7 @@ inputPanel <- function(...) {
 #' @param cellArgs Any additional attributes that should be used for each cell
 #'   of the layout.
 #'
-#' #' @examples
+#' @examples
 #' # Equal sizing
 #' splitLayout(
 #'   plotOutput("plot1"),

R/bootstrap.R

@@ -1,5 +1,4 @@
 #' @include utils.R
-#' @include htmltools.R
 NULL
 
 #' Create a Bootstrap page
@@ -38,16 +37,19 @@ bootstrapPage <- function(..., title = NULL, responsive = TRUE, theme = NULL) {
     }
     cssExt <- ext(".css")
     jsExt = ext(".js")
-    bs <- "shared/bootstrap"
+    bs <- c(
+      href = "shared/bootstrap",
+      file = system.file("www/shared/bootstrap", package = "shiny")
+    )
 
     list(
-      html_dependency("bootstrap", "2.3.2", path = bs,
+      htmlDependency("bootstrap", "2.3.2", bs,
         script = sprintf("js/bootstrap%s", jsExt),
         stylesheet = if (is.null(theme))
           sprintf("css/bootstrap%s", cssExt)
       ),
       if (responsive) {
-        html_dependency("bootstrap-responsive", "2.3.2", path = bs,
+        htmlDependency("bootstrap-responsive", "2.3.2", bs,
           stylesheet = sprintf("css/bootstrap-responsive%s", cssExt),
           meta = list(viewport = "width=device-width, initial-scale=1.0")
         )
@@ -55,7 +57,7 @@ bootstrapPage <- function(..., title = NULL, responsive = TRUE, theme = NULL) {
     )
   }
 
-  attach_dependency(
+  attachDependencies(
     tagList(
       if (!is.null(title)) tags$head(tags$title(title)),
       if (!is.null(theme)) {
@@ -158,6 +160,8 @@ pageWithSidebar <- function(headerPanel,
 #' @param theme Alternative Bootstrap stylesheet (normally a css file within the
 #'   www directory). For example, to use the theme located at
 #'   \code{www/bootstrap.css} you would use \code{theme = "bootstrap.css"}.
+#' @param windowTitle The title that should be displayed by the browser window.
+#'   Useful if \code{title} is not a string.
 #' @param icon Optional icon to appear on a \code{navbarMenu} tab.
 #'
 #' @return A UI defintion that can be passed to the \link{shinyUI} function.
@@ -192,7 +196,8 @@ navbarPage <- function(title,
                        collapsable = FALSE,
                        fluid = TRUE,
                        responsive = TRUE,
-                       theme = NULL) {
+                       theme = NULL,
+                       windowTitle = title) {
 
   # alias title so we can avoid conflicts w/ title in withTags
   pageTitle <- title
@@ -257,7 +262,7 @@ navbarPage <- function(title,
 
   # build the page
   bootstrapPage(
-    title = title,
+    title = windowTitle,
     responsive = responsive,
     theme = theme,
     div(class=navbarClass,
@@ -379,6 +384,11 @@ mainPanel <- function(..., width = 8) {
 #'   determine whether the panel should be displayed.
 #' @param ... Elements to include in the panel.
 #'
+#' @note You are not recommended to use special JavaScript characters such as a
+#'   period \code{.} in the input id's, but if you do use them anyway, for
+#'   example, \code{inputId = "foo.bar"}, you will have to use
+#'   \code{input["foo.bar"]} instead of \code{input.foo.bar} to read the input
+#'   value.
 #' @examples
 #' sidebarPanel(
 #'    selectInput(
@@ -555,6 +565,7 @@ checkboxInput <- function(inputId, label, value = FALSE) {
 #' @param choices List of values to show checkboxes for. If elements of the list
 #'   are named then that name rather than the value is displayed to the user.
 #' @param selected The values that should be initially selected, if any.
+#' @param inline If \code{TRUE}, render the choices inline (i.e. horizontally)
 #' @return A list of HTML elements that can be added to a UI definition.
 #'
 #' @family input elements
@@ -567,37 +578,19 @@ checkboxInput <- function(inputId, label, value = FALSE) {
 #'                      "Gears" = "gear"))
 #'
 #' @export
-checkboxGroupInput <- function(inputId, label, choices, selected = NULL) {
+checkboxGroupInput <- function(inputId, label, choices, selected = NULL, inline = FALSE) {
   # resolve names
   choices <- choicesWithNames(choices)
   if (!is.null(selected))
     selected <- validateSelected(selected, choices, inputId)
 
-  # Create tags for each of the options
-  ids <- paste0(inputId, seq_along(choices))
-
-  checkboxes <- mapply(ids, choices, names(choices),
-    SIMPLIFY = FALSE, USE.NAMES = FALSE,
-    FUN = function(id, value, name) {
-      inputTag <- tags$input(type = "checkbox",
-                             name = inputId,
-                             id = id,
-                             value = value)
-
-    if (value %in% selected)
-      inputTag$attribs$checked <- "checked"
-
-    tags$label(class = "checkbox",
-               inputTag,
-               tags$span(name))
-    }
-  )
+  options <- generateOptions(inputId, choices, selected, inline)
 
   # return label and select tag
   tags$div(id = inputId,
            class = "control-group shiny-input-checkboxgroup",
            controlLabel(inputId, label),
-           checkboxes)
+           options)
 }
 
 # Before shiny 0.9, `selected` refers to names/labels of `choices`; now it
@@ -605,11 +598,12 @@ checkboxGroupInput <- function(inputId, label, choices, selected = NULL) {
 validateSelected <- function(selected, choices, inputId) {
   # drop names, otherwise toJSON() keeps them too
   selected <- unname(selected)
-  if (is.list(choices)) {
-    # <optgroup> is not there yet
-    if (any(sapply(choices, length) > 1)) return(selected)
-    choices <- unlist(choices)
-  }
+  # if you are using optgroups, you're using shiny > 0.10.0, and you should
+  # already know that `selected` must be a value instead of a label
+  if (needOptgroup(choices)) return(selected)
+
+  if (is.list(choices)) choices <- unlist(choices)
+
   nms <- names(choices)
   # labels and values are identical, no need to validate
   if (identical(nms, unname(choices))) return(selected)
@@ -627,6 +621,29 @@ validateSelected <- function(selected, choices, inputId) {
   selected
 }
 
+# generate options for radio buttons and checkbox groups (type = 'checkbox' or
+# 'radio')
+generateOptions <- function(inputId, choices, selected, inline, type = 'checkbox') {
+  # create tags for each of the options
+  ids <- paste0(inputId, seq_along(choices))
+  # generate a list of <input type=? [checked] />
+  mapply(
+    ids, choices, names(choices),
+    FUN = function(id, value, name) {
+      inputTag <- tags$input(
+        type = type, name = inputId, id = id, value = value
+      )
+      if (value %in% selected)
+        inputTag$attribs$checked <- "checked"
+      tags$label(
+        class = paste(type, if (inline) "inline"),
+        inputTag, tags$span(name)
+      )
+    },
+    SIMPLIFY = FALSE, USE.NAMES = FALSE
+  )
+}
+
 #' Create a help text element
 #'
 #' Create help text which can be added to an input form to provide additional
@@ -651,20 +668,43 @@ controlLabel <- function(controlName, label) {
 # Takes a vector or list, and adds names (same as the value) to any entries
 # without names.
 choicesWithNames <- function(choices) {
-  if (is.null(choices)) return(choices)  # ignore NULL
+  # Take a vector or list, and convert to list. Also, if any children are
+  # vectors with length > 1, convert those to list. If the list is unnamed,
+  # convert it to a named list with blank names.
+  listify <- function(obj) {
+    # If a list/vector is unnamed, give it blank names
+    makeNamed <- function(x) {
+      if (is.null(names(x))) names(x) <- character(length(x))
+      x
+    }
 
-  # get choice names
-  choiceNames <- names(choices)
-  if (is.null(choiceNames))
-    choiceNames <- character(length(choices))
+    res <- lapply(obj, function(val) {
+      if (is.list(val))
+        listify(val)
+      else if (length(val) == 1)
+        val
+      else
+        makeNamed(as.list(val))
+    })
+
+    makeNamed(res)
+  }
+
+  choices <- listify(choices)
+  if (length(choices) == 0) return(choices)
+
+  # Recurse into any subgroups
+  choices <- mapply(choices, names(choices), FUN = function(choice, name) {
+    if (!is.list(choice)) return(choice)
+    if (name == "") stop('All sub-lists in "choices" must be named.')
+    choicesWithNames(choice)
+  }, SIMPLIFY = FALSE)
 
   # default missing names to choice values
-  missingNames <- choiceNames == ""
-  choiceNames[missingNames] <- paste(choices)[missingNames]
-  names(choices) <- choiceNames
+  missing <- names(choices) == ""
+  names(choices)[missing] <- as.character(choices)[missing]
 
-  # return choices
-  return (choices)
+  choices
 }
 
 #' Create a select list input control
@@ -704,21 +744,11 @@ selectInput <- function(inputId, label, choices, selected = NULL,
 
   # default value if it's not specified
   if (is.null(selected)) {
-    if (!multiple) selected <- choices[[1]]
+    if (!multiple) selected <- firstChoice(choices)
   } else selected <- validateSelected(selected, choices, inputId)
 
-  # Create tags for each of the options
-  options <- HTML(paste("<option value=\"",
-    htmlEscape(choices),
-    "\"",
-    ifelse(choices %in% selected, " selected", ""),
-    ">",
-    htmlEscape(names(choices)),
-    "</option>",
-    sep = "", collapse = "\n"));
-
   # create select tag and add options
-  selectTag <- tags$select(id = inputId, options)
+  selectTag <- tags$select(id = inputId, selectOptions(choices, selected))
   if (multiple)
     selectTag$attribs$multiple <- "multiple"
 
@@ -728,6 +758,44 @@ selectInput <- function(inputId, label, choices, selected = NULL,
   selectizeIt(inputId, res, NULL, width, nonempty = !multiple && !("" %in% choices))
 }
 
+firstChoice <- function(choices) {
+  if (length(choices) == 0L) return()
+  choice <- choices[[1]]
+  if (is.list(choice)) firstChoice(choice) else choice
+}
+
+# Create tags for each of the options; use <optgroup> if necessary.
+# This returns a HTML string instead of tags, because of the 'selected'
+# attribute.
+selectOptions <- function(choices, selected = NULL) {
+  html <- mapply(choices, names(choices), FUN = function(choice, label) {
+    if (is.list(choice)) {
+      # If sub-list, create an optgroup and recurse into the sublist
+      sprintf(
+        '<optgroup label="%s">\n%s\n</optgroup>',
+        htmlEscape(label),
+        selectOptions(choice, selected)
+      )
+
+    } else {
+      # If single item, just return option string
+      sprintf(
+        '<option value="%s"%s>%s</option>',
+        htmlEscape(choice),
+        if (choice %in% selected) ' selected' else '',
+        htmlEscape(label)
+      )
+    }
+  })
+
+  HTML(paste(html, collapse = '\n'))
+}
+
+# need <optgroup> when choices contains sub-lists
+needOptgroup <- function(choices) {
+  any(vapply(choices, is.list, logical(1)))
+}
+
 #' @rdname selectInput
 #' @param ... Arguments passed to \code{selectInput()}.
 #' @param options A list of options. See the documentation of \pkg{selectize.js}
@@ -753,7 +821,8 @@ selectizeInput <- function(inputId, ..., options = NULL, width = NULL) {
 selectizeIt <- function(inputId, select, options, width = NULL, nonempty = FALSE) {
   res <- checkAsIs(options)
 
-  selectizeDep <- html_dependency("selectize", "0.8.5", "shared/selectize",
+  selectizeDep <- htmlDependency(
+    "selectize", "0.8.5", c(href = "shared/selectize"),
     stylesheet = "css/selectize.bootstrap2.css",
     head = format(tagList(
       HTML('<!--[if lt IE 9]>'),
@@ -762,7 +831,7 @@ selectizeIt <- function(inputId, select, options, width = NULL, nonempty = FALSE
       tags$script(src = 'shared/selectize/js/selectize.min.js')
     ))
   )
-  attach_dependency(
+  attachDependencies(
     tagList(
       select,
       tags$script(
@@ -787,6 +856,7 @@ selectizeIt <- function(inputId, select, options, width = NULL, nonempty = FALSE
 #' named then that name rather than the value is displayed to the user)
 #' @param selected The initially selected value (if not specified then
 #' defaults to the first value)
+#' @param inline If \code{TRUE}, render the choices inline (i.e. horizontally)
 #' @return A set of radio buttons that can be added to a UI definition.
 #'
 #' @family input elements
@@ -799,7 +869,7 @@ selectizeIt <- function(inputId, select, options, width = NULL, nonempty = FALSE
 #'                "Log-normal" = "lnorm",
 #'                "Exponential" = "exp"))
 #' @export
-radioButtons <- function(inputId, label, choices, selected = NULL) {
+radioButtons <- function(inputId, label, choices, selected = NULL, inline = FALSE) {
   # resolve names
   choices <- choicesWithNames(choices)
 
@@ -807,33 +877,14 @@ radioButtons <- function(inputId, label, choices, selected = NULL) {
   selected <- if (is.null(selected)) choices[[1]] else {
     validateSelected(selected, choices, inputId)
   }
+  if (length(selected) > 1) stop("The 'selected' argument must be of length 1")
 
-  # Create tags for each of the options
-  ids <- paste0(inputId, seq_along(choices))
-
-  inputTags <- mapply(ids, choices, names(choices),
-    SIMPLIFY = FALSE, USE.NAMES = FALSE,
-    FUN = function(id, value, name) {
-      inputTag <- tags$input(type = "radio",
-                             name = inputId,
-                             id = id,
-                             value = value)
-
-      if (identical(value, selected))
-        inputTag$attribs$checked = "checked"
-
-      # Put the label text in a span
-      tags$label(class = "radio",
-                inputTag,
-                tags$span(name)
-      )
-    }
-  )
+  options <- generateOptions(inputId, choices, selected, inline, type = 'radio')
 
   tags$div(id = inputId,
     class = 'control-group shiny-input-radiogroup',
     label %AND% tags$label(class = "control-label", `for` = inputId, label),
-    inputTags)
+    options)
 }
 
 #' Create a submit button
@@ -979,8 +1030,9 @@ sliderInput <- function(inputId, label, min, max, value, step = NULL,
   }
 }
 
-datePickerDependency <- html_dependency("bootstrap-datepicker", "1.0.2",
-  "shared/datepicker", script = "js/bootstrap-datepicker.min.js",
+datePickerDependency <- htmlDependency(
+  "bootstrap-datepicker", "1.0.2", c(href = "shared/datepicker"),
+  script = "js/bootstrap-datepicker.min.js",
   stylesheet = "css/datepicker.css")
 
 #' Create date input
@@ -1059,7 +1111,7 @@ dateInput <- function(inputId, label, value = NULL, min = NULL, max = NULL,
   if (inherits(min,   "Date"))  min   <- format(min,   "%Y-%m-%d")
   if (inherits(max,   "Date"))  max   <- format(max,   "%Y-%m-%d")
 
-  attach_dependency(
+  attachDependencies(
     tags$div(id = inputId,
              class = "shiny-date-input",
 
@@ -1158,7 +1210,7 @@ dateRangeInput <- function(inputId, label, start = NULL, end = NULL,
   if (inherits(min,   "Date"))  min   <- format(min,   "%Y-%m-%d")
   if (inherits(max,   "Date"))  max   <- format(max,   "%Y-%m-%d")
 
-  attach_dependency(
+  attachDependencies(
     tags$div(id = inputId,
              # input-daterange class is needed for dropdown behavior
              class = "shiny-date-range-input input-daterange",
@@ -1484,13 +1536,15 @@ buildTabset <- function(tabs,
 #' text will be included within an HTML \code{div} tag by default.
 #' @param outputId output variable to read the value from
 #' @param container a function to generate an HTML element to contain the text
+#' @param inline use an inline (\code{span()}) or block container (\code{div()})
+#'   for the output
 #' @return A text output element that can be included in a panel
 #' @details Text is HTML-escaped prior to rendering. This element is often used
-#' to display \link{renderText} output variables.
+#'   to display \link{renderText} output variables.
 #' @examples
 #' h3(textOutput("caption"))
 #' @export
-textOutput <- function(outputId, container = div) {
+textOutput <- function(outputId, container = if (inline) span else div, inline = FALSE) {
   container(id = outputId, class = "shiny-text-output")
 }
 
@@ -1524,6 +1578,7 @@ verbatimTextOutput <- function(outputId) {
 #'   \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
 #'   string and have \code{"px"} appended.
 #' @param height Image height
+#' @inheritParams textOutput
 #' @return An image output element that can be included in a panel
 #' @examples
 #' # Show an image
@@ -1531,38 +1586,45 @@ verbatimTextOutput <- function(outputId) {
 #'   imageOutput("dataImage")
 #' )
 #' @export
-imageOutput <- function(outputId, width = "100%", height="400px") {
+imageOutput <- function(outputId, width = "100%", height="400px", inline=FALSE) {
   style <- paste("width:", validateCssUnit(width), ";",
     "height:", validateCssUnit(height))
-  div(id = outputId, class = "shiny-image-output", style = style)
+  container <- if (inline) span else div
+  container(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
-#' @param width Plot width. Must be a valid CSS unit (like \code{"100\%"},
-#'   \code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
-#'   string and have \code{"px"} appended.
-#' @param height Plot height
+#' @param width,height Plot width/height. 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. These two arguments are
+#'   ignored when \code{inline = TRUE}, in which case the width/height of a plot
+#'   must be specified in \code{renderPlot()}.
 #' @param clickId If not \code{NULL}, the plot will send coordinates to the
 #'   server whenever it is clicked. This information will be accessible on the
-#'   \code{input} object using \code{input$}\emph{\code{clickId}}. The value will be a
-#'   named list or vector with \code{x} and \code{y} elements indicating the
-#'   mouse position in user units.
+#'   \code{input} object using \code{input$}\emph{\code{clickId}}. The value
+#'   will be a named list or vector with \code{x} and \code{y} elements
+#'   indicating the mouse position in user units.
 #' @param hoverId If not \code{NULL}, the plot will send coordinates to the
 #'   server whenever the mouse pauses on the plot for more than the number of
 #'   milliseconds determined by \code{hoverTimeout}. This information will be
-#    accessible on the \code{input} object using \code{input$}\emph{\code{clickId}}.
-#'   The value will be \code{NULL} if the user is not hovering, and a named
-#'   list or vector with \code{x} and \code{y} elements indicating the mouse
-#'   position in user units.
+#'   accessible on the \code{input} object using
+#'   \code{input$}\emph{\code{clickId}}. The value will be \code{NULL} if the
+#'   user is not hovering, and a named list or vector with \code{x} and \code{y}
+#'   elements indicating the mouse position in user units.
 #' @param hoverDelay The delay for hovering, in milliseconds.
 #' @param hoverDelayType The type of algorithm for limiting the number of hover
 #'   events. Use \code{"throttle"} to limit the number of hover events to one
 #'   every \code{hoverDelay} milliseconds. Use \code{"debounce"} to suspend
 #'   events while the cursor is moving, and wait until the cursor has been at
 #'   rest for \code{hoverDelay} milliseconds before sending an event.
+#' @inheritParams textOutput
+#' @note The arguments \code{clickId} and \code{hoverId} only work for R base
+#'   graphics (see the \pkg{\link{graphics}} package). They do not work for
+#'   \pkg{\link[grid:grid-package]{grid}}-based graphics, such as \pkg{ggplot2},
+#'   \pkg{lattice}, and so on.
 #' @return A plot output element that can be included in a panel
 #' @examples
 #' # Show a plot of the generated distribution
@@ -1572,7 +1634,7 @@ imageOutput <- function(outputId, width = "100%", height="400px") {
 #' @export
 plotOutput <- function(outputId, width = "100%", height="400px",
                        clickId = NULL, hoverId = NULL, hoverDelay = 300,
-                       hoverDelayType = c("debounce", "throttle")) {
+                       hoverDelayType = c("debounce", "throttle"), inline = FALSE) {
   if (is.null(clickId) && is.null(hoverId)) {
     hoverDelay <- NULL
     hoverDelayType <- NULL
@@ -1580,9 +1642,12 @@ plotOutput <- function(outputId, width = "100%", height="400px",
     hoverDelayType <- match.arg(hoverDelayType)[[1]]
   }
 
-  style <- paste("width:", validateCssUnit(width), ";",
-    "height:", validateCssUnit(height))
-  div(id = outputId, class = "shiny-plot-output", style = style,
+  style <- if (!inline) {
+    paste("width:", validateCssUnit(width), ";", "height:", validateCssUnit(height))
+  }
+
+  container <- if (inline) span else div
+  container(id = outputId, class = "shiny-plot-output", style = style,
       `data-click-id` = clickId,
       `data-hover-id` = hoverId,
       `data-hover-delay` = hoverDelay,
@@ -1604,12 +1669,12 @@ tableOutput <- function(outputId) {
 }
 
 dataTableDependency <- list(
-  html_dependency(
-    "datatables", "1.9.4", "shared/datatables",
+  htmlDependency(
+    "datatables", "1.9.4", c(href = "shared/datatables"),
     script = "js/jquery.dataTables.min.js"
   ),
-  html_dependency(
-    "datatables-bootstrap", "1.9.4", "shared/datatables",
+  htmlDependency(
+    "datatables-bootstrap", "1.9.4", c(href = "shared/datatables"),
     stylesheet = "css/DT_bootstrap.css",
     script = "js/DT_bootstrap.js"
   )
@@ -1618,7 +1683,7 @@ dataTableDependency <- list(
 #' @rdname tableOutput
 #' @export
 dataTableOutput <- function(outputId) {
-  attach_dependency(
+  attachDependencies(
     div(id = outputId, class="shiny-datatable-output"),
     dataTableDependency
   )
@@ -1634,19 +1699,19 @@ dataTableOutput <- function(outputId) {
 #' server side. It is currently just an alias for \code{htmlOutput}.
 #'
 #' @param outputId output variable to read the value from
+#' @inheritParams textOutput
 #' @return An HTML output element that can be included in a panel
 #' @examples
 #' htmlOutput("summary")
 #' @export
-htmlOutput <- function(outputId) {
-  div(id = outputId, class="shiny-html-output")
+htmlOutput <- function(outputId, inline = FALSE) {
+  container <- if (inline) span else div
+  container(id = outputId, class="shiny-html-output")
 }
 
 #' @rdname htmlOutput
 #' @export
-uiOutput <- function(outputId) {
-  htmlOutput(outputId)
-}
+uiOutput <- htmlOutput
 
 #' Create a download button or link
 #'
@@ -1762,49 +1827,3 @@ icon <- function(name, class = NULL, lib = "font-awesome") {
 iconClass <- function(icon) {
   if (!is.null(icon)) icon[[2]]$attribs$class
 }
-
-#' Validate proper CSS formatting of a unit
-#'
-#' Checks that the argument is valid for use as a CSS unit of length.
-#'
-#' \code{NULL} and \code{NA} are returned unchanged.
-#'
-#' Single element numeric vectors are returned as a character vector with the
-#' number plus a suffix of \code{"px"}.
-#'
-#' Single element character vectors must be \code{"auto"} or \code{"inherit"},
-#' or a number. If the number has a suffix, it must be valid: \code{px},
-#' \code{\%}, \code{em}, \code{pt}, \code{in}, \code{cm}, \code{mm}, \code{ex},
-#' or \code{pc}. If the number has no suffix, the suffix \code{"px"} is
-#' appended.
-#'
-#' Any other value will cause an error to be thrown.
-#'
-#' @param x The unit to validate. Will be treated as a number of pixels if a
-#'   unit is not specified.
-#' @return A properly formatted CSS unit of length, if possible. Otherwise, will
-#'   throw an error.
-#' @examples
-#' validateCssUnit("10%")
-#' validateCssUnit(400)  #treated as '400px'
-#' @export
-validateCssUnit <- function(x) {
-  if (is.null(x) || is.na(x))
-    return(x)
-
-  if (length(x) > 1 || (!is.character(x) && !is.numeric(x)))
-    stop('CSS units must be a numeric or character vector with a single element')
-
-  # if the input is a character vector consisting only of digits (e.g. "960"), coerce it to a
-  # numeric value
-  if (is.character(x) && nchar(x) > 0 && gsub("\\d*", "", x) == "")
-    x <- as.numeric(x)
-
-  if (is.character(x) &&
-     !grepl("^(auto|inherit|((\\.\\d+)|(\\d+(\\.\\d+)?))(%|in|cm|mm|em|ex|pt|pc|px))$", x)) {
-    stop('"', x, '" is not a valid CSS unit (e.g., "100%", "400px", "auto")')
-  } else if (is.numeric(x)) {
-    x <- paste(x, "px", sep = "")
-  }
-  x
-}

R/globals.R

@@ -5,5 +5,5 @@
   # R's lazy-loading package scheme causes the private seed to be cached in the
   # package itself, making our PRNG completely deterministic. This line resets
   # the private seed during load.
-  withPrivateSeed(set.seed(NULL))
+  withPrivateSeed(reinitializeSeed())
 }

R/graph.R

@@ -55,7 +55,7 @@ renderReactLog <- function() {
 }
 
 .graphAppend <- function(logEntry, domain = getDefaultReactiveDomain()) {
-  if (isTRUE(getOption('shiny.reactlog', FALSE)))
+  if (isTRUE(getOption('shiny.reactlog')))
     .graphEnv$log <- c(.graphEnv$log, list(logEntry))
 
   if (!is.null(domain)) {

R/html-deps.R

@@ -1,5 +1,3 @@
-pathPattern <- "^(~|/|[a-zA-Z]:[/\\\\]|\\\\\\\\)"
-
 createWebDependency <- function(dependency) {
   if (is.null(dependency))
     return(NULL)
@@ -7,53 +5,11 @@ createWebDependency <- function(dependency) {
   if (!inherits(dependency, "html_dependency"))
     stop("Unexpected non-html_dependency type")
 
-  # Does it look like a path on disk? Register it as a resource and replace the
-  # disk-based path with a relative URL
-  if (grepl(pathPattern, dependency$path, perl = TRUE)) {
+  if (is.null(dependency$src$href)) {
     prefix <- paste(dependency$name, "-", dependency$version, sep = "")
-    addResourcePath(prefix, dependency$path)
-    dependency$path <- prefix
+    addResourcePath(prefix, dependency$src$file)
+    dependency$src$href <- prefix
   }
 
   return(dependency)
 }
-
-# Given a list of dependencies, choose the latest versions and return them as a
-# named list in the correct order.
-getNewestDeps <- function(dependencies) {
-  result <- list()
-  for (dep in dependencies) {
-    if (!is.null(dep)) {
-      other <- result[[dep$name]]
-      if (is.null(other) || compareVersion(dep$version, other$version) > 0) {
-        # Note that if the dep was already in the result list, then this
-        # assignment preserves its position in the list
-        result[[dep$name]] <- dep
-      }
-    }
-  }
-  return(result)
-}
-
-# Remove `remove` from `dependencies` if the name matches.
-# dependencies is a named list of dependencies.
-# remove is a named list of dependencies that take priority.
-# If warnOnConflict, then warn when a dependency is being removed because of an
-# older version already being loaded.
-removeDeps <- function(dependencies, remove, warnOnConflict = TRUE) {
-  matches <- names(dependencies) %in% names(remove)
-  if (warnOnConflict) {
-    for (depname in names(dependencies)[matches]) {
-      loser <- dependencies[[depname]]
-      winner <- remove[[depname]]
-      if (compareVersion(loser$version, winner$version) > 0) {
-        warning(sprintf(paste("The dependency %s %s conflicts with",
-          "version %s"), loser$name, loser$version, winner$version
-        ))
-      }
-    }
-  }
-
-  # Return only deps that weren't in remove
-  return(dependencies[!matches])
-}

R/htmltools.R

@@ -1,97 +1,7 @@
-
-
-# Define an HTML dependency
-#
-# Define an HTML dependency (e.g. CSS or Javascript and related library). HTML
-# dependency definitions are required for \code{\link{html_output}} that
-# require CSS or JavaScript within the document head to render correctly.
-#
-# @param name Library name
-# @param version Library version
-# @param path Full path to library
-# @param meta Named list of meta tags to insert into document head
-# @param script Script(s) to include within the document head (should be
-#   specified relative to the \code{path} parameter).
-# @param stylesheet Stylesheet(s) to include within the document (should be
-#   specified relative to the \code{path} parameter).
-# @param head Arbitrary lines of HTML to insert into the document head
-#
-# @return An object that can be included in the list of dependencies passed to
-#   \code{\link{html_print}} or \code{\link{html_knit_print}}.
-#
-# @details See the documentation on
-#   \href{http://rmarkdown.rstudio.com/developer_html_widgets.html}{R
-#   Markdown HTML Widgets} for examples and additional details.
-#
-html_dependency <- function(name,
-  version,
-  path,
-  meta = NULL,
-  script = NULL,
-  stylesheet = NULL,
-  head = NULL) {
-  structure(class = "html_dependency", list(
-    name = name,
-    version = version,
-    path = path,
-    meta = meta,
-    script = script,
-    stylesheet = stylesheet,
-    head = head
-  ))
-}
-
-
-# Given a list of HTML dependencies produce a character representation
-# suitable for inclusion within the head of an HTML document
-html_dependencies_as_character <- function(dependencies, lib_dir = NULL) {
-
-  html <- c()
-
-  for (dep in dependencies) {
-
-    # copy library files if necessary
-    if (!is.null(lib_dir)) {
-
-      if (!file.exists(lib_dir))
-        dir.create(lib_dir)
-
-      target_dir <- file.path(lib_dir, basename(dep$path))
-      if (!file.exists(target_dir))
-        file.copy(from = dep$path, to = lib_dir, recursive = TRUE)
-
-      dep$path <- file.path(basename(lib_dir), basename(target_dir))
-    }
-
-    # add meta content
-    for (name in names(dep$meta)) {
-      html <- c(html, paste("<meta name=\"", name,
-        "\" content=\"", dep$meta[[name]], "\" />",
-        sep = ""))
-    }
-
-    # add stylesheets
-    for (stylesheet in dep$stylesheet) {
-      stylesheet <- file.path(dep$path, stylesheet)
-      html <- c(html, paste("<link href=\"", stylesheet, "\" ",
-        "rel=\"stylesheet\" />",
-        sep = ""))
-    }
-
-    # add scripts
-    for (script in dep$script) {
-      script <- file.path(dep$path, script)
-      html <- c(html,
-        paste("<script src=\"", script, "\"></script>", sep = ""))
-    }
-
-    # add raw head content
-    html <- c(html, dep$head)
-  }
-
-  html
-}
-
-attach_dependency <- function(x, dependency) {
-  structure(x, html_dependency = dependency)
-}
+#' @export a br code div em h1 h2 h3 h4 h5 h6 hr HTML img p pre span strong
+#' @export includeCSS includeHTML includeMarkdown includeScript includeText
+#' @export is.singleton singleton
+#' @export tag tagAppendAttributes tagAppendChild tagAppendChildren tagList tags tagSetChildren withTags
+#' @export validateCssUnit
+#' @export knit_print.html knit_print.shiny.tag knit_print.shiny.tag.list
+NULL

R/imageutils.R

@@ -34,7 +34,7 @@ plotPNG <- function(func, filename=tempfile(fileext='.png'),
   # Finally, if neither quartz nor Cairo, use png().
   if (capabilities("aqua")) {
     pngfun <- png
-  } else if (getOption('shiny.usecairo', TRUE) &&
+  } else if ((getOption('shiny.usecairo') %OR% TRUE) &&
              nchar(system.file(package = "Cairo"))) {
     pngfun <- Cairo::CairoPNG
   } else {
@@ -42,9 +42,15 @@ plotPNG <- function(func, filename=tempfile(fileext='.png'),
   }
 
   pngfun(filename=filename, width=width, height=height, res=res, ...)
-  # Call plot.new() so that even if no plotting operations are performed
-  # at least we have a blank background
-  plot.new()
+  # Call plot.new() so that even if no plotting operations are performed at
+  # least we have a blank background. N.B. we need to set the margin to 0
+  # temporarily before plot.new() because when the plot size is small (e.g.
+  # 200x50), we will get an error "figure margin too large", which is triggered
+  # by plot.new() with the default (large) margin. However, this does not
+  # guarantee user's code in func() will not trigger the error -- they may have
+  # to set par(mar = smaller_value) before they draw base graphics.
+  op <- par(mar = rep(0, 4))
+  tryCatch(plot.new(), finally = par(op))
   dv <- dev.cur()
   tryCatch(shinyCallingHandlers(func()), finally = dev.off(dv))
 

R/middleware-shiny.R

@@ -5,7 +5,7 @@ reactLogHandler <- function(req) {
   if (!identical(req$PATH_INFO, '/reactlog'))
     return(NULL)
 
-  if (!getOption('shiny.reactlog', FALSE)) {
+  if (!isTRUE(getOption('shiny.reactlog'))) {
     return(NULL)
   }
 

R/middleware.R

@@ -281,7 +281,7 @@ HandlerManager <- setRefClass("HandlerManager",
     createHttpuvApp = function() {
       list(
         onHeaders = function(req) {
-          maxSize <- getOption('shiny.maxRequestSize', 5 * 1024 * 1024)
+          maxSize <- getOption('shiny.maxRequestSize') %OR% (5 * 1024 * 1024)
           if (maxSize <= 0)
             return(NULL)
 
@@ -306,7 +306,7 @@ HandlerManager <- setRefClass("HandlerManager",
           function (req) {
             return(handlers$invoke(req))
           },
-          getOption('shiny.sharedSecret', NULL)
+          getOption('shiny.sharedSecret')
         ),
         onWSOpen = function(ws) {
           return(wsHandlers$invoke(ws))
@@ -314,7 +314,7 @@ HandlerManager <- setRefClass("HandlerManager",
       )
     },
     .httpServer = function(handler, sharedSecret) {
-      filter <- getOption('shiny.http.response.filter', NULL)
+      filter <- getOption('shiny.http.response.filter')
       if (is.null(filter))
         filter <- function(req, response) response
 
@@ -329,11 +329,11 @@ HandlerManager <- setRefClass("HandlerManager",
         response <- handler(req)
         if (is.null(response))
           response <- httpResponse(404, content="<h1>Not Found</h1>")
-        
+
         if (inherits(response, "httpResponse")) {
           headers <- as.list(response$headers)
           headers$'Content-Type' <- response$content_type
-  
+
           response <- filter(req, response)
           return(list(status=response$status,
             body=response$content,

R/react.R

@@ -98,7 +98,7 @@ ReactiveEnvironment <- setRefClass(
     },
     currentContext = function() {
       if (is.null(.currentContext)) {
-        if (isTRUE(getOption('shiny.suppressMissingContextError', FALSE))) {
+        if (isTRUE(getOption('shiny.suppressMissingContextError'))) {
           return(getDummyContext())
         } else {
           stop('Operation not allowed without an active reactive context. ',
@@ -138,7 +138,7 @@ ReactiveEnvironment <- setRefClass(
       reactiveEnvironment <<- ReactiveEnvironment$new()
     return(reactiveEnvironment)
   }
-}) 
+})
 
 # Causes any pending invalidations to run.
 flushReact <- function() {

R/reactive-domains.R

@@ -75,6 +75,7 @@ createMockDomain <- function() {
 #
 ## ------------------------------------------------------------------------
 
+#' @name domains
 #' @rdname domains
 #' @export
 getDefaultReactiveDomain <- function() {

R/run-url.R

@@ -1,112 +1,22 @@
-#' Run a Shiny application from https://gist.github.com
-#'
-#' Download and launch a Shiny application that is hosted on GitHub as a gist.
-#'
-#' @param gist The identifier of the gist. For example, if the gist is
-#'   https://gist.github.com/jcheng5/3239667, then \code{3239667},
-#'   \code{'3239667'}, and \code{'https://gist.github.com/jcheng5/3239667'}
-#'   are all valid values.
-#' @param port The TCP port that the application should listen on. Defaults to
-#'   choosing a random port.
-#' @param launch.browser If true, the system's default web browser will be
-#'   launched automatically after the app is started. Defaults to true in
-#'   interactive sessions only.
-#'
-#' @examples
-#' \dontrun{
-#' runGist(3239667)
-#' runGist("https://gist.github.com/jcheng5/3239667")
-#'
-#' # Old URL format without username
-#' runGist("https://gist.github.com/3239667")
-#' }
-#'
-#' @export
-runGist <- function(gist,
-                    port=NULL,
-                    launch.browser=getOption('shiny.launch.browser',
-                                             interactive())) {
-
-  gistUrl <- if (is.numeric(gist) || grepl('^[0-9a-f]+$', gist)) {
-    sprintf('https://gist.github.com/%s/download', gist)
-  } else if(grepl('^https://gist.github.com/([^/]+/)?([0-9a-f]+)$', gist)) {
-    paste(gist, '/download', sep='')
-  } else {
-    stop('Unrecognized gist identifier format')
-  }
-
-  runUrl(gistUrl, filetype=".tar.gz", subdir=NULL, port=port,
-    launch.browser=launch.browser)
-}
-
-
-#' Run a Shiny application from a GitHub repository
-#'
-#' Download and launch a Shiny application that is hosted in a GitHub repository.
-#'
-#' @param repo Name of the repository
-#' @param username GitHub username
-#' @param ref Desired git reference. Could be a commit, tag, or branch
-#'   name. Defaults to \code{"master"}.
-#' @param subdir A subdirectory in the repository that contains the app. By
-#'   default, this function will run an app from the top level of the repo, but
-#'   you can use a path such as `\code{"inst/shinyapp"}.
-#' @param port The TCP port that the application should listen on. Defaults to
-#'   choosing a random port.
-#' @param launch.browser If true, the system's default web browser will be
-#'   launched automatically after the app is started. Defaults to true in
-#'   interactive sessions only.
-#'
-#' @examples
-#' \dontrun{
-#' runGitHub("shiny_example", "rstudio")
-#'
-#' # Can run an app from a subdirectory in the repo
-#' runGitHub("shiny_example", "rstudio", subdir = "inst/shinyapp/")
-#' }
-#'
-#' @export
-runGitHub <- function(repo, username = getOption("github.user"),
-  ref = "master", subdir = NULL, port = NULL,
-  launch.browser = getOption('shiny.launch.browser', interactive())) {
-
-  if (is.null(ref)) {
-    stop("Must specify either a ref. ")
-  }
-
-  message("Downloading github repo(s) ",
-    paste(repo, ref, sep = "/", collapse = ", "),
-    " from ",
-    paste(username, collapse = ", "))
-  name <- paste(username, "-", repo, sep = "")
-
-  url <- paste("https://github.com/", username, "/", repo, "/archive/",
-    ref, ".tar.gz", sep = "")
-
-  runUrl(url, subdir=subdir, port=port, launch.browser=launch.browser)
-}
-
-
 #' Run a Shiny application from a URL
 #'
-#' Download and launch a Shiny application that is hosted at a downloadable
-#' URL. The Shiny application must be saved in a .zip, .tar, or .tar.gz file.
-#' The Shiny application files must be contained in a subdirectory in the
-#' archive. For example, the files might be \code{myapp/server.r} and
-#' \code{myapp/ui.r}.
-#'
+#' \code{runUrl()} downloads and launches a Shiny application that is hosted at
+#' a downloadable URL. The Shiny application must be saved in a .zip, .tar, or
+#' .tar.gz file. The Shiny application files must be contained in the root
+#' directory or a subdirectory in the archive. For example, the files might be
+#' \code{myapp/server.r} and \code{myapp/ui.r}. The functions \code{runGitHub()}
+#' and \code{runGist()} are based on \code{runUrl()}, using URL's from GitHub
+#' (\url{https://github.com}) and GitHub gists (\url{https://gist.github.com}),
+#' respectively.
 #' @param url URL of the application.
 #' @param filetype The file type (\code{".zip"}, \code{".tar"}, or
 #'   \code{".tar.gz"}. Defaults to the file extension taken from the url.
 #' @param subdir A subdirectory in the repository that contains the app. By
 #'   default, this function will run an app from the top level of the repo, but
 #'   you can use a path such as `\code{"inst/shinyapp"}.
-#' @param port The TCP port that the application should listen on. Defaults to
-#'   choosing a random port.
-#' @param launch.browser If true, the system's default web browser will be
-#'   launched automatically after the app is started. Defaults to true in
-#'   interactive sessions only.
-#'
+#' @param ... Other arguments to be passed to \code{\link{runApp}()}, such as
+#'   \code{port} and \code{launch.browser}.
+#' @export
 #' @examples
 #' \dontrun{
 #' runUrl('https://github.com/rstudio/shiny_example/archive/master.tar.gz')
@@ -115,10 +25,7 @@ runGitHub <- function(repo, username = getOption("github.user"),
 #' runUrl("https://github.com/rstudio/shiny_example/archive/master.zip",
 #'  subdir = "inst/shinyapp/")
 #' }
-#'
-#' @export
-runUrl <- function(url, filetype = NULL, subdir = NULL, port = NULL,
-  launch.browser = getOption('shiny.launch.browser', interactive())) {
+runUrl <- function(url, filetype = NULL, subdir = NULL, ...) {
 
   if (!is.null(subdir) && ".." %in% strsplit(subdir, '/')[[1]])
     stop("'..' not allowed in subdir")
@@ -163,5 +70,65 @@ runUrl <- function(url, filetype = NULL, subdir = NULL, port = NULL,
   if (!file_test('-d', appdir)) appdir <- dirname(appdir)
 
   if (!is.null(subdir)) appdir <- file.path(appdir, subdir)
-  runApp(appdir, port=port, launch.browser=launch.browser)
+  runApp(appdir, ...)
+}
+
+#' @rdname runUrl
+#' @param gist The identifier of the gist. For example, if the gist is
+#'   https://gist.github.com/jcheng5/3239667, then \code{3239667},
+#'   \code{'3239667'}, and \code{'https://gist.github.com/jcheng5/3239667'} are
+#'   all valid values.
+#' @export
+#' @examples
+#' \dontrun{
+#' runGist(3239667)
+#' runGist("https://gist.github.com/jcheng5/3239667")
+#'
+#' # Old URL format without username
+#' runGist("https://gist.github.com/3239667")
+#' }
+#'
+runGist <- function(gist, ...) {
+
+  gistUrl <- if (is.numeric(gist) || grepl('^[0-9a-f]+$', gist)) {
+    sprintf('https://gist.github.com/%s/download', gist)
+  } else if(grepl('^https://gist.github.com/([^/]+/)?([0-9a-f]+)$', gist)) {
+    paste(gist, '/download', sep='')
+  } else {
+    stop('Unrecognized gist identifier format')
+  }
+
+  runUrl(gistUrl, filetype=".tar.gz", ...)
+}
+
+
+#' @rdname runUrl
+#' @param repo Name of the repository.
+#' @param username GitHub username. If \code{repo} is of the form
+#'   \code{"username/repo"}, \code{username} will be taken from \code{repo}.
+#' @param ref Desired git reference. Could be a commit, tag, or branch name.
+#'   Defaults to \code{"master"}.
+#' @export
+#' @examples
+#' \dontrun{
+#' runGitHub("shiny_example", "rstudio")
+#' # or runGitHub("rstudio/shiny_example")
+#'
+#' # Can run an app from a subdirectory in the repo
+#' runGitHub("shiny_example", "rstudio", subdir = "inst/shinyapp/")
+#' }
+runGitHub <- function(repo, username = getOption("github.user"),
+                      ref = "master", subdir = NULL, ...) {
+
+  if (grepl('/', repo)) {
+    res <- strsplit(repo, '/')[[1]]
+    if (length(res) != 2) stop("'repo' must be of the form 'username/repo'")
+    username <- res[1]
+    repo     <- res[2]
+  }
+
+  url <- paste("https://github.com/", username, "/", repo, "/archive/",
+               ref, ".tar.gz", sep = "")
+
+  runUrl(url, subdir=subdir, ...)
 }

R/server.R

@@ -249,8 +249,11 @@ decodeMessage <- function(data) {
     packBits(rawToBits(data[pos:(pos+3)]), type='integer')
   }
 
-  if (readInt(1) != 0x01020202L)
-    return(fromJSON(rawToChar(data), asText=TRUE, simplify=FALSE))
+  if (readInt(1) != 0x01020202L) {
+    # use native encoding for the message
+    nativeData <- iconv(rawToChar(data), 'UTF-8')
+    return(fromJSON(nativeData, asText=TRUE, simplify=FALSE))
+  }
 
   i <- 5
   parts <- list()
@@ -278,7 +281,7 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
   # This value, if non-NULL, must be present on all HTTP and WebSocket
   # requests as the Shiny-Shared-Secret header or else access will be
   # denied (403 response for HTTP, and instant close for websocket).
-  sharedSecret <- getOption('shiny.sharedSecret', NULL)
+  sharedSecret <- getOption('shiny.sharedSecret')
 
   appHandlers <- list(
     http = joinHandlers(c(
@@ -303,7 +306,7 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
         if (is.character(msg))
           msg <- charToRaw(msg)
 
-        if (getOption('shiny.trace', FALSE)) {
+        if (isTRUE(getOption('shiny.trace'))) {
           if (binary)
             message("RECV ", '$$binary data$$')
           else
@@ -463,7 +466,7 @@ identicalFunctionBodies <- function(a, b) {
 handlerManager <- HandlerManager$new()
 
 addSubApp <- function(appObj, autoRemove = TRUE) {
-  path <- sprintf("/%s", createUniqueId(16))
+  path <- createUniqueId(16, "/app")
   appHandlers <- createAppHandlers(appObj$httpHandler, appObj$serverFuncSource)
 
   # remove the leading / from the path so a relative path is returned
@@ -634,7 +637,9 @@ runApp <- function(appDir=getwd(),
   if (is.character(appDir)) {
     desc <- file.path.ci(appDir, "DESCRIPTION")
     if (file.exists(desc)) {
-      settings <- read.dcf(desc)
+      con <- file(desc, encoding = checkEncoding(desc))
+      on.exit(close(con), add = TRUE)
+      settings <- read.dcf(con)
       if ("DisplayMode" %in% colnames(settings)) {
         mode <- settings[1,"DisplayMode"]
         if (mode == "Showcase") {

R/shiny.R

@@ -15,17 +15,27 @@ NULL
 #' @name shiny-package
 #' @aliases shiny
 #' @docType package
-#' @import httpuv caTools RJSONIO xtable digest methods
+#' @import htmltools httpuv caTools xtable digest methods
+#' @importFrom RJSONIO fromJSON
 NULL
 
-createUniqueId <- function(bytes) {
+createUniqueId <- function(bytes, prefix = "", suffix = "") {
   withPrivateSeed({
     paste(
-      format(as.hexmode(sample(256, bytes, replace = TRUE)-1), width=2),
-      collapse = "")
+      prefix,
+      paste(
+        format(as.hexmode(sample(256, bytes, replace = TRUE)-1), width=2),
+        collapse = ""),
+      suffix,
+      sep = ""
+    )
   })
 }
 
+toJSON <- function(x, ..., digits = getOption("shiny.json.digits", 16)) {
+  RJSONIO::toJSON(x, digits = digits, ...)
+}
+
 # Call the workerId func with no args to get the worker id, and with an arg to
 # set it.
 #
@@ -483,11 +493,13 @@ ShinySession <- setRefClass(
       if (closed){
         return()
       }
-      if (getOption('shiny.trace', FALSE))
+      if (isTRUE(getOption('shiny.trace')))
         message('SEND ',
            gsub('(?m)base64,[a-zA-Z0-9+/=]+','[base64 data]',json,perl=TRUE))
-      if (getOption('shiny.transcode.json', TRUE))
-        json <- iconv(json, to='UTF-8')
+      # first convert to native encoding, then to UTF8, otherwise we may get the
+      # error in Chrome "WebSocket connection failed: Could not decode a text
+      # frame as UTF-8"
+      json <- enc2utf8(enc2native(json))
       .websocket$send(json)
     },
 

R/shinyui.R

@@ -1,143 +1,5 @@
 #' @include globals.R
-
-#' @rdname builder
-#' @export
-p <- function(...) tags$p(...)
-
-#' @rdname builder
-#' @export
-h1 <- function(...) tags$h1(...)
-
-#' @rdname builder
-#' @export
-h2 <- function(...) tags$h2(...)
-
-#' @rdname builder
-#' @export
-h3 <- function(...) tags$h3(...)
-
-#' @rdname builder
-#' @export
-h4 <- function(...) tags$h4(...)
-
-#' @rdname builder
-#' @export
-h5 <- function(...) tags$h5(...)
-
-#' @rdname builder
-#' @export
-h6 <- function(...) tags$h6(...)
-
-#' @rdname builder
-#' @export
-a <- function(...) tags$a(...)
-
-#' @rdname builder
-#' @export
-br <- function(...) tags$br(...)
-
-#' @rdname builder
-#' @export
-div <- function(...) tags$div(...)
-
-#' @rdname builder
-#' @export
-span <- function(...) tags$span(...)
-
-#' @rdname builder
-#' @export
-pre <- function(...) tags$pre(...)
-
-#' @rdname builder
-#' @export
-code <- function(...) tags$code(...)
-
-#' @rdname builder
-#' @export
-img <- function(...) tags$img(...)
-
-#' @rdname builder
-#' @export
-strong <- function(...) tags$strong(...)
-
-#' @rdname builder
-#' @export
-em <- function(...) tags$em(...)
-
-#' @rdname builder
-#' @export
-hr <- function(...) tags$hr(...)
-
-#' Include Content From a File
-#'
-#' Include HTML, text, or rendered Markdown into a \link[=shinyUI]{Shiny UI}.
-#'
-#' These functions provide a convenient way to include an extensive amount of
-#' HTML, textual, Markdown, CSS, or JavaScript content, rather than using a
-#' large literal R string.
-#'
-#' @note \code{includeText} escapes its contents, but does no other processing.
-#'   This means that hard breaks and multiple spaces will be rendered as they
-#'   usually are in HTML: as a single space character. If you are looking for
-#'   preformatted text, wrap the call with \code{\link{pre}}, or consider using
-#'   \code{includeMarkdown} instead.
-#'
-#' @note The \code{includeMarkdown} function requires the \code{markdown}
-#'   package.
-#'
-#' @param path The path of the file to be included. It is highly recommended to
-#'   use a relative path (the base path being the Shiny application directory),
-#'   not an absolute path.
-#'
-#' @rdname include
-#' @name include
-#' @aliases includeHTML
-#' @export
-includeHTML <- function(path) {
-  dependsOnFile(path)
-  lines <- readLines(path, warn=FALSE, encoding='UTF-8')
-  return(HTML(paste(lines, collapse='\r\n')))
-}
-
-#' @rdname include
-#' @export
-includeText <- function(path) {
-  dependsOnFile(path)
-  lines <- readLines(path, warn=FALSE, encoding='UTF-8')
-  return(paste(lines, collapse='\r\n'))
-}
-
-#' @rdname include
-#' @export
-includeMarkdown <- function(path) {
-  library(markdown)
-
-  dependsOnFile(path)
-  html <- markdown::markdownToHTML(path, fragment.only=TRUE)
-  Encoding(html) <- 'UTF-8'
-  return(HTML(html))
-}
-
-#' @param ... Any additional attributes to be applied to the generated tag.
-#' @rdname include
-#' @export
-includeCSS <- function(path, ...) {
-  dependsOnFile(path)
-  lines <- readLines(path, warn=FALSE, encoding='UTF-8')
-  args <- list(...)
-  if (is.null(args$type))
-    args$type <- 'text/css'
-  return(do.call(tags$style,
-                 c(list(HTML(paste(lines, collapse='\r\n'))), args)))
-}
-
-#' @rdname include
-#' @export
-includeScript <- function(path, ...) {
-  dependsOnFile(path)
-  lines <- readLines(path, warn=FALSE, encoding='UTF-8')
-  return(tags$script(HTML(paste(lines, collapse='\r\n')), ...))
-}
+NULL
 
 #' Load the MathJax library and typeset math expressions
 #'
@@ -162,22 +24,6 @@ withMathJax <- function(...) {
   )
 }
 
-#' Include Content Only Once
-#'
-#' Use \code{singleton} to wrap contents (tag, text, HTML, or lists) that should
-#' be included in the generated document only once, yet may appear in the
-#' document-generating code more than once. Only the first appearance of the
-#' content (in document order) will be used. Useful for custom components that
-#' have JavaScript files or stylesheets.
-#'
-#' @param x A \code{\link{tag}}, text, \code{\link{HTML}}, or list.
-#'
-#' @export
-singleton <- function(x) {
-  class(x) <- c(class(x), 'shiny.singleton')
-  return(x)
-}
-
 renderPage <- function(ui, connection, showcase=0) {
 
   if (showcase > 0)
@@ -187,17 +33,19 @@ renderPage <- function(ui, connection, showcase=0) {
 
   deps <- c(
     list(
-      html_dependency("jquery", "1.11.0", "shared", script = "jquery.js"),
-      html_dependency("shiny", packageVersion("shiny"), "shared",
+      htmlDependency("json2", "2014.02.04", c(href="shared"), script = "json2-min.js"),
+      htmlDependency("jquery", "1.11.0", c(href="shared"), script = "jquery.js"),
+      htmlDependency("shiny", packageVersion("shiny"), c(href="shared"),
         script = "shiny.js", stylesheet = "shiny.css")
     ),
     result$dependencies
   )
+  deps <- resolveDependencies(deps)
   deps <- lapply(deps, createWebDependency)
   depStr <- paste(sapply(deps, function(dep) {
     sprintf("%s[%s]", dep$name, dep$version)
   }), collapse = ";")
-  depHtml <- html_dependencies_as_character(deps)
+  depHtml <- renderDependencies(deps, "href")
 
   # write preamble
   writeLines(c('<!DOCTYPE html>',
@@ -281,23 +129,6 @@ uiHttpHandler <- function(ui, path = "/") {
       ui
     renderPage(uiValue, textConn, showcaseMode)
     html <- paste(textConnectionValue(textConn), collapse='\n')
-    return(httpResponse(200, content=html))
+    return(httpResponse(200, content=enc2utf8(html)))
   }
 }
-
-#' Return HTML dependencies provided by Shiny
-#'
-#' By default, Shiny supplies some framework scripts when it renders a page.
-#' \code{getProvidedHtmlDependencies} returns a list of those provided objects.
-#'
-#' @return A list of objects of type \code{html_dependency}, one per dependency
-#'
-#' @export
-getProvidedHtmlDependencies <- function() {
-  list(structure(
-    list(name = "jquery",
-         version = "1.11.0",
-         path = system.file("www/shared/jquery.js", package="shiny"),
-         script = "jquery.js"),
-    class = "html_dependency"))
-}

R/shinywrappers.R

@@ -16,18 +16,26 @@ globalVariables('func')
 #'
 #' @export
 markRenderFunction <- function(uiFunc, renderFunc) {
-  class(renderFunc) <- c("shiny.render.function", "function")
-  attr(renderFunc, "outputFunc") <- uiFunc
-  renderFunc
+  structure(renderFunc,
+            class      = c("shiny.render.function", "function"),
+            outputFunc = uiFunc)
 }
 
-useRenderFunction <- function(renderFunc) {
+useRenderFunction <- function(renderFunc, inline = FALSE) {
   outputFunction <- attr(renderFunc, "outputFunc")
-  id <- createUniqueId(8)
+  id <- createUniqueId(8, "out")
   o <- getDefaultReactiveDomain()$output
   if (!is.null(o))
     o[[id]] <- renderFunc
-  return(outputFunction(id))
+  if (is.logical(formals(outputFunction)[["inline"]])) {
+    outputFunction(id, inline = inline)
+  } else outputFunction(id)
+}
+
+#' @export
+#' @method as.tags shiny.render.function
+as.tags.shiny.render.function <- function(x, ..., inline = FALSE) {
+  useRenderFunction(x, inline = inline)
 }
 
 #' Plot Output
@@ -42,16 +50,13 @@ useRenderFunction <- function(renderFunc) {
 #'   the output, see \code{\link{plotPNG}}.
 #'
 #' @param expr An expression that generates a plot.
-#' @param width The width of the rendered plot, in pixels; or \code{'auto'} to
-#'   use the \code{offsetWidth} of the HTML element that is bound to this plot.
-#'   You can also pass in a function that returns the width in pixels or
-#'   \code{'auto'}; in the body of the function you may reference reactive
-#'   values and functions.
-#' @param height The height of the rendered plot, in pixels; or \code{'auto'} to
-#'   use the \code{offsetHeight} of the HTML element that is bound to this plot.
-#'   You can also pass in a function that returns the width in pixels or
-#'   \code{'auto'}; in the body of the function you may reference reactive
-#'   values and functions.
+#' @param width,height The width/height of the rendered plot, in pixels; or
+#'   \code{'auto'} to use the \code{offsetWidth}/\code{offsetHeight} of the HTML
+#'   element that is bound to this plot. You can also pass in a function that
+#'   returns the width/height in pixels or \code{'auto'}; in the body of the
+#'   function you may reference reactive values and functions. When rendering an
+#'   inline plot, you must provide numeric values (in pixels) to both
+#'   \code{width} and \code{height}.
 #' @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.
@@ -88,10 +93,8 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
   # div needs to adapt to the height of renderPlot. By default, plotOutput
   # sets the height to 400px, so to make it adapt we need to override it
   # with NULL.
-  outputFunc <- if (identical(height, 'auto'))
-    plotOutput
-  else
-    function(outputId) plotOutput(outputId, height = NULL)
+  outputFunc <- plotOutput
+  if (!identical(height, 'auto')) formals(outputFunc)['height'] <- list(NULL)
 
   return(markRenderFunction(outputFunc, function(shinysession, name, ...) {
     if (!is.null(widthWrapper))
@@ -314,7 +317,7 @@ renderTable <- function(expr, ..., env=parent.frame(), quoted=FALSE, func=NULL)
   }
 
   markRenderFunction(tableOutput, function() {
-    classNames <- getOption('shiny.table.class', 'data table table-bordered table-condensed')
+    classNames <- getOption('shiny.table.class') %OR% 'data table table-bordered table-condensed'
     data <- func()
 
     if (is.null(data) || identical(data, data.frame()))
@@ -459,7 +462,8 @@ renderUI <- function(expr, env=parent.frame(), quoted=FALSE, func=NULL) {
 
     result <- takeSingletons(result, shinysession$singletons, desingleton=FALSE)$ui
     result <- surroundSingletons(result)
-    dependencies <- lapply(getNewestDeps(findDependencies(result)), createWebDependency)
+    dependencies <- lapply(resolveDependencies(findDependencies(result)),
+      createWebDependency)
     names(dependencies) <- NULL
 
     # renderTags returns a list with head, singletons, and html

R/showcase.R

@@ -31,13 +31,13 @@ licenseLink <- function(licenseName) {
 showcaseHead <- function() {
 
   deps  <- list(
-    html_dependency("jqueryui", "1.10.4", "shared/jqueryui/1.10.4",
+    htmlDependency("jqueryui", "1.10.4", c(href="shared/jqueryui/1.10.4"),
       script = "jquery-ui.min.js"),
-    html_dependency("showdown", "0.3.1", "shared/showdown/compressed",
+    htmlDependency("showdown", "0.3.1", c(href="shared/showdown/compressed"),
       script = "showdown.js"),
-    html_dependency("font-awesome", "4.0.3", "shared/font-awesome",
+    htmlDependency("font-awesome", "4.0.3", c(href="shared/font-awesome"),
       stylesheet = "css/font-awesome.min.css"),
-    html_dependency("highlight.js", "6.2", "shared/highlight",
+    htmlDependency("highlight.js", "6.2", c(href="shared/highlight"),
       script = "highlight.pack.js")
   )
 
@@ -50,11 +50,11 @@ showcaseHead <- function() {
          href="shared/shiny-showcase.css"),
     if (file.exists(mdfile))
       script(type="text/markdown", id="showcase-markdown-content",
-        paste(readLines(mdfile, warn = FALSE), collapse="\n"))
+        paste(readUTF8(mdfile), collapse="\n"))
     else ""
   ))
 
-  return(attach_dependency(html, deps))
+  return(attachDependencies(html, deps))
 }
 
 # Returns tags containing the application metadata (title and author) in
@@ -106,8 +106,7 @@ showcaseCodeTabs <- function(codeLicense) {
                   # we need to prevent the indentation of <code> ... </code>
                   HTML(format(tags$code(
                     class="language-r",
-                    paste(readLines(file.path.ci(getwd(), rFile), warn=FALSE),
-                          collapse="\n")
+                    paste(readUTF8(file.path.ci(getwd(), rFile)), collapse="\n")
                   ), indent = FALSE))))
         })),
     codeLicense))
@@ -121,7 +120,9 @@ showcaseAppInfo <- function() {
   readmemd <- file.path.ci(getwd(), "Readme.md")
   hasReadme <- file.exists(readmemd)
   if (hasDesc) {
-    desc <- read.dcf(descfile)
+    con <- textConnection(readUTF8(descfile))
+    on.exit(close(con), add = TRUE)
+    desc <- read.dcf(con)
   }
   with(tags,
     div(class="container-fluid shiny-code-container well",

R/slider.R

@@ -99,13 +99,12 @@ slider <- function(inputId, min, max, value, step = NULL, ...,
   }
 
   # build slider
-  dep <- html_dependency(name = "jslider", version = "1",
-    path = "shared/slider",
+  dep <- htmlDependency("jslider", "1", c(href="shared/slider"),
     script = "js/jquery.slider.min.js",
     stylesheet = "css/jquery.slider.min.css"
   )
   sliderFragment <- list(
-    attach_dependency(
+    attachDependencies(
       tags$input(
         id=inputId, type="slider",
         name=inputId, value=paste(value, collapse=';'), class="jslider",

R/tags.R

@@ -1,637 +0,0 @@
-
-
-htmlEscape <- local({
-  .htmlSpecials <- list(
-    `&` = '&amp;',
-    `<` = '&lt;',
-    `>` = '&gt;'
-  )
-  .htmlSpecialsPattern <- paste(names(.htmlSpecials), collapse='|')
-  .htmlSpecialsAttrib <- c(
-    .htmlSpecials,
-    `'` = '&#39;',
-    `"` = '&quot;',
-    `\r` = '&#13;',
-    `\n` = '&#10;'
-  )
-  .htmlSpecialsPatternAttrib <- paste(names(.htmlSpecialsAttrib), collapse='|')
-
-  function(text, attribute=TRUE) {
-    pattern <- if(attribute)
-      .htmlSpecialsPatternAttrib
-    else
-      .htmlSpecialsPattern
-
-    # Short circuit in the common case that there's nothing to escape
-    if (!any(grepl(pattern, text)))
-      return(text)
-
-    specials <- if(attribute)
-      .htmlSpecialsAttrib
-    else
-      .htmlSpecials
-
-    for (chr in names(specials)) {
-      text <- gsub(chr, specials[[chr]], text, fixed=TRUE)
-    }
-
-    return(text)
-  }
-})
-
-isTag <- function(x) {
-  inherits(x, "shiny.tag")
-}
-
-#' @export
-print.shiny.tag <- function(x, ...) {
-  print(as.character(x), ...)
-  invisible(x)
-}
-
-# indent can be numeric to indicate an initial indent level,
-# or FALSE to suppress
-#' @export
-format.shiny.tag <- function(x, ..., singletons = character(0), indent = 0) {
-  as.character(renderTags(x, singletons = singletons, indent = indent)$html)
-}
-
-#' @export
-as.character.shiny.tag <- function(x, ...) {
-  renderTags(x)$html
-}
-
-#' @export
-print.shiny.tag.list <- print.shiny.tag
-
-#' @export
-format.shiny.tag.list <- format.shiny.tag
-
-#' @export
-as.character.shiny.tag.list <- as.character.shiny.tag
-
-#' @export
-print.html <- function(x, ...) {
-  cat(x, "\n")
-  invisible(x)
-}
-
-#' @export
-format.html <- function(x, ...) {
-  as.character(x)
-}
-
-normalizeText <- function(text) {
-  if (!is.null(attr(text, "html")))
-    text
-  else
-    htmlEscape(text, attribute=FALSE)
-
-}
-
-#' @rdname tag
-#' @export
-tagList <- function(...) {
-  lst <- list(...)
-  class(lst) <- c("shiny.tag.list", "list")
-  return(lst)
-}
-
-#' @rdname tag
-#' @export
-tagAppendAttributes <- function(tag, ...) {
-  tag$attribs <- c(tag$attribs, list(...))
-  tag
-}
-
-#' @rdname tag
-#' @export
-tagAppendChild <- function(tag, child) {
-  tag$children[[length(tag$children)+1]] <- child
-  tag
-}
-
-#' @rdname tag
-#' @export
-tagAppendChildren <- function(tag, ..., list = NULL) {
-  tag$children <- c(tag$children, c(list(...), list))
-  tag
-}
-
-#' @rdname tag
-#' @export
-tagSetChildren <- function(tag, ..., list = NULL) {
-  tag$children <- c(list(...), list)
-  tag
-}
-
-#' HTML Tag Object
-#'
-#' \code{tag()} creates an HTML tag definition. Note that all of the valid HTML5
-#' tags are already defined in the \code{\link{tags}} environment so these
-#' functions should only be used to generate additional tags.
-#' \code{tagAppendChild()} and \code{tagList()} are for supporting package
-#' authors who wish to create their own sets of tags; see the contents of
-#' bootstrap.R for examples.
-#' @param _tag_name HTML tag name
-#' @param varArgs List of attributes and children of the element. Named list
-#'   items become attributes, and unnamed list items become children. Valid
-#'   children are tags, single-character character vectors (which become text
-#'   nodes), and raw HTML (see \code{\link{HTML}}). You can also pass lists that
-#'   contain tags, text nodes, and HTML.
-#' @param tag A tag to append child elements to.
-#' @param child A child element to append to a parent tag.
-#' @param ...  Unnamed items that comprise this list of tags.
-#' @param list An optional list of elements. Can be used with or instead of the
-#'   \code{...} items.
-#' @return An HTML tag object that can be rendered as HTML using
-#'   \code{\link{as.character}()}.
-#' @export
-#' @examples
-#' tagList(tags$h1("Title"),
-#'         tags$h2("Header text"),
-#'         tags$p("Text here"))
-#'
-#' # Can also convert a regular list to a tagList (internal data structure isn't
-#' # exactly the same, but when rendered to HTML, the output is the same).
-#' x <- list(tags$h1("Title"),
-#'           tags$h2("Header text"),
-#'           tags$p("Text here"))
-#' tagList(x)
-tag <- function(`_tag_name`, varArgs) {
-  # Get arg names; if not a named list, use vector of empty strings
-  varArgsNames <- names(varArgs)
-  if (is.null(varArgsNames))
-    varArgsNames <- character(length=length(varArgs))
-
-  # Named arguments become attribs, dropping NULL values
-  named_idx <- nzchar(varArgsNames)
-  attribs <- dropNulls(varArgs[named_idx])
-
-  # Unnamed arguments are flattened and added as children.
-  # Use unname() to remove the names attribute from the list, which would
-  # consist of empty strings anyway.
-  children <- unname(varArgs[!named_idx])
-
-  # Return tag data structure
-  structure(
-    list(name = `_tag_name`,
-         attribs = attribs,
-         children = children),
-    class = "shiny.tag"
-  )
-}
-
-tagWrite <- function(tag, textWriter, indent=0, eol = "\n") {
-
-  if (length(tag) == 0)
-    return (NULL)
-
-  # optionally process a list of tags
-  if (!isTag(tag) && is.list(tag)) {
-    tag <- dropNullsOrEmpty(flattenTags(tag))
-    lapply(tag, tagWrite, textWriter, indent)
-    return (NULL)
-  }
-
-  nextIndent <- if (is.numeric(indent)) indent + 1 else indent
-  indent <- if (is.numeric(indent)) indent else 0
-
-  # compute indent text
-  indentText <- paste(rep(" ", indent*2), collapse="")
-
-  # Check if it's just text (may either be plain-text or HTML)
-  if (is.character(tag)) {
-    textWriter(paste(indentText, normalizeText(tag), eol, sep=""))
-    return (NULL)
-  }
-
-  # write tag name
-  textWriter(paste(indentText, "<", tag$name, sep=""))
-
-  # Convert all attribs to chars explicitly; prevents us from messing up factors
-  attribs <- lapply(tag$attribs, as.character)
-  # concatenate attributes
-  # split() is very slow, so avoid it if possible
-  if (anyDuplicated(names(attribs)))
-    attribs <- lapply(split(attribs, names(attribs)), paste, collapse = " ")
-
-  # write attributes
-  for (attrib in names(attribs)) {
-    attribValue <- attribs[[attrib]]
-    if (!is.na(attribValue)) {
-      if (is.logical(attribValue))
-        attribValue <- tolower(attribValue)
-      text <- htmlEscape(attribValue, attribute=TRUE)
-      textWriter(paste(" ", attrib,"=\"", text, "\"", sep=""))
-    }
-    else {
-      textWriter(paste(" ", attrib, sep=""))
-    }
-  }
-
-  # write any children
-  children <- dropNullsOrEmpty(flattenTags(tag$children))
-  if (length(children) > 0) {
-    textWriter(">")
-
-    # special case for a single child text node (skip newlines and indentation)
-    if ((length(children) == 1) && is.character(children[[1]]) ) {
-      textWriter(paste(normalizeText(children[[1]]), "</", tag$name, ">", eol,
-        sep=""))
-    }
-    else {
-      textWriter("\n")
-      for (child in children)
-        tagWrite(child, textWriter, nextIndent)
-      textWriter(paste(indentText, "</", tag$name, ">", eol, sep=""))
-    }
-  }
-  else {
-    # only self-close void elements
-    # (see: http://dev.w3.org/html5/spec/single-page.html#void-elements)
-    if (tag$name %in% c("area", "base", "br", "col", "command", "embed", "hr",
-                        "img", "input", "keygen", "link", "meta", "param",
-                        "source", "track", "wbr")) {
-      textWriter(paste("/>", eol, sep=""))
-    }
-    else {
-      textWriter(paste("></", tag$name, ">", eol, sep=""))
-    }
-  }
-}
-
-doRenderTags <- function(ui, indent = 0) {
-  # Render the body--the bodyHtml variable will be created
-  conn <- file(open="w+")
-  connWriter <- function(text) writeChar(text, conn, eos = NULL)
-  htmlResult <- tryCatch({
-    tagWrite(ui, connWriter, indent)
-    flush(conn)
-    readLines(conn)
-  },
-    finally = close(conn)
-  )
-  return(HTML(paste(htmlResult, collapse = "\n")))
-}
-
-renderTags <- function(ui, singletons = character(0), indent = 0) {
-  # Do singleton and head processing before rendering
-  singletonInfo <- takeSingletons(ui, singletons)
-  headInfo <- takeHeads(singletonInfo$ui)
-  deps <- getNewestDeps(findDependencies(singletonInfo$ui))
-
-  headIndent <- if (is.numeric(indent)) indent + 1 else indent
-  headHtml <- doRenderTags(headInfo$head, indent = headIndent)
-  bodyHtml <- doRenderTags(headInfo$ui, indent = indent)
-
-  return(list(head = headHtml,
-              singletons = singletonInfo$singletons,
-              dependencies = deps,
-              html = bodyHtml))
-}
-
-# Walk a tree of tag objects, rewriting objects according to func.
-# preorder=TRUE means preorder tree traversal, that is, an object
-# should be rewritten before its children.
-rewriteTags <- function(ui, func, preorder) {
-  if (preorder)
-    ui <- func(ui)
-
-  if (isTag(ui)) {
-    ui$children[] <- lapply(ui$children, rewriteTags, func, preorder)
-  } else if (is.list(ui)) {
-    ui[] <- lapply(ui, rewriteTags, func, preorder)
-  }
-
-  if (!preorder)
-    ui <- func(ui)
-
-  return(ui)
-}
-
-# Preprocess a tag object by changing any singleton X into
-# <!--SHINY.SINGLETON[sig]-->X'<!--/SHINY.SINGLETON[sig]-->
-# where sig is the sha1 of X, and X' is X minus the singleton
-# attribute.
-#
-# In the case of nested singletons, outer singletons are processed
-# before inner singletons (otherwise the processing of inner
-# singletons would cause the sha1 of the outer singletons to be
-# different).
-surroundSingletons <- local({
-  surroundSingleton <- function(uiObj) {
-    if (inherits(uiObj, "shiny.singleton")) {
-      sig <- digest(uiObj, "sha1")
-      class(uiObj) <- class(uiObj)[class(uiObj) != "shiny.singleton"]
-      return(tagList(
-        HTML(sprintf("<!--SHINY.SINGLETON[%s]-->", sig)),
-        uiObj,
-        HTML(sprintf("<!--/SHINY.SINGLETON[%s]-->", sig))
-      ))
-    } else {
-      uiObj
-    }
-  }
-
-  function(ui) {
-    rewriteTags(ui, surroundSingleton, TRUE)
-  }
-})
-
-# Given a tag object, apply singleton logic (allow singleton objects
-# to appear no more than once per signature) and return the processed
-# HTML objects and also the list of known singletons.
-takeSingletons <- function(ui, singletons=character(0), desingleton=TRUE) {
-  result <- rewriteTags(ui, function(uiObj) {
-    if (inherits(uiObj, "shiny.singleton")) {
-      sig <- digest(uiObj, "sha1")
-      if (sig %in% singletons)
-        return(NULL)
-      singletons <<- append(singletons, sig)
-      if (desingleton)
-        class(uiObj) <- class(uiObj)[class(uiObj) != "shiny.singleton"]
-      return(uiObj)
-    } else {
-      return(uiObj)
-    }
-  }, TRUE)
-
-  return(list(ui=result, singletons=singletons))
-}
-
-# Given a tag object, extract out any children of tags$head
-# and return them separate from the body.
-takeHeads <- function(ui) {
-  headItems <- list()
-  result <- rewriteTags(ui, function(uiObj) {
-    if (isTag(uiObj) && tolower(uiObj$name) == "head") {
-      headItems <<- append(headItems, uiObj$children)
-      return(NULL)
-    }
-    return(uiObj)
-  }, FALSE)
-
-  return(list(ui=result, head=headItems))
-}
-
-findDependencies <- function(ui) {
-  dep <- attr(ui, "html_dependency")
-  if (!is.null(dep) && inherits(dep, "html_dependency"))
-    dep <- list(dep)
-  children <- if (is.list(ui)) {
-    if (isTag(ui)) {
-      ui$children
-    } else {
-      ui
-    }
-  }
-  childDeps <- unlist(lapply(children, findDependencies), recursive = FALSE)
-  c(childDeps, if (!is.null(dep)) dep)
-}
-
-#' HTML Builder Functions
-#'
-#' Simple functions for constructing HTML documents.
-#'
-#' The \code{tags} environment contains convenience functions for all valid
-#' HTML5 tags. To generate tags that are not part of the HTML5 specification,
-#' you can use the \code{\link{tag}()} function.
-#'
-#' Dedicated functions are available for the most common HTML tags that do not
-#' conflict with common R functions.
-#'
-#' The result from these functions is a tag object, which can be converted using
-#' \code{\link{as.character}()}.
-#'
-#' @name builder
-#' @param ... Attributes and children of the element. Named arguments become
-#'   attributes, and positional arguments become children. Valid children are
-#'   tags, single-character character vectors (which become text nodes), and raw
-#'   HTML (see \code{\link{HTML}}). You can also pass lists that contain tags,
-#'   text nodes, and HTML.
-#' @export tags
-#' @examples
-#' doc <- tags$html(
-#'   tags$head(
-#'     tags$title('My first page')
-#'   ),
-#'   tags$body(
-#'     h1('My first heading'),
-#'     p('My first paragraph, with some ',
-#'       strong('bold'),
-#'       ' text.'),
-#'     div(id='myDiv', class='simpleDiv',
-#'         'Here is a div with some attributes.')
-#'   )
-#' )
-#' cat(as.character(doc))
-NULL
-
-#' @rdname builder
-#' @format NULL
-#' @docType NULL
-#' @keywords NULL
-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
-#'
-#' Marks the given text as HTML, which means the \link{tag} functions will know
-#' not to perform HTML escaping on it.
-#'
-#' @param text The text value to mark with HTML
-#' @param ... Any additional values to be converted to character and
-#'   concatenated together
-#' @return The same value, but marked as HTML.
-#'
-#' @examples
-#' el <- div(HTML("I like <u>turtles</u>"))
-#' cat(as.character(el))
-#'
-#' @export
-HTML <- function(text, ...) {
-  htmlText <- c(text, as.character(list(...)))
-  htmlText <- paste(htmlText, collapse=" ")
-  attr(htmlText, "html") <- TRUE
-  class(htmlText) <- c("html", "character")
-  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())
-}
-
-
-# Given a list of tags, lists, and other items, return a flat list, where the
-# items from the inner, nested lists are pulled to the top level, recursively.
-flattenTags <- function(x) {
-  if (isTag(x)) {
-    # For tags, wrap them into a list (which will be unwrapped by caller)
-    list(x)
-  } else if (is.list(x)) {
-    if (length(x) == 0) {
-      # Empty lists are simply returned
-      x
-    } else {
-      # For items that are lists (but not tags), recurse
-      unlist(lapply(x, flattenTags), recursive = FALSE)
-    }
-
-  } else if (is.character(x)){
-    # This will preserve attributes if x is a character with attribute,
-    # like what HTML() produces
-    list(x)
-
-  } else if (is.function(x) && inherits(x, "shiny.render.function")) {
-
-    list(useRenderFunction(x))
-
-  } else {
-    # For other items, coerce to character and wrap them into a list (which
-    # will be unwrapped by caller). Note that this will strip attributes.
-    list(as.character(x))
-  }
-}

R/tar.R

@@ -141,7 +141,7 @@ untar2 <- function(tarfile, files = NULL, list = FALSE, exdir = ".")
                             warning(gettextf("failed to copy %s to %s", sQuote(name2), sQuote(name)), domain = NA)
                     }
                 } else {
-                    if(.Platform$OS.type == "windows") {
+                    if(isWindows()) {
                         ## this will not work for links to dirs
                         from <- file.path(dirname(name), name2)
                         if (!file.copy(from, name))

R/update-input.R

@@ -118,7 +118,7 @@ updateSliderInput <- updateTextInput
 #' }
 #' @export
 updateDateInput <- function(session, inputId, label = NULL, value = NULL,
-    min = NULL, max = 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
@@ -163,8 +163,8 @@ updateDateInput <- function(session, inputId, label = NULL, value = NULL,
 #' }
 #' @export
 updateDateRangeInput <- function(session, inputId, label = NULL,
-    start = NULL, end = NULL, min = NULL, max = 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')
@@ -256,13 +256,28 @@ updateNumericInput <- function(session, inputId, label = NULL, value = NULL,
   session$sendInputMessage(inputId, message)
 }
 
+updateInputOptions <- function(session, inputId, label = NULL, choices = NULL,
+                               selected = NULL, inline = FALSE,
+                               type = 'checkbox') {
+
+  choices <- choicesWithNames(choices)
+  if (!is.null(selected))
+    selected <- validateSelected(selected, choices, inputId)
+
+  options <- if (length(choices))
+    format(tagList(
+      generateOptions(inputId, choices, selected, inline, type = type)
+    ))
+
+  message <- dropNulls(list(label = label, options = options, value = selected))
+
+  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 (values) which will be selected.
+#' @inheritParams checkboxGroupInput
 #'
 #' @seealso \code{\link{checkboxGroupInput}}
 #'
@@ -295,27 +310,16 @@ updateNumericInput <- function(session, inputId, label = NULL, value = NULL,
 #' }
 #' @export
 updateCheckboxGroupInput <- function(session, inputId, label = NULL,
-  choices = NULL, selected = NULL) {
-
-  choices <- choicesWithNames(choices)
-  if (!is.null(selected))
-    selected <- validateSelected(selected, choices, inputId)
-
-  options <- if (length(choices))
-    columnToRowData(list(value = choices, label = names(choices)))
-
-  message <- dropNulls(list(label = label, options = options, value = selected))
-
-  session$sendInputMessage(inputId, message)
+                                     choices = NULL, selected = NULL,
+                                     inline = FALSE) {
+  updateInputOptions(session, inputId, label, choices, selected, inline)
 }
 
 
 #' 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 (values) which will be selected.
+#' @inheritParams radioButtons
 #'
 #' @seealso \code{\link{radioButtons}}
 #'
@@ -345,15 +349,18 @@ updateCheckboxGroupInput <- function(session, inputId, label = NULL,
 #' })
 #' }
 #' @export
-updateRadioButtons <- updateCheckboxGroupInput
+updateRadioButtons <- function(session, inputId, label = NULL, choices = NULL,
+                               selected = NULL, inline = FALSE) {
+  # you must select at least one radio button
+  if (is.null(selected) && !is.null(choices)) selected <- choices[[1]]
+  updateInputOptions(session, inputId, label, choices, selected, inline, type = 'radio')
+}
 
 
 #' 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 (values) which will be selected.
+#' @inheritParams selectInput
 #'
 #' @seealso \code{\link{selectInput}}
 #'
@@ -386,19 +393,26 @@ updateRadioButtons <- updateCheckboxGroupInput
 #' })
 #' }
 #' @export
-updateSelectInput <- updateCheckboxGroupInput
+updateSelectInput <- function(session, inputId, label = NULL, choices = NULL,
+                              selected = NULL) {
+  choices <- choicesWithNames(choices)
+  if (!is.null(selected))
+    selected <- validateSelected(selected, choices, inputId)
+  options <- if (length(choices)) selectOptions(choices, selected)
+  message <- dropNulls(list(label = label, options = options, value = selected))
+  session$sendInputMessage(inputId, message)
+}
 
 #' @rdname updateSelectInput
-#' @param options a list of options (see \code{\link{selectizeInput}})
+#' @inheritParams selectizeInput
 #' @param server whether to store \code{choices} on the server side, and load
 #'   the select options dynamically on searching, instead of writing all
 #'   \code{choices} into the page at once (i.e., only use the client-side
 #'   version of \pkg{selectize.js})
 #' @export
-updateSelectizeInput <- function(
-  session, inputId, label = NULL, choices = NULL, selected = NULL,
-  options = list(), server = FALSE
-) {
+updateSelectizeInput <- function(session, inputId, label = NULL, choices = NULL,
+                                 selected = NULL, options = list(),
+                                 server = FALSE) {
   if (length(options)) {
     res <- checkAsIs(options)
     cfg <- tags$script(
@@ -407,7 +421,7 @@ updateSelectizeInput <- function(
       `data-eval` = if (length(res$eval)) HTML(toJSON(res$eval)),
       HTML(toJSON(res$options))
     )
-    session$sendInputMessage(inputId, list(newOptions = as.character(cfg)))
+    session$sendInputMessage(inputId, list(config = as.character(cfg)))
   }
   if (!server) {
     return(updateSelectInput(session, inputId, label, choices, selected))

R/utils.R

@@ -77,11 +77,22 @@ withPrivateSeed <- function(expr) {
     .globals$ownSeed, unset=is.null(.globals$ownSeed), {
       tryCatch({
         expr
-      }, finally = {.globals$ownSeed <- .Random.seed})
+      }, finally = {
+        .globals$ownSeed <- getExists('.Random.seed', 'numeric', globalenv())
+      })
     }
   )
 }
 
+# a homemade version of set.seed(NULL) for backward compatibility with R 2.15.x
+reinitializeSeed <- if (getRversion() >= '3.0.0') {
+  function() set.seed(NULL)
+} else function() {
+  if (exists('.Random.seed', globalenv()))
+    rm(list = '.Random.seed', pos = globalenv())
+  stats::runif(1)  # generate any random numbers so R can reinitialize the seed
+}
+
 # Version of runif that runs with private seed
 p_runif <- function(...) {
   withPrivateSeed(runif(...))
@@ -174,7 +185,7 @@ resolve <- function(dir, relpath) {
   abs.path <- normalizePath(abs.path, winslash='/', mustWork=TRUE)
   dir <- normalizePath(dir, winslash='/', mustWork=TRUE)
   # trim the possible trailing slash under Windows (#306)
-  if (.Platform$OS.type == 'windows') dir <- sub('/$', '', dir)
+  if (isWindows()) dir <- sub('/$', '', dir)
   if (nchar(abs.path) <= nchar(dir) + 1)
     return(NULL)
   if (substr(abs.path, 1, nchar(dir)) != dir ||
@@ -184,6 +195,8 @@ resolve <- function(dir, relpath) {
   return(abs.path)
 }
 
+isWindows <- function() .Platform$OS.type == 'windows'
+
 # This is a wrapper for download.file and has the same interface.
 # The only difference is that, if the protocol is https, it changes the
 # download settings, depending on platform.
@@ -192,7 +205,7 @@ download <- function(url, ...) {
   if (grepl('^https?://', url)) {
 
     # If Windows, call setInternet2, then use download.file with defaults.
-    if (.Platform$OS.type == "windows") {
+    if (isWindows()) {
       # If we directly use setInternet2, R CMD CHECK gives a Note on Mac/Linux
       mySI2 <- `::`(utils, 'setInternet2')
       # Store initial settings
@@ -476,7 +489,7 @@ shinyCallingHandlers <- function(expr) {
 shinyDeprecated <- function(new=NULL, msg=NULL,
                             old=as.character(sys.call(sys.parent()))[1L]) {
 
-  if (getOption("shiny.deprecation.messages", default=TRUE) == FALSE)
+  if (getOption("shiny.deprecation.messages") %OR% TRUE == FALSE)
     return(invisible())
 
   if (is.null(msg)) {
@@ -725,18 +738,6 @@ cachedFuncWithFile <- function(dir, file, func, case.sensitive = FALSE) {
   }
 }
 
-# Returns a function that sources the file and caches the result for subsequent
-# calls, unless the file's mtime changes.
-cachedSource <- function(dir, file, case.sensitive = FALSE) {
-  dir <- normalizePath(dir, mustWork=TRUE)
-  cachedFuncWithFile(dir, file, function(fname, ...) {
-    if (file.exists(fname))
-      return(source(fname, ...))
-    else
-      return(NULL)
-  })
-}
-
 # turn column-based data to row-based data (mainly for JSON), e.g. data.frame(x
 # = 1:10, y = 10:1) ==> list(list(x = 1, y = 10), list(x = 2, y = 9), ...)
 columnToRowData <- function(data) {
@@ -897,3 +898,84 @@ stopWithCondition <- function(class, message) {
   )
   stop(cond)
 }
+
+#' Collect information about the Shiny Server environment
+#'
+#' This function returns the information about the current Shiny Server, such as
+#' its version, and whether it is the open source edition or professional
+#' edition. If the app is not served through the Shiny Server, this function
+#' just returns \code{list(shinyServer = FALSE)}.
+#' @export
+#' @return A list of the Shiny Server information.
+serverInfo <- function() {
+  .globals$serverInfo
+}
+.globals$serverInfo <- list(shinyServer = FALSE)
+
+setServerInfo <- function(...) {
+  infoOld <- serverInfo()
+  infoNew <- list(...)
+  infoOld[names(infoNew)] <- infoNew
+  .globals$serverInfo <- infoOld
+}
+
+# see if the file can be read as UTF-8 on Windows, and converted from UTF-8 to
+# native encoding; if the conversion fails, it will produce NA's in the results
+checkEncoding <- function(file) {
+  # skip *nix because its locale is normally UTF-8 based (e.g. en_US.UTF-8), and
+  # *nix users have to make a conscious effort to save a file with an encoding
+  # that is not UTF-8; if they choose to do so, we cannot do much about it
+  # except sitting back and seeing them punished after they choose to escape a
+  # world of consistency (falling back to getOption('encoding') will not help
+  # because native.enc is also normally UTF-8 based on *nix)
+  if (!isWindows()) return('UTF-8')
+  # an empty file?
+  size <- file.info(file)[, 'size']
+  if (size == 0) return('UTF-8')
+
+  x <- readLines(file, encoding = 'UTF-8', warn = FALSE)
+  # if conversion is successful and there are no embedded nul's, use UTF-8
+  if (!any(is.na(iconv(x, 'UTF-8'))) &&
+        !any(readBin(file, 'raw', size) == as.raw(0))) return('UTF-8')
+
+  # check if there is a BOM character: this is also skipped on *nix, because R
+  # on *nix simply ignores this meaningless character if present, but it hurts
+  # on Windows
+  if (identical(charToRaw(readChar(file, 3L, TRUE)), charToRaw('\UFEFF'))) {
+    warning('You should not include the Byte Order Mark (BOM) in ', file, '. ',
+            'Please re-save it in UTF-8 without BOM. See ',
+            'http://shiny.rstudio.com/articles/unicode.html for more info.')
+    if (getRversion() < '3.0.0')
+      stop('R does not support UTF-8-BOM before 3.0.0. Please upgrade R.')
+    return('UTF-8-BOM')
+  }
+
+  enc <- getOption('encoding')
+  msg <- c(sprintf('The file "%s" is not encoded in UTF-8. ', file),
+           'Please convert its encoding to UTF-8 ',
+           '(e.g. use the menu `File -> Save with Encoding` in RStudio). ',
+           'See http://shiny.rstudio.com/articles/unicode.html for more info.')
+  if (enc == 'UTF-8') stop(msg)
+  # if you publish the app to ShinyApps.io, you will be in trouble
+  warning(c(msg, ' Falling back to the encoding "', enc, '".'))
+
+  enc
+}
+
+# try to read a file using UTF-8 (fall back to getOption('encoding') in case of
+# failure, which defaults to native.enc, i.e. native encoding)
+readUTF8 <- function(file) {
+  enc <- checkEncoding(file)
+  # readLines() does not support UTF-8-BOM directly; has to go through file()
+  if (enc == 'UTF-8-BOM') {
+    file <- base::file(file, encoding = enc)
+    on.exit(close(file), add = TRUE)
+  }
+  x <- readLines(file, encoding = enc, warn = FALSE)
+  enc2native(x)
+}
+
+# similarly, try to source() a file with UTF-8
+sourceUTF8 <- function(file, ...) {
+  source(file, ..., keep.source = TRUE, encoding = checkEncoding(file))
+}

README.md

@@ -1,6 +1,6 @@
 # Shiny
 
-[![Build Status](https://travis-ci.org/rstudio/shiny.png)](https://travis-ci.org/rstudio/shiny)
+[![Build Status](https://travis-ci.org/rstudio/shiny.svg?branch=master)](https://travis-ci.org/rstudio/shiny)
 
 Shiny is a new package from RStudio that makes it incredibly easy to build interactive web applications with R.
 

inst/staticdocs/index.r

@@ -127,8 +127,6 @@ sd_section("Running",
   c(
     "runApp",
     "runExample",
-    "runGist",
-    "runGitHub",
     "runUrl",
     "stopApp"
   )
@@ -152,15 +150,14 @@ sd_section("Utility functions",
     "parseQueryString",
     "plotPNG",
     "repeatable",
-    "shinyDeprecated"
+    "shinyDeprecated",
+    "serverInfo"
   )
 )
 sd_section("Embedding",
   "Functions that are intended for third-party packages that embed Shiny applications.",
   c(
     "shinyApp",
-    "maskReactiveContext",
-    "knitr_methods",
-    "getProvidedHtmlDependencies"
+    "maskReactiveContext"
   )
 )

inst/tests/test-bootstrap.r

@@ -43,3 +43,105 @@ test_that("Repeated names for selectInput and radioButtons choices", {
   expect_equal(choices[[2]][[3]]$children[[1]]$attribs$value, 'x3')
   expect_equal(choices[[2]][[3]]$children[[1]]$attribs$checked, NULL)
 })
+
+
+test_that("Choices are correctly assigned names", {
+  # Unnamed vector
+  expect_identical(
+    choicesWithNames(c("a","b","3")),
+    list(a="a", b="b", "3"="3")
+  )
+  # Unnamed list
+  expect_identical(
+    choicesWithNames(list("a","b",3)),
+    list(a="a", b="b", "3"=3)
+  )
+  # Vector, with some named, some not
+  expect_identical(
+    choicesWithNames(c(A="a", "b", C="3", "4")),
+    list(A="a", "b"="b", C="3", "4"="4")
+  )
+  # List, with some named, some not
+  expect_identical(
+    choicesWithNames(list(A="a", "b", C=3, 4)),
+    list(A="a", "b"="b", C=3, "4"=4)
+  )
+  # List, named, with a sub-vector
+  expect_identical(
+    choicesWithNames(list(A="a", B="b", C=c("d", "e"))),
+    list(A="a", B="b", C=list(d="d", e="e"))
+  )
+  # List, named, with sublist
+  expect_identical(
+    choicesWithNames(list(A="a", B="b", C=list("d", "e"))),
+    list(A="a", B="b", C=list(d="d", e="e"))
+  )
+  # List, some named, with sublist
+  expect_identical(
+    choicesWithNames(list(A="a", "b", C=list("d", E="e"))),
+    list(A="a", b="b", C=list(d="d", E="e"))
+  )
+  # Deeper nesting
+  expect_identical(
+    choicesWithNames(list(A="a", "b", C=list(D=list("e", "f"), G=c(H="h", "i")))),
+    list(A="a", b="b", C=list(D=list(e="e", f="f"), G=list(H="h", i="i")))
+  )
+  # Error when sublist is unnamed
+  expect_error(choicesWithNames(list(A="a", "b", list(1,2))))
+})
+
+
+test_that("selectOptions returns correct HTML", {
+  # None selected
+  expect_identical(
+    selectOptions(choicesWithNames(list("a", "b")), list()),
+    HTML("<option value=\"a\">a</option>\n<option value=\"b\">b</option>")
+  )
+  # One selected
+  expect_identical(
+    selectOptions(choicesWithNames(list("a", "b")), "a"),
+    HTML("<option value=\"a\" selected>a</option>\n<option value=\"b\">b</option>")
+  )
+  # One selected, with named items
+  expect_identical(
+    selectOptions(choicesWithNames(list(A="a", B="b")), "a"),
+    HTML("<option value=\"a\" selected>A</option>\n<option value=\"b\">B</option>")
+  )
+  # Two selected, with optgroup
+  expect_identical(
+    selectOptions(choicesWithNames(list("a", B=list("c", D="d"))), c("a", "d")),
+    HTML("<option value=\"a\" selected>a</option>\n<optgroup label=\"B\">\n<option value=\"c\">c</option>\n<option value=\"d\" selected>D</option>\n</optgroup>")
+  )
+
+  # Escape HTML in strings
+  expect_identical(
+    selectOptions(choicesWithNames(list("<A>"="a", B="b")), "a"),
+    HTML("<option value=\"a\" selected>&lt;A&gt;</option>\n<option value=\"b\">B</option>")
+  )
+})
+
+test_that("selectInput selects items by default", {
+  # None specified as selected (defaults to first)
+  expect_true(grepl(
+    '<option value="a" selected>',
+    selectInput('x', 'x', list("a", "b"))
+  ))
+
+  # Nested list (optgroup)
+  expect_true(grepl(
+    '<option value="a" selected>',
+    selectInput('x', 'x', list(A=list("a", "b"), "c"))
+  ))
+
+  # Nothing selected when choices=NULL
+  expect_identical(
+    '<select id="x"></select>',
+    format(selectInput('x', NULL, NULL, selectize = FALSE))
+  )
+
+  # None specified as selected. With multiple=TRUE, none selected by default.
+  expect_true(grepl(
+    '<option value="a">',
+    selectInput('x', 'x', list("a", "b"), multiple = TRUE)
+  ))
+})

inst/tests/test-staticdocs.R

@@ -6,7 +6,7 @@ test_that("All man pages have an entry in staticdocs/index.r", {
     return()
   }
   # Known not to be indexed
-  known_unindexed <- c("shiny-package")
+  known_unindexed <- c("shiny-package", "knitr_methods", "knitr_methods_htmltools")
 
   indexed_topics <- local({
     result <- character(0)

inst/tests/test-tags.r

@@ -1,432 +0,0 @@
-context("tags")
-
-test_that("Basic tag writing works", {
-  expect_equal(as.character(tagList("hi")), HTML("hi"))
-  expect_equal(
-    as.character(tagList("one", "two", tagList("three"))),
-    HTML("one\ntwo\nthree"))
-  expect_equal(
-    as.character(tags$b("one")),
-    HTML("<b>one</b>"))
-  expect_equal(
-    as.character(tags$b("one", "two")),
-    HTML("<b>\n  one\n  two\n</b>"))
-  expect_equal(
-    as.character(tagList(list("one"))),
-    HTML("one"))
-  expect_equal(
-    as.character(tagList(list(tagList("one")))),
-    HTML("one"))
-  expect_equal(
-    as.character(tagList(tags$br(), "one")),
-    HTML("<br/>\none"))
-})
-
-
-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())
-})
-
-
-test_that("HTML escaping in tags", {
-  # Regular text is escaped
-  expect_equivalent(format(div("<a&b>")), "<div>&lt;a&amp;b&gt;</div>")
-
-  # Text in HTML() isn't escaped
-  expect_equivalent(format(div(HTML("<a&b>"))), "<div><a&b></div>")
-
-  # Text in a property is escaped
-  expect_equivalent(format(div(class = "<a&b>", "text")),
-                    '<div class="&lt;a&amp;b&gt;">text</div>')
-
-  # HTML() has no effect in a property like 'class'
-  expect_equivalent(format(div(class = HTML("<a&b>"), "text")),
-                    '<div class="&lt;a&amp;b&gt;">text</div>')
-})
-
-
-test_that("Adding child tags", {
-  tag_list <- list(tags$p("tag1"), tags$b("tag2"), tags$i("tag3"))
-
-  # Creating nested tags by calling the tag$div function and passing a list
-  t1 <- tags$div(class="foo", tag_list)
-  expect_equal(length(t1$children), 1)
-  expect_equal(length(t1$children[[1]]), 3)
-  expect_equal(t1$children[[1]][[1]]$name, "p")
-  expect_equal(t1$children[[1]][[1]]$children[[1]], "tag1")
-  expect_equal(t1$children[[1]][[2]]$name, "b")
-  expect_equal(t1$children[[1]][[2]]$children[[1]], "tag2")
-  expect_equal(t1$children[[1]][[3]]$name, "i")
-  expect_equal(t1$children[[1]][[3]]$children[[1]], "tag3")
-
-
-  # div tag used as starting point for tests below
-  div_tag <- tags$div(class="foo")
-
-  # Appending each child
-  t2 <- tagAppendChild(div_tag, tag_list[[1]])
-  t2 <- tagAppendChild(t2, tag_list[[2]])
-  t2 <- tagAppendChild(t2, tag_list[[3]])
-  t2a <- do.call(tags$div, c(tag_list, class="foo"))
-  expect_identical(t2a, t2)
-
-
-  # tagSetChildren, using list argument
-  t2 <- tagSetChildren(div_tag, list = tag_list)
-  expect_identical(t2a, t2)
-
-  # tagSetChildren, using ... arguments
-  t2 <- tagSetChildren(div_tag, tag_list[[1]], tag_list[[2]], tag_list[[3]])
-  expect_identical(t2a, t2)
-
-  # tagSetChildren, using ... and list arguments
-  t2 <- tagSetChildren(div_tag, tag_list[[1]], list = tag_list[2:3])
-  expect_identical(t2a, t2)
-
-  # tagSetChildren overwrites existing children
-  t2 <- tagAppendChild(div_tag, p("should replace this tag"))
-  t2 <- tagSetChildren(div_tag, list = tag_list)
-  expect_identical(t2a, t2)
-
-
-  # tagAppendChildren, using list argument
-  t2 <- tagAppendChild(div_tag, tag_list[[1]])
-  t2 <- tagAppendChildren(t2, list = tag_list[2:3])
-  expect_identical(t2a, t2)
-
-  # tagAppendChildren, using ... arguments
-  t2 <- tagAppendChild(div_tag, tag_list[[1]])
-  t2 <- tagAppendChildren(t2, tag_list[[2]], tag_list[[3]])
-  expect_identical(t2a, t2)
-
-  # tagAppendChildren, using ... and list arguments
-  t2 <- tagAppendChild(div_tag, tag_list[[1]])
-  t2 <- tagAppendChildren(t2, tag_list[[2]], list = list(tag_list[[3]]))
-  expect_identical(t2a, t2)
-
-  # tagAppendChildren can start with no children
-  t2 <- tagAppendChildren(div_tag, list = tag_list)
-  expect_identical(t2a, t2)
-
-
-  # tagSetChildren preserves attributes
-  x <- tagSetChildren(div(), HTML("text"))
-  expect_identical(attr(x$children[[1]], "html"), TRUE)
-
-  # tagAppendChildren preserves attributes
-  x <- tagAppendChildren(div(), HTML("text"))
-  expect_identical(attr(x$children[[1]], "html"), TRUE)
-})
-
-
-test_that("Creating simple tags", {
-  # Empty tag
-  expect_identical(
-    div(),
-    structure(
-      list(name = "div", attribs = list(), children = list()),
-      .Names = c("name", "attribs", "children"),
-      class = "shiny.tag"
-    )
-  )
-
-  # Tag with text
-  expect_identical(
-    div("text"),
-    structure(
-      list(name = "div", attribs = list(), children = list("text")),
-      .Names = c("name", "attribs", "children"),
-      class = "shiny.tag"
-    )
-  )
-
-  # NULL attributes are dropped
-  expect_identical(
-    div(a = NULL, b = "value"),
-    div(b = "value")
-  )
-
-  # NULL children are dropped
-  expect_identical(
-    renderTags(div("foo", NULL, list(NULL, list(NULL, "bar"))))$html,
-    renderTags(div("foo", "bar"))$html
-  )
-
-  # Numbers are coerced to strings
-  expect_identical(
-    renderTags(div(1234))$html,
-    renderTags(div("1234"))$html
-  )
-})
-
-
-test_that("Creating nested tags", {
-  # Simple version
-  # Note that the $children list should not have a names attribute
-  expect_identical(
-    div(class="foo", list("a", "b")),
-    structure(
-      list(name = "div",
-           attribs = structure(list(class = "foo"), .Names = "class"),
-           children = list(list("a", "b"))),
-      .Names = c("name", "attribs", "children"),
-      class = "shiny.tag"
-    )
-  )
-
-  # More complex version
-  t1 <- withTags(
-    div(class = "foo",
-      p("child tag"),
-      list(
-        p("in-list child tag 1"),
-        "in-list character string",
-        p(),
-        p("in-list child tag 2")
-      ),
-      "character string",
-      1234
-    )
-  )
-
-  # t1 should be identical to this data structure.
-  # The nested list should be flattened, and non-tag, non-strings should be
-  # converted to strings
-  t1_full <- structure(
-    list(
-      name = "div",
-      attribs = list(class = "foo"),
-      children = list(
-        structure(list(name = "p",
-                       attribs = list(),
-                       children = list("child tag")),
-                  class = "shiny.tag"
-        ),
-        structure(list(name = "p",
-                       attribs = list(),
-                       children = list("in-list child tag 1")),
-                  class = "shiny.tag"
-        ),
-        "in-list character string",
-        structure(list(name = "p",
-                       attribs = list(),
-                       children = list()),
-                  class = "shiny.tag"
-        ),
-        structure(list(name = "p",
-                       attribs = list(),
-                       children = list("in-list child tag 2")),
-                  class = "shiny.tag"
-        ),
-        "character string",
-        "1234"
-      )
-    ),
-    class = "shiny.tag"
-  )
-
-  expect_identical(renderTags(t1)$html, renderTags(t1_full)$html)
-})
-
-test_that("Attributes are preserved", {
-  # HTML() adds an attribute to the data structure (note that this is
-  # different from the 'attribs' field in the list)
-  x <- HTML("<tag>&&</tag>")
-  expect_identical(attr(x, "html"), TRUE)
-  expect_equivalent(format(x), "<tag>&&</tag>")
-
-  # Make sure attributes are preserved when wrapped in other tags
-  x <- div(HTML("<tag>&&</tag>"))
-  expect_equivalent(x$children[[1]], HTML("<tag>&&</tag>"))
-  expect_identical(attr(x$children[[1]], "html"), TRUE)
-  expect_equivalent(format(x), "<div><tag>&&</tag></div>")
-
-  # Deeper nesting
-  x <- div(p(HTML("<tag>&&</tag>")))
-  expect_equivalent(x$children[[1]]$children[[1]], HTML("<tag>&&</tag>"))
-  expect_identical(attr(x$children[[1]]$children[[1]], "html"), TRUE)
-  expect_equivalent(format(x), "<div>\n  <p><tag>&&</tag></p>\n</div>")
-})
-
-
-test_that("Flattening a list of tags", {
-  # Flatten a nested list
-  nested <- list(
-    "a1",
-    list(
-      "b1",
-      list("c1", "c2"),
-      list(),
-      "b2",
-      list("d1", "d2")
-    ),
-    "a2"
-  )
-  flat <- list("a1", "b1", "c1", "c2", "b2", "d1", "d2", "a2")
-  expect_identical(flattenTags(nested), flat)
-
-  # no-op for flat lists
-  expect_identical(flattenTags(list(a="1", "b")), list(a="1", "b"))
-
-  # numbers are coerced to character
-  expect_identical(flattenTags(list(a=1, "b")), list(a="1", "b"))
-
-  # empty list results in empty list
-  expect_identical(flattenTags(list()), list())
-
-  # preserve attributes
-  nested <- list("txt1", list(structure("txt2", prop="prop2")))
-  flat <- list("txt1",
-               structure("txt2", prop="prop2"))
-  expect_identical(flattenTags(nested), flat)
-})
-
-test_that("Head and singleton behavior", {
-  result <- renderTags(tagList(
-    tags$head(singleton("hello"))
-  ))
-
-  expect_identical(result$html, HTML(""))
-  expect_identical(result$head, HTML("  hello"))
-  expect_identical(result$singletons, "60eed8231e688bcba7c275c58dd2e3b4dacb61f0")
-
-  # Ensure that "hello" actually behaves like a singleton
-  result2 <- renderTags(tagList(
-    tags$head(singleton("hello"))
-  ), singletons = result$singletons)
-
-  expect_identical(result$singletons, result2$singletons)
-  expect_identical(result2$head, HTML(""))
-  expect_identical(result2$html, HTML(""))
-
-  result3 <- renderTags(tagList(
-    tags$head(singleton("hello"), singleton("hello"))
-  ))
-  expect_identical(result$singletons, result3$singletons)
-  expect_identical(result3$head, HTML("  hello"))
-
-  # Ensure that singleton can be applied to lists, not just tags
-  result4 <- renderTags(list(singleton(list("hello")), singleton(list("hello"))))
-  expect_identical(result4$singletons, "d7319e3f14167c4c056dd7aa0b274c83fe2291f6")
-  expect_identical(result4$html, renderTags(HTML("hello"))$html)
-})
-
-test_that("Factors are treated as characters, not numbers", {
-  myfactors <- factor(LETTERS[1:3])
-  expect_identical(
-    as.character(tags$option(value=myfactors[[1]], myfactors[[1]])),
-    HTML('<option value="A">A</option>')
-  )
-
-  expect_identical(
-    as.character(tags$option(value=myfactors[[1]], value='B', value=3, myfactors[[1]])),
-    HTML('<option value="A B 3">A</option>')
-  )
-})
-
-test_that("Unusual list contents are rendered correctly", {
-  expect_identical(renderTags(list(NULL)), renderTags(HTML("")))
-  expect_identical(renderTags(list(100)), renderTags(HTML("100")))
-  expect_identical(renderTags(list(list(100))), renderTags(HTML("100")))
-  expect_identical(renderTags(list(list())), renderTags(HTML("")))
-  expect_identical(renderTags(NULL), renderTags(HTML("")))
-})
-
-test_that("Low-level singleton manipulation methods", {
-  # Default arguments drop singleton duplicates and strips the
-  # singletons it keeps of the singleton bit
-  result1 <- takeSingletons(tags$div(
-    singleton(tags$head(tags$script("foo"))),
-    singleton(tags$head(tags$script("foo")))
-  ))
-
-  expect_identical(result1$ui$children[[2]], NULL)
-  expect_false(is(result1$ui$children[[1]], "shiny.singleton"))
-
-  # desingleton=FALSE means drop duplicates but don't strip the
-  # singleton bit
-  result2 <- takeSingletons(tags$div(
-    singleton(tags$head(tags$script("foo"))),
-    singleton(tags$head(tags$script("foo")))
-  ), desingleton=FALSE)
-
-  expect_identical(result2$ui$children[[2]], NULL)
-  expect_is(result2$ui$children[[1]], "shiny.singleton")
-
-  result3 <- surroundSingletons(tags$div(
-    singleton(tags$script("foo")),
-    singleton(tags$script("foo"))
-  ))
-
-  expect_identical(
-    renderTags(result3)$html,
-    HTML("<div>
-  <!--SHINY.SINGLETON[58b302d493b50acb75e4a5606687cadccdf902d8]-->
-  <script>foo</script>
-  <!--/SHINY.SINGLETON[58b302d493b50acb75e4a5606687cadccdf902d8]-->
-  <!--SHINY.SINGLETON[58b302d493b50acb75e4a5606687cadccdf902d8]-->
-  <script>foo</script>
-  <!--/SHINY.SINGLETON[58b302d493b50acb75e4a5606687cadccdf902d8]-->
-</div>")
-  )
-})
-
-test_that("Indenting can be controlled/suppressed", {
-  expect_identical(
-    renderTags(tags$div("a", "b"))$html,
-    HTML("<div>\n  a\n  b\n</div>")
-  )
-  expect_identical(
-    format(tags$div("a", "b")),
-    "<div>\n  a\n  b\n</div>"
-  )
-
-  expect_identical(
-    renderTags(tags$div("a", "b"), indent = 2)$html,
-    HTML("    <div>\n      a\n      b\n    </div>")
-  )
-  expect_identical(
-    format(tags$div("a", "b"), indent = 2),
-    "    <div>\n      a\n      b\n    </div>"
-  )
-
-  expect_identical(
-    renderTags(tags$div("a", "b"), indent = FALSE)$html,
-    HTML("<div>\na\nb\n</div>")
-  )
-  expect_identical(
-    format(tags$div("a", "b"), indent = FALSE),
-    "<div>\na\nb\n</div>"
-  )
-
-  expect_identical(
-    renderTags(tagList(tags$div("a", "b")), indent = FALSE)$html,
-    HTML("<div>\na\nb\n</div>")
-  )
-  expect_identical(
-    format(tagList(tags$div("a", "b")), indent = FALSE),
-    "<div>\na\nb\n</div>"
-  )
-})

inst/tests/test-utils.R

@@ -21,6 +21,10 @@ test_that("Setting process-wide seed doesn't affect private randomness", {
 test_that("Resetting private seed doesn't result in dupes", {
   .globals$ownSeed <- NULL
   id3 <- createUniqueId(4)
+  # Make sure we let enough time pass that reinitializing the seed is
+  # going to result in a different value. This is especially required
+  # on Windows.
+  Sys.sleep(1)
   set.seed(0)
   .globals$ownSeed <- NULL
   id4 <- createUniqueId(4)

inst/www/shared/json2-min.js

@@ -0,0 +1,22 @@
+("object"!=typeof JSON||JSON.stringify("\uf977").length>3)&&(JSON={}),function(){"use strict"
+function f(t){return 10>t?"0"+t:t}function quote(t){return escapable.lastIndex=0,escapable.test(t)?'"'+t.replace(escapable,function(t){var e=meta[t]
+return"string"==typeof e?e:"\\u"+("0000"+t.charCodeAt(0).toString(16)).slice(-4)})+'"':'"'+t+'"'}function str(t,e){var n,r,o,f,u,p=gap,a=e[t]
+switch(a&&"object"==typeof a&&"function"==typeof a.toJSON&&(a=a.toJSON(t)),"function"==typeof rep&&(a=rep.call(e,t,a)),typeof a){case"string":return quote(a)
+case"number":return isFinite(a)?a+"":"null"
+case"boolean":case"null":return a+""
+case"object":if(!a)return"null"
+if(gap+=indent,u=[],"[object Array]"===Object.prototype.toString.apply(a)){for(f=a.length,n=0;f>n;n+=1)u[n]=str(n,a)||"null"
+return o=0===u.length?"[]":gap?"[\n"+gap+u.join(",\n"+gap)+"\n"+p+"]":"["+u.join(",")+"]",gap=p,o}if(rep&&"object"==typeof rep)for(f=rep.length,n=0;f>n;n+=1)"string"==typeof rep[n]&&(r=rep[n],o=str(r,a),o&&u.push(quote(r)+(gap?": ":":")+o))
+else for(r in a)Object.prototype.hasOwnProperty.call(a,r)&&(o=str(r,a),o&&u.push(quote(r)+(gap?": ":":")+o))
+return o=0===u.length?"{}":gap?"{\n"+gap+u.join(",\n"+gap)+"\n"+p+"}":"{"+u.join(",")+"}",gap=p,o}}"function"!=typeof Date.prototype.toJSON&&(Date.prototype.toJSON=function(){return isFinite(this.valueOf())?this.getUTCFullYear()+"-"+f(this.getUTCMonth()+1)+"-"+f(this.getUTCDate())+"T"+f(this.getUTCHours())+":"+f(this.getUTCMinutes())+":"+f(this.getUTCSeconds())+"Z":null},String.prototype.toJSON=Number.prototype.toJSON=Boolean.prototype.toJSON=function(){return this.valueOf()})
+var cx,escapable,gap,indent,meta,rep
+"function"!=typeof JSON.stringify&&(escapable=/[\\\"\x00-\x1f\x7f-\x9f\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g,meta={"\b":"\\b","	":"\\t","\n":"\\n","\f":"\\f","\r":"\\r",'"':'\\"',"\\":"\\\\"},JSON.stringify=function(t,e,n){var r
+if(gap="",indent="","number"==typeof n)for(r=0;n>r;r+=1)indent+=" "
+else"string"==typeof n&&(indent=n)
+if(rep=e,e&&"function"!=typeof e&&("object"!=typeof e||"number"!=typeof e.length))throw Error("JSON.stringify")
+return str("",{"":t})}),"function"!=typeof JSON.parse&&(cx=/[\u0000\u00ad\u0600-\u0604\u070f\u17b4\u17b5\u200c-\u200f\u2028-\u202f\u2060-\u206f\ufeff\ufff0-\uffff]/g,JSON.parse=function(text,reviver){function walk(t,e){var n,r,o=t[e]
+if(o&&"object"==typeof o)for(n in o)Object.prototype.hasOwnProperty.call(o,n)&&(r=walk(o,n),void 0!==r?o[n]=r:delete o[n])
+return reviver.call(t,e,o)}var j
+if(text+="",cx.lastIndex=0,cx.test(text)&&(text=text.replace(cx,function(t){return"\\u"+("0000"+t.charCodeAt(0).toString(16)).slice(-4)})),/^[\],:{}\s]*$/.test(text.replace(/\\(?:["\\\/bfnrt]|u[0-9a-fA-F]{4})/g,"@").replace(/"[^"\\\n\r]*"|true|false|null|-?\d+(?:\.\d*)?(?:[eE][+\-]?\d+)?/g,"]").replace(/(?:^|:|,)(?:\s*\[)+/g,"")))return j=eval("("+text+")"),"function"==typeof reviver?walk({"":j},""):j
+throw new SyntaxError("JSON.parse")})}()
+

inst/www/shared/shiny-showcase.js

@@ -85,6 +85,11 @@
       var code = document.getElementById(srcfile.replace(/\./g, "_") + "_code");
       var start = findTextPoint(code, ref[0], ref[4]);
       var end = findTextPoint(code, ref[2], ref[5]);
+      
+      // If the insertion point can't be found, bail out now
+      if (start.element === null || end.element === null)
+         return;
+
       var range = document.createRange();
       // If the text points are inside different <SPAN>s, we may not be able to
       // surround them without breaking apart the elements to keep the DOM tree

inst/www/shared/shiny.js

@@ -34,9 +34,14 @@
     var x;
     if (el.currentStyle)
       x = el.currentStyle[styleProp];
-    else if (window.getComputedStyle)
-      x = document.defaultView.getComputedStyle(el, null)
-          .getPropertyValue(styleProp);
+    else if (window.getComputedStyle) {
+      // getComputedStyle can return null when we're inside a hidden iframe on
+      // Firefox; don't attempt to retrieve style props in this case.
+      // https://bugzilla.mozilla.org/show_bug.cgi?id=548397 
+      var style = document.defaultView.getComputedStyle(el, null);
+      if (style)
+        x = style.getPropertyValue(styleProp);
+    }
     return x;
   }
 
@@ -1285,7 +1290,7 @@
 
     registerDependency(dep.name, dep.version);
 
-    var path = dep.path;
+    var href = dep.src.href;
 
     var $head = $("head").first();
 
@@ -1299,14 +1304,14 @@
     if (dep.stylesheet) {
       var stylesheets = $.map(asArray(dep.stylesheet), function(stylesheet) {
         return $("<link rel='stylesheet' type='text/css'>")
-          .attr("href", path + "/" + stylesheet);
+          .attr("href", href + "/" + stylesheet);
       });
       $head.append(stylesheets);
     }
 
     if (dep.script) {
       var scripts = $.map(asArray(dep.script), function(scriptName) {
-        return $("<script>").attr("src", path + "/" + scriptName);
+        return $("<script>").attr("src", href + "/" + scriptName);
       });
       $head.append(scripts);
     }
@@ -2091,37 +2096,20 @@
 
       // This will replace all the options
       if (data.hasOwnProperty('options')) {
-        // Clear existing options and add each new one
-        $el.empty();
         selectize = this._selectize(el);
-        if (selectize !== undefined) {
-          selectize.clearOptions();
-          // Selectize.js doesn't maintain insertion order on Chrome on Mac
-          // with >10 items if inserted using addOption (versus being present
-          // in the DOM at selectize() time). Putting $order on each option
-          // makes it work.
-          $.each(data.options, function(i, opt) {
-            opt.$order = i;
-          });
-          selectize.addOption(data.options);
-        }
-        for (var i = 0; i < data.options.length; i++) {
-          var in_opt = data.options[i];
-
-          var $newopt = $('<option/>', {
-            value: in_opt.value,
-            text: in_opt.label
-          });
-
-          $el.append($newopt);
-        }
+        // Must destroy selectize before appending new options, otherwise
+        // selectize will restore the original select
+        if (selectize) selectize.destroy();
+        // Clear existing options and add each new one
+        $el.empty().append(data.options);
+        this._selectize(el);
       }
 
       // re-initialize selectize
-      if (data.hasOwnProperty('newOptions')) {
+      if (data.hasOwnProperty('config')) {
         $el.parent()
            .find('script[data-for="' + $escape(el.id) + '"]')
-           .replaceWith(data.newOptions);
+           .replaceWith(data.config);
         this._selectize(el, true);
       }
 
@@ -2253,22 +2241,7 @@
       if (data.hasOwnProperty('options')) {
         // Clear existing options and add each new one
         $el.find('label.radio').remove();
-        for (var i = 0; i < data.options.length; i++) {
-          var in_opt = data.options[i];
-
-          var $newopt = $('<label class="radio"/>');
-          var $radio = $('<input/>', {
-            type:  "radio",
-            name:  el.id,
-            id:    el.id + (i+1).toString(),
-            value: in_opt.value
-          });
-
-          $newopt.append($radio);
-          $newopt.append('<span>' + in_opt.label + '</span>');
-
-          $el.append($newopt);
-        }
+        $el.append(data.options);
       }
 
       if (data.hasOwnProperty('value'))
@@ -2378,22 +2351,7 @@
       if (data.hasOwnProperty('options')) {
         // Clear existing options and add each new one
         $el.find('label.checkbox').remove();
-        for (var i = 0; i < data.options.length; i++) {
-          var in_opt = data.options[i];
-
-          var $newopt = $('<label class="checkbox"/>');
-          var $checkbox = $('<input/>', {
-            type:  "checkbox",
-            name:  el.id,
-            id:    el.id + (i+1).toString(),
-            value: in_opt.value
-          });
-
-          $newopt.append($checkbox);
-          $newopt.append('<span>' + in_opt.label + '</span>');
-
-          $el.append($newopt);
-        }
+        $el.append(data.options);
       }
 
       if (data.hasOwnProperty('value'))

man/HTML.Rd

@@ -1,4 +1,3 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
 \name{HTML}
 \alias{HTML}
 \title{Mark Characters as HTML}

man/absolutePanel.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{absolutePanel}
 \alias{absolutePanel}
 \alias{fixedPanel}

man/actionButton.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{actionButton}
 \alias{actionButton}
 \alias{actionLink}

man/addResourcePath.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{addResourcePath}
 \alias{addResourcePath}
 \title{Resource Publishing}

man/bootstrapPage.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{bootstrapPage}
 \alias{basicPage}
 \alias{bootstrapPage}

man/builder.Rd

@@ -1,5 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
-\name{p}
+\name{builder}
 \alias{a}
 \alias{br}
 \alias{builder}
@@ -21,6 +20,8 @@
 \alias{tags}
 \title{HTML Builder Functions}
 \usage{
+tags
+
 p(...)
 
 h1(...)
@@ -54,8 +55,6 @@ strong(...)
 em(...)
 
 hr(...)
-
-tags
 }
 \arguments{
 \item{...}{Attributes and children of the element. Named arguments become

man/checkboxGroupInput.Rd

@@ -1,9 +1,9 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{checkboxGroupInput}
 \alias{checkboxGroupInput}
 \title{Checkbox Group Input Control}
 \usage{
-checkboxGroupInput(inputId, label, choices, selected = NULL)
+checkboxGroupInput(inputId, label, choices, selected = NULL, inline = FALSE)
 }
 \arguments{
 \item{inputId}{Input variable to assign the control's value to.}
@@ -14,6 +14,8 @@ checkboxGroupInput(inputId, label, choices, selected = NULL)
 are named then that name rather than the value is displayed to the user.}
 
 \item{selected}{The values that should be initially selected, if any.}
+
+\item{inline}{If \code{TRUE}, render the choices inline (i.e. horizontally)}
 }
 \value{
 A list of HTML elements that can be added to a UI definition.

man/checkboxInput.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{checkboxInput}
 \alias{checkboxInput}
 \title{Checkbox Input Control}

man/column.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{column}
 \alias{column}
 \title{Create a column within a UI definition}

man/conditionalPanel.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{conditionalPanel}
 \alias{conditionalPanel}
 \title{Conditional Panel}
@@ -23,6 +23,13 @@ example, if you have an input with an id of \code{foo}, then you can use
 \code{input.foo} to read its value. (Be sure not to modify the input/output
 objects, as this may cause unpredictable behavior.)
 }
+\note{
+You are not recommended to use special JavaScript characters such as a
+  period \code{.} in the input id's, but if you do use them anyway, for
+  example, \code{inputId = "foo.bar"}, you will have to use
+  \code{input["foo.bar"]} instead of \code{input.foo.bar} to read the input
+  value.
+}
 \examples{
 sidebarPanel(
    selectInput(

man/dateInput.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{dateInput}
 \alias{dateInput}
 \title{Create date input}

man/dateRangeInput.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{dateRangeInput}
 \alias{dateRangeInput}
 \title{Create date range input}

man/domains.Rd

@@ -1,5 +1,5 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
-\name{getDefaultReactiveDomain}
+% Generated by roxygen2 (4.0.1): do not edit by hand
+\name{domains}
 \alias{domains}
 \alias{getDefaultReactiveDomain}
 \alias{onReactiveDomainEnded}

man/downloadButton.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{downloadButton}
 \alias{downloadButton}
 \alias{downloadLink}

man/downloadHandler.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{downloadHandler}
 \alias{downloadHandler}
 \title{File Downloads}

man/exprToFunction.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{exprToFunction}
 \alias{exprToFunction}
 \title{Convert an expression to a function}

man/fileInput.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{fileInput}
 \alias{fileInput}
 \title{File Upload Control}

man/fixedPage.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{fixedPage}
 \alias{fixedPage}
 \alias{fixedRow}

man/flowLayout.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{flowLayout}
 \alias{flowLayout}
 \title{Flow layout}
@@ -27,7 +27,5 @@ flowLayout(
 }
 \seealso{
 \code{\link{verticalLayout}}
-
-#'
 }
 

man/fluidPage.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{fluidPage}
 \alias{fluidPage}
 \alias{fluidRow}

man/getProvidedHtmlDependencies.Rd

@@ -1,15 +0,0 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
-\name{getProvidedHtmlDependencies}
-\alias{getProvidedHtmlDependencies}
-\title{Return HTML dependencies provided by Shiny}
-\usage{
-getProvidedHtmlDependencies()
-}
-\value{
-A list of objects of type \code{html_dependency}, one per dependency
-}
-\description{
-By default, Shiny supplies some framework scripts when it renders a page.
-\code{getProvidedHtmlDependencies} returns a list of those provided objects.
-}
-

man/headerPanel.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{headerPanel}
 \alias{headerPanel}
 \title{Create a header panel}

man/helpText.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{helpText}
 \alias{helpText}
 \title{Create a help text element}

man/htmlOutput.Rd

@@ -1,15 +1,18 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{htmlOutput}
 \alias{htmlOutput}
 \alias{uiOutput}
 \title{Create an HTML output element}
 \usage{
-htmlOutput(outputId)
+htmlOutput(outputId, inline = FALSE)
 
-uiOutput(outputId)
+uiOutput(outputId, inline = FALSE)
 }
 \arguments{
 \item{outputId}{output variable to read the value from}
+
+\item{inline}{use an inline (\code{span()}) or block container (\code{div()})
+for the output}
 }
 \value{
 An HTML output element that can be included in a panel

man/icon.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{icon}
 \alias{icon}
 \title{Create an icon}

man/imageOutput.Rd

@@ -1,9 +1,9 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{imageOutput}
 \alias{imageOutput}
 \title{Create a image output element}
 \usage{
-imageOutput(outputId, width = "100\%", height = "400px")
+imageOutput(outputId, width = "100\%", height = "400px", inline = FALSE)
 }
 \arguments{
 \item{outputId}{output variable to read the image from}
@@ -13,6 +13,9 @@ imageOutput(outputId, width = "100\%", height = "400px")
 string and have \code{"px"} appended.}
 
 \item{height}{Image height}
+
+\item{inline}{use an inline (\code{span()}) or block container (\code{div()})
+for the output}
 }
 \value{
 An image output element that can be included in a panel

man/include.Rd

@@ -1,4 +1,3 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
 \name{include}
 \alias{include}
 \alias{includeCSS}
@@ -26,7 +25,7 @@ includeScript(path, ...)
 \item{...}{Any additional attributes to be applied to the generated tag.}
 }
 \description{
-Include HTML, text, or rendered Markdown into a \link[=shinyUI]{Shiny UI}.
+Load HTML, text, or rendered Markdown from a file and turn into HTML.
 }
 \details{
 These functions provide a convenient way to include an extensive amount of

man/inputPanel.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{inputPanel}
 \alias{inputPanel}
 \title{Input panel}

man/installExprFunction.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{installExprFunction}
 \alias{installExprFunction}
 \title{Install an expression as a function}

man/invalidateLater.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{invalidateLater}
 \alias{invalidateLater}
 \title{Scheduled Invalidation}

man/is.reactivevalues.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{is.reactivevalues}
 \alias{is.reactivevalues}
 \title{Checks whether an object is a reactivevalues object}

man/isolate.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{isolate}
 \alias{isolate}
 \title{Create a non-reactive scope for an expression}

man/knitr_methods.Rd

@@ -1,24 +1,20 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{knitr_methods}
 \alias{knit_print.shiny.appobj}
 \alias{knit_print.shiny.render.function}
-\alias{knit_print.shiny.tag}
-\alias{knit_print.shiny.tag.list}
 \alias{knitr_methods}
 \title{Knitr S3 methods}
 \usage{
 knit_print.shiny.appobj(x, ...)
 
-knit_print.shiny.tag(x, ...)
-
-knit_print.shiny.tag.list(x, ...)
-
-knit_print.shiny.render.function(x, ...)
+knit_print.shiny.render.function(x, ..., inline = FALSE)
 }
 \arguments{
 \item{x}{Object to knit_print}
 
 \item{...}{Additional knit_print arguments}
+
+\item{inline}{Whether the object is printed inline.}
 }
 \description{
 These S3 methods are necessary to help Shiny applications and UI chunks embed

man/knitr_methods_htmltools.Rd

@@ -0,0 +1,22 @@
+\name{knit_print.html}
+\alias{knit_print.html}
+\alias{knit_print.shiny.tag}
+\alias{knit_print.shiny.tag.list}
+\title{Knitr S3 methods}
+\usage{
+knit_print.shiny.tag(x, ...)
+
+knit_print.html(x, ...)
+
+knit_print.shiny.tag.list(x, ...)
+}
+\arguments{
+\item{x}{Object to knit_print}
+
+\item{...}{Additional knit_print arguments}
+}
+\description{
+These S3 methods are necessary to allow HTML tags to print themselves in
+knitr/rmarkdown documents.
+}
+

man/mainPanel.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{mainPanel}
 \alias{mainPanel}
 \title{Create a main panel}

man/makeReactiveBinding.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{makeReactiveBinding}
 \alias{makeReactiveBinding}
 \title{Make a reactive variable}

man/markRenderFunction.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{markRenderFunction}
 \alias{markRenderFunction}
 \title{Mark a function as a render function}

man/maskReactiveContext.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{maskReactiveContext}
 \alias{maskReactiveContext}
 \title{Evaluate an expression without a reactive context}

man/navbarPage.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{navbarPage}
 \alias{navbarMenu}
 \alias{navbarPage}
@@ -6,7 +6,7 @@
 \usage{
 navbarPage(title, ..., id = NULL, header = NULL, footer = NULL,
   inverse = FALSE, collapsable = FALSE, fluid = TRUE, responsive = TRUE,
-  theme = NULL)
+  theme = NULL, windowTitle = title)
 
 navbarMenu(title, ..., icon = NULL)
 }
@@ -43,6 +43,9 @@ and resize page elements based on the size of the viewing device)}
 www directory). For example, to use the theme located at
 \code{www/bootstrap.css} you would use \code{theme = "bootstrap.css"}.}
 
+\item{windowTitle}{The title that should be displayed by the browser window.
+Useful if \code{title} is not a string.}
+
 \item{icon}{Optional icon to appear on a \code{navbarMenu} tab.}
 }
 \value{

man/navlistPanel.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{navlistPanel}
 \alias{navlistPanel}
 \title{Create a navigation list panel}

man/numericInput.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{numericInput}
 \alias{numericInput}
 \title{Create a numeric input control}

man/observe.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{observe}
 \alias{observe}
 \title{Create a reactive observer}

man/outputOptions.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{outputOptions}
 \alias{outputOptions}
 \title{Set options for an output object.}

man/pageWithSidebar.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{pageWithSidebar}
 \alias{pageWithSidebar}
 \title{Create a page with a sidebar}

man/parseQueryString.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{parseQueryString}
 \alias{parseQueryString}
 \title{Parse a GET query string from a URL}

man/plotOutput.Rd

@@ -1,33 +1,34 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{plotOutput}
 \alias{plotOutput}
 \title{Create an plot output element}
 \usage{
 plotOutput(outputId, width = "100\%", height = "400px", clickId = NULL,
   hoverId = NULL, hoverDelay = 300, hoverDelayType = c("debounce",
-  "throttle"))
+  "throttle"), inline = FALSE)
 }
 \arguments{
 \item{outputId}{output variable to read the plot from}
 
-\item{width}{Plot width. Must be a valid CSS unit (like \code{"100\%"},
-\code{"400px"}, \code{"auto"}) or a number, which will be coerced to a
-string and have \code{"px"} appended.}
-
-\item{height}{Plot height}
+\item{width,height}{Plot width/height. 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. These two arguments are
+ignored when \code{inline = TRUE}, in which case the width/height of a plot
+must be specified in \code{renderPlot()}.}
 
 \item{clickId}{If not \code{NULL}, the plot will send coordinates to the
 server whenever it is clicked. This information will be accessible on the
-\code{input} object using \code{input$}\emph{\code{clickId}}. The value will be a
-named list or vector with \code{x} and \code{y} elements indicating the
-mouse position in user units.}
+\code{input} object using \code{input$}\emph{\code{clickId}}. The value
+will be a named list or vector with \code{x} and \code{y} elements
+indicating the mouse position in user units.}
 
 \item{hoverId}{If not \code{NULL}, the plot will send coordinates to the
 server whenever the mouse pauses on the plot for more than the number of
 milliseconds determined by \code{hoverTimeout}. This information will be
-The value will be \code{NULL} if the user is not hovering, and a named
-list or vector with \code{x} and \code{y} elements indicating the mouse
-position in user units.}
+accessible on the \code{input} object using
+\code{input$}\emph{\code{clickId}}. The value will be \code{NULL} if the
+user is not hovering, and a named list or vector with \code{x} and \code{y}
+elements indicating the mouse position in user units.}
 
 \item{hoverDelay}{The delay for hovering, in milliseconds.}
 
@@ -36,6 +37,9 @@ events. Use \code{"throttle"} to limit the number of hover events to one
 every \code{hoverDelay} milliseconds. Use \code{"debounce"} to suspend
 events while the cursor is moving, and wait until the cursor has been at
 rest for \code{hoverDelay} milliseconds before sending an event.}
+
+\item{inline}{use an inline (\code{span()}) or block container (\code{div()})
+for the output}
 }
 \value{
 A plot output element that can be included in a panel
@@ -43,6 +47,12 @@ A plot output element that can be included in a panel
 \description{
 Render a \link{renderPlot} within an application page.
 }
+\note{
+The arguments \code{clickId} and \code{hoverId} only work for R base
+  graphics (see the \pkg{\link{graphics}} package). They do not work for
+  \pkg{\link[grid:grid-package]{grid}}-based graphics, such as \pkg{ggplot2},
+  \pkg{lattice}, and so on.
+}
 \examples{
 # Show a plot of the generated distribution
 mainPanel(

man/plotPNG.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{plotPNG}
 \alias{plotPNG}
 \title{Run a plotting function and save the output as a PNG}

man/radioButtons.Rd

@@ -1,9 +1,9 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{radioButtons}
 \alias{radioButtons}
 \title{Create radio buttons}
 \usage{
-radioButtons(inputId, label, choices, selected = NULL)
+radioButtons(inputId, label, choices, selected = NULL, inline = FALSE)
 }
 \arguments{
 \item{inputId}{Input variable to assign the control's value to}
@@ -15,6 +15,8 @@ named then that name rather than the value is displayed to the user)}
 
 \item{selected}{The initially selected value (if not specified then
 defaults to the first value)}
+
+\item{inline}{If \code{TRUE}, render the choices inline (i.e. horizontally)}
 }
 \value{
 A set of radio buttons that can be added to a UI definition.

man/reactive.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{reactive}
 \alias{is.reactive}
 \alias{reactive}

man/reactiveFileReader.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{reactiveFileReader}
 \alias{reactiveFileReader}
 \title{Reactive file reader}

man/reactivePlot.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{reactivePlot}
 \alias{reactivePlot}
 \title{Plot output (deprecated)}

man/reactivePoll.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{reactivePoll}
 \alias{reactivePoll}
 \title{Reactive polling}

man/reactivePrint.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{reactivePrint}
 \alias{reactivePrint}
 \title{Print output (deprecated)}

man/reactiveTable.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{reactiveTable}
 \alias{reactiveTable}
 \title{Table output (deprecated)}

man/reactiveText.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{reactiveText}
 \alias{reactiveText}
 \title{Text output (deprecated)}

man/reactiveTimer.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{reactiveTimer}
 \alias{reactiveTimer}
 \title{Timer}

man/reactiveUI.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{reactiveUI}
 \alias{reactiveUI}
 \title{UI output (deprecated)}

man/reactiveValues.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{reactiveValues}
 \alias{reactiveValues}
 \title{Create an object for storing reactive values}

man/reactiveValuesToList.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{reactiveValuesToList}
 \alias{reactiveValuesToList}
 \title{Convert a reactivevalues object to a list}

man/registerInputHandler.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{registerInputHandler}
 \alias{registerInputHandler}
 \title{Register an Input Handler}

man/removeInputHandler.Rd

@@ -1,4 +1,4 @@
-% Generated by roxygen2 (4.0.0): do not edit by hand
+% Generated by roxygen2 (4.0.1): do not edit by hand
 \name{removeInputHandler}
 \alias{removeInputHandler}
 \title{Deregister an Input Handler}