Extract HTML functionality to htmltools library

DESCRIPTION

@@ -12,7 +12,8 @@ Description: Shiny makes it incredibly easy to build interactive web
 License: GPL-3
 Depends:
  R (>= 2.14.1),
- methods
+ methods,
+ htmltools (>= 0.2.0)
 Imports:
  tools,
  utils,
@@ -23,7 +24,6 @@ Imports:
  digest
 Suggests:
  datasets,
- markdown,
  Cairo (>= 1.5-5),
  testthat,
  knitr
@@ -36,7 +36,6 @@ Collate:
  'map.R'
  'globals.R'
  'utils.R'
- 'htmltools.R'
  'bootstrap.R'
  'cache.R'
  'fileupload.R'
@@ -58,7 +57,6 @@ Collate:
  'shinywrappers.R'
  'showcase.R'
  'slider.R'
- 'tags.R'
  'tar.R'
  'timer.R'
  'update-input.R'

NAMESPACE

@@ -13,24 +13,14 @@ 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(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)
 export(absolutePanel)
 export(actionButton)
 export(actionLink)
@@ -39,20 +29,16 @@ export(animationOptions)
 export(as.shiny.appobj)
 export(basicPage)
 export(bootstrapPage)
-export(br)
 export(checkboxGroupInput)
 export(checkboxInput)
-export(code)
 export(column)
 export(conditionalPanel)
 export(dataTableOutput)
 export(dateInput)
 export(dateRangeInput)
-export(div)
 export(downloadButton)
 export(downloadHandler)
 export(downloadLink)
-export(em)
 export(exprToFunction)
 export(fileInput)
 export(fixedPage)
@@ -62,25 +48,11 @@ export(flowLayout)
 export(fluidPage)
 export(fluidRow)
 export(getDefaultReactiveDomain)
-export(getProvidedHtmlDependencies)
-export(h1)
-export(h2)
-export(h3)
-export(h4)
-export(h5)
-export(h6)
 export(headerPanel)
 export(helpText)
-export(hr)
 export(htmlOutput)
 export(icon)
 export(imageOutput)
-export(img)
-export(includeCSS)
-export(includeHTML)
-export(includeMarkdown)
-export(includeScript)
-export(includeText)
 export(inputPanel)
 export(installExprFunction)
 export(invalidateLater)
@@ -89,8 +61,6 @@ export(is.reactivevalues)
 export(isolate)
 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)
@@ -103,12 +73,10 @@ export(numericInput)
 export(observe)
 export(onReactiveDomainEnded)
 export(outputOptions)
-export(p)
 export(pageWithSidebar)
 export(parseQueryString)
 export(plotOutput)
 export(plotPNG)
-export(pre)
 export(radioButtons)
 export(reactive)
 export(reactiveFileReader)
@@ -145,23 +113,13 @@ export(shinyUI)
 export(showReactLog)
 export(sidebarLayout)
 export(sidebarPanel)
-export(singleton)
 export(sliderInput)
-export(span)
 export(splitLayout)
 export(stopApp)
-export(strong)
 export(submitButton)
 export(tabPanel)
 export(tableOutput)
 export(tabsetPanel)
-export(tag)
-export(tagAppendAttributes)
-export(tagAppendChild)
-export(tagAppendChildren)
-export(tagList)
-export(tagSetChildren)
-export(tags)
 export(textInput)
 export(textOutput)
 export(titlePanel)
@@ -178,16 +136,15 @@ export(updateSliderInput)
 export(updateTabsetPanel)
 export(updateTextInput)
 export(validate)
-export(validateCssUnit)
 export(verbatimTextOutput)
 export(verticalLayout)
 export(wellPanel)
 export(withMathJax)
 export(withReactiveDomain)
-export(withTags)
 import(RJSONIO)
 import(caTools)
 import(digest)
+import(htmltools)
 import(httpuv)
 import(methods)
 import(xtable)

R/app.R

@@ -273,37 +273,10 @@ 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)),
+ knitr::asis_output(htmlPreserve(format(output, indent=FALSE)),
  meta = shiny_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
 # calling output$value <- renderFoo(...) and fooOutput().
 #' @rdname knitr_methods
@@ -313,11 +286,3 @@ knit_print.shiny.render.function <- function(x, ...) {
  attr(output, "knit_cacheable") <- FALSE
  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.R

@@ -1,5 +1,4 @@
 #' @include utils.R
-#' @include htmltools.R
 NULL
 
 #' Create a Bootstrap page
@@ -41,21 +40,21 @@ bootstrapPage <- function(..., title = NULL, responsive = TRUE, theme = NULL) {
  bs <- "shared/bootstrap"
 
  list(
- html_dependency("bootstrap", "2.3.2", path = bs,
+ htmlDependency("bootstrap", "2.3.2", c(href = 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", c(href = bs),
  stylesheet = sprintf("css/bootstrap-responsive%s", cssExt),
  meta = list(viewport = "width=device-width, initial-scale=1.0")
  )
  }
  )
  }
 
- attach_dependency(
+ attachDependency(
  tagList(
  if (!is.null(title)) tags$head(tags$title(title)),
  if (!is.null(theme)) {
@@ -753,7 +752,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 +762,7 @@ selectizeIt <- function(inputId, select, options, width = NULL, nonempty = FALSE
  tags$script(src = 'shared/selectize/js/selectize.min.js')
  ))
  )
- attach_dependency(
+ attachDependency(
  tagList(
  select,
  tags$script(
@@ -979,8 +979,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 +1060,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(
+ attachDependency(
  tags$div(id = inputId,
  class = "shiny-date-input",
 
@@ -1158,7 +1159,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(
+ attachDependency(
  tags$div(id = inputId,
  # input-daterange class is needed for dropdown behavior
  class = "shiny-date-range-input input-daterange",
@@ -1604,12 +1605,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 +1619,7 @@ dataTableDependency <- list(
 #' @rdname tableOutput
 #' @export
 dataTableOutput <- function(outputId) {
- attach_dependency(
+ attachDependency(
  div(id = outputId, class="shiny-datatable-output"),
  dataTableDependency
  )
@@ -1762,49 +1763,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
-}