Add spanning (multi-row) column headers to tfl_table

CLAUDE.md

@@ -123,6 +123,21 @@ When `sub_tfl` is set on a `tfl_table`:
 - when the global `caption` is `NULL`, the suffix becomes the entire caption
   (no leading prefix).
 
+### Spanning (multi-row) column headers (D-53)
+
+`tfl_table(col_header_sep = "|||")` (a single `NA` disables) splits each column
+`label` on the separator into stacked, **bottom-aligned** header rows; adjacent
+columns with equal text in a row merge into one spanning cell. Merging is
+**hierarchical** (only within a shared parent span; the row-header/data divide
+is a hard boundary; empty cells are transparent singletons). Merge comparison
+uses raw text; display right-trims, so a trailing space prevents a merge. A
+spanner's width is the **sum of the columns beneath it**, and a spanned block is
+**atomic** across column-continuation pages (an over-wide atom routes to
+`overflow_action`). `"\n"` still line-breaks *within* a single header cell. When
+no label contains the separator the header is a single row and output is
+byte-identical to the pre-feature behavior (`R == 1` short-circuit). See D-53
+and `.compute_header_spans()` in `R/table_utils.R`.
+
 ---
 
 ## Key behavioral rules (implement exactly as specified)
@@ -394,14 +409,22 @@ writetfl/
 │   │                                    .paginate_oversized_group()
 │   ├── reexports.R                   ← re-exports unit, gpar from grid
 │   ├── table_columns.R               ← resolve_col_specs(), compute_col_widths(),
-│   │                                    paginate_cols()
-│   ├── table_rows.R                  ← measure_row_heights_tbl(), paginate_rows()
+│   │                                    .apply_header_span_widths(),
+│   │                                    .data_atoms(), paginate_cols()
+│   ├── table_rows.R                  ← .span_deficit() (shared row/col span
+│   │                                    kernel), measure_row_heights_tbl(),
+│   │                                    paginate_rows()
 │   ├── table_draw.R                  ← build_table_grob(),
-│   │                                    drawDetails.tfl_table_grob()
+│   │                                    drawDetails.tfl_table_grob(),
+│   │                                    .draw_header_block() (spanning header)
 │   ├── table_pagelist.R              ← tfl_table_to_pagelist(),
 │   │                                    compute_table_content_area()
-│   └── table_utils.R                 ← .make_outer_vp(), measurement/formatting
-│                                        helpers shared across table_* files
+│   └── table_utils.R                 ← .make_outer_vp(), .compute_header_spans()
+│                                        (spanning-header structure),
+│                                        .measure_header_block(),
+│                                        .slice_header_spans(), and
+│                                        measurement/formatting helpers shared
+│                                        across table_* files
 ├── tests/
 │   ├── testthat.R
 │   └── testthat/

R/table_draw.R

@@ -67,7 +67,9 @@ build_table_grob <- function(row_page, col_group_idx, n_group_cols,
                              cont_row_h_in       = NULL,
                              is_first_col_page   = TRUE,
                              is_last_col_page    = TRUE,
-                             clip_width_caches   = NULL) {
+                             clip_width_caches   = NULL,
+                             header_spans        = NULL,
+                             header_block        = NULL) {
   # Subset to display columns for this page
   page_cols <- resolved_cols[col_group_idx]
 
@@ -87,6 +89,10 @@ build_table_grob <- function(row_page, col_group_idx, n_group_cols,
                                                 # drawDetails will create
                                                 # per-page envs (e.g. grobs
                                                 # assembled outside pipeline)
+    header_spans        = header_spans,         # full-table span structure
+                                                # (NULL -> single-row header)
+    header_block        = header_block,         # cached per-row header heights
+                                                # + total; NULL -> recompute
     cl                  = "tfl_table_grob"
   )
 }
