bootstrap utils

NAMESPACE

@@ -6,6 +6,7 @@ export(addSpinner)
 export(airDatepickerInput)
 export(airMonthpickerInput)
 export(airYearpickerInput)
+export(alert)
 export(animateOptions)
 export(appendVerticalTab)
 export(ask_confirmation)
@@ -34,6 +35,7 @@ export(execute_safely)
 export(hideDropMenu)
 export(inputSweetAlert)
 export(knobInput)
+export(list_group)
 export(materialSwitch)
 export(multiInput)
 export(noUiSliderInput)

R/bootstrap-utils.R

@@ -0,0 +1,100 @@
+
+#' @title Bootstrap panel / alert
+#'
+#' @description Create a panel (box) with basic border and padding,
+#' you can use Bootstrap status to style the panel,
+#' see \url{http://getbootstrap.com/components/#panels}.
+#'
+#' @param ... UI elements to include inside the panel or alert.
+#' @param heading Title for the panel in a plain header.
+#' @param footer Footer for the panel.
+#' @param extra Additional elements to include like a table or a \code{list_group}, see examples.
+#' @param status Bootstrap status for contextual alternative.
+#'
+#' @return A UI definition.
+#' @export
+#'
+#' @name bootstrap-utils
+#'
+#' @importFrom htmltools tags
+#'
+#' @example examples/panel.R
+#' @example examples/alert.R
+#' @example examples/list_group.R
+panel <- function(...,
+                  heading = NULL, footer = NULL, extra = NULL,
+                  status = c("default", "primary", "success", "info", "warning", "danger")) {
+  status <- match.arg(
+    arg = status,
+    choices = c("default", "primary", "success", "info", "warning", "danger")
+  )
+  if (...length() > 0) {
+    body <- tags$div(class = "panel-body", ...)
+  } else {
+    body <- NULL
+  }
+  if (!is.null(heading)) {
+    heading <- tags$div(
+      class = "panel-heading",
+      if (is.character(heading))
+        tags$h3(class = "panel-title", heading)
+      else
+        heading
+    )
+  }
+  tags$div(
+    class = paste0("panel panel-", status),
+    heading, body, extra,
+    if (!is.null(footer)) tags$div(class = "panel-footer", footer)
+  )
+}
+
+
+#' @param dismissible Add the possiblity to close the alert.
+#' @export
+#' @rdname bootstrap-utils
+#' @importFrom htmltools tags HTML
+alert <- function(..., status = c("info", "success", "danger", "warning"), dismissible = FALSE) {
+  status <- match.arg(status)
+  tags$div(
+    class = paste0("alert alert-", status),
+    class = if (isTRUE(dismissible)) "alert-dismissible",
+    if (isTRUE(dismissible)) {
+      tags$button(
+        type = "button",
+        class = "close",
+        `data-dismiss` = "alert",
+        `aria-label` = "Close",
+        tags$span(`aria-hidden` = "true", HTML("&times;"))
+      )
+    },
+    ...
+  )
+}
+
+
+#' @export
+#' @rdname bootstrap-utils
+#' @importFrom htmltools tags
+list_group <- function(...) {
+  tags$ul(
+    class = "list-group",
+    lapply(
+      X = list(...),
+      FUN = function(x) {
+        # tags$li(class = "list-group-item", x)
+        do.call(tags$li, c(list(class = "list-group-item"), x))
+      }
+    )
+  )
+}
+
+
+
+
+
+
+
+
+
+

examples/alert.R

@@ -0,0 +1,47 @@
+
+# Alerts ---------------------------------
+
+library(shiny)
+library(shinyWidgets)
+
+ui <- fluidPage(
+  tags$h2("Alerts"),
+  fluidRow(
+    column(
+      width = 6,
+      alert(
+        status = "success",
+        tags$b("Well done!"), "You successfully read this important alert message."
+      ),
+      alert(
+        status = "info",
+        tags$b("Heads up!"), "This alert needs your attention, but it's not super important."
+      ),
+      alert(
+        status = "info",
+        dismissible = TRUE,
+        tags$b("Dismissable"), "You can close this one."
+      )
+    ),
+    column(
+      width = 6,
+      alert(
+        status = "warning",
+        tags$b("Warning!"), "Better check yourself, you're not looking too good."
+      ),
+      alert(
+        status = "danger",
+        tags$b("Oh snap!"), "Change a few things up and try submitting again."
+      )
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+}
+
+if (interactive())
+  shinyApp(ui, server)
+
+

examples/list_group.R

@@ -0,0 +1,30 @@
+
+# List group -----------------------------
+
+library(shiny)
+library(shinyWidgets)
+
+ui <- fluidPage(
+  tags$h2("List group"),
+
+  tags$b("List of item:"),
+  list_group(
+    "First item",
+    "Second item",
+    "And third item"
+  ),
+
+  tags$b("Set active item:"),
+  list_group(
+    list(class = "active", "First item"),
+    "Second item",
+    "And third item"
+  )
+)
+
+server <- function(input, output, session) {
+
+}
+
+if (interactive())
+  shinyApp(ui, server)

examples/panel.R

@@ -0,0 +1,60 @@
+
+# Panels ---------------------------------
+
+library(shiny)
+library(shinyWidgets)
+
+ui <- fluidPage(
+
+  tags$h2("Bootstrap panel"),
+
+  # Default
+  panel(
+    "Content goes here",
+  ),
+
+  # With header and footer
+  panel(
+    "Content goes here",
+    heading = "My title",
+    footer = "Something"
+  ),
+
+  # With status
+  panel(
+    "Content goes here",
+    heading = "My title",
+    status = "primary"
+  ),
+
+  # With table
+  panel(
+    heading = "A famous table",
+    extra = tableOutput(outputId = "table")
+  ),
+
+  # With list group
+  panel(
+    heading = "A list of things",
+    extra = list_group(
+      "First item",
+      "Second item",
+      "And third item"
+    )
+  )
+)
+
+server <- function(input, output, session) {
+
+  output$table <- renderTable({
+    head(mtcars)
+  }, width = "100%")
+
+}
+
+if (interactive())
+  shinyApp(ui = ui, server = server)
+
+
+
+