Allow custom CSS theme/customization with 1 line

.Rbuildignore

@@ -6,3 +6,4 @@
 ^\.travis\.yml$
 ^appveyor\.yml$
 ^\.github$
+^custom-theme-vs-regular-theme$

DESCRIPTION

@@ -4,6 +4,8 @@ Version: 0.7.2
 Authors@R: c(
     person("Winston", "Chang", role = c("aut", "cre"), email = "[email protected]"),
     person("Barbara", "Borges Ribeiro", role = "aut", email = "[email protected]"),
+    person("Garrick", "Aden-Buie", role = "ctb", email = "[email protected]"),
+    person("Mauricio", "Vargas Sepulveda", role = "ctb", email = "[email protected]"),
     person(family = "RStudio", role = "cph"),
     person(family = "Almasaeed Studio", role = c("ctb", "cph"), comment = "AdminLTE theme for Bootstrap"),
     person(family = "Adobe Systems Incorporated", role = c("ctb", "cph"), comment = "Source Sans Pro font")
@@ -20,5 +22,5 @@ Imports:
     htmltools (>= 0.2.6),
     promises
 BugReports: https://github.com/rstudio/shinydashboard
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.0
 Encoding: UTF-8

R/boxes.R

@@ -17,24 +17,24 @@
 #'
 #' @export
 valueBox <- function(value, subtitle, icon = NULL, color = "aqua", width = 4,
-  href = NULL)
+                     href = NULL)
 {
   validateColor(color)
   if (!is.null(icon)) tagAssert(icon, type = "i")
 
   boxContent <- div(class = paste0("small-box bg-", color),
-    div(class = "inner",
-      h3(value),
-      p(subtitle)
-    ),
-    if (!is.null(icon)) div(class = "icon-large", icon)
+                    div(class = "inner",
+                        h3(value),
+                        p(subtitle)
+                    ),
+                    if (!is.null(icon)) div(class = "icon-large", icon)
   )
 
   if (!is.null(href))
     boxContent <- a(href = href, boxContent)
 
   div(class = if (!is.null(width)) paste0("col-sm-", width),
-    boxContent
+      boxContent
   )
 }
 
@@ -64,8 +64,8 @@ valueBox <- function(value, subtitle, icon = NULL, color = "aqua", width = 4,
 #'
 #' @export
 infoBox <- function(title, value = NULL, subtitle = NULL,
-  icon = shiny::icon("bar-chart"), color = "aqua", width = 4, href = NULL,
-  fill = FALSE) {
+                    icon = shiny::icon("bar-chart"), color = "aqua", width = 4, href = NULL,
+                    fill = FALSE) {
 
   validateColor(color)
   tagAssert(icon, type = "i")
@@ -81,17 +81,17 @@ infoBox <- function(title, value = NULL, subtitle = NULL,
       icon
     ),
     div(class = "info-box-content",
-      span(class = "info-box-text", title),
-      if (!is.null(value)) span(class = "info-box-number", value),
-      if (!is.null(subtitle)) p(subtitle)
+        span(class = "info-box-text", title),
+        if (!is.null(value)) span(class = "info-box-number", value),
+        if (!is.null(subtitle)) p(subtitle)
     )
   )
 
   if (!is.null(href))
     boxContent <- a(href = href, boxContent)
 
   div(class = if (!is.null(width)) paste0("col-sm-", width),
-    boxContent
+      boxContent
   )
 }
 