@@ -150,12 +156,25 @@ drawDetails.tfl_table_grob <- function(x, recording) {
 
   lh <- tbl$line_height %||% 1.05   # defensive fallback for old grob objects
 
-  # Header row height (delegates to the same helper used during pagination so
-  # any auto-wrapping of column labels is accounted for here too).
-  header_row_h <- if (tbl$show_col_names) {
-    .measure_header_row_height(page_cols, gp_tbl, cp, lh, breaks = breaks,
-                               wrap_extra_pad_in = wrap_extra_pad_in)
-  } else 0
+  # Spanning-header structure sliced to this page's columns (group columns
+  # first, then a contiguous data range).  NULL / R == 1 -> single-row header.
+  spans_full <- x$header_spans
+  spans_page <- if (!is.null(spans_full)) {
+    .slice_header_spans(spans_full, x$col_group_idx)
+  } else NULL
+
+  # Header block height.  Prefer the per-row heights cached during pagination
+  # (full-table, uniform across pages); recompute for grobs built outside the
+  # normal pipeline.  Delegates to the single-row helper when R == 1.
+  header_block <- if (!is.null(x$header_block)) {
+    x$header_block
+  } else if (tbl$show_col_names) {
+    .measure_header_block(page_cols, spans_page, gp_tbl, cp, lh,
+                          breaks = breaks, wrap_extra_pad_in = wrap_extra_pad_in)
+  } else {
+    list(row_heights = numeric(0L), total = 0)
+  }
+  header_row_h <- if (tbl$show_col_names) header_block$total else 0
 
   # Continuation row height — prefer cached value
   cont_row_h <- if (!is.null(x$cont_row_h_in)) {
@@ -275,11 +294,20 @@ drawDetails.tfl_table_grob <- function(x, recording) {
         gp     = grid::gpar(fill = hdr_gp_full$fill, col = NA)
       )
     }
-    .draw_header_row(page_cols, col_x_left, col_x_right, col_widths_in,
-                     y_cursor, header_row_h, vp_w, vp_h,
-                     h_lft_in, h_rgt_in, v_top_in, gp_tbl, lh,
-                     breaks         = breaks,
-                     text_dim_cache = text_dim_cache)
+    if (!is.null(spans_page) && spans_page$R > 1L) {
+      .draw_header_block(page_cols, col_x_left, col_x_right,
+                         y_cursor, header_block$row_heights, spans_page,
+                         vp_w, vp_h, h_lft_in, h_rgt_in, v_top_in, gp_tbl, lh,
+                         breaks         = breaks,
+                         span_rule      = isTRUE(tbl$col_header_span_rule %||% TRUE),
+                         text_dim_cache = text_dim_cache)
+    } else {
+      .draw_header_row(page_cols, col_x_left, col_x_right, col_widths_in,
+                       y_cursor, header_row_h, vp_w, vp_h,
+                       h_lft_in, h_rgt_in, v_top_in, gp_tbl, lh,
+                       breaks         = breaks,
+                       text_dim_cache = text_dim_cache)
+    }
     y_cursor <- y_cursor + header_row_h
 
     # Column header rule — spans table width only
@@ -571,6 +599,85 @@ drawDetails.tfl_table_grob <- function(x, recording) {
   }
 }
 
