Add title elements

R/reactable.R

@@ -97,6 +97,16 @@
 #'
 #'   To set the width of a column, see [colDef()].
 #' @param height Height of the table in pixels. Defaults to `"auto"` for automatic sizing.
+#' @param title String of title to appear above table, defaults to NULL.
+#' @param subtitle String of subtitle to appear above table, defaults to NULL.
+#' @param caption String of title to appear below table, defaults to NULL.
+#' @param logo Logo (htmltools::img object) to appear below table, defaults to NULL.
+#' @param titleStyle CSS styling of title, defaults to NULL,
+#' @param subtitleStyle CSS styling of subtitle, defaults to NULL,
+#' @param captionStyle CSS styling of caption underneath table, defaults to NULL.
+#' @param logoStyle CSS styling of logo underneath table, defaults to `float: right;margin-right:10px;width:200px;`.
+#' @param googlefonts List of Google fonts to import.
+#' @param backgroundStyle CSS styling of background behind table, defaults to NULL.
 #' @param theme Theme options for the table, specified by
 #'   [reactableTheme()]. Defaults to the global `reactable.theme` option.
 #'   Can also be a function that returns a [reactableTheme()] or `NULL`.
@@ -151,7 +161,8 @@
 #' ))
 #'
 #' @export
-reactable <- function(data, columns = NULL, columnGroups = NULL,
+reactable <- function(data,
+                      columns = NULL, columnGroups = NULL,
                       rownames = NULL, groupBy = NULL,
                       sortable = TRUE, resizable = FALSE, filterable = FALSE,
                       searchable = FALSE, defaultColDef = NULL, defaultColGroup = NULL,
@@ -167,6 +178,16 @@ reactable <- function(data, columns = NULL, columnGroups = NULL,
                       showSortIcon = TRUE, showSortable = FALSE,
                       class = NULL, style = NULL, rowClass = NULL, rowStyle = NULL,
                       fullWidth = TRUE, width = "auto", height = "auto",
+                      title = NULL,
+                      subtitle = NULL,
+                      caption = NULL,
+                      logo = NULL,
+                      titleStyle = NULL,
+                      subtitleStyle = NULL,
+                      captionStyle = NULL,
+                      logoStyle = NULL,
+                      backgroundStyle = NULL,
+                      googlefonts = NULL,
                       theme = getOption("reactable.theme"),
                       language = getOption("reactable.language"),
                       elementId = NULL) {
@@ -611,9 +632,41 @@ reactable <- function(data, columns = NULL, columnGroups = NULL,
     key = if (!isV2()) dataKey
   ))
 
+  # add elements (title, subtitle, caption, logo)
+  content_tags <- list(title = title,
+                       subtitle = subtitle,
+                       table = component,
+                       caption = caption,
+                       logo = logo)
+
+  content_tags <- Filter(Negate(is.null), content_tags)
+
+  content_tags <- lapply(seq_along(content_tags), function(i){
+    name <- names(content_tags)[[i]]
+    x <- content_tags[[i]]
+    if("reactR_component" %in% class(x)) return(x)
+    htmltools::tags$div(x, id = paste0("reactable-",name))
+  })
+
+  # import fonts if googlefonts param is not null
+  if(!is.null(googlefonts)){
+    font_import <- import_googlefonts(fonts = googlefonts)
+    font_tag <- htmltools::tags$style(font_import)
+    content_tags$font_tag <- font_tag
+  }
+
+  if(is.null(logoStyle)) logoStyle <- "float: right;margin-right:10px;width:200px;"
+
+  content_tags$style_tag <-
+    htmltools::tags$style(
+      paste0(
+        ".reactable {",backgroundStyle,"} #reactable-title {",titleStyle,"} #reactable-subtitle {",subtitleStyle,"} #reactable-caption {",captionStyle,"} #reactable-logo img {",logoStyle,"}"))
+
+  content <- htmltools::tag("div", unname(content_tags))
+
   htmlwidgets::createWidget(
     name = widgetName,
-    reactR::reactMarkup(component),
+    reactR::reactMarkup(content),
     width = width,
     height = height,
     # Don't limit width when rendered inside an R Notebook

R/utils.R

@@ -2,6 +2,12 @@
 #' @export
 htmlwidgets::JS
 
+import_googlefonts <- function(fonts){
+  font_names <- gsub(" ", "+", unlist(fonts))
+  imports <- paste0("@import url('https://fonts.googleapis.com/css?family=",font_names,"');")
+  paste0(imports, collapse = "")
+}
+
 mergeLists <- function(a, b) {
   if (is.null(a)) {
     a <- list()

tests/testthat/test-reactable.R

@@ -1,6 +1,31 @@
 library(htmltools)
 
-getAttribs <- function(widget) widget$x$tag$attribs
+getChildrenAttribs <- function(widget) widget$x$tag$children %>% purrr::map(~ .x$attribs)
+
+getAttribs <- function(widget){
+  children_attribs <- getChildrenAttribs(widget)
+  table_attribs <- children_attribs %>% purrr::compact("data")
+  table_attribs[[1]]
+}
+
+getElement <- function(widget, elementType){
+  children_attribs <- getChildrenAttribs(widget)
+  element_ids <- children_attribs %>% purrr::compact("id") %>% unlist()
+
+  if(length(element_ids) == 0) return(warning("Table does not have extra elements."))
+
+  if(!elementType %in% c("title", "subtitle", "caption", "logo")) return(warning("Not a valid elementType."))
+
+  type <- paste0("reactable-", elementType)
+
+  if(!type %in% element_ids) stop("Table does not have a ", elementType, " element.")
+
+  element_index <- match(type, element_ids)
+
+  if(elementType %in% c("caption", "logo")) element_index <- element_index + 1
+
+  widget$x$tag$children[[element_index]][[3]][[1]]
+}
 
 test_that("reactable handles invalid args", {
   expect_error(reactable(1))
@@ -169,6 +194,32 @@ test_that("reactable", {
   expect_equal(attribs$style, list("border-bottom" = "1px solid", top = "50px"))
 })
 
+test_that("extra elements created", {
+  title <- "some title"
+  subtitle <- "some subtitle"
+  caption <- "some caption"
+  logo <- "logo"
+
+  tbl <- reactable(data.frame(x = "a", stringsAsFactors = TRUE),
+                   title = title,
+                   subtitle = subtitle,
+                   caption = caption,
+                   logo = logo)
+
+  expect_equal(getElement(tbl, elementType = "title"), title)
+  expect_equal(getElement(tbl, elementType = "subtitle"), subtitle)
+  expect_equal(getElement(tbl, elementType = "caption"), caption)
+  expect_equal(getElement(tbl, elementType = "logo"), logo)
+
+  tbl <- reactable(data.frame(x = "a", stringsAsFactors = TRUE),
+                   subtitle = subtitle,
+                   caption = caption,
+                   logo = logo)
+
+  expect_error(getElement(tbl, elementType = "title"), "Table does not have a title element.")
+
+})
+
 test_that("data can be a matrix", {
   data <- matrix(c(1, 2, 3, 4), nrow = 2)
   tbl <- reactable(data)