theme: breakup into separate files

R/theme_bootstrap.R

@@ -0,0 +1,17 @@
+theme_bootstrap <- function(x, ...) {
+    fn <- function(table) {
+        if (isTRUE(table@output == "markdown")) {
+            tab <- table@table_string
+            tab <- strsplit(tab, "\n")[[1]]
+            tab <- tab[!grepl("^[\\+|-]+$", tab)]
+            tab <- gsub("|", " ", tab, fixed = TRUE)
+            table@table_string <- paste(tab, collapse = "\n")
+        } else if (isTRUE(table@output == "typst")) {
+            table <- style_tt(table, i = 0:nrow(table), line = "bt", line_width = 0.05, line_color = "silver")
+        }
+        return(table)
+    }
+    x <- theme_tt(x, theme = "void") # only affects LaTeX
+    x <- style_tt(x, tabularray_inner = "hlines={gray8},", finalize = fn)
+    return(x)
+}

R/theme_default.R

@@ -0,0 +1,17 @@
+theme_default <- function(x, ...) {
+    if (isTRUE(x@output %in% c("html", "typst"))) {
+      x <- style_tt(x, 
+          bootstrap_class = "table table-borderless",
+          i = nrow(x), 
+          line = "b", 
+          line_color = "#d3d8dc", 
+          line_width = 0.1)
+      x <- style_tt(x, 
+          bootstrap_class = "table table-borderless",
+          i = 0, 
+          line = "bt", 
+          line_color = "#d3d8dc", 
+          line_width = 0.1)
+    }
+    return(x)
+}

R/theme_grid.R

@@ -0,0 +1,20 @@
+theme_grid <- function(x, ...) {
+    fn <- function(table) {
+        if (isTRUE(table@output == "latex")) {
+            s <- table@table_string
+            s <- lines_drop(s, regex = "\\\\bottomrule", position = "equal")
+            s <- lines_drop(s, regex = "\\\\midrule", position = "equal")
+            s <- lines_drop(s, regex = "\\\\toprule", position = "equal")
+            table@table_string <- s
+        } else if (isTRUE(table@output == "typst")) {
+            table@table_string <- sub(
+                "stroke: none,",
+                "stroke: (paint: black),",
+                table@table_string)
+        }
+        return(table)
+    }
+    x <- style_tt(x, tabularray_inner = "hlines, vlines,", finalize = fn,
+        bootstrap_class = "table table-bordered")
+    return(x)
+}

R/theme_multipage.R

@@ -0,0 +1,41 @@
+theme_multipage <- function(x, 
+                            rowhead = get_option("tinytable_theme_multipage_rowhead", 0L), 
+                            rowfoot = get_option("tinytable_theme_multipage_rowfoot", 0L), 
+                            ...) {
+    # do not change the defaul theme
+    if (identical(x@theme[[1]], "multipage")) x@theme <- list("default")
+    assert_integerish(rowhead, lower = 0, len = 1)
+    assert_integerish(rowfoot, lower = 0, len = 1)
+    cap <- sprintf("caption={%s}", x@caption)
+    x@caption <- ""
+    fn <- function(table) {
+        if (!isTRUE(table@output == "latex")) return(table)
+
+        tab <- table@table_string
+        tab <- sub("\\\\begin\\{talltblr", "\\\\begin\\{longtblr", tab)
+        tab <- sub("\\\\end\\{talltblr", "\\\\end\\{longtblr", tab)
+
+        tab <- strsplit(tab, "\n")[[1]]
+        idx <- grepl("^\\\\caption\\{|^\\\\begin\\{table|^\\\\end\\{table|^\\\\centering", trimws(tab))
+        tab <- tab[!idx]
+        tab <- paste(tab, collapse = "\n")
+
+        table@table_string <- tab
+
+        table <- style_tt(table, tabularray_outer = cap)
+
+        if (rowhead > 0) {
+            table <- style_tt(table, tabularray_inner = sprintf("rowhead=%s", rowhead))
+        }
+
+        if (rowfoot > 0) {
+            table <- style_tt(table, tabularray_inner = sprintf("rowfoot=%s", rowfoot))
+        }
+
+        return(table)
+    }
+    x <- style_tt(x, finalize = fn)
+    return(x)
+}
+
+

