diff --git a/DESCRIPTION b/DESCRIPTION index 60dd107..239ea0a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,5 +40,7 @@ Suggests: tibble VignetteBuilder: knitr Config/testthat/edition: 3 +Config/testthat/parallel: true +Config/testthat/start-first: tfl_table, gt, integration, table1, flextable, rtables URL: https://humanpred.github.io/writetfl/ Config/roxygen2/version: 8.0.0 diff --git a/R/draw.R b/R/draw.R index f48939a..98dcb3f 100644 --- a/R/draw.R +++ b/R/draw.R @@ -77,9 +77,11 @@ draw_rule <- function(rule, y_mid_npc) { #' Ignored for ggplot and grob content. #' @param content_just Horizontal justification for character content: #' `"left"`, `"right"`, or `"centre"`. Ignored for ggplot and grob content. +#' @inheritDotParams .convert_tabs tab_indent_spaces tab_infix_spaces #' @keywords internal #' @importFrom ggplot2 ggplot -draw_content <- function(content, vp, gp = grid::gpar(), content_just = "left") { +draw_content <- function(content, vp, gp = grid::gpar(), content_just = "left", + ...) { if (inherits(content, "ggplot")) { grid::pushViewport(vp) print(content, newpage = FALSE) @@ -93,7 +95,7 @@ draw_content <- function(content, vp, gp = grid::gpar(), content_just = "left") grid::pushViewport(vp) text <- paste(content, collapse = "\n") avail_w <- .width_in(grid::unit(1, "npc")) - wrapped <- .wrap_text(text, avail_w, gp) + wrapped <- .wrap_text(text, avail_w, gp, ...) g <- grid::textGrob( label = wrapped, x = grid::unit(x_npc, "npc"), diff --git a/R/export_tfl_page.R b/R/export_tfl_page.R index 4d184de..46edf5a 100644 --- a/R/export_tfl_page.R +++ b/R/export_tfl_page.R @@ -85,9 +85,8 @@ #' not normally supplied when calling this function directly. #' @param preview Logical. If `TRUE`, calls `grid.newpage()` and draws to the #' currently open device without opening or closing any device. -#' @param ... Additional arguments. Currently recognised: -#' - `overlap_warn_mm`: numeric threshold in mm for near-miss overlap -#' warnings. Set to `NULL` to disable. +#' @inheritDotParams check_overlap overlap_warn_mm +#' @inheritDotParams .convert_tabs tab_indent_spaces tab_infix_spaces #' #' @return Invisibly returns `NULL`. #' @@ -213,9 +212,9 @@ export_tfl_page <- function( # --------------------------------------------------------------------------- vp_width_in <- .width_in(grid::unit(1, "npc")) norm$caption <- wrap_normalized_text(norm$caption, resolved_gps$caption, - vp_width_in) + vp_width_in, ...) norm$footnote <- wrap_normalized_text(norm$footnote, resolved_gps$footnote, - vp_width_in) + vp_width_in, ...) # --------------------------------------------------------------------------- # 6. Build all section grobs @@ -347,7 +346,8 @@ export_tfl_page <- function( just = c("left", "bottom"), name = "content_vp" ) - draw_content(x$content, content_vp, gp = content_gp, content_just = content_just) + draw_content(x$content, content_vp, gp = content_gp, + content_just = content_just, ...) y_cursor <- y_cursor - content_h_in # --- Content-footnote padding --- diff --git a/R/normalize.R b/R/normalize.R index 49b6aee..7c0917a 100644 --- a/R/normalize.R +++ b/R/normalize.R @@ -28,11 +28,12 @@ normalize_text <- function(x) { #' @param norm Output of [normalize_text()]. #' @param gp Resolved `gpar()` for this text element. #' @param width_in Available width in inches. +#' @inheritDotParams .convert_tabs tab_indent_spaces tab_infix_spaces #' @return A list with `$text` (wrapped string) and `$nlines` (updated count). #' @keywords internal -wrap_normalized_text <- function(norm, gp, width_in) { +wrap_normalized_text <- function(norm, gp, width_in, ...) { if (is.null(norm$text)) return(norm) - wrapped <- .wrap_text(norm$text, width_in, gp) + wrapped <- .wrap_text(norm$text, width_in, gp, ...) normalize_text(wrapped) } diff --git a/R/table_utils.R b/R/table_utils.R index d846fad..6e3db4c 100644 --- a/R/table_utils.R +++ b/R/table_utils.R @@ -339,8 +339,8 @@ # user-configured break spec applies. # # Must be called while a viewport with the target font context is active. -.wrap_text <- function(text, available_w_in, gp) { - .wrap_string(text, available_w_in, gp, wrap_breaks_default()) +.wrap_text <- function(text, available_w_in, gp, ...) { + .wrap_string(text, available_w_in, gp, wrap_breaks_default(), ...) } # --------------------------------------------------------------------------- diff --git a/R/wrap.R b/R/wrap.R index 7204514..31f37a4 100644 --- a/R/wrap.R +++ b/R/wrap.R @@ -181,6 +181,43 @@ wrap_breaks_default <- function() { w } +#' Expand tab characters in one line of text to spaces +#' +#' The PDF graphics device cannot measure or render the tab glyph (0x09): it +#' warns "font width unknown" and treats the tab as zero width, so a tab in +#' cell or page text would silently collapse. Tabs are therefore expanded to +#' spaces before any measuring or drawing. +#' +#' @param s A single character string with no embedded newline. +#' @param ... Ignored. +#' @param tab_indent_spaces Number of spaces a *leading* (indentation) tab — +#' one preceded only by whitespace — is expanded to. Default `2`, matching +#' the common "a tab indents by two spaces" convention. +#' @param tab_infix_spaces Number of spaces an *in-line* tab — one with +#' non-whitespace to its left — is expanded to. Default `1`; the resulting +#' space then behaves as an ordinary breakable space. +#' +#' @return `s` with tab characters replaced by spaces. Strings containing no +#' tab are returned untouched (fast path). +#' +#' @keywords internal +.convert_tabs <- function(s, ..., tab_indent_spaces = 2L, tab_infix_spaces = 1L) { + if (!grepl("\t", s, fixed = TRUE)) return(s) + indent_fill <- strrep(" ", tab_indent_spaces) + infix_fill <- strrep(" ", tab_infix_spaces) + chars <- strsplit(s, "", fixed = TRUE)[[1L]] + in_lead <- TRUE + for (i in seq_along(chars)) { + ch <- chars[[i]] + if (ch == "\t") { + chars[[i]] <- if (in_lead) indent_fill else infix_fill + } else if (ch != " ") { + in_lead <- FALSE + } + } + paste0(chars, collapse = "") +} + #' Wrap text to fit a target width, preserving paragraph breaks. #' #' Greedy left-to-right packing. Paragraphs (separated by `\n` in `text`) @@ -193,13 +230,14 @@ wrap_breaks_default <- function() { #' @param available_w_in Numeric, available width in inches. #' @param gp A `gpar()` for measurement font context. #' @param breaks A `wrap_breaks` object; if `NULL`, the package default. +#' @inheritDotParams .convert_tabs tab_indent_spaces tab_infix_spaces #' #' @return A single character string, possibly with `\n` inserted at break #' points. #' #' @keywords internal .wrap_string <- function(text, available_w_in, gp, - breaks = wrap_breaks_default()) { + breaks = wrap_breaks_default(), ...) { if (is.null(text) || !nzchar(text)) return(text) if (is.null(breaks)) breaks <- wrap_breaks_default() @@ -211,15 +249,52 @@ wrap_breaks_default <- function() { paragraphs <- strsplit(text, "\n", fixed = TRUE)[[1L]] wrapped <- vapply(paragraphs, function(para) { if (!nzchar(para)) return("") - .wrap_paragraph(para, available_w_in, gp, breaks, width_cache) + .wrap_paragraph(para, available_w_in, gp, breaks, width_cache, ...) }, character(1L)) paste(wrapped, collapse = "\n") } +# Maximal leading run of `drop` characters at the start of `s`, as a string +# (e.g. the indentation on `" Indented label"`). Returns `""` when there is +# none. Used by `.wrap_paragraph()` to re-attach a paragraph's prefix that the +# tokenizer would otherwise consume. Fast path: a single `substr()` check +# short-circuits the common no-indentation case before any `strsplit()`. +.leading_drop_run <- function(s, drop_chars) { + if (length(drop_chars) == 0L || !nzchar(s)) return("") + if (!(substr(s, 1L, 1L) %in% drop_chars)) return("") + chars <- strsplit(s, "", fixed = TRUE)[[1L]] + n <- length(chars) + k <- 1L + while (k < n && chars[[k + 1L]] %in% drop_chars) k <- k + 1L + substr(s, 1L, k) +} + .wrap_paragraph <- function(para, available_w_in, gp, breaks, - width_cache = NULL) { - tokens <- .tokenize_for_wrap(para, breaks) - if (length(tokens) == 0L) return("") + width_cache = NULL, ...) { + # Expand tabs to spaces first so leading indentation is measurable and any + # in-line tab becomes an ordinary space (the device cannot render tabs). + para <- .convert_tabs(para, ...) + + # Preserve leading indentation as a hanging indent. The tokenizer treats a + # run of `drop` characters as a between-token separator and `.wrap_paragraph()` + # drops the first token's separator, so a paragraph like `" Indented label"` + # would otherwise lose its prefix entirely. Capture the leading `drop` run, + # wrap the remaining body against the width reduced by the indent, then + # re-attach the prefix to *every* wrapped line so indented text stays + # indented across the wrap. + lead_ws <- .leading_drop_run(para, breaks$drop) + body <- if (nzchar(lead_ws)) substring(para, nchar(lead_ws) + 1L) else para + + tokens <- .tokenize_for_wrap(body, breaks) + # A whitespace-only paragraph tokenizes to nothing; return the prefix so its + # spacing survives rather than collapsing to "". + if (length(tokens) == 0L) return(lead_ws) + + # Width taken up by the indent shrinks the room each line has for body text. + indent_w <- if (nzchar(lead_ws)) { + .measure_text_width_in(lead_ws, gp, width_cache) + } else 0 + body_w <- max(0, available_w_in - indent_w) lines <- character(0L) current_line <- "" @@ -231,7 +306,7 @@ wrap_breaks_default <- function() { } cand <- paste0(current_line, tok$lead, tok$text) if (.measure_text_width_in(cand, gp, width_cache) <= - available_w_in + 1e-6) { + body_w + 1e-6) { current_line <- cand } else { lines <- c(lines, current_line) @@ -239,6 +314,7 @@ wrap_breaks_default <- function() { } } if (nzchar(current_line)) lines <- c(lines, current_line) + if (nzchar(lead_ws)) lines <- paste0(lead_ws, lines) paste(lines, collapse = "\n") } @@ -269,10 +345,13 @@ wrap_breaks_default <- function() { #' Width (inches) of the widest unbreakable token across a column's strings. #' #' This is the wrapping floor: a column cannot be narrowed below the width -#' needed to render its longest single token. +#' needed to render its longest single token. Tabs are expanded to spaces +#' first (matching the table draw path) so the floor agrees with the rendered +#' text. #' +#' @inheritDotParams .convert_tabs tab_indent_spaces tab_infix_spaces #' @keywords internal -.column_min_token_width_in <- function(strings, gp, breaks) { +.column_min_token_width_in <- function(strings, gp, breaks, ...) { if (length(strings) == 0L) return(0) # Single shared cache across the column: tokens like "the", units, and # other short repeats appear in many cells and would otherwise each @@ -282,9 +361,15 @@ wrap_breaks_default <- function() { if (!nzchar(s)) return(0) paragraphs <- strsplit(s, "\n", fixed = TRUE)[[1L]] max(vapply(paragraphs, function(p) { + p <- .convert_tabs(p, ...) tokens <- .tokenize_for_wrap(p, breaks) if (length(tokens) == 0L) return(0) - max(vapply(tokens, function(tok) { + # A hanging indent (preserved by .wrap_paragraph) widens every wrapped + # line, so the floor must leave room for indent + widest token or the + # indented lines would clip when the column is narrowed. + indent_w <- .measure_text_width_in(.leading_drop_run(p, breaks$drop), + gp, cache) + indent_w + max(vapply(tokens, function(tok) { .measure_text_width_in(tok$text, gp, cache) }, numeric(1L))) }, numeric(1L))) diff --git a/design/ARCHITECTURE.md b/design/ARCHITECTURE.md index 91fe14b..24db5ae 100644 --- a/design/ARCHITECTURE.md +++ b/design/ARCHITECTURE.md @@ -376,7 +376,7 @@ export_tfl(x = list_of_table1, ...) [exported] | `R/reexports.R` | `%||%` from rlang | | `R/tfl_table.R` | `tfl_colspec()`, `tfl_table()`, `print.tfl_table()`, `.check_named_subset()` | | `R/table_columns.R` | `resolve_col_specs()`, `compute_col_widths()`, `paginate_cols()` | -| `R/wrap.R` | `wrap_breaks()`, `wrap_breaks_default()`, `.is_wrap_breaks()`, `.tokenize_for_wrap()`, `.wrap_string()`, `.column_has_breakable_text()`, `.column_min_token_width_in()`, `.wrap_label_for_width()`, `.compute_wrapped_widths()` | +| `R/wrap.R` | `wrap_breaks()`, `wrap_breaks_default()`, `.is_wrap_breaks()`, `.tokenize_for_wrap()`, `.leading_drop_run()`, `.convert_tabs()`, `.wrap_string()`, `.column_has_breakable_text()`, `.column_min_token_width_in()`, `.wrap_label_for_width()`, `.compute_wrapped_widths()` | | `R/table_rows.R` | `measure_row_heights_tbl()` (returns per-cell matrix), `.compute_page_row_heights()`, `paginate_rows()` | | `R/table_draw.R` | `build_table_grob()`, `drawDetails.tfl_table_grob()`, `.compute_cell_suppression()`, `.draw_header_row()`, `.draw_cont_row()`, `.draw_cell_text()` | | `R/table_pagelist.R` | `tfl_table_to_pagelist()`, `compute_table_content_area()` | diff --git a/design/DECISIONS.md b/design/DECISIONS.md index 60340e2..130f4fc 100644 --- a/design/DECISIONS.md +++ b/design/DECISIONS.md @@ -1932,3 +1932,145 @@ A 17× drop on the line that motivated the refactor. - `grep -n "grDevices::pdf(" R/` shows exactly three occurrences, all in `R/export_tfl.R` (the `.open_metric_device` normal/preview paths + the defensive legacy fallback in `.export_tfl_pages`). + +## D-49: Preserve leading whitespace in wrapped text + tab expansion + +**Decision:** The word-wrap module preserves a line's leading whitespace +as a *hanging indent* (the prefix is re-attached to every wrapped line of +the paragraph, and its width is charged against the line so wrapping +accounts for it). Tab characters are expanded to spaces before +wrapping: a *leading* (indentation) tab becomes `tab_indent_spaces` +spaces (default 2), an *in-line* tab becomes `tab_infix_spaces` spaces +(default 1). The two tab counts are advanced knobs surfaced only via +`...` on `export_tfl()` / `export_tfl_page()`; they are not added to the +main function signatures. The counts are *defined* (with their defaults) +in exactly one place — `.convert_tabs()` — and every function above it +passes `...` straight through, so there is no per-layer default to keep +in sync. Their documentation is shared via roxygen's +`@inheritDotParams .convert_tabs tab_indent_spaces tab_infix_spaces`. + +**Context:** The tokenizer (`.tokenize_for_wrap()`) treats a run of +`drop` characters as a between-token separator, and `.wrap_paragraph()` +drops the first token's separator. A cell or content string like +`" Indented label"` therefore lost its leading spaces entirely, so the +common clinical convention of indenting sub-category labels with spaces +silently collapsed. Empirically confirmed: `.wrap_string(" Indented +label", ...)` returned `"Indented label"`, while `grid::textGrob()` +itself *does* render leading spaces (a 3-space prefix measures ~0.139 in) +— so the loss was purely in the wrap module, not the device. + +Separately, the PDF device cannot render the tab glyph (0x09): it draws +nothing and warns "font width unknown for character 0x09". A tab in cell +or content text would therefore vanish (and emit warnings during both +measurement and drawing). + +**Change:** + +1. `R/wrap.R`: + - `.leading_drop_run(s, drop_chars)` — returns the maximal leading run + of `drop` characters (fast-pathed when the first char isn't one). + - `.convert_tabs(s, ..., tab_indent_spaces = 2L, tab_infix_spaces = 1L)` + — expands leading vs. in-line tabs to spaces; tab-free strings + short-circuit. This is the *only* function that defines the two + counts and their defaults; the named args sit after `...` so they are + matched by name, and `...` absorbs any unrelated pass-through args + (e.g. `overlap_warn_mm`) that arrive via the forwarding chain. + Roxygen-documented so its params can be reused via `@inheritDotParams`. + - `.wrap_paragraph()` converts tabs (forwarding `...` to + `.convert_tabs()`), captures the leading run, wraps the body against + the width reduced by the indent, and re-attaches the prefix to every + wrapped line. Whitespace-only paragraphs return the (converted) + prefix rather than `""`. + - `.column_min_token_width_in()` adds `indent + widest token` to the + per-column floor (so an indented wrapped cell cannot clip when the + column is narrowed) and converts tabs first. It too takes `...` and + forwards it to `.convert_tabs(p, ...)`, so *every* `.convert_tabs()` + call site receives the same knobs and the floor can never disagree + with the drawn text under a non-default tab width. + - `.wrap_string()` takes `...` and forwards it to `.wrap_paragraph()`; + no tab args of its own. + +2. Pure `...` forwarding for the page-level character / caption / footnote + paths (table cells and headers use the `.convert_tabs()` defaults): + - `.wrap_text()` (`R/table_utils.R`), `wrap_normalized_text()` + (`R/normalize.R`), and `draw_content()` (`R/draw.R`) gain `...` and + forward it down — no explicit tab args, no per-layer defaults. + - `export_tfl_page()` does **not** read or validate the tab counts; it + forwards `...` (after reading `overlap_warn_mm` for its own use) to + the caption/footnote wrap and `draw_content()`. `export_tfl()` + already forwards `...`, so the knobs reach the page function + unchanged. + - Documentation is kept DRY with `@inheritDotParams .convert_tabs + tab_indent_spaces tab_infix_spaces` on `.wrap_string()`, + `.column_min_token_width_in()`, `wrap_normalized_text()`, + `draw_content()`, and `export_tfl_page()`. `export_tfl_page()`'s own + `overlap_warn_mm` dot-arg is documented via a second + `@inheritDotParams check_overlap overlap_warn_mm` (roxygen merges + multiple `@inheritDotParams` into the one `...` item), so no `...` + argument is described by hand in `@param`/`@details`. + +**Alternatives considered:** + +- *Indent on the first line only* (the initial implementation): rejected + after review — a hanging indent reads correctly when indented content + wraps, and matches the "every wrapped line stays indented" expectation. +- *Explicit `tab_indent_spaces` / `tab_infix_spaces` params with defaults + on every function in the chain* (the first implementation of this + decision): rejected — it duplicated the defaults and the doc strings at + each layer. Defining them once in `.convert_tabs()` and forwarding + `...` everywhere above is DRY and keeps the defaults in a single place. +- *Carrying tab config on the `wrap_breaks` object*: rejected; tab + expansion is orthogonal to break-character policy, and the request was + explicitly to surface it via `...` rather than a documented argument. +- *Making `tab_infix_spaces` configurable for table cells via a new + `tfl_table()` `...`*: deferred. In-line whitespace runs collapse to a + single break inside `.wrap_string()` anyway (pre-existing behaviour), + so `tab_infix_spaces > 1` is not visible through the wrap; table cells + use the defaults and an explicit space count is available by typing + literal spaces. + +**Tests:** `tests/testthat/test-wrap.R` — `.leading_drop_run()`, +`.convert_tabs()`, leading-space preservation (exact count, hanging +indent across wraps, whitespace-only, per-paragraph), tab expansion and +custom counts. `tests/testthat/test-normalize.R` — tab knobs forwarded +through `wrap_normalized_text()`. `tests/testthat/test-export_tfl_page.R` +— tabbed character content renders without the device warning and the +`...` knobs (mixed with `overlap_warn_mm`) flow through without error. + +**Verification:** full `devtools::test()` passing; manual repro confirms +3 leading spaces survive (`" Indented label"` round-trips) and a +`\t`-indented export produces no `0x09` warning. + +## D-50: Run testthat in parallel + +**Decision:** Enable parallel test execution via +`Config/testthat/parallel: true` in `DESCRIPTION`, with +`Config/testthat/start-first: tfl_table, gt, integration, table1, +flextable, rtables` to launch the slowest files first. + +**Context:** The suite has 22 test files and takes ~184 s sequentially on +an 8-core machine. Edition 3 (already set) supports running each file in +its own worker subprocess. The connector / rendering files (`tfl_table`, +`gt`, `integration`, `table1`, `flextable`, `rtables`) dominate runtime. + +**Change:** + +1. `DESCRIPTION` — add `Config/testthat/parallel: true` and + `Config/testthat/start-first: ...`. +2. `tests/testthat/test-export_tfl.R` — the + `.measure_text_dims_in fails fast without an active device` test + depended on the null-device state (`dev.cur() == 1L`). Sequentially it + happened to hold; under parallel a worker runs several files in one + process, so a graphics device left open by an earlier file in that + worker was still current and the guard did not fire. The test now + closes any open device first + (`while (grDevices::dev.cur() > 1L) grDevices::dev.off()`) so it + establishes its own precondition and is order-independent. + +**Measured impact** (8 cores): ~184 s sequential -> ~115 s parallel +(~35-40 % faster). All 22 files run; 608 test blocks; 0 fail / 0 skip / +0 warn; `R CMD check --as-cran` clean. + +**Note on test hygiene:** with parallel execution a test must not rely on +ambient global state left by another file (most relevantly the graphics +device stack). See TESTING.md. diff --git a/design/TESTING.md b/design/TESTING.md index 7d2c184..a45cf32 100644 --- a/design/TESTING.md +++ b/design/TESTING.md @@ -4,6 +4,16 @@ All tests use `testthat` (>= 3.0.0) with `testthat::test_that()`. Visual regression tests are explicitly out of scope (see D-18 in DECISIONS.md). **Coverage target: 100% line coverage** (see D-25). +**Parallel execution** is enabled via `Config/testthat/parallel: true` in +`DESCRIPTION` (see D-50); `Config/testthat/start-first` launches the +slowest files (`tfl_table`, `gt`, `integration`, `table1`, `flextable`, +`rtables`) first for better load balancing. Each test file runs in its own +worker subprocess, and a worker runs several files in sequence, so **a test +must not rely on ambient global state left by another file** — most +relevantly the graphics-device stack. Tests that depend on the null-device +state (e.g. the `.measure_text_dims_in` no-device guard) must close any open +devices first (`while (grDevices::dev.cur() > 1L) grDevices::dev.off()`). + --- ## Test organisation @@ -24,7 +34,7 @@ One test file per source file — `tests/testthat/test-.R` covers | `test-export_tfl.R` | `export_tfl()` — file validation, return values, preview mode, device lifecycle, tfl_table coercion, argument merging | | `test-export_tfl_page.R` | `export_tfl_page()` — argument resolution from x, overlap_warn_mm, page_i prefix, section presence, rules, page-level grob overflow under `overflow_action` (issue #30) | | `test-table_utils.R` | `.compute_group_sizes()`, `.collect_col_strings()`, `.measure_max_string_width()`, `.wrap_text()` (now a default-breaks shim) | -| `test-wrap.R` | `wrap_breaks()` constructor + validation; `.tokenize_for_wrap()` (drop / keep_before / mixed); `.wrap_string()` (paragraphs, single token, keep_before); `.column_has_breakable_text()`; `.column_min_token_width_in()` (floor calculation, keep_before reduces floor); `.wrap_label_for_width()`; `.compute_wrapped_widths()` (no-eligible no-op, water-from-top widest-first, longest-token floor) | +| `test-wrap.R` | `wrap_breaks()` constructor + validation; `.tokenize_for_wrap()` (drop / keep_before / mixed); `.leading_drop_run()`; `.convert_tabs()` (leading vs. in-line tab expansion, custom counts); `.wrap_string()` (paragraphs, single token, keep_before, leading-space preservation as a hanging indent, tab expansion); `.column_has_breakable_text()`; `.column_min_token_width_in()` (floor calculation, keep_before reduces floor); `.wrap_label_for_width()`; `.compute_wrapped_widths()` (no-eligible no-op, water-from-top widest-first, longest-token floor) | | `test-table_draw.R` | `build_table_grob()`, `drawDetails.tfl_table_grob()` (uncached fallback, wrap branch, rotated col_cont_msg labels, first_data fallback) | | `test-tfl_table.R` | `tfl_colspec()`, `tfl_table()`, column/row pagination, column width calculation, col_cont_msg flags, `tfl_table_to_pagelist()` | | `test-sub_tfl.R` | `.compute_sub_tfl_groups()`, `.format_sub_tfl_caption()`, `.apply_sub_tfl_caption()`, `.strip_sub_tfl_cols()`, `.resolve_col_label()`, `tfl_table_to_pagelist()` sub_tfl branch (factor ordering, multi-column suffix, NULL caption, group_vars overlap, custom sep/collapse/prefix, label resolution via colspec) | diff --git a/man/dot-column_min_token_width_in.Rd b/man/dot-column_min_token_width_in.Rd index d6d1e84..7d69f1c 100644 --- a/man/dot-column_min_token_width_in.Rd +++ b/man/dot-column_min_token_width_in.Rd @@ -4,10 +4,24 @@ \alias{.column_min_token_width_in} \title{Width (inches) of the widest unbreakable token across a column's strings.} \usage{ -.column_min_token_width_in(strings, gp, breaks) +.column_min_token_width_in(strings, gp, breaks, ...) +} +\arguments{ +\item{...}{ + Arguments passed on to \code{\link{.convert_tabs}} + \describe{ + \item{\code{tab_indent_spaces}}{Number of spaces a \emph{leading} (indentation) tab — +one preceded only by whitespace — is expanded to. Default \code{2}, matching +the common "a tab indents by two spaces" convention.} + \item{\code{tab_infix_spaces}}{Number of spaces an \emph{in-line} tab — one with +non-whitespace to its left — is expanded to. Default \code{1}; the resulting +space then behaves as an ordinary breakable space.} + }} } \description{ This is the wrapping floor: a column cannot be narrowed below the width -needed to render its longest single token. +needed to render its longest single token. Tabs are expanded to spaces +first (matching the table draw path) so the floor agrees with the rendered +text. } \keyword{internal} diff --git a/man/dot-convert_tabs.Rd b/man/dot-convert_tabs.Rd new file mode 100644 index 0000000..e2e4611 --- /dev/null +++ b/man/dot-convert_tabs.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/wrap.R +\name{.convert_tabs} +\alias{.convert_tabs} +\title{Expand tab characters in one line of text to spaces} +\usage{ +.convert_tabs(s, ..., tab_indent_spaces = 2L, tab_infix_spaces = 1L) +} +\arguments{ +\item{s}{A single character string with no embedded newline.} + +\item{...}{Ignored.} + +\item{tab_indent_spaces}{Number of spaces a \emph{leading} (indentation) tab — +one preceded only by whitespace — is expanded to. Default \code{2}, matching +the common "a tab indents by two spaces" convention.} + +\item{tab_infix_spaces}{Number of spaces an \emph{in-line} tab — one with +non-whitespace to its left — is expanded to. Default \code{1}; the resulting +space then behaves as an ordinary breakable space.} +} +\value{ +\code{s} with tab characters replaced by spaces. Strings containing no +tab are returned untouched (fast path). +} +\description{ +The PDF graphics device cannot measure or render the tab glyph (0x09): it +warns "font width unknown" and treats the tab as zero width, so a tab in +cell or page text would silently collapse. Tabs are therefore expanded to +spaces before any measuring or drawing. +} +\keyword{internal} diff --git a/man/dot-wrap_string.Rd b/man/dot-wrap_string.Rd index 22aa076..c1a354b 100644 --- a/man/dot-wrap_string.Rd +++ b/man/dot-wrap_string.Rd @@ -4,7 +4,7 @@ \alias{.wrap_string} \title{Wrap text to fit a target width, preserving paragraph breaks.} \usage{ -.wrap_string(text, available_w_in, gp, breaks = wrap_breaks_default()) +.wrap_string(text, available_w_in, gp, breaks = wrap_breaks_default(), ...) } \arguments{ \item{text}{Single character string.} @@ -14,6 +14,17 @@ \item{gp}{A \code{gpar()} for measurement font context.} \item{breaks}{A \code{wrap_breaks} object; if \code{NULL}, the package default.} + +\item{...}{ + Arguments passed on to \code{\link{.convert_tabs}} + \describe{ + \item{\code{tab_indent_spaces}}{Number of spaces a \emph{leading} (indentation) tab — +one preceded only by whitespace — is expanded to. Default \code{2}, matching +the common "a tab indents by two spaces" convention.} + \item{\code{tab_infix_spaces}}{Number of spaces an \emph{in-line} tab — one with +non-whitespace to its left — is expanded to. Default \code{1}; the resulting +space then behaves as an ordinary breakable space.} + }} } \value{ A single character string, possibly with \verb{\\n} inserted at break diff --git a/man/draw_content.Rd b/man/draw_content.Rd index ab8f070..e13b009 100644 --- a/man/draw_content.Rd +++ b/man/draw_content.Rd @@ -4,7 +4,7 @@ \alias{draw_content} \title{Draw the page content (ggplot, grob, or character string) inside a viewport} \usage{ -draw_content(content, vp, gp = grid::gpar(), content_just = "left") +draw_content(content, vp, gp = grid::gpar(), content_just = "left", ...) } \arguments{ \item{content}{A ggplot object, any grid grob (including gtable), or a @@ -19,6 +19,17 @@ Ignored for ggplot and grob content.} \item{content_just}{Horizontal justification for character content: \code{"left"}, \code{"right"}, or \code{"centre"}. Ignored for ggplot and grob content.} + +\item{...}{ + Arguments passed on to \code{\link{.convert_tabs}} + \describe{ + \item{\code{tab_indent_spaces}}{Number of spaces a \emph{leading} (indentation) tab — +one preceded only by whitespace — is expanded to. Default \code{2}, matching +the common "a tab indents by two spaces" convention.} + \item{\code{tab_infix_spaces}}{Number of spaces an \emph{in-line} tab — one with +non-whitespace to its left — is expanded to. Default \code{1}; the resulting +space then behaves as an ordinary breakable space.} + }} } \description{ Draw the page content (ggplot, grob, or character string) inside a viewport diff --git a/man/export_tfl_page.Rd b/man/export_tfl_page.Rd index 993c48f..c136a5f 100644 --- a/man/export_tfl_page.Rd +++ b/man/export_tfl_page.Rd @@ -129,11 +129,17 @@ not normally supplied when calling this function directly.} \item{preview}{Logical. If \code{TRUE}, calls \code{grid.newpage()} and draws to the currently open device without opening or closing any device.} -\item{...}{Additional arguments. Currently recognised: -\itemize{ -\item \code{overlap_warn_mm}: numeric threshold in mm for near-miss overlap -warnings. Set to \code{NULL} to disable. -}} +\item{...}{ + Arguments passed on to \code{\link{check_overlap}}, \code{\link{.convert_tabs}} + \describe{ + \item{\code{overlap_warn_mm}}{Near-miss threshold in mm. NULL skips all detection.} + \item{\code{tab_indent_spaces}}{Number of spaces a \emph{leading} (indentation) tab — +one preceded only by whitespace — is expanded to. Default \code{2}, matching +the common "a tab indents by two spaces" convention.} + \item{\code{tab_infix_spaces}}{Number of spaces an \emph{in-line} tab — one with +non-whitespace to its left — is expanded to. Default \code{1}; the resulting +space then behaves as an ordinary breakable space.} + }} } \value{ Invisibly returns \code{NULL}. diff --git a/man/wrap_normalized_text.Rd b/man/wrap_normalized_text.Rd index 407f479..61c3e93 100644 --- a/man/wrap_normalized_text.Rd +++ b/man/wrap_normalized_text.Rd @@ -4,7 +4,7 @@ \alias{wrap_normalized_text} \title{Word-wrap a normalized text to fit within a given width} \usage{ -wrap_normalized_text(norm, gp, width_in) +wrap_normalized_text(norm, gp, width_in, ...) } \arguments{ \item{norm}{Output of \code{\link[=normalize_text]{normalize_text()}}.} @@ -12,6 +12,17 @@ wrap_normalized_text(norm, gp, width_in) \item{gp}{Resolved \code{gpar()} for this text element.} \item{width_in}{Available width in inches.} + +\item{...}{ + Arguments passed on to \code{\link{.convert_tabs}} + \describe{ + \item{\code{tab_indent_spaces}}{Number of spaces a \emph{leading} (indentation) tab — +one preceded only by whitespace — is expanded to. Default \code{2}, matching +the common "a tab indents by two spaces" convention.} + \item{\code{tab_infix_spaces}}{Number of spaces an \emph{in-line} tab — one with +non-whitespace to its left — is expanded to. Default \code{1}; the resulting +space then behaves as an ordinary breakable space.} + }} } \value{ A list with \verb{$text} (wrapped string) and \verb{$nlines} (updated count). diff --git a/tests/testthat/test-export_tfl.R b/tests/testthat/test-export_tfl.R index faef027..d634e03 100644 --- a/tests/testthat/test-export_tfl.R +++ b/tests/testthat/test-export_tfl.R @@ -284,6 +284,12 @@ test_that(".measure_text_dims_in fails fast without an active device", { # Safety guard added in Phase 2d. All internal callers run under # `.open_metric_device()`; a future regression that forgets this # should produce a readable error rather than silent nonsense. + # + # The guard only fires on the null device, so establish that precondition + # explicitly: under parallel testthat a worker runs several files in one + # process, and a device left open by an earlier file would otherwise still + # be current here. + while (grDevices::dev.cur() > 1L) grDevices::dev.off() expect_error( .measure_text_dims_in("anything", grid::gpar()), "requires an active graphics device" diff --git a/tests/testthat/test-export_tfl_page.R b/tests/testthat/test-export_tfl_page.R index b9c6f36..3a92254 100644 --- a/tests/testthat/test-export_tfl_page.R +++ b/tests/testthat/test-export_tfl_page.R @@ -371,3 +371,36 @@ test_that("page-level overflow message includes the diagnostic-mode hint", { "overflow_action = \"warn\"" ) }) + +# --------------------------------------------------------------------------- +# Tab handling in character content (advanced `...` knobs) +# --------------------------------------------------------------------------- + +test_that("tabbed character content renders without the device tab warning", { + # If tabs reached the device unconverted, drawing would warn + # "font width unknown for character 0x09". Conversion to spaces must + # prevent that. + f <- tempfile(fileext = ".pdf") + grDevices::pdf(f, width = 8.5, height = 11) + on.exit({ grDevices::dev.off(); unlink(f) }) + + expect_warning( + export_tfl_page(list(content = "\tIndented line\nNormal\twith infix tab")), + regexp = NA + ) +}) + +test_that("export_tfl_page accepts tab_indent_spaces / tab_infix_spaces via ...", { + # The knobs are not consumed by export_tfl_page(); they flow through `...` + # to the caption / footnote / content wrap where .convert_tabs() applies + # them (and absorbs any other forwarded `...`, e.g. overlap_warn_mm). + f <- tempfile(fileext = ".pdf") + grDevices::pdf(f, width = 8.5, height = 11) + on.exit({ grDevices::dev.off(); unlink(f) }) + + expect_no_error( + export_tfl_page(list(content = "\tindented"), + tab_indent_spaces = 4L, tab_infix_spaces = 2L, + overlap_warn_mm = 2) + ) +}) diff --git a/tests/testthat/test-normalize.R b/tests/testthat/test-normalize.R index e230da0..89b22bc 100644 --- a/tests/testthat/test-normalize.R +++ b/tests/testthat/test-normalize.R @@ -122,3 +122,14 @@ test_that("wrap_normalized_text preserves explicit newlines", { expect_equal(result$nlines, 2L) expect_true(grepl("\n", result$text)) }) + +test_that("wrap_normalized_text forwards tab-expansion knobs", { + grDevices::pdf(NULL, width = 11, height = 8.5) + on.exit(grDevices::dev.off(), add = TRUE) + + norm <- normalize_text("\tindented\tinfix") + gp <- grid::gpar(fontsize = 12) + # Leading tab -> 3 spaces, in-line tab -> 1 space (the default infix). + result <- wrap_normalized_text(norm, gp, 10, tab_indent_spaces = 3L) + expect_equal(result$text, " indented infix") +}) diff --git a/tests/testthat/test-wrap.R b/tests/testthat/test-wrap.R index 5ca2744..92fcceb 100644 --- a/tests/testthat/test-wrap.R +++ b/tests/testthat/test-wrap.R @@ -89,6 +89,56 @@ test_that(".tokenize_for_wrap returns an empty list for an empty string", { list()) }) +# .leading_drop_run() --------------------------------------------------------- + +test_that(".leading_drop_run captures the leading run of drop characters", { + d <- writetfl:::wrap_breaks_default()$drop # c(" ", "\t") + expect_equal(writetfl:::.leading_drop_run(" Indented", d), " ") + expect_equal(writetfl:::.leading_drop_run("\t\tTabbed", d), "\t\t") + expect_equal(writetfl:::.leading_drop_run(" \t mixed", d), " \t ") +}) + +test_that(".leading_drop_run returns \"\" when there is no leading drop char", { + d <- writetfl:::wrap_breaks_default()$drop + expect_equal(writetfl:::.leading_drop_run("Normal", d), "") + expect_equal(writetfl:::.leading_drop_run("", d), "") + expect_equal(writetfl:::.leading_drop_run("a b", d), "") +}) + +test_that(".leading_drop_run handles an all-whitespace string", { + d <- writetfl:::wrap_breaks_default()$drop + expect_equal(writetfl:::.leading_drop_run(" ", d), " ") +}) + +test_that(".leading_drop_run with an empty drop set never strips", { + expect_equal(writetfl:::.leading_drop_run(" x", character(0L)), "") +}) + +# .convert_tabs() ------------------------------------------------------------- + +test_that(".convert_tabs expands leading tabs to tab_indent_spaces each", { + expect_equal(writetfl:::.convert_tabs("\tfoo"), " foo") # default 2 + expect_equal(writetfl:::.convert_tabs("\t\tfoo"), " foo") # two leads + expect_equal(writetfl:::.convert_tabs("\tfoo", tab_indent_spaces = 4L), + " foo") +}) + +test_that(".convert_tabs expands in-line tabs to tab_infix_spaces each", { + expect_equal(writetfl:::.convert_tabs("a\tb\tc"), "a b c") # default 1 + expect_equal(writetfl:::.convert_tabs("a\tb", tab_infix_spaces = 3L), + "a b") +}) + +test_that(".convert_tabs treats a tab after leading spaces as still 'leading'", { + # Everything to the tab's left is whitespace, so it is an indentation tab. + expect_equal(writetfl:::.convert_tabs(" \tfoo"), " foo") # 2 sp + 2 sp +}) + +test_that(".convert_tabs leaves tab-free strings untouched", { + expect_equal(writetfl:::.convert_tabs("no tabs here"), "no tabs here") + expect_equal(writetfl:::.convert_tabs(""), "") +}) + # .wrap_string() core behavior ----------------------------------------------- test_that(".wrap_string returns NULL / empty input unchanged", { @@ -150,6 +200,112 @@ test_that(".wrap_string with NULL breaks falls back to defaults", { }) }) +# .wrap_string() leading-space (indentation) preservation -------------------- +# Prefixed spaces on cell / content text are part of the intended spacing +# (e.g. indented sub-category labels in clinical tables). The tokenizer +# consumes leading whitespace as a between-token separator, so .wrap_paragraph +# re-attaches it to the first line. + +test_that(".wrap_string preserves leading spaces when no wrap is needed", { + with_vp({ + expect_equal( + writetfl:::.wrap_string(" Indented label", 10, grid::gpar()), + " Indented label" + ) + }) +}) + +test_that(".wrap_string preserves the exact number of leading spaces", { + with_vp({ + for (n in c(1L, 2L, 4L, 8L)) { + pre <- strrep(" ", n) + out <- writetfl:::.wrap_string(paste0(pre, "label"), 10, grid::gpar()) + expect_equal(out, paste0(pre, "label")) + } + }) +}) + +test_that(".wrap_string expands leading tabs to spaces (default 2 each)", { + with_vp({ + # The PDF device cannot render the tab glyph, so .wrap_string() expands + # tabs to spaces before wrapping: each of the two leading tabs becomes + # two spaces (four total), and the result measures cleanly (no warning). + expect_warning( + out <- writetfl:::.wrap_string("\t\tTabbed", 10, grid::gpar()), + regexp = NA + ) + expect_equal(out, " Tabbed") + }) +}) + +test_that(".wrap_string honours custom tab_indent_spaces (hanging indent)", { + with_vp({ + out <- writetfl:::.wrap_string("\tlead\tinfix", 10, grid::gpar(), + tab_indent_spaces = 4L, tab_infix_spaces = 2L) + # The leading tab expands to a four-space hanging indent (preserved). + # The in-line tab expands to spaces that the greedy packer then collapses + # to a single break, like any internal whitespace run. + expect_equal(out, " lead infix") + }) +}) + +test_that(".wrap_string keeps the indent on every line when wrapping (hanging indent)", { + with_vp({ + out <- writetfl:::.wrap_string(" alpha beta gamma delta epsilon", 0.6, + grid::gpar(fontsize = 12)) + lines <- strsplit(out, "\n", fixed = TRUE)[[1L]] + expect_gt(length(lines), 1L) + # Every wrapped line carries the four-space hanging indent. + for (ln in lines) expect_match(ln, "^ \\S") + # Stripping the indent leaves no line that still starts with whitespace + # (i.e. the prefix is exactly the original indent, not doubled). + bodies <- sub("^ ", "", lines) + for (b in bodies) expect_false(startsWith(b, " ")) + }) +}) + +test_that(".wrap_string hanging indent reduces room for body text on each line", { + with_vp({ + gp <- grid::gpar(fontsize = 12) + indented <- writetfl:::.wrap_string(" alpha beta gamma delta", 1.2, gp) + plain <- writetfl:::.wrap_string("alpha beta gamma delta", 1.2, gp) + n_indent <- length(strsplit(indented, "\n", fixed = TRUE)[[1L]]) + n_plain <- length(strsplit(plain, "\n", fixed = TRUE)[[1L]]) + # A wide indent eats into the available width, so the indented form needs + # at least as many lines as the un-indented form. + expect_gte(n_indent, n_plain) + }) +}) + +test_that(".wrap_string preserves per-paragraph indentation across \\n", { + with_vp({ + out <- writetfl:::.wrap_string("Header\n Child A\n Child B", 10, + grid::gpar()) + expect_equal(out, "Header\n Child A\n Child B") + }) +}) + +test_that(".wrap_string preserves a whitespace-only paragraph", { + with_vp({ + expect_equal(writetfl:::.wrap_string(" ", 10, grid::gpar()), " ") + }) +}) + +test_that("leading spaces add measurable width to the wrapped text", { + # The user-visible point: prefixed spaces count toward the rendered spacing. + # The indented string must render wider than the same string with the + # prefix stripped. + with_vp({ + indented <- writetfl:::.wrap_string(" Indented label", 10, grid::gpar()) + plain <- writetfl:::.wrap_string("Indented label", 10, grid::gpar()) + w_indent <- grid::convertWidth(grid::grobWidth(grid::textGrob(indented)), + "inches", valueOnly = TRUE) + w_plain <- grid::convertWidth(grid::grobWidth(grid::textGrob(plain)), + "inches", valueOnly = TRUE) + expect_gt(w_indent, w_plain) + }) +}) + # .column_has_breakable_text() ------------------------------------------------ test_that(".column_has_breakable_text detects whitespace by default", { @@ -197,6 +353,23 @@ test_that(".column_min_token_width_in counts keep_before char as part of the lef }) }) +test_that(".column_min_token_width_in forwards tab knobs (...) to .convert_tabs", { + with_vp({ + gp <- grid::gpar(fontsize = 12) + b <- writetfl:::wrap_breaks_default() + # A tab-indented single-token cell. The floor includes the (hanging) + # indent, so a wider tab_indent_spaces must yield a wider floor -- which + # only happens if the knob is forwarded all the way to .convert_tabs(). + # Every .convert_tabs() call site must receive `...` for the floor to + # agree with the drawn text under a non-default tab width. + narrow <- writetfl:::.column_min_token_width_in("\tToken", gp, b, + tab_indent_spaces = 1L) + wide <- writetfl:::.column_min_token_width_in("\tToken", gp, b, + tab_indent_spaces = 8L) + expect_gt(wide, narrow) + }) +}) + # .wrap_label_for_width() ---------------------------------------------------- test_that(".wrap_label_for_width returns NULL / empty input unchanged", { diff --git a/vignettes/v03-tfl_table_styling.Rmd b/vignettes/v03-tfl_table_styling.Rmd index f58c15d..58c471d 100644 --- a/vignettes/v03-tfl_table_styling.Rmd +++ b/vignettes/v03-tfl_table_styling.Rmd @@ -555,6 +555,62 @@ tbl <- tfl_table( ) ``` +### Leading spaces (indentation) + +Leading spaces in cell text — a common way to indent sub-category labels in +clinical tables — are **preserved**. The wrap module keeps a line's leading +spaces as a *hanging indent*: when the text wraps onto continuation lines, +every wrapped line carries the same indent, and the indent width is counted +when deciding where to break (so an indented line still fits its column). + +```{r wrap-indent, eval = FALSE} +df <- data.frame( + Parameter = c("Adverse events", + " Any AE", + " Serious AE", + " Mild AE"), + n = c(120L, 95L, 12L, 83L) +) +# The two- and four-space prefixes render exactly as written, and survive +# wrapping if the column is narrowed. +export_tfl(tfl_table(df), file = "ae.pdf") +``` + +This works in table cells, in column headers, and in page-level character +content, captions, and footnotes. No option is needed — spaces are taken +literally. + +### Tabs + +The PDF graphics device cannot render the tab glyph (it draws nothing and +warns). `writetfl` therefore expands tabs to spaces before measuring and +drawing: + +- A **leading** (indentation) tab — one preceded only by whitespace — + becomes **two spaces** by default. +- An **in-line** tab — one with text to its left — becomes **one space** + by default, which then behaves like an ordinary breakable space. + +The two counts are *advanced* options. They are not part of the main +function signatures; pass them through `...` to `export_tfl()` (which +forwards to `export_tfl_page()`), where they apply to word-wrapped +character **content**, **captions**, and **footnotes**: + +```{r wrap-tabs, eval = FALSE} +# A tab-indented report note. Each leading tab -> 4 spaces, each in-line +# tab -> 1 space. +export_tfl( + "\tStudy summary\n\t\tCohort A\twell tolerated", + file = "note.pdf", + tab_indent_spaces = 4, # advanced; via ... + tab_infix_spaces = 1 # advanced; via ... +) +``` + +Table cells and headers use the defaults (leading tab → 2 spaces, in-line +tab → 1 space); for tabular data, indent with literal spaces when you need a +specific depth. + ### Algorithm in one paragraph The wrap module computes a *floor* per wrap-eligible column equal to the