+# Draw the multi-row / spanning column-header block.
+#
+# `spans_page` is the page-local span structure from `.slice_header_spans()`;
+# `row_heights` are the per-row band heights (from the cached header block).
+# Each non-empty span cell is drawn once, centered across the columns beneath
+# it (`col_x_left[a] .. col_x_right[b]`), wrapped to that span width, reusing
+# `.draw_cell_text()`.  The leaf (bottom) row is drawn here too.
+#
+# When `span_rule` is TRUE, an underline is drawn beneath each multi-column
+# spanner cell in the above-leaf rows.  Where two spanner underlines are
+# horizontally adjacent, each is inset by half the cell's side padding so the
+# two rules are separated by a gap equal to one side margin (the underlines
+# read as distinct group underlines).
+.draw_header_block <- function(page_cols, col_x_left, col_x_right,
+                               y_top_in, row_heights, spans_page,
+                               vp_w, vp_h, h_lft_in, h_rgt_in, v_top_in,
+                               gp_tbl, lh, breaks = NULL,
+                               span_rule = TRUE, text_dim_cache = NULL) {
+  hdr_gp     <- .gp_with_lineheight(.resolve_table_gp(gp_tbl, "header_row"), lh)
+  hdr_gp_key <- paste0("header_row_lh", lh)
+  h_pad_in   <- h_lft_in + h_rgt_in
+
+  # Span-rule style: an explicit gp$col_header_span_rule wins, otherwise the
+  # underline inherits the gp$col_header_rule style.
+  span_rule_gp <- if (span_rule) {
+    if (is.list(gp_tbl) && !is.null(gp_tbl[["col_header_span_rule"]])) {
+      .resolve_table_gp(gp_tbl, "col_header_span_rule")
+    } else {
+      .resolve_table_gp(gp_tbl, "col_header_rule")
+    }
+  } else NULL
+  gap_half <- (h_lft_in + h_rgt_in) / 4   # half the side-margin gap
+
+  y <- y_top_in
+  for (r in seq_len(spans_page$R)) {
+    row_h <- row_heights[[r]]
+    cells <- spans_page$cells_by_row[[r]]
+    for (cell in cells) {
+      if (!nzchar(cell$text)) next
+      x_left  <- col_x_left[[cell$start]]
+      x_right <- col_x_right[[cell$end]]
+      span_w  <- x_right - x_left
+      label   <- .wrap_header_cell(cell$text, span_w, h_pad_in, hdr_gp, breaks)
+      .draw_cell_text(label, "centre",
+                      x_left, x_right, y, row_h, vp_w, vp_h,
+                      h_lft_in, h_rgt_in, v_top_in,
+                      hdr_gp, span_w,
+                      text_dim_cache = text_dim_cache,
+                      gp_key         = hdr_gp_key)
+    }
+
+    # Underlines beneath multi-column spanners (not the leaf row: the leaf is
+    # followed by the full-width col_header_rule).
+    if (span_rule && r < spans_page$R) {
+      y_rule_npc <- 1 - (y + row_h) / vp_h
+      n_cells    <- length(cells)
+      for (ci in seq_len(n_cells)) {
+        cell <- cells[[ci]]
+        if (cell$end <= cell$start) next          # only true (multi-col) spans
+        x_l <- col_x_left[[cell$start]]
+        x_r <- col_x_right[[cell$end]]
+        # Inset only where the neighbour is itself a spanner, so a gap opens
+        # between two adjacent group underlines (but not at the block edges
+        # or beside a single column).
+        left_nb  <- if (ci > 1L)       cells[[ci - 1L]] else NULL
+        right_nb <- if (ci < n_cells)  cells[[ci + 1L]] else NULL
+        if (!is.null(left_nb)  && left_nb$end  > left_nb$start)  x_l <- x_l + gap_half
+        if (!is.null(right_nb) && right_nb$end > right_nb$start) x_r <- x_r - gap_half
+        grid::grid.lines(
+          x  = grid::unit(c(x_l / vp_w, x_r / vp_w), "npc"),
+          y  = grid::unit(c(y_rule_npc, y_rule_npc), "npc"),
+          gp = span_rule_gp
+        )
+      }
+    }
+    y <- y + row_h
+  }
+}
+
 # Draw a continuation-marker row
 .draw_cont_row <- function(msg, n_group_cols, n_disp_cols,
                             col_x_left, col_x_right,

R/table_pagelist.R

@@ -153,6 +153,20 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
   resolved_cols <- resolve_col_specs(tbl)
   n_group_cols  <- length(tbl$group_vars)
 
+  # Spanning (multi-row) column-header structure, computed once on the full
+  # column set.  Attaches each column's leaf (bottom-row) segment so width
+  # measurement uses only the leaf; the full span structure drives width
+  # adjustment, atomic pagination, and drawing.  Trivial (R == 1) when no
+  # label contains `col_header_sep`, in which case every downstream step is
+  # byte-identical to the single-row-header behaviour.
+  header_spans <- .compute_header_spans(
+    vapply(resolved_cols, function(cs) cs$label, character(1L)),
+    tbl$col_header_sep, n_group_cols
+  )
+  for (j in seq_along(resolved_cols)) {
+    resolved_cols[[j]]$leaf_label <- header_spans$leaf_labels[[j]]
+  }
+
   # --- Step 4-6: Compute column widths, measure row heights, paginate ---
   # Under col_split_strategy = "balanced", a row whose wrapped height exceeds
   # the available page content height triggers a retry: the bottleneck
@@ -202,12 +216,17 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
     grid::pushViewport(rh_outer_vp)
     on.exit(grid::popViewport(), add = TRUE)
 
-    header_row_h <- if (tbl$show_col_names) {
-      .measure_header_row_height(resolved_cols, tbl$gp, tbl$cell_padding,
-                                 tbl$line_height, breaks = breaks,
-                                 wrap_extra_pad_in = wrap_extra_pad_in,
-                                 cache = text_dim_cache)
-    } else 0
+    # Multi-row / spanning header block.  $total drives pagination; the
+    # per-row heights are cached for drawing so measure and draw agree.
+    header_block <- if (tbl$show_col_names) {
+      .measure_header_block(resolved_cols, header_spans, tbl$gp,
+                            tbl$cell_padding, tbl$line_height, breaks = breaks,
+                            wrap_extra_pad_in = wrap_extra_pad_in,
+                            cache = text_dim_cache)
+    } else {
+      list(row_heights = numeric(0L), total = 0)
+    }
+    header_row_h <- header_block$total
 
     cell_h_mat <- measure_row_heights_tbl(
       tbl$data, resolved_cols, tbl$gp, tbl$cell_padding,
@@ -236,9 +255,10 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
     }
     pr_res <- do.call(paginate_rows, pr_args)
     list(
-      pr_res     = pr_res,
-      cell_h_mat = cell_h_mat,
-      cont_row_h = cont_row_h
+      pr_res       = pr_res,
+      cell_h_mat   = cell_h_mat,
+      cont_row_h   = cont_row_h,
+      header_block = header_block
     )
   }
 