R/theme_placement.R

@@ -0,0 +1,30 @@
+# Don't do much in here
+theme_placement <- function(x, 
+                            horizontal = get_option("tinytable_theme_placement_horizontal", default = NULL),
+                            latex_float = get_option("tinytable_theme_placement_latex_float", default = NULL)) {
+    # do not change the defaul theme
+    if (identical(x@theme[[1]], "placement")) x@theme <- list("default")
+    fn <- function(table) {
+        tab <- table@table_string
+        if (table@output == "latex" && !is.null(latex_float)) {
+            assert_string(latex_float, null.ok = TRUE)
+            tab <- sub(
+                "\\\\begin\\{table\\}([^\\[])",
+                sprintf("\\\\begin{table}[%s]\\1", latex_float),
+                tab)
+        } else if (table@output == "typst" && !is.null(horizontal)) {
+            assert_choice(horizontal, c("l", "c", "r"))
+            if (horizontal == "l") {
+                tab <- sub("#align(center,", "#align(left,", tab, fixed = TRUE)
+            } else if (horizontal == "r") {
+                tab <- sub("#align(center,", "#align(right,", tab, fixed = TRUE)
+            }
+        }
+        table@table_string <- tab
+        return(table)
+    }
+    x <- style_tt(x, finalize = fn)
+    return(x)
+}
+
+

R/theme_resize.R

@@ -0,0 +1,38 @@
+theme_resize <- function(x, 
+                         width = get_option("tinytable_theme_resize_width", 1), 
+                         direction = get_option("tinytable_theme_resize_direction", "down"), 
+                         ...) {
+    assert_numeric(width, len = 1, lower = 0.01, upper = 1)
+    assert_choice(direction, c("down", "up", "both"))
+    # do not change the default theme
+    if (identical(x@theme[[1]], "resize")) x@theme <- list("default")
+    fn <- function(table) {
+        if (!isTRUE(table@output == "latex")) return(table)
+
+        tab <- table@table_string
+
+        if (direction == "both") {
+          new <- sprintf("\\resizebox{%s\\linewidth}{!}{", width)
+        } else if (direction == "down") {
+          new <- sprintf("\\resizebox{\\ifdim\\width>\\linewidth %s\\linewidth\\else\\width\\fi}{!}{", width)
+        } else if (direction == "up") {
+          new <- sprintf("\\resizebox{\\ifdim\\width<\\linewidth %s\\linewidth\\else\\width\\fi}{!}{", width)
+        }
+
+        reg <- "\\\\begin\\{tblr\\}|\\\\begin\\{talltblr\\}"
+        tab <- lines_insert(tab, regex = reg, new = new, position = "before")
+
+        new <- "}"
+        reg <- "\\\\end\\{tblr\\}|\\\\end\\{talltblr\\}"
+        tab <- lines_insert(tab, regex = reg, new = new, position = "after")
+
+        table@table_string <- tab
+
+        return(table)
+    }
+
+    x <- style_tt(x, finalize = fn)
+    return(x)
+}
+
+

R/theme_rotate.R

@@ -0,0 +1,35 @@
+theme_rotate <- function(x, angle = 90, ...) {
+    assert_numeric(angle, len = 1, lower = 0, upper = 360)
+    fn <- function(table) {
+        if (isTRUE(table@output == "latex")) {
+            rot <- sprintf("\\begin{table}\n\\rotatebox{%s}{", angle)
+            table@table_string <- sub(
+                "\\begin{table}",
+                rot,
+                table@table_string,
+                fixed = TRUE)
+            table@table_string <- sub(
+                "\\end{table}",
+                "}\n\\end{table}",
+                table@table_string,
+                fixed = TRUE)
+        } else if (isTRUE(table@output == "typst")) {
+            rot <- sprintf("#rotate(-%sdeg, reflow: true, [\n  #figure(", angle)
+            table@table_string <- sub(
+                "#figure(",
+                rot,
+                table@table_string,
+                fixed = TRUE)
+            table@table_string <- sub(
+                ") // end figure",
+                ") ]) // end figure",
+                table@table_string,
+                fixed = TRUE)
+        }
+        table <- style_tt(table, finalize = fn)
+        return(table)
+    }
+    x <- style_tt(x, finalize = fn)
+    return(x)
+}
+

