Fourth attempt.

Author: dmpe

DESCRIPTION

@@ -15,8 +15,7 @@ Depends:
 License: GPL-2 | file LICENSE
 Imports:
     utils,
-    shiny (>= 0.12.2),
+    shiny (>= 0.12.1),
     htmltools (>= 0.2.6)
 BugReports: https://github.com/rstudio/shinydashboard
 RoxygenNote: 5.0.1
-

NAMESPACE

@@ -1,6 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
 export(box)
+export(boxItem)
+export(boxMenuOutput)
 export(dashboardBody)
 export(dashboardHeader)
 export(dashboardPage)

NEWS

@@ -2,6 +2,8 @@ shinydashboard 0.5.1.9000
 --------------------------------------------------------------------------------
 * Updated to AdminLTE 2.3.2 (1ee281b).
 
+* Add wrench icon to the box-header (and a log more by using dropdown box-menu)
+
 shinydashboard 0.5.1
 --------------------------------------------------------------------------------
 

R/boxes.R

@@ -17,7 +17,8 @@
 #'
 #' @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")
 
@@ -118,8 +119,8 @@ infoBox <- function(title, value = NULL, subtitle = NULL,
 #'   the user to collapse the box.
 #' @param collapsed If TRUE, start collapsed. This must be used with
 #'   \code{collapsible=TRUE}.
-#' @param ... Contents of the box.
-#' @param wrench adds a dropdown menu
+#' @param ... Contents of the box/boxItem.
+#' @param boxMenu Adds a box menu consisting of \link{boxItem}.
 #'
 #' @family boxes
 #'
@@ -250,7 +251,8 @@ infoBox <- function(title, value = NULL, subtitle = NULL,
 #' @export
 box <- function(..., title = NULL, footer = NULL, status = NULL,
                 solidHeader = FALSE, background = NULL, width = 6,
-                height = NULL, collapsible = FALSE, collapsed = FALSE, wrench = FALSE) {
+                height = NULL, collapsible = FALSE, collapsed = FALSE,
+                boxMenu = NULL) {
 
   boxClass <- "box"
   if (solidHeader || !is.null(background)) {
@@ -263,7 +265,6 @@ box <- function(..., title = NULL, footer = NULL, status = NULL,
   if (collapsible && collapsed) {
     boxClass <- paste(boxClass, "collapsed-box")
   }
-
   if (!is.null(background)) {
     validateColor(background)
     boxClass <- paste0(boxClass, " bg-", background)
@@ -279,36 +280,26 @@ box <- function(..., title = NULL, footer = NULL, status = NULL,
     titleTag <- h3(class = "box-title", title)
   }
 
+  boxTools <- NULL
   collapseTag <- NULL
-  wrenchTag <- NULL
-  boxToolsTag <- NULL
-
-  if (collapsible == TRUE && wrench == TRUE) {
-    buttonStatus <- status %OR% "default"
 
+  if (collapsible) {
     collapseIcon <- if (collapsed) "plus" else "minus"
 
-    collapseTag <- tags$button(class = paste0("btn btn-box-tool"), `data-widget` = "collapse", shiny::icon(collapseIcon))
-    wrenchTag <- div(class = paste0("btn-group"),
-                     tags$button(class = "btn btn-box-tool dropdown-toggle", `type` = "button", `data-toggle` = "dropdown", shiny::icon("wrench")),
-                     tags$ul(class = "dropdown-menu", `role` = "menu")
-                     ## todo vymyslet jak zaridit abych to pouzivatelne z UI
-    )
-
-    boxToolsTag <- div(class = "box-tools pull-right",
-                       collapseTag,
-                       wrenchTag
-    )
+    collapseTag <- tags$button(class = "btn btn-box-tool",
+                               `data-widget` = "collapse",
+                               shiny::icon(collapseIcon))
   }
 
-
-
+  if (!is.null(collapseTag) || !is.null(boxMenu)) {
+    boxTools <- div(class = "box-tools pull-right", collapseTag, boxMenu)
+  }
 
   headerTag <- NULL
-  if (!is.null(titleTag) || !is.null(collapseTag)) {
+  if (!is.null(titleTag) || !is.null(boxTools)) {
     headerTag <- div(class = "box-header",
       titleTag,
-      boxToolsTag
+      boxTools
     )
   }
 
@@ -322,6 +313,26 @@ box <- function(..., title = NULL, footer = NULL, status = NULL,
   )
 }
 
+#' @inheritParams box
+#' @param icon Default icon (if boxMenu is used) is wrench
+#' @rdname box
+#' @export
+boxItem <- function(..., icon = shiny::icon("wrench")) {
+  listOfValues <- list(...)
+  # include each arg into <li> </li> tags
+  listOfLi <- lapply(listOfValues, tags$li)
+
+  tags$div(class = "btn-group",
+           tags$button(class = "btn btn-box-tool dropdown-toggle",
+                       `type` = "button",
+                       `data-toggle` = "dropdown",
+                       icon),
+           tags$ul(class = "dropdown-menu",
+                   `role` = "menu",
+                   listOfLi)
+  )
+}
+
 #' Create a tabbed box
 #'
 #' @inheritParams shiny::tabsetPanel
@@ -380,8 +391,8 @@ box <- function(..., title = NULL, footer = NULL, status = NULL,
 #' }
 #' @export
 tabBox <- function(..., id = NULL, selected = NULL, title = NULL,
-                   width = 6, height = NULL, side = c("left", "right")) {
-
+                   width = 6, height = NULL, side = c("left", "right"))
+{
   side <- match.arg(side)
 
   # The content is basically a tabsetPanel with some custom modifications

R/deps.R

@@ -20,7 +20,7 @@ addDeps <- function(x) {
   }
 
   dashboardDeps <- list(
-    htmlDependency("AdminLTE", "2.0.6",
+    htmlDependency("AdminLTE", "2.3.2",
       c(file = system.file("AdminLTE", package = "shinydashboard")),
       script = adminLTE_js,
       stylesheet = adminLTE_css

R/menuOutput.R

@@ -19,6 +19,21 @@ menuOutput <- function(outputId, tag = tags$li) {
 }
 
 
+#' Create a sidebar menu item output (client side)
+#'
+#' This is the UI-side function for creating a dynamic sidebar menu item.
+#'
+#' @inheritParams menuOutput
+#' @family menu outputs
+#' @seealso \code{\link{renderMenu}} for the corresponding server-side function
+#'   and examples, and \code{\link{menuItem}} for the corresponding function
+#'   for generating static sidebar menus.
+#' @export
+menuItemOutput <- function(outputId) {
+  menuOutput(outputId = outputId, tag = tags$li)
+}
+
+
 #' Create a dropdown menu output (client side)
 #'
 #' This is the UI-side function for creating a dynamic dropdown menu.
@@ -34,35 +49,35 @@ dropdownMenuOutput <- function(outputId) {
 }
 
 
-#' Create a sidebar menu output (client side)
+#' Create a dropdown box-menu output (client side)
 #'
-#' This is the UI-side function for creating a dynamic sidebar menu.
+#' This is the UI-side function for creating a dynamic dropdown box-menu.
 #'
 #' @inheritParams menuOutput
 #' @family menu outputs
 #' @seealso \code{\link{renderMenu}} for the corresponding server-side function
-#'   and examples, and \code{\link{sidebarMenu}} for the corresponding function
-#'   for generating static sidebar menus.
+#'   and examples, and \code{\link{dropdownMenu}} for the corresponding function
+#'   for generating static menus.
 #' @export
-sidebarMenuOutput <- function(outputId) {
-  menuOutput(outputId = outputId, tag = tags$ul)
+boxMenuOutput <- function(outputId) {
+  menuOutput(outputId = outputId, tag = tags$div)
 }
 
-#' Create a sidebar menu item output (client side)
+
+#' Create a sidebar menu output (client side)
 #'
-#' This is the UI-side function for creating a dynamic sidebar menu item.
+#' This is the UI-side function for creating a dynamic sidebar menu.
 #'
 #' @inheritParams menuOutput
 #' @family menu outputs
 #' @seealso \code{\link{renderMenu}} for the corresponding server-side function
-#'   and examples, and \code{\link{menuItem}} for the corresponding function
+#'   and examples, and \code{\link{sidebarMenu}} for the corresponding function
 #'   for generating static sidebar menus.
 #' @export
-menuItemOutput <- function(outputId) {
-  menuOutput(outputId = outputId, tag = tags$li)
+sidebarMenuOutput <- function(outputId) {
+  menuOutput(outputId = outputId, tag = tags$ul)
 }
 
-
 #' Create dynamic menu output (server side)
 #'
 #' @inheritParams shiny::renderUI