fixes/closes issue #125 #118 where light skins of color can be added

Author: dmpe

R/boxes.R

@@ -284,6 +284,8 @@ box <- function(..., title = NULL, footer = NULL, status = NULL,
   }
 
   boxToolsTag <- NULL
+  boxTools <- NULL
+
   if (collapsible == TRUE || wrench == TRUE) {
     boxToolsTag <- TRUE
   } else {
@@ -311,17 +313,17 @@ box <- function(..., title = NULL, footer = NULL, status = NULL,
       )
     }
 
-    boxToolsTag <- div(class = "box-tools pull-right",
+    boxTools <- div(class = "box-tools pull-right",
                        collapseTag,
                        wrenchTag
     )
   }
 
   headerTag <- NULL
-  if (!is.null(titleTag) || !is.null(boxToolsTag)) {
+  if (!is.null(titleTag) || !is.null(boxTools)) {
     headerTag <- div(class = "box-header",
       titleTag,
-      boxToolsTag
+      boxTools
     )
   }
 

R/dashboardPage.R

@@ -8,10 +8,12 @@
 #' @param title A title to display in the browser's title bar. If no value is
 #'   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"}.
+#'   \code{"purple"}, \code{"green"}, \code{"red"}, or \code{"yellow"}. Or light
+#'   skin of each color, e.g. \code{"red-light"}
 #'
 #' @seealso \code{\link{dashboardHeader}}, \code{\link{dashboardSidebar}},
 #'   \code{\link{dashboardBody}}.
+#'
 #' @examples
 #' ## Only run this example in interactive R sessions
 #' if (interactive()) {
@@ -29,7 +31,9 @@
 #' }
 #' @export
 dashboardPage <- function(header, sidebar, body, title = NULL,
-  skin = c("blue", "black", "purple", "green", "red", "yellow")) {
+  skin = c("blue", "blue-light", "black", "black-light", "purple",
+           "purple-light", "green", "green-light", "red", "red-light", "yellow",
+           "yellow-light")) {
 
   tagAssert(header, type = "header", class = "main-header")
   tagAssert(sidebar, type = "aside", class = "main-sidebar")

R/utils.R

@@ -83,9 +83,10 @@ validateColor <- function(color) {
 #' @format NULL
 #'
 #' @keywords internal
-validColors <- c("red", "yellow", "aqua", "blue", "light-blue", "green",
+validColors <- c("red", "yellow", "aqua", "blue", "light-blue","blue-light",
+                 "green","black-light", "purple-light","green-light",
                  "navy", "teal", "olive", "lime", "orange", "fuchsia",
-                 "purple", "maroon", "black")
+                 "purple", "maroon", "black", "red-light", "yellow-light")
 
 
 # Returns TRUE if a status is valid; throws error otherwise.
@@ -112,13 +113,14 @@ validateStatus <- function(status) {
 #'   \item \code{info} Blue
 #'   \item \code{warning} Orange
 #'   \item \code{danger} Red
+#'   \item \code{default} Grey
 #' }
 #'
 #' @usage NULL
 #' @format NULL
 #'
 #' @keywords internal
-validStatuses <- c("primary", "success", "info", "warning", "danger")
+validStatuses <- c("primary", "success", "info", "warning", "danger", "default")
 
 
 "%OR%" <- function(a, b) if (!is.null(a)) a else b

man/dashboardPage.Rd

@@ -211,6 +211,7 @@ body <- dashboardBody(tabItems(
 
     box(
       width = 4,
+      status = "default",
       background = "light-blue",
       p("This is content. The background color is set to light-blue")
     )
@@ -306,6 +307,7 @@ server <- function(input, output) {
 
 ui <- dashboardPage(header,
                     sidebar,
-                    body)
+                    body,
+                    skin = "blue-light")
 
 shinyApp(ui, server)