Restore HTML generating functions

These functions were temporarily ripped out of Shiny and moved
to the htmltools package. We've discovered that it's safe to
keep including them in shiny; as long as the functions in shiny
and the functions in htmltools are identical, the user won't
receive a conflict warning.

.travis.yml

@@ -13,7 +13,8 @@ install:
   - sudo apt-get update
   - sudo apt-get install r-base-dev r-cran-shiny r-cran-cairo r-cran-markdown
   - "[ ! -d ~/R ] && mkdir ~/R"
-  - Rscript -e "install.packages(c('xtable', 'knitr', 'htmltools'), repos = 'http://cran.rstudio.org')"
+  - 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')"
 
 # run tests

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 0.10.0.9000
-Date: 2014-06-13
+Version: 0.9.1.9008
+Date: 2014-03-19
 Author: RStudio, Inc.
 Maintainer: Winston Chang <winston@rstudio.com>
 Description: Shiny makes it incredibly easy to build interactive web

NAMESPACE

@@ -17,7 +17,6 @@ S3method(as.list,reactivevalues)
 S3method(as.shiny.appobj,character)
 S3method(as.shiny.appobj,list)
 S3method(as.shiny.appobj,shiny.appobj)
-S3method(as.tags,shiny.appobj)
 S3method(as.tags,shiny.render.function)
 S3method(names,reactivevalues)
 S3method(print,reactive)
@@ -81,11 +80,8 @@ 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)
-export(knit_print.shiny.tag.list)
 export(mainPanel)
 export(makeReactiveBinding)
 export(markRenderFunction)
@@ -133,7 +129,6 @@ export(runGitHub)
 export(runUrl)
 export(selectInput)
 export(selectizeInput)
-export(serverInfo)
 export(shinyApp)
 export(shinyAppDir)
 export(shinyServer)

NEWS

@@ -1,18 +1,9 @@
-shiny 0.10.0
+shiny 0.9.1.9XXX
 --------------------------------------------------------------------------------
 
 * 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
