R/box2.R

Defines functions box2

Documented in box2

#' Create a custom shinydashboard box with interactive capabilities
#'
#' @inheritParams shinydashboard::box
#' @param id Box unique id. \link{updateBox2} target.
#' @export
box2 <- function(..., title = NULL, footer = NULL,
                 background = NULL, width = 6, height = NULL,
                 collapsible = FALSE, collapsed = FALSE, id = NULL) {
  boxClass <- "box"
  if (collapsible && collapsed) {
    boxClass <- paste(boxClass, "collapsed-box")
  }

  if (!is.null(background)) {
    boxClass <- paste0(boxClass, " bg-", background)
  }

  style <- NULL
  if (!is.null(height)) {
    style <- paste0("height: ", validateCssUnit(height))
  }

  titleTag <- NULL
  if (!is.null(title)) {
    titleTag <- h3(class = "box-title", title)
  }

  collapseTag <- NULL
  if (collapsible) {
    buttonStatus <- "default"
    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)
    ))
  }

  headerTag <- NULL
  if (!is.null(titleTag) || !is.null(collapseTag)) {
    headerTag <- div(class = "box-header", titleTag, collapseTag)
  }

  tagList(
    # include deps here
    div(
      class = if (!is.null(width)) paste0("col-sm-", width),
      div(
        # include an id here
        class = boxClass,
        style = if (!is.null(style)) {
          style
        },
        headerTag,
        div(class = "box-body", ...),
        if (!is.null(footer)) div(class = "box-footer", footer)
      )
    )
  )
}
RinteRface/Unleash-Shiny-Exercise-3 documentation built on Oct. 12, 2020, 7:10 p.m.