Detect too-wide content and add overflow_action to downgrade to a warning

R/export_tfl.R

@@ -77,9 +77,10 @@
 #'
 #'   In preview mode each page is drawn via `grid::grid.newpage()` (so knitr
 #'   captures it as an inline graphic). Returns `NULL` invisibly.
-#' @param ... Additional arguments passed to [writetfl::export_tfl_page()].
-#'   These serve as defaults for all pages and are overridden by per-page
-#'   list elements in `x`.
+#' @inheritDotParams export_tfl_page -x -page_i -preview
+#' @details
+#' Arguments forwarded via `...` serve as defaults for all pages and are
+#' overridden by per-page list elements in `x`.
 #'
 #' @return
 #' - Normal mode (`preview = FALSE`): the normalized absolute path to the PDF

R/export_tfl_page.R

@@ -64,6 +64,22 @@
 #' @param min_content_height Minimum acceptable content area height as a `unit`
 #'   object. An error is raised if the computed content height falls below this
 #'   value.
+#' @param overflow_action One of `"error"` (default) or `"warn"`. Controls how
+#'   width-overflow conditions are reported when the content does not fit in
+#'   its allocated area:
+#'   - `"error"`: append the message to the layout-error vector and abort
+#'     before drawing (no PDF page is produced).
+#'   - `"warn"`: emit `rlang::warn()` and continue rendering. The PDF is
+#'     produced with the overflow visibly clipped by `grid`, which is useful
+#'     for diagnosing what is too wide. See issue #30.
+#'
+#'   The same setting applies to all width-overflow detections: the
+#'   page-level content grob check (any `grob` content wider than the
+#'   content viewport), the [tfl_table()] total-width check (when
+#'   `allow_col_split = FALSE` and the column total still exceeds the
+#'   page after wrapping), and the [tfl_table()] per-column check (any
+#'   single column — or any data column combined with the row-header
+#'   group columns — wider than the page).
 #' @param page_i Integer page index, used to prefix layout error messages with
 #'   `"Page <i>: "`. Set automatically by [writetfl::export_tfl()];
 #'   not normally supplied when calling this function directly.