R/theme_striped.R

@@ -0,0 +1,25 @@
+theme_striped <- function(x, ...) {
+    x <- style_tt(x,
+        tabularray_inner = "row{even}={bg=black!5!white}",
+        bootstrap_class = "table table-striped",
+        output = "latex")
+    x <- style_tt(x, 
+        i = seq(1, nrow(x), by = 2),
+        background = "#ededed",
+        output = "typst")
+
+    # theme_default
+    if (isTRUE(x@output %in% c("html", "typst"))) {
+      x <- style_tt(x, 
+          i = nrow(x), 
+          line = "b", 
+          line_color = "#d3d8dc", 
+          line_width = 0.1)
+      x <- style_tt(x, 
+          i = 0, 
+          line = "bt", 
+          line_color = "#d3d8dc", 
+          line_width = 0.1)
+    }
+    return(x)
+}

R/theme_tabular.R

@@ -0,0 +1,55 @@
+theme_tabular <- function(x, 
+                          style = get_option("tinytable_theme_tabular_style", "tabular"), 
+                          ...) {
+
+    assert_choice(style, c("tabular", "tabularray"))
+
+    # do not change the default theme
+    if (identical(x@theme[[1]], "tabular")) x@theme <- list("default")
+
+    fn <- function(table) {
+        tab <- table@table_string
+
+        if (isTRUE(table@output == "latex")) {
+            tab <- lines_drop(tab, regex = "\\\\begin\\{table\\}", position = "before")
+            tab <- lines_drop(tab, regex = "\\\\begin\\{table\\}", position = "equal")
+            tab <- lines_drop(tab, regex = "\\\\end\\{table\\}", position = "after")
+            tab <- lines_drop(tab, regex = "\\\\end\\{table\\}", position = "equal")
+            tab <- lines_drop(tab, regex = "\\\\centering", position = "equal")
+            if (style == "tabular") {
+                tab <- lines_drop_between(tab, regex_start = "tabularray outer open", regex_end = "tabularray inner close")
+                tab <- lines_drop(tab, regex = "tabularray outer close", position = "equal")
+                tab <- lines_drop(tab, regex = "tabularray inner open", position = "equal")
+                tab <- lines_drop(tab, regex = "tabularray inner close", position = "equal")
+                tab <- lines_drop(tab, regex = "^colspec=\\{", position = "equal")
+                tab <- gsub("cmidrule\\[(.*?)\\]", "cmidrule(\\1)", tab)
+                tab <- gsub("\\{tblr\\}\\[*", "{tabular}", tab)
+                tab <- gsub("\\{talltblr\\}\\[", "{tabular}", tab)
+                tab <- gsub("\\{talltblr\\}", "{tabular}", tab)
+                tab <- gsub("\\{longtblr\\}\\[", "{tabular}", tab)
+                tab <- gsub("\\{longtblr\\}", "{tabular}", tab)
+                tab <- gsub("\\\\toprule|\\\\midrule|\\\\bottomrule", "\\\\hline", tab)
+                tab <- sub("\\s*%% tabularray outer open", "", tab)
+                tab <- sub("\\s*%% TinyTableHeader", "", tab)
+                # align
+                a <- sprintf("begin{tabular}{%s}", strrep("l", ncol(table)))
+                tab <- sub("begin{tabular}", a, tab, fixed = TRUE)
+            }
+
+        } else if (isTRUE(table@output == "html")) {
+            tab <- lines_drop(tab, regex = "<table class", position = "before")
+            tab <- lines_drop(tab, regex = "<\\/table>", position = "after")
+
+        } else if (isTRUE(table@output == "typst")) {
+            tab <- lines_drop(tab, regex = "table\\(", position = "before")
+            tab <- lines_drop(tab, regex = "\\/\\/ end table", position = "after")
+        }
+
+        table@table_string <- tab
+        return(table)
+    }
+    x <- style_tt(x, finalize = fn)
+    return(x)
+}
+
+