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)