Skip to content

Commit

Permalink
style_eval is not called all the time
Browse files Browse the repository at this point in the history
  • Loading branch information
@vincentarelbundock
vincentarelbundock committed Nov 2, 2024
1 parent 295316d commit da25cd3
Show file tree
Hide file tree
Showing 9 changed files with 44 additions and 135 deletions.
37 changes: 14 additions & 23 deletions R/build_tt.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,10 +66,7 @@ build_tt <- function(x, output = NULL) {

# markdown styles need to be applied before creating the table, otherwise there's annoying parsing, etc.
if (x@output %in% c("markdown", "gfm", "dataframe")) {
for (l in x@lazy_style) {
l[["x"]] <- x
x <- eval(l)
}
# TODO
}

# draw the table
Expand All @@ -86,18 +83,18 @@ build_tt <- function(x, output = NULL) {
x <- eval(l)
}

if (x@output == "typst") {
if (is.null(x@theme[[1]]) || is.function(x@theme[[1]]) || isTRUE(x@theme[[1]] %in% c("default", "striped"))) {
# reverse the order of the lines to allow overwriting defaults
x <- style_tt(x, i = nrow(x), line = "b", line_width = 0.1)
if (x@nhead > 0) {
x <- style_tt(x, i = -x@nhead + 1, line = "t", line_width = 0.1)
x <- style_tt(x, i = 1, line = "t", line_width = 0.05)
} else {
x <- style_tt(x, i = 1, line = "t", line_width = 0.1)
}
}
}
# if (x@output == "typst") {
# if (is.null(x@theme[[1]]) || is.function(x@theme[[1]]) || isTRUE(x@theme[[1]] %in% c("default", "striped"))) {
# # reverse the order of the lines to allow overwriting defaults
# x <- style_tt(x, i = nrow(x), line = "b", line_width = 0.1)
# if (x@nhead > 0) {
# x <- style_tt(x, i = -x@nhead + 1, line = "t", line_width = 0.1)
# x <- style_tt(x, i = 1, line = "t", line_width = 0.05)
# } else {
# x <- style_tt(x, i = 1, line = "t", line_width = 0.1)
# }
# }
# }

if (!x@output %in% c("markdown", "gfm", "dataframe")) {
for (l in x@lazy_style) {
Expand All @@ -109,13 +106,7 @@ build_tt <- function(x, output = NULL) {
}
}

if (x@output == "typst") {
x <- style_apply_typst(x)
} else if (x@output == "html") {
x <- style_apply_bootstrap(x)
} else if (x@output == "latex") {
x <- style_apply_tabularray(x)
}
x <- style_eval(x)

x <- finalize(x)

Expand Down
2 changes: 1 addition & 1 deletion R/group_tabularray.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -53,7 +53,7 @@ group_tabularray_col <- function(x, j, ihead, ...) {
j = z,
align = "c",
colspan = max(j[[k]]) - min(j[[k]]) + 1)
x <- do.call(style_eval, args)
x <- do.call(style_tt, args)
}

return(x)
Expand Down
8 changes: 1 addition & 7 deletions R/style_bootstrap.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,12 +30,6 @@ setMethod(
bootstrap_css_rule = NULL,
...) {

return(x)
})



style_apply_bootstrap <- function(x) {

if (length(x@bootstrap_css_rule) == 1) {
x@table_string <- bootstrap_setting(x@table_string, x@bootstrap_css_rule, component = "css")
Expand Down Expand Up @@ -150,6 +144,6 @@ style_apply_bootstrap <- function(x) {
}

return(x)
}
})


5 changes: 1 addition & 4 deletions R/style_grid.R
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,3 @@



#' tinytable S4 method
#'
#' @keywords internal
Expand Down Expand Up @@ -90,5 +87,5 @@ style_grid_internal <- function(x,
setMethod(
f = "style_eval",
signature = "tinytable_grid",
definition = style_grid_internal
definition = identity
)
2 changes: 1 addition & 1 deletion R/style_grid_dataframe.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
#' @keywords internal
setMethod(f = "style_eval",
signature = "tinytable_dataframe",
definition = style_grid_internal
definition = identity
)


Expand Down
23 changes: 10 additions & 13 deletions R/style_tabularray.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,12 +24,8 @@ setMethod(
tabularray_outer = NULL,
...) {

return(x)
})


style_apply_tabularray <- function(x) {

sty <- x@style
sty$i <- sty$i + x@nhead

Expand Down Expand Up @@ -113,14 +109,14 @@ style_apply_tabularray <- function(x) {

}

clean <- function(x) {
x <- gsub("^\\s*,", "", x)
x <- gsub(",\\s*,", ",,", x)
x <- gsub("\\s+", " ", x)
x <- gsub(",+", ",", x)
x <- gsub("^[,|\\s]*", "", x, perl = TRUE)
x <- trimws(x)
return(x)
clean <- function(k) {
k <- gsub("^\\s*,", "", k)
k <- gsub(",\\s*,", ",,", k)
k <- gsub("\\s+", " ", k)
k <- gsub(",+", ",", k)
k <- gsub("^[,|\\s]*", "", k, perl = TRUE)
k <- trimws(k)
return(k)
}

rec$set <- clean(set)
Expand Down Expand Up @@ -186,7 +182,8 @@ style_apply_tabularray <- function(x) {
}

return(x)
}

})


