added NEWS entry

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 0.14.2
+Version: 0.14.1.9001
 Authors@R: c(
     person("Winston", "Chang", role = c("aut", "cre"), email = "winston@rstudio.com"),
     person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"),
@@ -142,7 +142,6 @@ Collate:
     'shinywrappers.R'
     'showcase.R'
     'tar.R'
-    'test-export.R'
     'timer.R'
     'update-input.R'
 RoxygenNote: 5.0.1

NAMESPACE

@@ -38,6 +38,7 @@ export(actionButton)
 export(actionLink)
 export(addResourcePath)
 export(animationOptions)
+export(applyInputHandlers)
 export(as.shiny.appobj)
 export(basicPage)
 export(bookmarkButton)
@@ -69,7 +70,6 @@ export(downloadLink)
 export(em)
 export(enableBookmarking)
 export(eventReactive)
-export(exportTestValues)
 export(exprToFunction)
 export(extractStackTrace)
 export(fileInput)

NEWS.md

@@ -1,22 +1,18 @@
-shiny 0.14.2
+shiny 0.14.1.9001
 ============
 
-This is a maintenance release of Shiny, with some bug fixes and minor new features.
-
 ## Full changelog
 
 ### Minor new features and improvements
 
+* HTML markup can now be used in the choices' names for radio buttons. ([#1439](https://github.com/rstudio/shiny/pull/1439))
+
 * Added a `fade` argument to `modalDialog()` -- setting it to `FALSE` will remove the usual fade-in animation for that modal window. ([#1414](https://github.com/rstudio/shiny/pull/1414))
 
+* Exported function to apply input handlers to input values. This can be used for testing Shiny applications. ([#1421](https://github.com/rstudio/shiny/pull/1421))
+
 * Fixed a "duplicate binding" error that occurred in some edge cases involving `insertUI` and nested `uiOutput`. ([#1402](https://github.com/rstudio/shiny/pull/1402))
 
-* Fixed [#1422](https://github.com/rstudio/shiny/issues/1422): When using the `shiny.trace` option, allow specifying to only log SEND or RECV messages, or both. (PR [#1428](https://github.com/rstudio/shiny/pull/1428))
-
-* Fixed [#1419](https://github.com/rstudio/shiny/issues/1419): Allow overriding a JS custom message handler. (PR [#1445](https://github.com/rstudio/shiny/pull/1445))
-
-* Added `exportTestValues()` function, which allows a test driver to query the session for values internal to an application's server function. This only has an effect if the `shiny.testmode` option is set to `TRUE`. ([#1436](https://github.com/rstudio/shiny/pull/1436))
-
 ### Bug fixes
 
 * Fixed [#1427](https://github.com/rstudio/shiny/issues/1427): make sure that modals do not close incorrectly when an element inside them is triggered as hidden. ([#1430](https://github.com/rstudio/shiny/pull/1430))
@@ -25,8 +21,6 @@ This is a maintenance release of Shiny, with some bug fixes and minor new featur
 
 * `sliderInputBinding.setValue()` now sends a slider's value immediately, instead of waiting for the usual 250ms debounce delay. ([#1429](https://github.com/rstudio/shiny/pull/1429))
 
-* Fixed a bug where, in versions of R before 3.2, Shiny applications could crash due to a bug in R's implementation of `list2env()`. ([#1446](https://github.com/rstudio/shiny/pull/1446))
-
 shiny 0.14.1
 ============
 

R/bookmark-state.R

@@ -362,7 +362,7 @@ RestoreContext <- R6Class("RestoreContext",
       self$input <- RestoreInputSet$new(inputs)
 
       values <- valuesFromJSON(values)
-      self$values <- list2env2(values, self$values)
+      self$values <- list2env(values, self$values)
     }
   )
 )
@@ -385,7 +385,7 @@ RestoreInputSet <- R6Class("RestoreInputSet",
 
   public = list(
     initialize = function(values) {
-      private$values <- list2env2(values, parent = emptyenv())
+      private$values <- list2env(values, parent = emptyenv())
     },
 
     exists = function(name) {

R/input-utils.R

@@ -51,10 +51,10 @@ generateOptions <- function(inputId, choices, selected, inline, type = 'checkbox
       # If inline, there's no wrapper div, and the label needs a class like
       # checkbox-inline.
       if (inline) {
-        tags$label(class = paste0(type, "-inline"), inputTag, tags$span(name))
+        tags$label(class = paste0(type, "-inline"), inputTag, tags$span(HTML(name)))
       } else {
         tags$div(class = type,
-          tags$label(inputTag, tags$span(name))
+          tags$label(inputTag, tags$span(HTML(name)))
         )
       }
     },

R/server-input-handlers.R

@@ -73,7 +73,7 @@ removeInputHandler <- function(type){
 
 
 # Apply input handler to a single input value
-applyInputHandler <- function(name, val, shinysession) {
+applyInputHandler <- function(name, val) {
   splitName <- strsplit(name, ':')[[1]]
   if (length(splitName) > 1) {
     if (!inputHandlers$containsKey(splitName[[2]])) {
@@ -108,14 +108,23 @@ applyInputHandler <- function(name, val, shinysession) {
 #' output.
 #'
 #' @param inputs A named list of input values.
-#' @param shinysession A Shiny session object.
 #'
 #' @seealso registerInputHandler
-#' @keywords internal
-applyInputHandlers <- function(inputs, shinysession = getDefaultReactiveDomain()) {
-  inputs <- mapply(applyInputHandler, names(inputs), inputs,
-                   MoreArgs = list(shinysession = shinysession),
-                   SIMPLIFY = FALSE)
+#'
+#' @examples
+#' applyInputHandlers(list(
+#'   "m1" = list(list(1, 2), list(3, 4)),
+#'   "m2:shiny.matrix" = list(list(1, 2), list(3, 4)),
+#'
+#'   "d1" = "2016-01-01",
+#'   "d2:shiny.date" = "2016-01-01",  # Date object
+#'
+#'   "n1" = NULL,
+#'   "n2:shiny.number" = NULL  # Converts to NA
+#' ))
+#' @export
+applyInputHandlers <- function(inputs) {
+  inputs <- mapply(applyInputHandler, names(inputs), inputs, SIMPLIFY = FALSE)
 
   # Convert names like "button1:shiny.action" to "button1"
   names(inputs) <- vapply(

R/server.R

@@ -218,8 +218,7 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
           if (is.character(msg))
             msg <- charToRaw(msg)
 
-          traceOption <- getOption('shiny.trace', FALSE)
-          if (isTRUE(traceOption) || traceOption == "recv") {
+          if (isTRUE(getOption('shiny.trace'))) {
             if (binary)
               message("RECV ", '$$binary data$$')
             else

R/shiny.R

@@ -39,12 +39,9 @@ NULL
 #'     when an app is run. See \code{\link{runApp}} for more information.}
 #'   \item{shiny.port}{A port number that Shiny will listen on. See
 #'     \code{\link{runApp}} for more information.}
-#'   \item{shiny.trace}{Print messages sent between the R server and the web
-#'     browser client to the R console. This is useful for debugging. Possible
-#'     values are \code{"send"} (only print messages sent to the client),
-#'     \code{"recv"} (only print messages received by the server), \code{TRUE}
-#'     (print all messages), or \code{FALSE} (default; don't print any of these
-#'     messages).}
+#'   \item{shiny.trace}{If \code{TRUE}, all of the messages sent between the R
+#'     server and the web browser client will be printed on the console. This
+#'     is useful for debugging.}
 #'   \item{shiny.autoreload}{If \code{TRUE} when a Shiny app is launched, the
 #'     app directory will be continually monitored for changes to files that
 #'     have the extensions: r, htm, html, js, css, png, jpg, jpeg, gif. If any
@@ -107,9 +104,6 @@ NULL
 #'     particular error \code{e} to get displayed to the user, then set this option
 #'     to \code{TRUE} and use \code{stop(safeError(e))} for errors you want the
 #'     user to see.}
-#'   \item{shiny.testmode}{If \code{TRUE}, then enable features for testing Shiny
-#'     applications. If \code{FALSE} (the default), do not enable those features.
-#'   }
 #' }
 #' @name shiny-options
 NULL
@@ -329,19 +323,6 @@ workerId <- local({
 #' \item{doBookmark()}{
 #'   Do bookmarking and invoke the onBookmark and onBookmarked callback functions.
 #' }
-#' \item{exportTestValues()}{
-#'   Registers expressions for export in test mode, available at the test
-#'   endpoint URL.
-#' }
-#' \item{getTestEndpointUrl(inputs=TRUE, outputs=TRUE, exports=TRUE,
-#'   format="rds")}{
-#'   Returns a URL for the test endpoint. Only has an effect when the
-#'   \code{shiny.testmode} option is set to TRUE. For the inputs, outputs, and
-#'   exports arguments, TRUE means to return all of these values. It is also
-#'   possible to specify by name which values to return by providing a
-#'   character vector, as in \code{inputs=c("x", "y")}. The format can be
-#'   "rds" or "json".
-#' }
 #'
 #' @name session
 NULL
@@ -412,10 +393,6 @@ ShinySession <- R6Class(
     restoredCallbacks = 'Callbacks',
     bookmarkExclude = character(0),  # Names of inputs to exclude from bookmarking
 
-    testValueExprs = list(),
-    outputValues = list(),           # Saved output values (for testing mode)
-    testEndpointUrl = character(0),
-
     sendResponse = function(requestMsg, value) {
       if (is.null(requestMsg$tag)) {
         warning("Tried to send response for untagged message; method: ",
@@ -437,8 +414,7 @@ ShinySession <- R6Class(
       if (self$closed){
         return()
       }
-      traceOption <- getOption('shiny.trace', FALSE)
-      if (isTRUE(traceOption) || traceOption == "send")
+      if (isTRUE(getOption('shiny.trace')))
         message('SEND ',
            gsub('(?m)base64,[a-zA-Z0-9+/=]+','[base64 data]',json,perl=TRUE))
       private$websocket$send(json)
@@ -572,98 +548,6 @@ ShinySession <- R6Class(
         })
 
       }) # withReactiveDomain
-    },
-
-    # Save output values and errors. This is only used for testing mode.
-    storeOutputValues = function(values = NULL) {
-      private$outputValues <- mergeVectors(private$outputValues, values)
-    },
-
-    enableTestEndpoint = function() {
-      private$testEndpointUrl <- self$registerDataObj("shinytest", NULL,
-        function(data, req) {
-          if (!isTRUE(getOption("shiny.testmode"))) {
-            return()
-          }
-
-          params <- parseQueryString(req$QUERY_STRING)
-          # The format of the response that will be sent back. Default to "rds"
-          # unless requested otherwise. The only other valid value is "json".
-          format <- params$format %OR% "rds"
-
-          values <- list()
-
-          if (!is.null(params$inputs)) {
-
-            allInputs <- isolate(
-              reactiveValuesToList(self$input, all.names = TRUE)
-            )
-
-            # If params$inputs is "1", return all; otherwise return just the
-            # inputs that are named in params$inputs, like "x,y,z".
-            if (params$inputs == "1") {
-              values$inputs <- allInputs
-            } else {
-              items <- strsplit(params$inputs, ",")[[1]]
-              items <- intersect(items, names(allInputs))
-              values$inputs <- allInputs[items]
-            }
-          }
-
-          if (!is.null(params$outputs)) {
-
-            if (params$outputs == "1") {
-              values$outputs <- private$outputValues
-            } else {
-              items <- strsplit(params$outputs, ",")[[1]]
-              items <- intersect(items, names(private$outputValues))
-              values$outputs <- private$outputValues[items]
-            }
-          }
-
-          if (!is.null(params$exports)) {
-
-            testValueExprs <- private$testValueExprs
-            if (params$exports == "1") {
-              values$exports <- isolate(
-                lapply(private$testValueExprs, function(item) {
-                  eval(item$expr, envir = item$env)
-                })
-              )
-            } else {
-              items <- strsplit(params$exports, ",")[[1]]
-              items <- intersect(items, names(private$testValueExprs))
-              values$exports <- isolate(
-                lapply(private$testValueExprs[items], function(item) {
-                  eval(item$expr, envir = item$env)
-                })
-              )
-            }
-          }
-
-          if (length(values) == 0) {
-            return(httpResponse(400, "text/plain",
-              "No exports, inputs, or outputs requested."
-            ))
-          }
-
-          if (identical(format, "json")) {
-            content <- toJSON(values, pretty = TRUE)
-            httpResponse(200, "application/json", content)
-
-          } else if (identical(format, "rds")) {
-            tmpfile <- tempfile("shinytest", fileext = ".rds")
-            saveRDS(values, tmpfile)
-            on.exit(unlink(tmpfile))
-
-            content <- readBin(tmpfile, "raw", n = file.info(tmpfile)$size)
-            httpResponse(200, "application/octet-stream", content)
-
-          } else {
-            httpResponse(400, "text/plain", paste("Invalid format requested:", format))
-          }
-        }
-      )
     }
   ),
   public = list(
@@ -716,8 +600,6 @@ ShinySession <- R6Class(
       private$restoredCallbacks <- Callbacks$new()
       private$createBookmarkObservers()
 
-      private$enableTestEndpoint()
-
       private$registerSessionEndCallbacks()
 
       if (!is.null(websocket$request$HTTP_SHINY_SERVER_CREDENTIALS)) {
@@ -793,24 +675,6 @@ ShinySession <- R6Class(
             stop("`fun` must be a function that takes one argument")
           }
           restoredCallbacks$register(fun)
-        },
-        exportTestValues = function(..., quoted_ = FALSE, env_ = parent.frame()) {
-          if (quoted_) {
-            dots <- list(...)
-          } else {
-            dots <- eval(substitute(alist(...)))
-          }
-
-          if (anyUnnamed(dots))
-            stop("exportTestValues: all arguments must be named.")
-
-          names(dots) <- vapply(names(dots), ns, character(1))
-
-          do.call(
-            .subset2(self, "exportTestValues"),
-            c(dots, quoted_ = TRUE, env_ = env_),
-            quote = TRUE
-          )
         }
       )
 
@@ -1128,20 +992,16 @@ ShinySession <- R6Class(
       }
 
       private$progressKeys <- character(0)
-      values <- as.list(private$invalidatedOutputValues)
+      values <- private$invalidatedOutputValues
       private$invalidatedOutputValues <- Map$new()
-      errors <- as.list(private$invalidatedOutputErrors)
+      errors <- private$invalidatedOutputErrors
       private$invalidatedOutputErrors <- Map$new()
       inputMessages <- private$inputMessageQueue
       private$inputMessageQueue <- list()
 
-      if (isTRUE(getOption("shiny.testmode"))) {
-        private$storeOutputValues(mergeVectors(values, errors))
-      }
-
       private$sendMessage(
-        errors = errors,
-        values = values,
+        errors = as.list(errors),
+        values = as.list(values),
         inputMessages = inputMessages
       )
     },
@@ -1314,45 +1174,6 @@ ShinySession <- R6Class(
       )
     },
 
-    exportTestValues = function(..., quoted_ = FALSE, env_ = parent.frame()) {
-      # Get a named list of unevaluated expressions.
-      if (quoted_) {
-        dots <- list(...)
-      } else {
-        dots <- eval(substitute(alist(...)))
-      }
-
-      if (anyUnnamed(dots))
-        stop("exportTestValues: all arguments must be named.")
-
-      # Create a named list where each item is a list with an expression and
-      # environment in which to eval the expression.
-      items <- lapply(dots, function(expr) {
-        list(expr = expr, env = env_)
-      })
-
-      private$testValueExprs <- mergeVectors(private$testValueExprs, items)
-    },
-
-    getTestEndpointUrl = function(inputs = TRUE, outputs = TRUE, exports = TRUE,
-                                  format = "rds") {
-      reqString <- function(group, value) {
-        if (isTRUE(value))
-          paste0(group, "=1")
-        else if (is.character(value))
-          paste0(group, "=", paste(value, collapse = ","))
-        else
-          ""
-      }
-      paste(
-        private$testEndpointUrl,
-        reqString("inputs", inputs),
-        reqString("outputs", outputs),
-        reqString("exports", exports),
-        paste0("format=", format),
-        sep = "&"
-      )
-    },
 
     reactlog = function(logEntry) {
       # Use sendCustomMessage instead of sendMessage, because the handler in

R/test-export.R

@@ -1,60 +0,0 @@
-#' Register expressions for export in test mode
-#'
-#' This function registers expressions that will be evaluated when a test export
-#' event occurs. These events are triggered by accessing an API endpoint URL.
-#'
-#' This function only has an effect if the global option \code{shiny.testmode}
-#' is set to \code{TRUE}.
-#'
-#' @param quoted_ Are the expression quoted? Default is \code{FALSE}.
-#' @param env_ The environment in which the expression should be evaluated.
-#' @param session_ A Shiny session object.
-#' @param ... Named arguments that are quoted or unquoted expressions that will
-#'   be captured and evaluated when API endpoint is visited.
-#' @examples
-#' ## Only run this example in interactive R sessions
-#' if (interactive()) {
-#'
-#' options(shiny.testmode = TRUE)
-#'
-#' # This application shows the test endpoint URL; clicking on it will
-#' # fetch the input, output, and exported values in JSON format.
-#' shinyApp(
-#'   ui = basicPage(
-#'     h4("Snapshot URL: "),
-#'     uiOutput("url"),
-#'     h4("Current values:"),
-#'     verbatimTextOutput("values"),
-#'     actionButton("inc", "Increment x")
-#'   ),
-#'
-#'   server = function(input, output, session) {
-#'     vals <- reactiveValues(x = 1)
-#'     y <- reactive({ vals$x + 1 })
-#'
-#'     observeEvent(input$inc, {
-#'       vals$x <<- vals$x + 1
-#'     })
-#'
-#'     exportTestValues(
-#'       x = vals$x,
-#'       y = y()
-#'     )
-#'
-#'     output$url <- renderUI({
-#'       url <- session$getTestEndpointUrl(format="json")
-#'       a(href = url, url)
-#'     })
-#'
-#'     output$values <- renderText({
-#'       paste0("vals$x: ", vals$x, "\ny: ", y())
-#'     })
-#'   }
-#' )
-#' }
-#' @export
-exportTestValues <- function(..., quoted_ = FALSE, env_ = parent.frame(),
-  session_ = getDefaultReactiveDomain())
-{
-  session_$exportTestValues(..., quoted_ = quoted_, env_ = env_)
-}

R/update-input.R

@@ -622,7 +622,7 @@ updateSelectizeInput <- function(session, inputId, label = NULL, choices = NULL,
     res <- checkAsIs(options)
     cfg <- tags$script(
       type = 'application/json',
-      `data-for` = session$ns(inputId),
+      `data-for` = inputId,
       `data-eval` = if (length(res$eval)) HTML(toJSON(res$eval)),
       HTML(toJSON(res$options))
     )

R/utils.R

@@ -196,16 +196,6 @@ mergeVectors <- function(a, b) {
   x[!drop_idx]
 }
 
-# Wrapper around list2env with a NULL check. In R <3.2.0, if an empty unnamed
-# list is passed to list2env(), it errors. But an empty named list is OK. For
-# R >=3.2.0, this wrapper is not necessary.
-list2env2 <- function(x, ...) {
-  # Ensure that zero-length lists have a name attribute
-   if (length(x) == 0)
-    attr(x, "names") <- character(0)
-
-  list2env(x, ...)
-}
 
 # Combine dir and (file)name into a file path. If a file already exists with a
 # name differing only by case, then use it instead.

inst/staticdocs/index.r

@@ -189,7 +189,6 @@ sd_section("Utility functions",
     "installExprFunction",
     "parseQueryString",
     "plotPNG",
-    "exportTestValues",
     "repeatable",
     "shinyDeprecated",
     "serverInfo",

inst/www/shared/shiny.js

@@ -675,7 +675,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
       // function to normalize hostnames
       var normalize = function normalize(hostname) {
-        if (hostname === "127.0.0.1") return "localhost";else return hostname;
+        if (hostname == "127.0.0.1") return "localhost";else return hostname;
       };
 
       // Send a 'disconnected' message to parent if we are on the same domin
@@ -686,7 +686,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
         a.href = parentUrl;
 
         // post the disconnected message if the hostnames are the same
-        if (normalize(a.hostname) === normalize(window.location.hostname)) {
+        if (normalize(a.hostname) == normalize(window.location.hostname)) {
           var protocol = a.protocol.replace(':', ''); // browser compatability
           var origin = protocol + '://' + a.hostname;
           if (a.port) origin = origin + ':' + a.port;
@@ -971,14 +971,8 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
     // Adds custom message handler - this one is exposed to the user
     function addCustomMessageHandler(type, handler) {
-      // Remove any previously defined handlers so that only the most recent one
-      // will be called
       if (customMessageHandlers[type]) {
-        var typeIdx = customMessageHandlerOrder.indexOf(type);
-        if (typeIdx !== -1) {
-          customMessageHandlerOrder.splice(typeIdx, 1);
-          delete customMessageHandlers[type];
-        }
+        throw 'handler for message of type "' + type + '" already added.';
       }
       if (typeof handler !== 'function') {
         throw 'handler must be a function.';
@@ -1311,12 +1305,6 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
     };
 
     exports.progressHandlers = progressHandlers;
-
-    // Returns a URL which can be queried to get values from inside the server
-    // function. This is enabled with `options(shiny.testmode=TRUE)`.
-    this.getTestEndpointUrl = function () {
-      return "session/" + encodeURIComponent(this.config.sessionId) + "/dataobj/shinytest?w=" + encodeURIComponent(this.config.workerId) + "&nonce=" + randomId();
-    };
   }).call(ShinyApp.prototype);
 
   exports.showReconnectDialog = function () {
@@ -2689,7 +2677,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
         var aProps = Object.getOwnPropertyNames(a);
         var bProps = Object.getOwnPropertyNames(b);
 
-        if (aProps.length !== bProps.length) return false;
+        if (aProps.length != bProps.length) return false;
 
         for (var i = 0; i < aProps.length; i++) {
           var propName = aProps[i];
@@ -3657,7 +3645,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
         };
       }
 
-      if (this._numValues(el) === 2) {
+      if (this._numValues(el) == 2) {
         return [convert(result.from), convert(result.to)];
       } else {
         return convert(result.from);
@@ -3669,7 +3657,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
 
       $el.data('immediate', true);
       try {
-        if (this._numValues(el) === 2 && value instanceof Array) {
+        if (this._numValues(el) == 2 && value instanceof Array) {
           slider.update({ from: value[0], to: value[1] });
         } else {
           slider.update({ from: value });
@@ -3694,7 +3682,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
       var msg = {};
 
       if (data.hasOwnProperty('value')) {
-        if (this._numValues(el) === 2 && data.value instanceof Array) {
+        if (this._numValues(el) == 2 && data.value instanceof Array) {
           msg.from = data.value[0];
           msg.to = data.value[1];
         } else {
@@ -4548,7 +4536,7 @@ var _typeof = typeof Symbol === "function" && typeof Symbol.iterator === "symbol
       // from being mistakenly selected)
       if ($el.find('i[class]').length > 0) {
         var icon_html = $el.find('i[class]')[0];
-        if (icon_html === $el.children()[0]) {
+        if (icon_html == $el.children()[0]) {
           // another check for robustness
           icon = $(icon_html).prop('outerHTML');
         }

man/applyInputHandlers.Rd

@@ -4,12 +4,10 @@
 \alias{applyInputHandlers}
 \title{Apply input handlers to raw input values}
 \usage{
-applyInputHandlers(inputs, shinysession = getDefaultReactiveDomain())
+applyInputHandlers(inputs)
 }
 \arguments{
 \item{inputs}{A named list of input values.}
-
-\item{shinysession}{A Shiny session object.}
 }
 \description{
 The purpose of this function is to make it possible for external packages to
@@ -23,8 +21,19 @@ like \code{"x:shiny.date"}. This function would apply the \code{"shiny.date"}
 input handler to the value, and then rename the result to \code{"x"}, in the
 output.
 }
+\examples{
+applyInputHandlers(list(
+  "m1" = list(list(1, 2), list(3, 4)),
+  "m2:shiny.matrix" = list(list(1, 2), list(3, 4)),
+
+  "d1" = "2016-01-01",
+  "d2:shiny.date" = "2016-01-01",  # Date object
+
+  "n1" = NULL,
+  "n2:shiny.number" = NULL  # Converts to NA
+))
+}
 \seealso{
 registerInputHandler
 }
-\keyword{internal}
 

man/exportTestValues.Rd

@@ -1,70 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/test-export.R
-\name{exportTestValues}
-\alias{exportTestValues}
-\title{Register expressions for export in test mode}
-\usage{
-exportTestValues(..., quoted_ = FALSE, env_ = parent.frame(),
-  session_ = getDefaultReactiveDomain())
-}
-\arguments{
-\item{...}{Named arguments that are quoted or unquoted expressions that will
-be captured and evaluated when API endpoint is visited.}
-
-\item{quoted_}{Are the expression quoted? Default is \code{FALSE}.}
-
-\item{env_}{The environment in which the expression should be evaluated.}
-
-\item{session_}{A Shiny session object.}
-}
-\description{
-This function registers expressions that will be evaluated when a test export
-event occurs. These events are triggered by accessing an API endpoint URL.
-}
-\details{
-This function only has an effect if the global option \code{shiny.testmode}
-is set to \code{TRUE}.
-}
-\examples{
-## Only run this example in interactive R sessions
-if (interactive()) {
-
-options(shiny.testmode = TRUE)
-
-# This application shows the test endpoint URL; clicking on it will
-# fetch the input, output, and exported values in JSON format.
-shinyApp(
-  ui = basicPage(
-    h4("Snapshot URL: "),
-    uiOutput("url"),
-    h4("Current values:"),
-    verbatimTextOutput("values"),
-    actionButton("inc", "Increment x")
-  ),
-
-  server = function(input, output, session) {
-    vals <- reactiveValues(x = 1)
-    y <- reactive({ vals$x + 1 })
-
-    observeEvent(input$inc, {
-      vals$x <<- vals$x + 1
-    })
-
-    exportTestValues(
-      x = vals$x,
-      y = y()
-    )
-
-    output$url <- renderUI({
-      url <- session$getTestEndpointUrl(format="json")
-      a(href = url, url)
-    })
-
-    output$values <- renderText({
-      paste0("vals$x: ", vals$x, "\\ny: ", y())
-    })
-  }
-)
-}
-}
-

man/session.Rd

@@ -155,19 +155,6 @@
 \item{doBookmark()}{
   Do bookmarking and invoke the onBookmark and onBookmarked callback functions.
 }
-\item{exportTestValues()}{
-  Registers expressions for export in test mode, available at the test
-  endpoint URL.
-}
-\item{getTestEndpointUrl(inputs=TRUE, outputs=TRUE, exports=TRUE,
-  format="rds")}{
-  Returns a URL for the test endpoint. Only has an effect when the
-  \code{shiny.testmode} option is set to TRUE. For the inputs, outputs, and
-  exports arguments, TRUE means to return all of these values. It is also
-  possible to specify by name which values to return by providing a
-  character vector, as in \code{inputs=c("x", "y")}. The format can be
-  "rds" or "json".
-}
 }
 \description{
 Shiny server functions can optionally include \code{session} as a parameter

man/shiny-options.Rd

@@ -13,12 +13,9 @@ be set with (for example) \code{options(shiny.trace=TRUE)}.
     when an app is run. See \code{\link{runApp}} for more information.}
   \item{shiny.port}{A port number that Shiny will listen on. See
     \code{\link{runApp}} for more information.}
-  \item{shiny.trace}{Print messages sent between the R server and the web
-    browser client to the R console. This is useful for debugging. Possible
-    values are \code{"send"} (only print messages sent to the client),
-    \code{"recv"} (only print messages received by the server), \code{TRUE}
-    (print all messages), or \code{FALSE} (default; don't print any of these
-    messages).}
+  \item{shiny.trace}{If \code{TRUE}, all of the messages sent between the R
+    server and the web browser client will be printed on the console. This
+    is useful for debugging.}
   \item{shiny.autoreload}{If \code{TRUE} when a Shiny app is launched, the
     app directory will be continually monitored for changes to files that
     have the extensions: r, htm, html, js, css, png, jpg, jpeg, gif. If any
@@ -81,9 +78,6 @@ The default polling interval is 500 milliseconds. You can change this
     particular error \code{e} to get displayed to the user, then set this option
     to \code{TRUE} and use \code{stop(safeError(e))} for errors you want the
     user to see.}
-  \item{shiny.testmode}{If \code{TRUE}, then enable features for testing Shiny
-    applications. If \code{FALSE} (the default), do not enable those features.
-  }
 }
 }
 

srcjs/input_binding_actionbutton.js

@@ -37,7 +37,7 @@ $.extend(actionButtonInputBinding, {
     // from being mistakenly selected)
     if ($el.find('i[class]').length > 0) {
       var icon_html = $el.find('i[class]')[0];
-      if (icon_html === $el.children()[0]) {     // another check for robustness
+      if (icon_html == $el.children()[0]) {     // another check for robustness
         icon = $(icon_html).prop('outerHTML');
       }
     }

srcjs/input_binding_slider.js

@@ -44,7 +44,7 @@ $.extend(sliderInputBinding, textInputBinding, {
       convert = function(val) { return +val; };
     }
 
-    if (this._numValues(el) === 2) {
+    if (this._numValues(el) == 2) {
       return [convert(result.from), convert(result.to)];
     }
     else {
@@ -58,7 +58,7 @@ $.extend(sliderInputBinding, textInputBinding, {
 
     $el.data('immediate', true);
     try {
-      if (this._numValues(el) === 2 && value instanceof Array) {
+      if (this._numValues(el) == 2 && value instanceof Array) {
         slider.update({ from: value[0], to: value[1] });
       } else {
         slider.update({ from: value });
@@ -83,7 +83,7 @@ $.extend(sliderInputBinding, textInputBinding, {
     var msg = {};
 
     if (data.hasOwnProperty('value')) {
-      if (this._numValues(el) === 2 && data.value instanceof Array) {
+      if (this._numValues(el) == 2 && data.value instanceof Array) {
         msg.from = data.value[0];
         msg.to = data.value[1];
       } else {

srcjs/output_binding_image.js

@@ -983,7 +983,7 @@ imageutils.createBrush = function($el, opts, coordmap, expandPixels) {
       var aProps = Object.getOwnPropertyNames(a);
       var bProps = Object.getOwnPropertyNames(b);
 
-      if (aProps.length !== bProps.length)
+      if (aProps.length != bProps.length)
         return false;
 
       for (var i=0; i<aProps.length; i++) {

srcjs/shinyapp.js

@@ -146,7 +146,7 @@ var ShinyApp = function() {
 
     // function to normalize hostnames
     var normalize = function(hostname) {
-      if (hostname === "127.0.0.1")
+      if (hostname == "127.0.0.1")
         return "localhost";
       else
         return hostname;
@@ -160,7 +160,7 @@ var ShinyApp = function() {
       a.href = parentUrl;
 
       // post the disconnected message if the hostnames are the same
-      if (normalize(a.hostname) === normalize(window.location.hostname)) {
+      if (normalize(a.hostname) == normalize(window.location.hostname)) {
         var protocol = a.protocol.replace(':',''); // browser compatability
         var origin = protocol + '://' + a.hostname;
         if (a.port)
@@ -456,14 +456,8 @@ var ShinyApp = function() {
 
   // Adds custom message handler - this one is exposed to the user
   function addCustomMessageHandler(type, handler) {
-    // Remove any previously defined handlers so that only the most recent one
-    // will be called
     if (customMessageHandlers[type]) {
-      var typeIdx = customMessageHandlerOrder.indexOf(type);
-      if (typeIdx !== -1) {
-        customMessageHandlerOrder.splice(typeIdx, 1);
-        delete customMessageHandlers[type];
-      }
+      throw('handler for message of type "' + type + '" already added.');
     }
     if (typeof(handler) !== 'function') {
       throw('handler must be a function.');
@@ -838,15 +832,6 @@ var ShinyApp = function() {
 
   exports.progressHandlers = progressHandlers;
 
-  // Returns a URL which can be queried to get values from inside the server
-  // function. This is enabled with `options(shiny.testmode=TRUE)`.
-  this.getTestEndpointUrl = function() {
-    return "session/" +
-      encodeURIComponent(this.config.sessionId) +
-      "/dataobj/shinytest?w=" +
-      encodeURIComponent(this.config.workerId) +
-      "&nonce=" + randomId();
-  };
 
 }).call(ShinyApp.prototype);
 

tests/testthat/test-bootstrap.r

@@ -33,15 +33,15 @@ test_that("Repeated names for selectInput and radioButtons choices", {
   x <- radioButtons('id','label', choices = c(a='x1', a='x2', b='x3'))
   choices <- x$children
 
-  expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[2]]$children[[1]], 'a')
+  expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[2]]$children[[1]], HTML('a'))
   expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[1]]$attribs$value, 'x1')
   expect_equal(choices[[2]]$children[[1]][[1]]$children[[1]]$children[[1]]$attribs$checked, 'checked')
 
-  expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[2]]$children[[1]], 'a')
+  expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[2]]$children[[1]], HTML('a'))
   expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[1]]$attribs$value, 'x2')
   expect_equal(choices[[2]]$children[[1]][[2]]$children[[1]]$children[[1]]$attribs$checked, NULL)
 
-  expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[2]]$children[[1]], 'b')
+  expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[2]]$children[[1]], HTML('b'))
   expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[1]]$attribs$value, 'x3')
   expect_equal(choices[[2]]$children[[1]][[3]]$children[[1]]$children[[1]]$attribs$checked, NULL)
 })

tools/Gruntfile.js

@@ -94,7 +94,6 @@ module.exports = function(grunt) {
         rules: {
           "consistent-return": 1,
           "dot-location": [1, "property"],
-          "eqeqeq": 1,
           // "no-shadow": 1,
           "no-undef": 1,
           "no-unused-vars": [1, {"args": "none"}],