caption argument now supported for Markdown tables (#101)

* `caption` argument now supported for Markdown tables

* defensive programming

R/build_tt.R

@@ -74,12 +74,7 @@ build_tt <- function(x, output = NULL) {
 
   # finalize 
   out <- finalize_bootstrap(out)
-
-  # formal grid specification in pandoc includes lines everywhere
-  hlines <- getOption("tinytable_grid_hlines", default = TRUE)
-  if (isTRUE(hlines) && output == "markdown") {
-    out <- grid_hlines(out)
-  }
+  out <- finalize_grid(out)
 
   m <- meta(x)
   m$lazy_style <- list()
@@ -90,18 +85,5 @@ build_tt <- function(x, output = NULL) {
 }
 
 
-finalize_bootstrap <- function(x) {
-    if (meta(x)$output != "html") return(x)
-    out <- gsub(
-      "$tinytable_BOOTSTRAP_CLASS",
-      "table",
-      x,
-      fixed = TRUE)
-    # Rmarkdown and Quarto load their own bootstrap, which we probably don't want to override
-    if (isTRUE(getOption('knitr.in.progress'))) {
-      out <- strsplit(out, split = "\n")[[1]]
-      out <- out[!grepl("https://cdn.jsdelivr.net/npm/bootstrap", out, fixed = TRUE)]
-      out <- paste(out, collapse = "\n")
-    }
-    return(out)
-}
+
+

R/finalize_bootstrap.R

@@ -0,0 +1,16 @@
+
+finalize_bootstrap <- function(x) {
+    if (!isTRUE(meta(x)$output == "html")) return(x)
+    out <- gsub(
+      "$tinytable_BOOTSTRAP_CLASS",
+      "table",
+      x,
+      fixed = TRUE)
+    # Rmarkdown and Quarto load their own bootstrap, which we probably don't want to override
+    if (isTRUE(getOption('knitr.in.progress'))) {
+      out <- strsplit(out, split = "\n")[[1]]
+      out <- out[!grepl("https://cdn.jsdelivr.net/npm/bootstrap", out, fixed = TRUE)]
+      out <- paste(out, collapse = "\n")
+    }
+    return(out)
+}

R/finalize_grid.R

@@ -0,0 +1,20 @@
+
+finalize_grid <- function(x) {
+    if (!isTRUE(meta(x)$output == "markdown")) return(x)
+
+    out <- x
+
+    # formal grid specification in pandoc includes lines everywhere
+    # important for docx output
+    hlines <- getOption("tinytable_grid_hlines", default = TRUE)
+    if (isTRUE(hlines)) {
+      out <- grid_hlines(out)
+    }
+
+    cap <- meta(x, "caption")
+    if (is.character(cap) && length(cap) == 1) {
+        out <- paste0(out, "\n", "Table: ", cap, "\n")
+    }
+
+    return(out)
+}

R/format_tt.R

@@ -199,15 +199,15 @@ format_tt_lazy <- function(x,
   if (isTRUE(markdown)) {
     assert_dependency("markdown")
     for (col in j) {
-      if (meta(x)$output == "html") {
+      if (isTRUE(meta(x)$output == "html")) {
         fun <- function(x) {
           out <- trimws(markdown::mark_html(text = x, template = FALSE))
           out <- sub("<p>", "", out, fixed = TRUE)
           out <- sub("</p>", "", out, fixed = TRUE)
           return(out)
         }
         x[, col] <- sapply(x[, col], fun)
-      } else if (meta(x)$output == "latex") {
+      } else if (isTRUE(meta(x)$output == "latex")) {
         fun <- function(x) trimws(markdown::mark_latex(text = x, template = FALSE))
         x[, col] <- sapply(x[, col], fun)
       }

R/plot_tt.R

@@ -188,18 +188,18 @@ plot_tt_lazy <- function(x,
     }
   }
 
-  if (meta(x)$output == "latex") {
+  if (isTRUE(meta(x)$output == "latex")) {
     cell <- "\\includegraphics[height=%sem]{%s}"
     cell <- sprintf(cell, height, images)
 
-  } else if (meta(x)$output == "html") {
+  } else if (isTRUE(meta(x)$output == "html")) {
     cell <- ifelse(
       grepl("^http", trimws(images)),
       '<img src="%s" style="height: %sem;">',
       '<img src="./%s" style="height: %sem;">')
     cell <- sprintf(cell, images, height)
 
-  } else if (meta(x)$output == "markdown") {
+  } else if (isTRUE(meta(x)$output == "markdown")) {
     cell <- '![](%s)'
     cell <- sprintf(cell, images)
 

R/tt.R

@@ -68,6 +68,7 @@ tt <- function(x,
   out <- meta(out, "nhead", if (is.null(colnames(x))) 0 else 1)
   out <- meta(out, "nrows", nrow(x))
   out <- meta(out, "ncols", ncol(x))
+  out <- meta(out, "caption", caption)
   class(out) <- c("tinytable", class(out))
 
   # build table

inst/tinytest/_tinysnapshot/markdown-caption.txt

@@ -0,0 +1,15 @@
+
+
+
++------+-----+------+
+| mpg  | cyl | disp |
++======+=====+======+
+| 21   | 6   | 160  |
++------+-----+------+
+| 21   | 6   | 160  |
++------+-----+------+
+| 22.8 | 4   | 108  |
++------+-----+------+
+
+Table: Blah blah blah
+

inst/tinytest/test-markdown.R

@@ -8,7 +8,7 @@ colnames(k) <- NULL
 expect_snapshot_print(
   tt(k), label = "markdown-nocolnames")
 
-
+# group rows and columns
 tab <- tt(mtcars[1:10, 1:5]) |>
     group_tt(
       i = list(
@@ -17,8 +17,13 @@ tab <- tt(mtcars[1:10, 1:5]) |>
       j = list(
         "Foo" = 2:3,
         "Bar" = 4:5))
-
 expect_snapshot_print(tab, label = "markdown-group_tt")
 
+# simple caption
+tab <- tt(mtcars[1:3, 1:3], caption = "Blah blah blah") 
+expect_snapshot_print(tab, label = "markdown-caption")
+
+
+
 
 options(tinytable_print_output = NULL)