@@ -247,6 +267,7 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
       resolved_cols_0, tbl$data, cw, tbl, pg_width, pg_height, margins,
       overflow_action = overflow_action,
       floor_overrides = floor_overrides,
+      spans           = header_spans,
       cache           = text_dim_cache
     )
     resolved_cols <- col_result$resolved_cols
@@ -270,6 +291,7 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
         overflow_action   = overflow_action,
         validate_overflow = FALSE,
         floor_overrides   = floor_overrides,
+        spans             = header_spans,
         cache             = text_dim_cache
       )
       resolved_cols <- col_result$resolved_cols
@@ -280,9 +302,10 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
     if (use_retry_loop && retries < max_retries) {
       iter_res <- .run_pagination_iter(resolved_cols, collect_overflows = TRUE)
       if (length(iter_res$pr_res$overflows) == 0L) {
-        row_pages  <- iter_res$pr_res$pages
-        cell_h_mat <- iter_res$cell_h_mat
-        cont_row_h <- iter_res$cont_row_h
+        row_pages    <- iter_res$pr_res$pages
+        cell_h_mat   <- iter_res$cell_h_mat
+        cont_row_h   <- iter_res$cont_row_h
+        header_block <- iter_res$header_block
         break
       }
       # Raise the bottleneck column's floor for the next retry.
@@ -305,9 +328,10 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
       # No retries left (or wrap_first mode): make the final call with the
       # user's overflow_action so error/warn fires through the normal path.
       iter_res <- .run_pagination_iter(resolved_cols, collect_overflows = FALSE)
-      row_pages  <- iter_res$pr_res
-      cell_h_mat <- iter_res$cell_h_mat
-      cont_row_h <- iter_res$cont_row_h
+      row_pages    <- iter_res$pr_res
+      cell_h_mat   <- iter_res$cell_h_mat
+      cont_row_h   <- iter_res$cont_row_h
+      header_block <- iter_res$header_block
       break
     }
   }
@@ -339,7 +363,9 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
         cont_row_h_in        = cont_row_h,
         is_first_col_page    = (cg == 1L),
         is_last_col_page     = (cg == n_cg),
-        clip_width_caches    = clip_width_caches
+        clip_width_caches    = clip_width_caches,
+        header_spans         = header_spans,
+        header_block         = header_block
       )
       page_spec <- list(content = grob)
       pages[[idx]] <- page_spec

R/table_rows.R

@@ -5,6 +5,20 @@
 #   .compute_page_row_heights()  — resolve per-row heights with group spanning
 #   paginate_rows()              — split rows into pages (span-aware)
 
+# ---------------------------------------------------------------------------
+# .span_deficit() — shared span-extent kernel
+# ---------------------------------------------------------------------------
+
+# The amount by which a span's `required` extent exceeds the summed extent of
+# its members, or 0 when the members already cover it (within `eps`).  Shared
+# by the row-span height logic (below, deficit applied to the span-start row)
+# and the column-span width logic in R/table_columns.R (deficit distributed
+# across members).
+.span_deficit <- function(members, required, eps = 1e-6) {
+  d <- required - sum(members)
+  if (d > eps) d else 0
+}
+
 # ---------------------------------------------------------------------------
 # measure_row_heights_tbl() — per-cell height matrix
 # ---------------------------------------------------------------------------
@@ -185,10 +199,11 @@ measure_row_heights_tbl <- function(data, resolved_cols, gp_tbl, cell_padding,
       ri_start <- starts[[s_idx]]
       ri_end   <- ends[[s_idx]]
       label_h  <- cell_h_mat[page_rows[[ri_start]], j_mat]
-      avail    <- sum(row_h[ri_start:ri_end])
-      if (label_h > avail + 1e-9) {
-        row_h[[ri_start]] <- row_h[[ri_start]] + (label_h - avail)
-      }
+      # Deficit (label taller than the summed span rows) grows only the
+      # span-start row, so a multi-line label flows downward into the
+      # suppressed cells.  eps kept at 1e-9 to preserve prior heights.
+      deficit  <- .span_deficit(row_h[ri_start:ri_end], label_h, eps = 1e-9)
+      row_h[[ri_start]] <- row_h[[ri_start]] + deficit
     }
   }
   row_h