@@ -21,39 +12,20 @@ shiny 0.10.0
 * `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. `flowLayout` lays out its children in a left-to-right,
+  elements side by side. `flowPanel` 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. 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.
+  size instead of filling up all available horizontal space.
 
 * Fixed a bug of renderDataTable() when the data object only has 1 row and 1
   column. (Thanks, ZJ Dai, #429)

R/app.R

@@ -224,21 +224,6 @@ 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

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

@@ -557,7 +557,6 @@ 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
@@ -570,7 +569,7 @@ checkboxInput <- function(inputId, label, value = FALSE) {
 #'                      "Gears" = "gear"))
 #'
 #' @export
-checkboxGroupInput <- function(inputId, label, choices, selected = NULL, inline = FALSE) {
+checkboxGroupInput <- function(inputId, label, choices, selected = NULL) {
   # resolve names
   choices <- choicesWithNames(choices)
   if (!is.null(selected))
@@ -590,7 +589,7 @@ checkboxGroupInput <- function(inputId, label, choices, selected = NULL, inline
     if (value %in% selected)
       inputTag$attribs$checked <- "checked"
 
-    tags$label(class = if (inline) "checkbox inline" else "checkbox",
+    tags$label(class = "checkbox",
                inputTag,
                tags$span(name))
     }
@@ -791,7 +790,6 @@ 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
@@ -804,7 +802,7 @@ selectizeIt <- function(inputId, select, options, width = NULL, nonempty = FALSE
 #'                "Log-normal" = "lnorm",
 #'                "Exponential" = "exp"))
 #' @export
-radioButtons <- function(inputId, label, choices, selected = NULL, inline = FALSE) {
+radioButtons <- function(inputId, label, choices, selected = NULL) {
   # resolve names
   choices <- choicesWithNames(choices)
 
@@ -828,7 +826,7 @@ radioButtons <- function(inputId, label, choices, selected = NULL, inline = FALS
         inputTag$attribs$checked = "checked"
 
       # Put the label text in a span
-      tags$label(class = if (inline) "radio inline" else "radio",
+      tags$label(class = "radio",
                 inputTag,
                 tags$span(name)
       )

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(reinitializeSeed())
+  withPrivateSeed(set.seed(NULL))
 }

R/htmltools.R

@@ -1,7 +1,101 @@
-#' @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
+#' @export
+a <- htmltools::a
+
+#' @export
+br <- htmltools::br
+
+#' @export
+code <- htmltools::code
+
+#' @export
+div <- htmltools::div
+
+#' @export
+em <- htmltools::em
+
+#' @export
+h1 <- htmltools::h1
+
+#' @export
+h2 <- htmltools::h2
+
+#' @export
+h3 <- htmltools::h3
+
+#' @export
+h4 <- htmltools::h4
+
+#' @export
+h5 <- htmltools::h5
+
+#' @export
+h6 <- htmltools::h6
+
+#' @export
+hr <- htmltools::hr
+
+#' @export
+HTML <- htmltools::HTML
+
+#' @export
+img <- htmltools::img
+
+#' @export
+includeCSS <- htmltools::includeCSS
+
+#' @export
+includeHTML <- htmltools::includeHTML
+
+#' @export
+includeMarkdown <- htmltools::includeMarkdown
+
+#' @export
+includeScript <- htmltools::includeScript
+
+#' @export
+includeText <- htmltools::includeText
+
+#' @export
+is.singleton <- htmltools::is.singleton
+
+#' @export
+p <- htmltools::p
+
+#' @export
+pre <- htmltools::pre
+
+#' @export
+singleton <- htmltools::singleton
+
+#' @export
+span <- htmltools::span
+
+#' @export
+strong <- htmltools::strong
+
+#' @export
+tag <- htmltools::tag
+
+#' @export
+tagAppendAttributes <- htmltools::tagAppendAttributes
+
+#' @export
+tagAppendChild <- htmltools::tagAppendChild
+
+#' @export
+tagAppendChildren <- htmltools::tagAppendChildren
+
+#' @export
+tagList <- htmltools::tagList
+
+#' @export
+tags <- htmltools::tags
+
+#' @export
+tagSetChildren <- htmltools::tagSetChildren
+
+#' @export
+validateCssUnit <- htmltools::validateCssUnit
+
+#' @export
+withTags <- htmltools::withTags

R/imageutils.R

@@ -42,15 +42,9 @@ 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. 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))
+  # Call plot.new() so that even if no plotting operations are performed
+  # at least we have a blank background
+  plot.new()
   dv <- dev.cur()
   tryCatch(shinyCallingHandlers(func()), finally = dev.off(dv))
 

R/shinywrappers.R

@@ -30,8 +30,7 @@ useRenderFunction <- function(renderFunc) {
   return(outputFunction(id))
 }
 
-#' @export
-#' @method as.tags shiny.render.function
+#' @S3method as.tags shiny.render.function
 as.tags.shiny.render.function <- function(x, ...) {
   useRenderFunction(x)
 }
@@ -124,9 +123,13 @@ renderPlot <- function(expr, width='auto', height='auto', res=72, ...,
 
     coordmap <- NULL
     plotFunc <- function() {
-      # Actually perform the plotting: use capture.output() to suppress output
-      # to console, and print func() if it returns a visible value
-      capture.output(func())
+      # Actually perform the plotting
+      result <- withVisible(func())
+      if (result$visible) {
+        # Use capture.output to squelch printing to the actual console; we
+        # are only interested in plot output
+        capture.output(print(result$value))
+      }
 
       # Now capture some graphics device info before we close it
       usrCoords <- par('usr')

R/utils.R

@@ -77,22 +77,11 @@ withPrivateSeed <- function(expr) {
     .globals$ownSeed, unset=is.null(.globals$ownSeed), {
       tryCatch({
         expr
-      }, finally = {
-        .globals$ownSeed <- getExists('.Random.seed', 'numeric', globalenv())
-      })
+      }, finally = {.globals$ownSeed <- .Random.seed})
     }
   )
 }
 
-# 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(...))
@@ -908,23 +897,3 @@ 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
-}

README.md

@@ -1,6 +1,6 @@
 # Shiny
 
-[![Build Status](https://travis-ci.org/rstudio/shiny.svg?branch=master)](https://travis-ci.org/rstudio/shiny)
+[![Build Status](https://travis-ci.org/rstudio/shiny.png)](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/tests/test-utils.R

@@ -21,10 +21,6 @@ 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/shiny.js

@@ -1058,10 +1058,7 @@
   (function() {
     // Returns a jQuery object or element array that contains the
     // descendants of scope that match this binding
-    this.find = function(scope) {
-      if (typeof(this.className) !== 'undefined')
-        return $(scope).find('.' + this.className);
-    };
+    this.find = function(scope) { throw "Not implemented"; };
 
     this.getId = function(el) {
       return el['data-input-id'] || el.id;
@@ -1253,7 +1250,6 @@
 
       exports.renderHtml(html, el, dependencies);
       exports.initializeInputs(el);
-      exports.initializeOutputs(el);
       exports.bindAll(el);
     }
   });
@@ -2995,10 +2991,14 @@
     };
     exports.unbindAll = unbindAll;
 
-    function initializeElements(scope, bindings) {
+    // Calls .initialize() for all of the input objects in all input bindings,
+    // in the given scope.
+    function initializeInputs(scope) {
       if (scope === undefined)
         scope = document;
 
+      var bindings = inputBindings.getBindings();
+
       // Iterate over all bindings
       for (var i = 0; i < bindings.length; i++) {
         var binding = bindings[i].binding;
@@ -3010,24 +3010,11 @@
         }
       }
     }
-
-    // Calls .initialize() for all of the input objects in all input bindings,
-    // in the given scope.
-    function initializeInputs(scope) {
-      initializeElements(scope, inputBindings.getBindings());
-    }
     exports.initializeInputs = initializeInputs;
 
-    // Calls .initialize() for all of the output objects in all output bindings,
-    // in the given scope.
-    function initializeOutputs(scope) {
-      initializeElements(scope, outputBindings.getBindings());
-    }
-    exports.initializeOutputs = initializeOutputs;
 
     // Initialize all input objects in the document, before binding
     initializeInputs(document);
-    initializeOutputs(document);
 
     // Binding multiInputs in this method is useful for old-style (<=0.5.0)
     // HTML generated by Shiny. This should be deprecated at some point.

man/checkboxGroupInput.Rd

@@ -3,7 +3,7 @@
 \alias{checkboxGroupInput}
 \title{Checkbox Group Input Control}
 \usage{
-checkboxGroupInput(inputId, label, choices, selected = NULL, inline = FALSE)
+checkboxGroupInput(inputId, label, choices, selected = NULL)
 }
 \arguments{
 \item{inputId}{Input variable to assign the control's value to.}
@@ -14,8 +14,6 @@ checkboxGroupInput(inputId, label, choices, selected = NULL, inline = FALSE)
 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/flowLayout.Rd

@@ -27,5 +27,7 @@ flowLayout(
 }
 \seealso{
 \code{\link{verticalLayout}}
+
+#'
 }
 

man/knitr_methods_htmltools.Rd

@@ -1,22 +0,0 @@
-\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/radioButtons.Rd

@@ -3,7 +3,7 @@
 \alias{radioButtons}
 \title{Create radio buttons}
 \usage{
-radioButtons(inputId, label, choices, selected = NULL, inline = FALSE)
+radioButtons(inputId, label, choices, selected = NULL)
 }
 \arguments{
 \item{inputId}{Input variable to assign the control's value to}
@@ -15,8 +15,6 @@ 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/serverInfo.Rd

@@ -1,17 +0,0 @@
-% Generated by roxygen2 (4.0.1): do not edit by hand
-\name{serverInfo}
-\alias{serverInfo}
-\title{Collect information about the Shiny Server environment}
-\usage{
-serverInfo()
-}
-\value{
-A list of the Shiny Server information.
-}
-\description{
-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)}.
-}
-

man/shinyApp.Rd

@@ -4,7 +4,6 @@
 \alias{as.shiny.appobj.character}
 \alias{as.shiny.appobj.list}
 \alias{as.shiny.appobj.shiny.appobj}
-\alias{as.tags.shiny.appobj}
 \alias{print.shiny.appobj}
 \alias{shinyApp}
 \alias{shinyAppDir}
@@ -23,8 +22,6 @@ as.shiny.appobj(x)
 \method{as.shiny.appobj}{character}(x)
 
 \method{print}{shiny.appobj}(x, ...)
-
-\method{as.tags}{shiny.appobj}(x, ...)
 }
 \arguments{
 \item{ui}{The UI definition of the app (for example, a call to

man/splitLayout.Rd

@@ -15,7 +15,9 @@ be interpreted as CSS lengths (see \code{\link{validateCssUnit}}), numeric
 values as pixels.}
 
 \item{cellArgs}{Any additional attributes that should be used for each cell
-  of the layout.}
+  of the layout.
+
+#'}
 }
 \description{
 Lays out elements horizontally, dividing the available horizontal space into