Merge branch 'issue401'

DESCRIPTION

@@ -2,7 +2,7 @@ Package: tinytable
 Type: Package
 Title: Simple and Configurable Tables in 'HTML', 'LaTeX', 'Markdown', 'Word', 'PNG', 'PDF', and 'Typst' Formats
 Description: Create highly customized tables with this simple and dependency-free package. Data frames can be converted to 'HTML', 'LaTeX', 'Markdown', 'Word', 'PNG', 'PDF', or 'Typst' tables. The user interface is minimalist and easy to learn. The syntax is concise. 'HTML' tables can be customized using the flexible 'Bootstrap' framework, and 'LaTeX' code with the 'tabularray' package.
-Version: 0.6.1.1
+Version: 0.6.1.3
 Imports:
     methods
 Depends:
@@ -31,8 +31,8 @@ Suggests:
 URL: https://vincentarelbundock.github.io/tinytable/
 BugReports: https://github.com/vincentarelbundock/tinytable/issues
 Authors@R: c(
-  person("Vincent", "Arel-Bundock", 
-  email = "[email protected]", 
+  person("Vincent", "Arel-Bundock",
+  email = "[email protected]",
   role = c("aut", "cre"),
   comment = c(ORCID = "0000-0003-2042-7063")))
 License: GPL (>= 3)

NEWS.md

@@ -6,6 +6,10 @@ Bugs:
 
 * `save_tt("file.pdf")` works with colors. Thanks to @olivedv for the report and solution #395.
 
+New:
+
+* `style_tt("notes")` and `style_tt("caption")` can style footnotes and captions. Note: This will only style captions handled by the `caption` argument in `tt()`, and not captions created by Quarto.
+
 Misc:
 
 * Documentation improvements
@@ -92,7 +96,7 @@ MathJax = {
 * `format_tt(num_big_mark)` applies to integer columns.
 * Use `getOption("viewer")` instead of `rstudioapi::viewer()` for positron support
 * `glue::glue()` string is accepted by `format_tt()`. Thanks to @LukasWallrich for report #792 on the `modelsummary` repository.
-* Support Github Flavored Markdown (`gfm`) output. Thanks to @kylebutts for contribution #315. 
+* Support Github Flavored Markdown (`gfm`) output. Thanks to @kylebutts for contribution #315.
 * `theme_tt("rotate")` to rotate tables in LaTeX or Typst.
 * `save_tt("/path/to/file")` returns the file path invisibly. Thanks to @yjunechoe for issue #328.
 
@@ -197,7 +201,7 @@ New features:
 
 * `rbind()` and `rbind2()` can be used to stack `tinytable` objects. `rbind2()` is more flexible than `rbind()`. See `?tinytable::rbind2`
 * New output format in `print()`: "dataframe"
-* Rename table headers: `colnames(tab) <- c("a", "b", "c")` 
+* Rename table headers: `colnames(tab) <- c("a", "b", "c")`
 * `theme_tt("resize")` gets a `direction` argument with "up", "down", "both" options. Thanks to @MarcoPortmann for feature request #207
 
 Minor:
@@ -216,7 +220,7 @@ New function `theme_tt()`:
 
 * Function to apply collections of transformations to a `tinytable`.
 * Visual themes:
-  - grid, void, striped, bootstrap, default 
+  - grid, void, striped, bootstrap, default
 * `resize`: Insert a LaTeX table in a `resizebox` environment to ensure a table fits the page, or to scale it to a fraction of `\linewidth`
 * `placement`: Determine where a LaTeX table float is positioned. Ex: `[H]`, `[htbp]`
 * `multipage`: Split long LaTeX tables across multiple pages with (optional) repeated headers/footers. Uses the `longtblr` environment from `tabularray`.
@@ -284,7 +288,7 @@ Bugfix:
 
 New:
 
-- `Typst` tables are now supported using the `tablex` extension: 
+- `Typst` tables are now supported using the `tablex` extension:
   - https://typst.app/
   - https://github.com/PgBiel/typst-tablex
 - `escape` argument in `format_tt()` escapes or substitutes special characters in LaTeX or HTML output to prevent compilation and rendering errors.
@@ -315,7 +319,7 @@ Bug fixes:
 
 Documentation:
 
-- Improved vignette on the package website. 
+- Improved vignette on the package website.
 - Various documentation updates.
 - Math in $$ is the new recommendation.
 

R/build_tt.R

@@ -18,6 +18,10 @@ build_tt <- function(x, output = NULL) {
 
   x@output <- output
 
+  # apply the style_notes
+  x <- style_notes(x)
+  x <- style_caption(x)
+
   for (th in x@lazy_theme) {
     fn <- th[[1]]
     args <- th[[2]]

R/class.R

@@ -45,6 +45,8 @@ setClass(
     bootstrap_css_rule = "character",
     css = "data.frame",
     style = "data.frame",
+    style_caption = "list",
+    style_notes = "list",
     lazy_format = "list",
     lazy_group = "list",
     lazy_style = "list",

R/finalize_typst.R

@@ -10,7 +10,7 @@ setMethod(
 
     cap <- x@caption
     if (length(cap) == 1) {
-      out <- sub("$TINYTABLE_TYPST_CAPTION", sprintf("caption: [%s],", cap), out, fixed = TRUE)
+      out <- sub("$TINYTABLE_TYPST_CAPTION", sprintf("caption: %s,", cap), out, fixed = TRUE)
     } else {
       out <- sub("$TINYTABLE_TYPST_CAPTION", "", out, fixed = TRUE)
     }

R/sanity.R

@@ -13,7 +13,12 @@ sanity_align <- function(align, i) {
 
 
 sanitize_i <- function(i, x, pre_group_i = FALSE, lazy = TRUE) {
+  if (is.character(i)) {
+    assert_choice(i, c("notes", "caption"))
+    return(i)
+  }
   out <- seq_len(nrow(x))
+  assert_numeric(i, null.ok = TRUE, name = "i")
   if (is.null(i) && isTRUE(lazy)) {
     out <- NA
     attr(out, "null") <- TRUE

R/style_string.R

@@ -0,0 +1,121 @@
+style_string_html <- function(n, styles) {
+  if (isTRUE(styles[["italic"]])) {
+    n <- sprintf("<i>%s</i>", n)
+  }
+  if (isTRUE(styles[["strikeout"]])) {
+    n <- sprintf("<s>%s</s>", n)
+  }
+  if (isTRUE(styles[["underline"]])) {
+    n <- sprintf("<u>%s</u>", n)
+  }
+  if (isTRUE(styles[["bold"]])) {
+    n <- sprintf("<b>%s</b>", n)
+  }
+  if (isTRUE(styles[["monospace"]])) {
+    n <- sprintf("<code>%s</code>", n)
+  }
+  if (!is.null(styles[["color"]])) {
+    n <- sprintf("<span style='color:%s'>%s</span>", styles[["color"]], n)
+  }
+  if (!is.null(styles[["fontsize"]])) {
+    n <- sprintf("<span style='font-size:%sem'>%s</span>", styles[["fontsize"]], n)
+  }
+  n
+}
+
+
+style_string_latex <- function(n, styles) {
+  if (isTRUE(styles[["italic"]])) {
+    n <- sprintf("\\textit{%s}", n)
+  }
+  if (isTRUE(styles[["strikeout"]])) {
+    n <- sprintf("\\sout{%s}", n)
+  }
+  if (isTRUE(styles[["underline"]])) {
+    n <- sprintf("\\underline{%s}", n)
+  }
+  if (isTRUE(styles[["bold"]])) {
+    n <- sprintf("\\textbf{%s}", n)
+  }
+  if (isTRUE(styles[["monospace"]])) {
+    n <- sprintf("\\texttt{%s}", n)
+  }
+  if (!is.null(styles[["color"]])) {
+    n <- sprintf("\\textcolor{%s}{%s}", styles[["color"]], n)
+  }
+  if (!is.null(styles[["fontsize"]])) {
+    n <- sprintf("{\\fontsize{%sem}{%sem}\\selectfont %s}", styles[["fontsize"]], styles[["fontsize"]], n)
+  }
+  n
+}
+
+
+style_string_typst <- function(n, styles) {
+  sty <- NULL
+  if (isTRUE(styles[["italic"]])) {
+    sty <- c(sty, 'style: "italic"')
+  }
+  if (isTRUE(styles[["bold"]])) {
+    sty <- c(sty, 'weight: "bold"')
+  }
+  if (isTRUE(styles[["strikeout"]])) {
+    # not sure how to do this
+  }
+  if (isTRUE(styles[["underline"]])) {
+    # not sure how to do this
+  }
+  if (!is.null(styles[["fontsize"]])) {
+    fs <- sprintf("size: %sem", styles[["fontsize"]])
+    sty <- c(sty, fs)
+  }
+  if (!is.null(styles[["color"]])) {
+    col <- styles[["color"]]
+    if (grepl("^#", col)) col <- sprintf('rgb("%s")', col)
+    col <- sprintf("fill: %s", col)
+    sty <- c(sty, col)
+  }
+  template <- paste0("text(", paste(sty, collapse = ", "), ", [%s])")
+  out <- sprintf(template, n)
+  out <- sub("text(, ", "text(", out, fixed = TRUE)
+  return(out)
+}
+
+
+
+style_notes <- function(x) {
+  fun <- switch(x@output,
+    "typst" = style_string_typst,
+    "html" = style_string_html,
+    "html_portable" = style_string_html,
+    "latex" = style_string_latex,
+    function(k, ...) identity(k)
+  )
+  x@notes <- lapply(x@notes, fun, x@style_notes)
+  return(x)
+}
+
+style_notes <- function(x) {
+  fun <- switch(x@output,
+    "typst" = style_string_typst,
+    "html" = style_string_html,
+    "html_portable" = style_string_html,
+    "latex" = style_string_latex,
+    function(k, ...) identity(k)
+  )
+  x@notes <- lapply(x@notes, fun, x@style_notes)
+  return(x)
+}
+
+style_caption <- function(x) {
+  fun <- switch(x@output,
+    "typst" = style_string_typst,
+    "html" = style_string_html,
+    "html_portable" = style_string_html,
+    "latex" = style_string_latex,
+    function(k, ...) identity(k)
+  )
+  if (length(x@caption) > 0) {
+    x@caption <- fun(x@caption, x@style_caption)
+  }
+  return(x)
+}

R/style_tt.R

@@ -4,7 +4,10 @@
 #' This function applies styling to a table created by `tt()`. It allows customization of text style (bold, italic, monospace), text and background colors, font size, cell width, text alignment, column span, and indentation. The function also supports passing native instructions to LaTeX (tabularray) and HTML (bootstrap) formats.
 #'
 #' @param x A table object created by `tt()`.
-#' @param i Row indices where the styling should be applied. Can be a single value, a vector, or a logical matrix with the same number of rows and columns as `x`. `i=0` is the header, and negative values are higher level headers. Row indices refer to rows *after* the insertion of row labels by `group_tt()`, when applicable.
+#' @param i Numeric vector, logical matrix, or string..
+#'   - Numeric vector: Row indices where the styling should be applied. Can be a single value or a vector.
+#'   - Logical matrix: A matrix with the same number of rows and columns as `x`. `i=0` is the header, and negative values are higher level headers. Row indices refer to rows *after* the insertion of row labels by `group_tt()`, when applicable.
+#'   - String: "notes" or "caption".
 #' @param j Column indices where the styling should be applied. Can be:
 #' + Integer vectors indicating column positions.
 #' + Character vector indicating column names.
@@ -157,6 +160,19 @@ style_tt <- function(x,
     tabularray_inner = tabularray_inner, tabularray_outer = tabularray_outer, bootstrap_css = bootstrap_css,
     bootstrap_css_rule = bootstrap_css_rule)
 
+  if (isTRUE(i %in% c("notes", "caption"))) {
+    tmp <- list(
+      color = color,
+      fontsize = fontsize,
+      italic = italic,
+      monospace = monospace,
+      strikeout = strikeout,
+      underline = underline
+    )
+    if (identical(i, "notes")) out@style_notes <- tmp
+    if (identical(i, "caption")) out@style_caption <- tmp
+    return(out)
+  }
 
   if (!is.null(bootstrap_class)) {
     out@bootstrap_class <- bootstrap_class

R/tt.R

@@ -131,7 +131,8 @@ tt <- function(x,
     caption = caption,
     notes = notes,
     theme = list(theme),
-    width = width)
+    width = width
+  )
 
   if (is.null(theme)) {
     out <- theme_tt(out, theme = "default")

R/tt_typst.R

@@ -50,10 +50,14 @@ setMethod(
       notes <- sapply(notes, function(n) if (is.list(n)) n$text else n)
       for (k in seq_along(notes)) {
         if (lab[k] == "") {
-          tmp <- sprintf("    table.cell(align: left, colspan: %s, [%s]),", ncol(x), notes[k])
+          tmp <- sprintf("    table.cell(align: left, colspan: %s, %s),", ncol(x), notes[k])
         } else {
-          tmp <- sprintf("    table.cell(align: left, colspan: %s, [#super[%s] %s]),", ncol(x), lab[k], notes[k])
+          n <- notes[k]
+          l <- sprintf("[#super[%s] ", lab[k])
+          n <- sub("[", l, n, fixed = TRUE)
+          tmp <- sprintf("    table.cell(align: left, colspan: %s, %s),", ncol(x), n)
         }
+        tmp <- sub("text(, ", "text(", tmp, fixed = TRUE)
         out <- lines_insert(out, tmp, "tinytable notes after", "after")
       }
     }

inst/tinytest/_tinysnapshot/typst-complicated.txt

@@ -1,6 +1,6 @@
 #show figure: set block(breakable: true)
 #figure( // start figure preamble
-  caption: [Hello World],
+  caption: text([Hello World]),
   kind: "tinytable",
   supplement: "Table", // end figure preamble
 

sandbox/typst.qmd

@@ -11,6 +11,13 @@ options(tinytable_quarto_figure = TRUE)
 options(tinytable_print_output = "typst")
 ```
 
+```{r}
+tt(head(iris), caption = "Hello World", notes = "This is a note") |>
+  style_tt("notes", color = "orange", italic = TRUE) |>
+  style_tt("caption", color = "green", bold = TRUE, strikeout = TRUE)
+```
+
+
 ```{r}
 # Semi-complicated
 tab <- tt(mtcars[1:4, 1:5], caption = "Hello World") |>