@@ -100,6 +100,7 @@ infoBox <- function(title, value = NULL, subtitle = NULL,
 #'
 #' Boxes can be used to hold content in the main body of a dashboard.
 #'
+#' @param id Optional id that will be used to access the box.
 #' @param title Optional title.
 #' @param footer Optional footer text.
 #' @param status The status of the item This determines the item's background
@@ -248,7 +249,7 @@ infoBox <- function(title, value = NULL, subtitle = NULL,
 #' )
 #' }
 #' @export
-box <- function(..., title = NULL, footer = NULL, status = NULL,
+box <- function(..., id = NULL, title = NULL, footer = NULL, status = NULL,
                 solidHeader = FALSE, background = NULL, width = 6,
                 height = NULL, collapsible = FALSE, collapsed = FALSE) {
 
@@ -285,28 +286,28 @@ box <- function(..., title = NULL, footer = NULL, status = NULL,
     collapseIcon <- if (collapsed) "plus" else "minus"
 
     collapseTag <- div(class = "box-tools pull-right",
-      tags$button(class = paste0("btn btn-box-tool"),
-        `data-widget` = "collapse",
-        shiny::icon(collapseIcon)
-      )
+                       tags$button(class = paste0("btn btn-box-tool"),
+                                   `data-widget` = "collapse",
+                                   shiny::icon(collapseIcon)
+                       )
     )
   }
 
   headerTag <- NULL
   if (!is.null(titleTag) || !is.null(collapseTag)) {
     headerTag <- div(class = "box-header",
-      titleTag,
-      collapseTag
+                     titleTag,
+                     collapseTag
     )
   }
 
   div(class = if (!is.null(width)) paste0("col-sm-", width),
-    div(class = boxClass,
-      style = if (!is.null(style)) style,
-      headerTag,
-      div(class = "box-body", ...),
-      if (!is.null(footer)) div(class = "box-footer", footer)
-    )
+      div(class = boxClass,
+          style = if (!is.null(style)) style,
+          headerTag,
+          div(class = "box-body", ...),
+          if (!is.null(footer)) div(class = "box-footer", footer)
+      )
   )
 }
 
@@ -379,14 +380,14 @@ tabBox <- function(..., id = NULL, selected = NULL, title = NULL,
   # Set height
   if (!is.null(height)) {
     content <- tagAppendAttributes(content,
-      style = paste0("height: ", validateCssUnit(height))
+                                   style = paste0("height: ", validateCssUnit(height))
     )
   }
 
   # Move tabs to right side if needed
   if (side == "right") {
     content$children[[1]] <- tagAppendAttributes(content$children[[1]],
-      class = "pull-right"
+                                                 class = "pull-right"
     )
   }
 
@@ -398,7 +399,7 @@ tabBox <- function(..., id = NULL, selected = NULL, title = NULL,
       titleClass <- "pull-left"
 
     content$children[[1]] <- htmltools::tagAppendChild(content$children[[1]],
-      tags$li(class = paste("header", titleClass), title)
+                                                       tags$li(class = paste("header", titleClass), title)
     )
   }
 

R/dashboardPage.R

@@ -9,6 +9,9 @@
 #'   provided, it will try to extract the title from the \code{dashboardHeader}.
 #' @param skin A color theme. One of \code{"blue"}, \code{"black"},
 #'   \code{"purple"}, \code{"green"}, \code{"red"}, or \code{"yellow"}.
+#' @param theme CSS files to be used in place of the shinydashboard AdminLTE
+#'   theme. Typically, this will be \code{c("AdminLTE.css", "_all-skins.css")}.
+#'   CSS files should be placed in \code{www/}.
 #'
 #' @seealso \code{\link{dashboardHeader}}, \code{\link{dashboardSidebar}},
 #'   \code{\link{dashboardBody}}.
@@ -29,7 +32,9 @@
 #' }
 #' @export
 dashboardPage <- function(header, sidebar, body, title = NULL,
-  skin = c("blue", "black", "purple", "green", "red", "yellow")) {
+  skin = c("blue", "black", "purple", "green", "red", "yellow"),
+  theme = NULL
+  ) {
 
   tagAssert(header, type = "header", class = "main-header")
   tagAssert(sidebar, type = "aside", class = "main-sidebar")
@@ -51,7 +56,16 @@ dashboardPage <- function(header, sidebar, body, title = NULL,
 
   title <- title %OR% extractTitle(header)
 
+  theme <- if (!is.null(theme)) {
+    tagList(
+      lapply(theme, function(css) {
+        tags$head(tags$link(rel="stylesheet", type="text/css", href = css))
+      })
+    )
+  }
+
   content <- div(class = "wrapper",
+    if (!is.null(theme)) theme,
     header,
     sidebar,
     body
@@ -67,7 +81,8 @@ dashboardPage <- function(header, sidebar, body, title = NULL,
       # the collapsed (AdminLTE code)
       class = paste0("skin-", skin, if (collapsed) " sidebar-collapse"),
       style = "min-height: 611px;",
-      shiny::bootstrapPage(content, title = title)
+      shiny::bootstrapPage(content, title = title),
+      include_adminLTE_css = is.null(theme)
     )
   )
 }

R/deps.R

@@ -10,28 +10,30 @@ appendDependencies <- function(x, value) {
 }
 
 # Add dashboard dependencies to a tag object
-addDeps <- function(x) {
+addDeps <- function(x, include_adminLTE_css = TRUE) {
   if (getOption("shiny.minified", TRUE)) {
     adminLTE_js <- "app.min.js"
     shinydashboard_js <- "shinydashboard.min.js"
+    shinydashboard_css <- "shinydashboard.min.css"
     adminLTE_css <- c("AdminLTE.min.css", "_all-skins.min.css")
   } else {
     adminLTE_js <- "app.js"
     shinydashboard_js <- "shinydashboard.js"
+    shinydashboard_css <- "shinydashboard.css"
     adminLTE_css <- c("AdminLTE.css", "_all-skins.css")
   }
 
   dashboardDeps <- list(
     htmlDependency("AdminLTE", "2.0.6",
       c(file = system.file("AdminLTE", package = "shinydashboard")),
       script = adminLTE_js,
-      stylesheet = adminLTE_css
+      stylesheet = if (include_adminLTE_css) adminLTE_css
     ),
     htmlDependency("shinydashboard",
       as.character(utils::packageVersion("shinydashboard")),
       c(file = system.file(package = "shinydashboard")),
       script = shinydashboard_js,
-      stylesheet = "shinydashboard.css"
+      stylesheet = shinydashboard_css
     )
   )
 

custom-theme-vs-regular-theme/custom-theme/app.R

@@ -0,0 +1,69 @@
+#
+# This is a Shiny web application. You can run the application by clicking
+# the 'Run App' button above.
+#
+# Find out more about building applications with Shiny here:
+#
+#    http://shiny.rstudio.com/
+#
+
+library(shiny)
+library(shinydashboard)
+
+# Define UI for application that draws a histogram
+ui <- dashboardPage(
+    # this setup provides almost any customization
+    # just a custom AdminLTE.min.css with a subset of the original AdminLTE.css
+    # suffices for quite complete tailoring, this is shown for completitude
+    skin = "blue",
+    theme = c("css/AdminLTE.min.css", "css/_all-skins.min.css", "css/custom.min.css",
+                          "css/ion.rangeSlider.min.css"),
+
+    # Application title
+    dashboardHeader(title = "Old Faithful Geyser Data"),
+
+    ## Sidebar content
+    dashboardSidebar(
+        sidebarMenu(
+            menuItem("Tab 1", tabName = "tab1", icon = icon("th"))
+        )
+    ),
+
+    ## Body content
+    dashboardBody(
+        tabItems(
+            # First tab content
+            tabItem(tabName = "tab1",
+                    fluidRow(
+                        box(
+                            title = "Controls",
+                            # Sidebar with a slider input for number of bins 
+                            sliderInput("bins", "Number of bins:", min = 1, max = 50,
+                                        value = 30)
+                        ),
+
+                        box(
+                            # Show a plot of the generated distribution
+                            plotOutput("plot1", height = 250)
+                        )
+                    )
+            )
+        )
+    )
+)
+
+# Define server logic required to draw a histogram
+server <- function(input, output) {
+
+    output$plot1 <- renderPlot({
+        # generate bins based on input$bins from ui.R
+        x    <- faithful[, 2]
+        bins <- seq(min(x), max(x), length.out = input$bins + 1)
+
+        # draw the histogram with the specified number of bins
+        hist(x, breaks = bins, col = 'darkgray', border = 'white')
+    })
+}
+
+# Run the application 
+shinyApp(ui = ui, server = server)

custom-theme-vs-regular-theme/custom-theme/custom-theme.Rproj

@@ -0,0 +1,13 @@
+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX