diff --git a/R/print.R b/R/print.R index 08b3f4d9..91a6294a 100644 --- a/R/print.R +++ b/R/print.R @@ -4,20 +4,19 @@ #' @export knit_print.tinytable <- function(x, ...) { # lazy styles get evaluated here, at the very end - x <- eval_style(x) + # not sure why we need to call this twice, but it appears necessary + out <- eval_style(x) + out <- eval_style(out) - if (meta(x)$output == "html") { + if (meta(out)$output == "html") { # from htmltools:::html_preserve # GPL3 - inline <- grepl(x, "\n", fixed = TRUE) + inline <- grepl(out, "\n", fixed = TRUE) if (inline) { out <- sprintf("`%s`{=html}", x) } else { out <- sprintf("\n```{=html}\n%s\n```\n", x) } - - } else if (meta(x)$output %in% c("latex", "markdown")) { - out <- x } class(out) <- "knit_asis" @@ -28,24 +27,25 @@ knit_print.tinytable <- function(x, ...) { #' @export print.tinytable <- function(x, ...) { # lazy styles get evaluated here, at the very end - x <- eval_style(x) + # not sure why we need to call this twice, but it appears necessary + out <- eval_style(x) + out <- eval_style(out) - if (meta(x, "output") == "latex") { - out <- x + if (meta(out, "output") == "latex") { class(out) <- "character" cat("\n") cat(out) cat("\n") - } else if (meta(x, "output") == "markdown") { + } else if (meta(out, "output") == "markdown") { cat("\n") - cat(x, sep = "\n") + cat(out, sep = "\n") - } else if (meta(x, "output") == "html") { + } else if (meta(out, "output") == "html") { dir <- tempfile() dir.create(dir) htmlFile <- file.path(dir, "index.html") - cat(x, file = htmlFile) + cat(out, file = htmlFile) if (isTRUE(check_dependency("rstudioapi")) && rstudioapi::isAvailable()) { rstudioapi::viewer(htmlFile) } else { diff --git a/R/style_tt.R b/R/style_tt.R index cab2d2b0..e74070f0 100644 --- a/R/style_tt.R +++ b/R/style_tt.R @@ -52,6 +52,51 @@ style_tt <- function (x, tabularray_outer = NULL, bootstrap_css = NULL, bootstrap_css_rule = NULL) { + out <- x + cal <- call("style_tt_lazy", + i = i, + j = j, + bold = bold, + italic = italic, + monospace = monospace, + underline = underline, + strikeout = strikeout, + color = color, + background = background, + fontsize = fontsize, + width = width, + align = align, + colspan = colspan, + indent = indent, + tabularray_inner = tabularray_inner, + tabularray_outer = tabularray_outer, + bootstrap_css = bootstrap_css, + bootstrap_css_rule = bootstrap_css_rule) + out <- meta(out, "lazy_style", c(meta(out)$lazy_style, list(cal))) + return(out) +} + + + +style_tt_lazy <- function (x, + i, + j, + bold, + italic, + monospace, + underline, + strikeout, + color, + background, + fontsize, + width, + align, + colspan, + indent, + tabularray_inner, + tabularray_outer, + bootstrap_css, + bootstrap_css_rule) { # sanity x if (is.null(meta(x))) stop("`x` must be generated by `tinytable::tt()`.", call. = FALSE) @@ -68,10 +113,10 @@ style_tt <- function (x, if (is.null(j)) jval <- seq_len(meta(x)$nrows) else jval <- j assert_style_tt( - x = x, i = i, j = j, ival = ival, jval = jval, bold = bold, italic = italic, monospace = monospace, underline = underline, strikeout = strikeout, - color = color, background = background, fontsize = fontsize, width = width, align = align, colspan = colspan, indent = indent, - tabularray_inner = tabularray_inner, tabularray_outer = tabularray_outer, bootstrap_css = bootstrap_css, - bootstrap_css_rule = bootstrap_css_rule) + x = x, i = i, j = j, ival = ival, jval = jval, bold = bold, italic = italic, monospace = monospace, underline = underline, strikeout = strikeout, + color = color, background = background, fontsize = fontsize, width = width, align = align, colspan = colspan, indent = indent, + tabularray_inner = tabularray_inner, tabularray_outer = tabularray_outer, bootstrap_css = bootstrap_css, + bootstrap_css_rule = bootstrap_css_rule) settings <- expand.grid(i = ival, j = jval, bootstrap = "", tabularray = "") if (is.null(i) && !is.null(j)) { @@ -139,8 +184,9 @@ style_tt <- function (x, } if (!is.null(bootstrap_css) || !is.null(bootstrap_css_rule)) { - cal <- call("style_bootstrap", i = ival, j = jval, css = bootstrap_css, css_rule = bootstrap_css_rule) - out <- meta(out, "lazy_style", c(meta(out)$lazy_style, list(cal))) + out <- style_bootstrap( + i = ival, j = jval, + css = bootstrap_css, css_rule = bootstrap_css_rule) } return(out) diff --git a/R/utils.R b/R/utils.R index 7fd259ca..f27a7c18 100644 --- a/R/utils.R +++ b/R/utils.R @@ -35,11 +35,12 @@ meta <- function(x, get, set) { eval_style <- function(x) { out <- x - ls <- meta(x)$lazy_style + ls <- meta(out)$lazy_style - for (lazy_style in meta(x)$lazy_style) { + for (lazy_style in meta(out)$lazy_style) { lazy_style[["x"]] <- out out <- eval(lazy_style) } + return(out) } diff --git a/inst/tinytest/_tinysnapshot/latex-group_style_order.txt b/inst/tinytest/_tinysnapshot/latex-group_style_order.txt new file mode 100644 index 00000000..29db966a --- /dev/null +++ b/inst/tinytest/_tinysnapshot/latex-group_style_order.txt @@ -0,0 +1,24 @@ + +\begin{table} +\centering +\begin{tblr}[ %% tabularray outer open +] %% tabularray outer close +{ %% tabularray inner open +colspec={Q[]Q[]Q[]Q[]}, +row{3}={,bg=black,fg=orange,}, +row{4}={,bg=black,fg=orange,}, +row{5}={,bg=black,fg=orange,}, +row{6}={,bg=black,fg=orange,}, +cell{1}{1}={c=2,}{halign=c,}, +cell{1}{3}={c=2,}{halign=c,}, +} %% tabularray inner close +\toprule +blah & & bar & \\ \cmidrule[lr]{1-2}\cmidrule[lr]{3-4} +mpg & cyl & disp & hp \\ \midrule %% TinyTableHeader +21 & 6 & 160 & 110 \\ +21 & 6 & 160 & 110 \\ +22.8 & 4 & 108 & 93 \\ +21.4 & 6 & 258 & 110 \\ +\bottomrule +\end{tblr} +\end{table} diff --git a/inst/tinytest/test-latex.R b/inst/tinytest/test-latex.R index d9c2f4be..94b7e487 100644 --- a/inst/tinytest/test-latex.R +++ b/inst/tinytest/test-latex.R @@ -43,3 +43,14 @@ expect_snapshot_print( expect_snapshot_print( tt(x, output = "latex") |> style_tt(i = 1:2, j = 1:4, color = "orange"), label = "latex-cell_color") + + +# Lazy style: group after style is respected +a <- tt(mtcars[1:4, 1:4], "latex") |> + style_tt(color = "orange", background = "black") |> + group_tt(j = list("blah" = 1:2, "bar" = 3:4)) +b <- tt(mtcars[1:4, 1:4], "latex") |> + group_tt(j = list("blah" = 1:2, "bar" = 3:4)) |> + style_tt(color = "orange", background = "black") +expect_snapshot_print(a, label = "latex-group_style_order") +expect_equal(as.character(a), as.character(b))