@@ -101,6 +117,7 @@ export_tfl_page <- function(
   content_just       = "left",
   margins            = grid::unit(c(t = 0.5, r = 0.5, b = 0.5, l = 0.5), "inches"),
   min_content_height = grid::unit(3, "inches"),
+  overflow_action    = c("error", "warn"),
   page_i             = NULL,
   preview            = FALSE,
   ...
@@ -137,16 +154,18 @@ export_tfl_page <- function(
   content_just       <- resolve_from_x(content_just,       "content_just")
   padding            <- resolve_from_x(padding,            "padding")
   min_content_height <- resolve_from_x(min_content_height, "min_content_height")
+  overflow_action    <- resolve_from_x(overflow_action,    "overflow_action")
 
   # ---------------------------------------------------------------------------
   # 1c. Validate resolved inputs
   # ---------------------------------------------------------------------------
   checkmate::assert_class(padding,            "unit", .var.name = "padding")
   checkmate::assert_class(margins,            "unit", .var.name = "margins")
   checkmate::assert_class(min_content_height, "unit", .var.name = "min_content_height")
-  caption_just  <- match.arg(caption_just,  c("left", "right", "centre"))
-  footnote_just <- match.arg(footnote_just, c("left", "right", "centre"))
-  content_just  <- match.arg(content_just,  c("left", "right", "centre"))
+  caption_just    <- match.arg(caption_just,    c("left", "right", "centre"))
+  footnote_just   <- match.arg(footnote_just,   c("left", "right", "centre"))
+  content_just    <- match.arg(content_just,    c("left", "right", "centre"))
+  overflow_action <- match.arg(overflow_action, c("error", "warn"))
 
   # ---------------------------------------------------------------------------
   # 2. Normalize all text and rule inputs
@@ -259,6 +278,29 @@ export_tfl_page <- function(
   content_h_in <- compute_content_height(vp_height_in, section_heights, present, padding_in)
   errors       <- check_content_height(content_h_in, min_content_height, errors)
 
+  # Page-level width overflow check for non-ggplot, non-character content.
+  # ggplot scales to fit and character content is word-wrapped, so neither
+  # produces width overflow.  Other grobs (gt::as_gtable, rtables textGrob,
+  # gridExtra::tableGrob, raw user grobs) have a natural width that
+  # grobWidth() can measure while outer_vp is active.
+  #
+  # tfl_table_grobs are skipped here because compute_col_widths() already
+  # ran a more precise per-column / group-aware overflow check during
+  # tfl_table_to_pagelist().  Re-checking the assembled grob would emit a
+  # duplicate (less informative) warning under overflow_action = "warn".
+  if (inherits(x$content, "grob") &&
+      !inherits(x$content, "ggplot") &&
+      !inherits(x$content, "tfl_table_grob")) {
+    content_w_in <- tryCatch(
+      .width_in(grid::grobWidth(x$content)),
+      error = function(e) NA_real_
+    )
+    if (is.finite(content_w_in)) {
+      errors <- check_content_width(content_w_in, vp_width_in, overflow_action,
+                                    errors, what = "Content")
+    }
+  }
+
   if (length(errors) > 0) {
     grid::popViewport()
     page_prefix <- if (!is.null(page_i)) paste0("Page ", page_i, ": ") else ""

R/layout.R

@@ -1,4 +1,4 @@
-# layout.R — Content height computation and validation
+# layout.R — Content height/width computation and validation
 
 #' Compute available content height after subtracting all other sections
 #'
@@ -39,3 +39,48 @@ check_content_height <- function(content_h_in, min_content_height, errors) {
   }
   errors
 }
+
+# Shared dispatch for width-overflow events.  Either appends `msg` to `errors`
+# (when `overflow_action == "error"`) or emits an immediate rlang::warn() (when
+# `"warn"`) and returns `errors` unchanged.  Every overflow message ends with
+# the diagnostic-mode hint so users always see the escape hatch.
+.overflow_signal <- function(msg, overflow_action, errors) {
+  msg <- paste0(
+    msg,
+    "\n  Set `overflow_action = \"warn\"` to convert this error to a ",
+    "warning and still produce output for diagnosis."
+  )
+  if (identical(overflow_action, "warn")) {
+    rlang::warn(msg)
+    errors
+  } else {
+    c(errors, msg)
+  }
+}
+
+#' Check content width against an upper bound and signal if too wide
+#'
+#' Mirrors [check_content_height()] but is a maximum-ceiling check rather than
+#' a minimum-floor check, and accepts an `overflow_action` knob that downgrades
+#' the error to a warning so output can still be produced for diagnosis (see
+#' issue #30).
+#'
+#' @param content_w_in Natural width of the content in inches.
+#' @param vp_width_in Available content viewport width in inches.
+#' @param overflow_action One of `"error"` (default) or `"warn"`.
+#' @param errors Character vector to append to (when action is `"error"`).
+#' @param what Label for the source of the width (e.g. `"Content"`,
+#'   `"Column 'x'"`, `"Total column width"`).
+#' @return Updated `errors` character vector.
+#' @keywords internal
+check_content_width <- function(content_w_in, vp_width_in, overflow_action,
+                                errors, what = "Content") {
+  if (content_w_in > vp_width_in + 1e-6) {
+    msg <- sprintf(
+      "%s width (%.4g in) exceeds available content width (%.4g in)",
+      what, content_w_in, vp_width_in
+    )
+    errors <- .overflow_signal(msg, overflow_action, errors)
+  }
+  errors
+}

R/table_columns.R

@@ -67,11 +67,20 @@ resolve_col_specs <- function(tbl) {
 
 #' Compute final column widths and column groups
 #'
+#' @param overflow_action One of `"error"` (default) or `"warn"`. Controls how
+#'   width-overflow conditions are reported. See [export_tfl_page()].
+#' @param validate_overflow Logical (internal). When `FALSE`, skip the
+#'   per-column / group-aware / total-width overflow checks. The second
+#'   `cw_adj` pass in `.tfl_table_to_pagelist_default()` sets this to `FALSE`
+#'   so the same overflow is not re-signalled on every pass.
 #' @return A list with `$resolved_cols` (widths_in filled in) and
 #'   `$col_groups` (list of integer vectors of column indices per group).
 #' @keywords internal
 compute_col_widths <- function(resolved_cols, data, content_width_in,
-                               tbl, pg_width, pg_height, margins) {
+                               tbl, pg_width, pg_height, margins,
+                               overflow_action   = c("error", "warn"),
+                               validate_overflow = TRUE) {
+  overflow_action <- match.arg(overflow_action)
   n_cols    <- length(resolved_cols)
   n_grp     <- length(tbl$group_vars)
   min_in    <- .width_in(tbl$min_col_width)
@@ -163,20 +172,91 @@ compute_col_widths <- function(resolved_cols, data, content_width_in,
   }
 
   # --- Check feasibility ---
-  if (total_w > content_width_in + 1e-6) {
-    if (!tbl$allow_col_split) {
-      col_detail <- paste(vapply(seq_len(n_cols), function(j) {
-        sprintf("  %s: %.3g in", resolved_cols[[j]]$col, widths_in[[j]])
-      }, character(1L)), collapse = "\n")
-      rlang::abort(sprintf(paste0(
-        "Total column width (%.3g in) exceeds available content width (%.3g in) ",
-        "after wrapping.\nColumn widths:\n%s\n",
-        "Set `allow_col_split = TRUE` to split columns across pages, ",
-        "or reduce column widths / enable wrap_cols."
-      ), total_w, content_width_in, col_detail))
+  errors <- character(0)
+
+  if (!validate_overflow) {
+    # Skip overflow validation entirely.  The caller (typically the second
+    # cw_adj pass in .tfl_table_to_pagelist_default) is recomputing widths
+    # for layout reasons after a prior pass already validated the same
+    # configuration; re-signalling here would emit a duplicate warning.
+    resolved_cols <- lapply(seq_len(n_cols), function(j) {
+      cs <- resolved_cols[[j]]
+      cs$width_in <- widths_in[[j]]
+      cs
+    })
+    col_groups <- paginate_cols(widths_in, content_width_in, n_grp,
+                                tbl$allow_col_split, tbl$balance_col_pages)
+    return(list(resolved_cols         = resolved_cols,
+                col_groups            = col_groups,
+                col_cont_label_half_w = col_cont_label_half_w))
+  }
+
+  # Per-column / group-aware overflow check.  Group columns repeat on every
+  # column-paginated page, so the available width for any single data column
+  # is content_width_in - grp_w.  A group column itself must fit in the full
+  # content width (grp_w == 0 if there are no group columns, in which case the
+  # data-col rule reduces to `widths_in[j] > content_width_in`).
+  grp_w <- if (n_grp > 0L) sum(widths_in[seq_len(n_grp)]) else 0
+  for (j in seq_len(n_cols)) {
+    cs <- resolved_cols[[j]]
+    if (j <= n_grp) {
+      # Group column j: must fit in content_width_in alone
+      if (widths_in[[j]] > content_width_in + 1e-6) {
+        errors <- .overflow_signal(
+          sprintf(
+            paste0("Group column '%s' width (%.3g in) exceeds available ",
+                   "content width (%.3g in)"),
+            cs$col, widths_in[[j]], content_width_in
+          ),
+          overflow_action, errors
+        )
+      }
+    } else {
+      # Data column j: must fit alongside the group columns on a single page.
+      # Use a tiny tolerance and avoid double-reporting when n_grp == 0 and
+      # the same overflow would also be caught by the (commented) total check.
+      if (grp_w + widths_in[[j]] > content_width_in + 1e-6) {
+        if (n_grp > 0L) {
+          msg <- sprintf(
+            paste0("Column '%s' (%.3g in) plus group columns (%.3g in) ",
+                   "= %.3g in exceeds available content width (%.3g in); ",
+                   "no column-paginated page can fit this column with the ",
+                   "row headers"),
+            cs$col, widths_in[[j]], grp_w,
+            grp_w + widths_in[[j]], content_width_in
+          )
+        } else {
+          msg <- sprintf(
+            paste0("Column '%s' width (%.3g in) exceeds available content ",
+                   "width (%.3g in)"),
+            cs$col, widths_in[[j]], content_width_in
+          )
+        }
+        errors <- .overflow_signal(msg, overflow_action, errors)
+      }
     }
   }
 
+  # Total-width check: only meaningful when allow_col_split = FALSE.  When
+  # allow_col_split = TRUE, paginate_cols() handles the multi-page split and
+  # this is not an overflow event.
+  if (total_w > content_width_in + 1e-6 && !tbl$allow_col_split) {
+    col_detail <- paste(vapply(seq_len(n_cols), function(j) {
+      sprintf("  %s: %.3g in", resolved_cols[[j]]$col, widths_in[[j]])
+    }, character(1L)), collapse = "\n")
+    msg <- sprintf(paste0(
+      "Total column width (%.3g in) exceeds available content width (%.3g in) ",
+      "after wrapping.\nColumn widths:\n%s\n",
+      "Set `allow_col_split = TRUE` to split columns across pages, ",
+      "or reduce column widths / enable wrap_cols."
+    ), total_w, content_width_in, col_detail)
+    errors <- .overflow_signal(msg, overflow_action, errors)
+  }
+
+  if (length(errors) > 0L) {
+    rlang::abort(paste(errors, collapse = "\n"))
+  }
+
   # --- Store final widths in resolved_cols ---
   resolved_cols <- lapply(seq_len(n_cols), function(j) {
     cs <- resolved_cols[[j]]

R/table_pagelist.R

@@ -13,13 +13,14 @@
 
 # Default values mirroring export_tfl_page() for use when dots are absent
 .tfl_page_defaults <- list(
-  margins        = grid::unit(c(t = 0.5, r = 0.5, b = 0.5, l = 0.5), "inches"),
-  padding        = grid::unit(0.5, "lines"),
-  header_rule    = FALSE,
-  footer_rule    = FALSE,
-  caption_just   = "left",
-  footnote_just  = "left",
-  gp             = grid::gpar()
+  margins         = grid::unit(c(t = 0.5, r = 0.5, b = 0.5, l = 0.5), "inches"),
+  padding         = grid::unit(0.5, "lines"),
+  header_rule     = FALSE,
+  footer_rule     = FALSE,
+  caption_just    = "left",
+  footnote_just   = "left",
+  gp              = grid::gpar(),
+  overflow_action = "error"
 )
 
 # ---------------------------------------------------------------------------
@@ -96,13 +97,15 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
   .dot <- function(key) {
     if (!is.null(dots[[key]])) dots[[key]] else .tfl_page_defaults[[key]]
   }
-  margins      <- .dot("margins")
-  padding      <- .dot("padding")
-  header_rule  <- .dot("header_rule")
-  footer_rule  <- .dot("footer_rule")
-  cap_just     <- .dot("caption_just")
-  fn_just      <- .dot("footnote_just")
-  gp_page      <- .dot("gp")
+  margins         <- .dot("margins")
+  padding         <- .dot("padding")
+  header_rule     <- .dot("header_rule")
+  footer_rule     <- .dot("footer_rule")
+  cap_just        <- .dot("caption_just")
+  fn_just         <- .dot("footnote_just")
+  gp_page         <- .dot("gp")
+  overflow_action <- .dot("overflow_action")
+  overflow_action <- match.arg(overflow_action, c("error", "warn"))
 
   annot <- list(
     header_left   = dots$header_left,
@@ -138,7 +141,8 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
   # Keep a pre-width copy of resolved_cols in case a second pass is needed.
   resolved_cols_0 <- resolved_cols
   col_result <- compute_col_widths(
-    resolved_cols, tbl$data, cw, tbl, pg_width, pg_height, margins
+    resolved_cols, tbl$data, cw, tbl, pg_width, pg_height, margins,
+    overflow_action = overflow_action
   )
   resolved_cols   <- col_result$resolved_cols   # widths now set in inches
   col_groups      <- col_result$col_groups       # list of integer vectors
@@ -157,7 +161,9 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
     if (!is.null(tbl$col_cont_msg[[1L]])) cw_adj <- cw_adj - hw
     if (!is.null(tbl$col_cont_msg[[2L]])) cw_adj <- cw_adj - hw
     col_result    <- compute_col_widths(
-      resolved_cols_0, tbl$data, cw_adj, tbl, pg_width, pg_height, margins
+      resolved_cols_0, tbl$data, cw_adj, tbl, pg_width, pg_height, margins,
+      overflow_action   = overflow_action,
+      validate_overflow = FALSE   # first pass already validated
     )
     resolved_cols <- col_result$resolved_cols
     col_groups    <- col_result$col_groups

design/ARCHITECTURE.md

@@ -96,6 +96,10 @@ export_tfl_page(x, ...)                               [exported]
   ├── check_overlap(widths, vp_width, overlap_warn_mm)    — overlap.R
   ├── compute_figure_height(...)                          — layout.R
   ├── check_figure_height(h, min_content_height, errors)  — layout.R
+  ├── if grob content and not (ggplot/character/tfl_table_grob): — layout.R
+  │     check_content_width(grobWidth, vp_width, overflow_action, errors)
+  │     [tfl_table_grob is skipped: compute_col_widths() already ran a
+  │      more precise per-column check during tfl_table_to_pagelist()]
   ├── if errors: rlang::abort(paste(errors, collapse="\n"))
   │
   ├── [DRAWING PHASE]
@@ -317,7 +321,7 @@ export_tfl(x = list_of_table1, ...)                [exported]
 | `R/normalize.R` | `normalize_text()`, `wrap_normalized_text()`, `normalize_rule()` |
 | `R/resolve_gp.R` | `resolve_gp()`, `merge_gpar()` |
 | `R/overlap.R` | `check_overlap()` |
-| `R/layout.R` | `compute_figure_height()`, `check_figure_height()` |
+| `R/layout.R` | `compute_figure_height()`, `check_figure_height()`, `check_content_width()`, `.overflow_signal()` |
 | `R/utils.R` | `validate_file_arg()`, `coerce_x_to_pagelist()`, `build_page_args()` |
 | `R/gt.R` | `export_tfl.gt_tbl()`, `gt_to_pagelist()`, `.extract_gt_annotations()`, `.clean_gt()`, `.gt_content_height()`, `.gt_grob_height()`, `.gt_row_groups()`, `.paginate_gt()`, `.rebuild_gt_subset()` |
 | `R/rtables.R` | `export_tfl.VTableTree()`, `rtables_to_pagelist()`, `.extract_rtables_annotations()`, `.clean_rtables()`, `.rtables_content_height()`, `.rtables_content_width()`, `.rtables_lpp_cpp()`, `.rtables_to_grob()` |
@@ -571,16 +575,23 @@ resolve_col_specs(tbl)
     { col, label, width (unit/numeric/NULL), align, wrap,
       gp, is_group_col }
 
-compute_col_widths(resolved_cols, data, content_width_in, tbl, ...)
+compute_col_widths(resolved_cols, data, content_width_in, tbl, ...,
+                   overflow_action = c("error", "warn"))
   1. Measure auto-size columns: max string width over unique values
      (limited to max_measure_rows rows for efficiency)
   2. Apply min_col_width floor to auto-sized columns
   3. Allocate relative-weight columns proportionally from remaining width
   4. If total > content_width_in and wrap_eligible cols exist:
        .apply_col_wrapping() narrows wrap cols iteratively
-  5. If total still > content_width_in and allow_col_split:
-       paginate_cols() splits into column groups
-  6. Each resolved col gets $width_in set (inches, scalar)
+  5. Per-column / group-aware overflow check (issue #30):
+       For group cols j:  widths_in[j] > content_width_in  → signal
+       For data cols  j:  grp_w + widths_in[j] > content_width_in → signal
+       (signal = abort under "error", rlang::warn() under "warn")
+  6. Total-width check, only when allow_col_split = FALSE:
+       total_w > content_width_in → signal
+  7. paginate_cols() splits into column groups (always called; under "warn"
+       it gracefully paginates around the overflow)
+  8. Each resolved col gets $width_in set (inches, scalar)
 
 paginate_cols(col_indices, col_widths_in, group_col_indices,
               content_width_in, balance_col_pages)