diff --git a/DESCRIPTION b/DESCRIPTION
index d8710e9f..026de3ed 100644
--- a/DESCRIPTION
+++ b/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
-
diff --git a/NAMESPACE b/NAMESPACE
index d3773d32..0b7b5e7c 100644
--- a/NAMESPACE
+++ b/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)
diff --git a/NEWS b/NEWS
index d26178f8..c4b23a19 100644
--- a/NEWS
+++ b/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
--------------------------------------------------------------------------------
diff --git a/R/boxes.R b/R/boxes.R
index 184f4dde..e3ded371 100644
--- a/R/boxes.R
+++ b/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
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
diff --git a/R/deps.R b/R/deps.R
index c5276df4..5d0758a4 100644
--- a/R/deps.R
+++ b/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
diff --git a/R/menuOutput.R b/R/menuOutput.R
index acc073d4..4c08254a 100644
--- a/R/menuOutput.R
+++ b/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
diff --git a/man/box.Rd b/man/box.Rd
index 81c4ba9b..91f92c17 100644
--- a/man/box.Rd
+++ b/man/box.Rd
@@ -2,14 +2,17 @@
% Please edit documentation in R/boxes.R
\name{box}
\alias{box}
+\alias{boxItem}
\title{Create a box for the main body of a dashboard}
\usage{
box(..., title = NULL, footer = NULL, status = NULL,
solidHeader = FALSE, background = NULL, width = 6, height = NULL,
- collapsible = FALSE, collapsed = FALSE, wrench = FALSE)
+ collapsible = FALSE, collapsed = FALSE, boxMenu = NULL)
+
+boxItem(..., icon = shiny::icon("wrench"))
}
\arguments{
-\item{...}{Contents of the box.}
+\item{...}{Contents of the box/boxItem.}
\item{title}{Optional title.}
@@ -39,7 +42,9 @@ the user to collapse the box.}
\item{collapsed}{If TRUE, start collapsed. This must be used with
\code{collapsible=TRUE}.}
-\item{wrench}{adds a dropdown menu}
+\item{boxMenu}{Adds a box menu consisting of \link{boxItem}.}
+
+\item{icon}{Default icon (if boxMenu is used) is wrench}
}
\description{
Boxes can be used to hold content in the main body of a dashboard.
diff --git a/man/boxMenuOutput.Rd b/man/boxMenuOutput.Rd
new file mode 100644
index 00000000..df85cb46
--- /dev/null
+++ b/man/boxMenuOutput.Rd
@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/menuOutput.R
+\name{boxMenuOutput}
+\alias{boxMenuOutput}
+\title{Create a dropdown box-menu output (client side)}
+\usage{
+boxMenuOutput(outputId)
+}
+\arguments{
+\item{outputId}{Output variable name.}
+}
+\description{
+This is the UI-side function for creating a dynamic dropdown box-menu.
+}
+\seealso{
+\code{\link{renderMenu}} for the corresponding server-side function
+ and examples, and \code{\link{dropdownMenu}} for the corresponding function
+ for generating static menus.
+
+Other menu outputs: \code{\link{dropdownMenuOutput}},
+ \code{\link{menuItemOutput}}, \code{\link{menuOutput}},
+ \code{\link{renderMenu}}, \code{\link{sidebarMenuOutput}}
+}
+
diff --git a/man/dropdownMenuOutput.Rd b/man/dropdownMenuOutput.Rd
index dfe460a9..960b5026 100644
--- a/man/dropdownMenuOutput.Rd
+++ b/man/dropdownMenuOutput.Rd
@@ -17,8 +17,8 @@ This is the UI-side function for creating a dynamic dropdown menu.
and examples, and \code{\link{dropdownMenu}} for the corresponding function
for generating static menus.
-Other menu outputs: \code{\link{menuItemOutput}},
- \code{\link{menuOutput}}, \code{\link{renderMenu}},
- \code{\link{sidebarMenuOutput}}
+Other menu outputs: \code{\link{boxMenuOutput}},
+ \code{\link{menuItemOutput}}, \code{\link{menuOutput}},
+ \code{\link{renderMenu}}, \code{\link{sidebarMenuOutput}}
}
diff --git a/man/menuItemOutput.Rd b/man/menuItemOutput.Rd
index b2bf5776..aa27db7e 100644
--- a/man/menuItemOutput.Rd
+++ b/man/menuItemOutput.Rd
@@ -17,7 +17,8 @@ This is the UI-side function for creating a dynamic sidebar menu item.
and examples, and \code{\link{menuItem}} for the corresponding function
for generating static sidebar menus.
-Other menu outputs: \code{\link{dropdownMenuOutput}},
+Other menu outputs: \code{\link{boxMenuOutput}},
+ \code{\link{dropdownMenuOutput}},
\code{\link{menuOutput}}, \code{\link{renderMenu}},
\code{\link{sidebarMenuOutput}}
}
diff --git a/man/menuOutput.Rd b/man/menuOutput.Rd
index ab37fa3e..e632dba6 100644
--- a/man/menuOutput.Rd
+++ b/man/menuOutput.Rd
@@ -24,7 +24,8 @@ present; for example, \code{\link{dropdownMenuOutput}} and
\code{\link{renderMenu}} for the corresponding server side function
and examples.
-Other menu outputs: \code{\link{dropdownMenuOutput}},
+Other menu outputs: \code{\link{boxMenuOutput}},
+ \code{\link{dropdownMenuOutput}},
\code{\link{menuItemOutput}}, \code{\link{renderMenu}},
\code{\link{sidebarMenuOutput}}
}
diff --git a/man/renderMenu.Rd b/man/renderMenu.Rd
index a7192167..949dddaf 100644
--- a/man/renderMenu.Rd
+++ b/man/renderMenu.Rd
@@ -96,7 +96,8 @@ shinyApp(ui, server)
\code{\link{menuOutput}} for the corresponding client side function
and examples.
-Other menu outputs: \code{\link{dropdownMenuOutput}},
+Other menu outputs: \code{\link{boxMenuOutput}},
+ \code{\link{dropdownMenuOutput}},
\code{\link{menuItemOutput}}, \code{\link{menuOutput}},
\code{\link{sidebarMenuOutput}}
}
diff --git a/man/sidebarMenuOutput.Rd b/man/sidebarMenuOutput.Rd
index 5bee9719..af9afec1 100644
--- a/man/sidebarMenuOutput.Rd
+++ b/man/sidebarMenuOutput.Rd
@@ -17,7 +17,8 @@ This is the UI-side function for creating a dynamic sidebar menu.
and examples, and \code{\link{sidebarMenu}} for the corresponding function
for generating static sidebar menus.
-Other menu outputs: \code{\link{dropdownMenuOutput}},
+Other menu outputs: \code{\link{boxMenuOutput}},
+ \code{\link{dropdownMenuOutput}},
\code{\link{menuItemOutput}}, \code{\link{menuOutput}},
\code{\link{renderMenu}}
}
diff --git a/tests-manual/box.R b/tests-manual/box.R
index f47b107a..4b325e86 100644
--- a/tests-manual/box.R
+++ b/tests-manual/box.R
@@ -1,6 +1,8 @@
# A dashboard body with a row of infoBoxes and valueBoxes, and two rows of other boxes
library(shiny)
+library(shinydashboard)
+
body <- dashboardBody(
# infoBoxes
@@ -39,10 +41,15 @@ body <- dashboardBody(
selectInput("progress", "Progress",
choices = c("0%" = 0, "20%" = 20, "40%" = 40, "60%" = 60, "80%" = 80,
"100%" = 100)
- )
+ ),
+ boxMenu = boxItem(a(href="https://www.bing.com", "bing it!",
+ style = "color: yellow", target = "_blank"),
+ downloadButton("svgdown", "download svg")),
+ collapsible = FALSE, collapsed = FALSE
),
box(title = "Histogram box title",
- status = "warning", solidHeader = TRUE, collapsible = F, wrench = TRUE,
+ status = "info", solidHeader = TRUE, collapsible = T,
+ boxMenu = boxMenuOutput("menuWrench"),
plotOutput("plot", height = 250)
)
),
@@ -74,6 +81,25 @@ body <- dashboardBody(
)
server <- function(input, output) {
+ output$menuWrench <- renderMenu({
+ boxItem(p("some text", style="color: red"),
+ a(href="https://google.cz", "google czech", style = "color: red", target = "_blank"),
+ a(href="https://www.polygon.com", "polygon!", style = "color: yellow", target = "_blank"))
+ })
+
+ select_plot2 = function() {
+ hist(rnorm(input$orders))
+ }
+
+ output$svgdown <- downloadHandler(
+ filename <- "plot.svg",
+ content = function(file) {
+ svg(file)
+ select_plot2()
+ dev.off()
+ }
+ )
+
output$orderNum <- renderText({
prettyNum(input$orders, big.mark=",")
})
@@ -104,10 +130,10 @@ server <- function(input, output) {
p("Current status is: ", icon(iconName, lib = "glyphicon"))
})
-
output$plot <- renderPlot({
hist(rnorm(input$orders))
})
+
}
# A dashboard header with 3 dropdown menus
header <- dashboardHeader(
@@ -160,12 +186,21 @@ header <- dashboardHeader(
"Write documentation"
)
)
+
+)
+
+sidebar <- dashboardSidebar(
+ sidebarUserPanel(
+ "User Name",
+ subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
+ image = "https://almsaeedstudio.com/themes/AdminLTE/dist/img/user2-160x160.jpg"
+ )
)
shinyApp(
ui = dashboardPage(
header,
- dashboardSidebar(),
+ sidebar,
body
),
server = server
diff --git a/tests-manual/repro_issues_112.R b/tests-manual/repro_issues_112.R
deleted file mode 100644
index 2bd40412..00000000
--- a/tests-manual/repro_issues_112.R
+++ /dev/null
@@ -1,19 +0,0 @@
-ui <- dashboardPage(
- dashboardHeader(
- title = "Sidebar spill"
- ),
- dashboardSidebar(
- sidebarMenu(
- menuItem(text = "sfsdf sfaosh oas fwue wi aseiu wehw wuer woeur owuer")
- )
- ),
- dashboardBody(
- fluidRow()
- )
-)
-
-server <- function(input, output) {
-}
-
-shinyApp(ui, server)
-
diff --git a/tests-manual/repro_issues_113.R b/tests-manual/repro_issues_113.R
deleted file mode 100644
index 627ebba7..00000000
--- a/tests-manual/repro_issues_113.R
+++ /dev/null
@@ -1,20 +0,0 @@
-library(shiny)
-library(shinydashboard)
-
-ui = shinyUI(dashboardPage(
- dashboardHeader(),
- dashboardSidebar(disable = TRUE),
- dashboardBody(
- box(title = "Report", width = 12, verbatimTextOutput("protocol")
- )
-
- )
-))
-
-server = shinyServer(function(input, output, session) {
- output$protocol <- renderPrint({
- print(numeric(10e3))
- })
-})
-
-shinyApp(ui, server)