hlines_tabularray <- function(k) {
Expand Down
88 changes: 11 additions & 77 deletions R/style_tt.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -150,6 +150,17 @@ style_tt <- function (x,

out <- x

assert_choice(alignv, c("t", "m", "b"), null.ok = TRUE)

assert_style_tt(
x = out, i = i, j = j, bold = bold, italic = italic, monospace = monospace, underline = underline, strikeout = strikeout,
color = color, background = background, fontsize = fontsize, align = align,
colspan = colspan, rowspan = rowspan, indent = indent,
line = line, line_color = line_color, line_width = line_width,
tabularray_inner = tabularray_inner, tabularray_outer = tabularray_outer, bootstrap_css = bootstrap_css,
bootstrap_css_rule = bootstrap_css_rule)


if (!is.null(bootstrap_class)) {
out@bootstrap_class <- bootstrap_class
}
Expand Down Expand Up @@ -246,39 +257,6 @@ style_tt <- function (x,
# This is a very bad idea. Breaks a ton of things. We need unique IDs.
# out@id <- get_id("tinytable_")

cal <- call("style_tt_lazy",
# out <- style_tt_lazy(
# x should not be in here otherwise the object becomes very big
i = i,
j = j,
bold = bold,
italic = italic,
monospace = monospace,
underline = underline,
strikeout = strikeout,
color = color,
background = background,
fontsize = fontsize,
align = align,
alignv = alignv,
colspan = colspan,
rowspan = rowspan,
indent = indent,
line = line,
line_color = line_color,
line_width = line_width,
tabularray_inner = tabularray_inner,
tabularray_outer = tabularray_outer,
bootstrap_css = bootstrap_css,
bootstrap_css_rule = bootstrap_css_rule,
output = output)

if (isTRUE(list(...)[["tt_build_now"]])) {
out <- eval(cal)
} else {
out@lazy_style <- c(out@lazy_style, list(cal))
}

assert_function(finalize, null.ok = TRUE)
if (is.function(finalize)) {
out@lazy_finalize <- c(out@lazy_finalize, list(finalize))
Expand All @@ -289,50 +267,6 @@ style_tt <- function (x,



style_tt_lazy <- function (x,
i,
j,
bold,
italic,
monospace,
underline,
strikeout,
color,
background,
fontsize,
align,
alignv,
colspan,
rowspan,
indent,
line,
line_color,
line_width,
tabularray_inner,
tabularray_outer,
bootstrap_css,
bootstrap_css_rule,
output) {

out <- x

# alignv can only be a single character for now
assert_choice(alignv, c("t", "m", "b"), null.ok = TRUE)

assert_style_tt(
x = out, i = i, j = j, bold = bold, italic = italic, monospace = monospace, underline = underline, strikeout = strikeout,
color = color, background = background, fontsize = fontsize, align = align,
colspan = colspan, rowspan = rowspan, indent = indent,
line = line, line_color = line_color, line_width = line_width,
tabularray_inner = tabularray_inner, tabularray_outer = tabularray_outer, bootstrap_css = bootstrap_css,
bootstrap_css_rule = bootstrap_css_rule)

out <- style_eval(x = out, i = i, j = j, bold = bold, italic = italic, monospace = monospace, underline = underline, strikeout = strikeout, color = color, background = background, fontsize = fontsize, align = align, alignv = alignv, colspan = colspan, rowspan = rowspan, indent = indent, tabularray_inner = tabularray_inner, tabularray_outer = tabularray_outer, bootstrap_css = bootstrap_css, bootstrap_css_rule = bootstrap_css_rule, line = line, line_color = line_color, line_width = line_width)

return(out)
}


assert_style_tt <- function (x,
i,
j,
Expand Down
6 changes: 1 addition & 5 deletions R/style_typst.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,12 +25,8 @@ setMethod(
indent = 0,
midrule = FALSE, # undocumented, only used by `group_tt()`
...) {
return(x)
})



style_apply_typst <- function(x) {
sty <- x@style

# gutters are used for group_tt(j) but look ugly with cell fill
Expand Down Expand Up @@ -138,7 +134,7 @@ style_apply_typst <- function(x) {
}

return(x)
}
})


split_chunks <- function(x) {
Expand Down
8 changes: 4 additions & 4 deletions R/theme_tt.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -193,7 +193,7 @@ theme_bootstrap <- function(x, ...) {
tab <- gsub("|", " ", tab, fixed = TRUE)
table@table_string <- paste(tab, collapse = "\n")
} else if (isTRUE(table@output == "typst")) {
table <- style_eval(table, i = 0:nrow(table), line = "bt", line_width = 0.05, line_color = "silver")
table <- style_tt(table, i = 0:nrow(table), line = "bt", line_width = 0.05, line_color = "silver")
}
return(table)
}
Expand Down Expand Up @@ -257,14 +257,14 @@ theme_multipage <- function(x,

table@table_string <- tab

table <- style_eval(table, tabularray_outer = cap)
table <- style_tt(table, tabularray_outer = cap)

if (rowhead > 0) {
table <- style_eval(table, tabularray_inner = sprintf("rowhead=%s", rowhead))
table <- style_tt(table, tabularray_inner = sprintf("rowhead=%s", rowhead))
}

if (rowfoot > 0) {
table <- style_eval(table, tabularray_inner = sprintf("rowfoot=%s", rowfoot))
table <- style_tt(table, tabularray_inner = sprintf("rowfoot=%s", rowfoot))
}

return(table)
Expand Down

0 comments on commit da25cd3

Please sign in to comment.