Word wrapping

.Rbuildignore

@@ -2,6 +2,7 @@
 ^CLAUDE\.md$
 ^docs$
 ^design$
+^examples$
 ^build_docs\.R$
 ^.*\.pdf$
 ^\.github$

R/table_columns.R

@@ -3,8 +3,11 @@
 # Functions:
 #   resolve_col_specs()      — merge tfl_colspec + flat tfl_table() args per column
 #   compute_col_widths()     — auto-size, relative, fixed, wrap; returns widths + groups
-#   .apply_col_wrapping()    — iteratively narrow wrap-eligible columns to fit
 #   paginate_cols()          — split column indices into per-page groups
+#
+# The text-wrap narrowing pass that used to live here as .apply_col_wrapping()
+# now lives in R/wrap.R as .compute_wrapped_widths() so it can also be used
+# (and disabled) as a coherent module.
 
 # ---------------------------------------------------------------------------
 # resolve_col_specs() — merge tfl_colspec + flat args into unified list
@@ -38,14 +41,27 @@ resolve_col_specs <- function(tbl) {
     align <- spec$align %||% .nlookup(tbl$col_align, cn) %||%
       .default_align(tbl$data[[cn]])
 
-    # Wrap: tfl_colspec > wrap_cols flat arg
-    wrap <- if (!is.null(spec$wrap)) {
-      spec$wrap
+    # Wrap: tfl_colspec > wrap_cols flat arg.
+    # Result is logical of length 1: TRUE / FALSE / NA.  NA means "auto-detect
+    # based on whether the column contains a break character" and is resolved
+    # to TRUE / FALSE inside compute_col_widths() once the data and break spec
+    # are in scope.
+    spec_wrap <- spec$wrap
+    wrap <- if (!is.null(spec_wrap) && !is.na(spec_wrap)) {
+      as.logical(spec_wrap)
     } else {
       w <- tbl$wrap_cols
-      if (isTRUE(w)) !is_group_col  # TRUE = all data cols eligible
-      else if (isFALSE(w)) FALSE
-      else cn %in% w
+      if (identical(w, "auto")) {
+        if (is_group_col) FALSE else NA
+      } else if (isTRUE(w)) {
+        !is_group_col
+      } else if (isFALSE(w)) {
+        FALSE
+      } else if (is.character(w)) {
+        !is_group_col && cn %in% w
+      } else {
+        FALSE  # nocov - validated upstream
+      }
     }
 
     # gp: tfl_colspec$gp (group cols only, already validated at construction)
@@ -114,13 +130,22 @@ compute_col_widths <- function(resolved_cols, data, content_width_in,
     } else if (is.numeric(w) && !is.null(w)) {
       NA_real_  # relative weight — resolved in second pass
     } else {
-      # NULL / missing — auto-size from content
+      # NULL / missing - auto-size from content.  Header labels are rendered
+      # with the header_row gpar (typically bold) and cells with the cell
+      # gpar (regular); measuring a bold header with the regular-weight
+      # cell gpar undersizes the column and makes the rendered header bleed
+      # into the next column.  Measure each kind of text with its actual
+      # rendering gpar and take the larger of the two as the natural width.
       cell_gp <- .gp_with_lineheight(
         .resolve_table_cell_gp(tbl$gp, cs$is_group_col), tbl$line_height
       )
-      strings <- .collect_col_strings(data[[cs$col]], cs$label, na_str, max_rows)
-      w_max   <- .measure_max_string_width(strings, cell_gp)
-      max(min_in, w_max + h_pad_in)
+      hdr_gp <- .gp_with_lineheight(
+        .resolve_table_gp(tbl$gp, "header_row"), tbl$line_height
+      )
+      parts  <- .split_col_strings(data[[cs$col]], cs$label, na_str, max_rows)
+      w_data <- .measure_max_string_width(parts$data, cell_gp)
+      w_hdr  <- .measure_max_string_width(parts$header, hdr_gp)
+      max(min_in, max(w_data, w_hdr) + h_pad_in)
     }
   }, numeric(1L))
 
@@ -160,13 +185,44 @@ compute_col_widths <- function(resolved_cols, data, content_width_in,
     }, numeric(1L))
   }
 
+  # --- Resolve auto-detect wrap eligibility (cs$wrap == NA) ---
+  # The "auto" mode marks data columns as NA in resolve_col_specs(); we
+  # promote each NA to TRUE / FALSE here based on whether the column actually
+  # contains a break character.  Skipping a column with no breakable text
+  # avoids wasting a wrap pass on numeric / single-token columns where it
+  # could not narrow the width anyway.
+  breaks <- tbl$wrap_breaks %||% wrap_breaks_default()
+  for (j in seq_len(n_cols)) {
+    cs_j <- resolved_cols[[j]]
+    if (is.logical(cs_j$wrap) && length(cs_j$wrap) == 1L && is.na(cs_j$wrap)) {
+      strings <- .collect_col_strings(data[[cs_j$col]], cs_j$label,
+                                      na_str, max_rows)
+      resolved_cols[[j]]$wrap <- .column_has_breakable_text(strings, breaks)
+    }
+  }
+
   # --- Attempt word-wrap if total exceeds content width ---
   total_w <- sum(widths_in)
 
   if (total_w > content_width_in + 1e-6) {
-    widths_in <- .apply_col_wrapping(
+    widths_in <- .compute_wrapped_widths(
       widths_in, resolved_cols, data, tbl, content_width_in,
-      min_in, h_pad_in, na_str, max_rows, pg_width, pg_height, margins
+      h_pad_in, min_in, pg_width, pg_height, margins
+    )
+    total_w <- sum(widths_in)
+  }
+
+  # --- Optional height-balance pass (opt-in via wrap_balance = "height") ---
+  # Runs unconditionally when opted in; the algorithm itself is a no-op if
+  # there is no improvement available.  Falls back silently to the input
+  # widths on any error or invariant violation, so opting in cannot worsen
+  # the result.
+  if (identical(tbl$wrap_balance, "height")) {
+    widths_in <- .height_balance_widths(
+      widths_in, resolved_cols, data, tbl,
+      h_pad_in = h_pad_in, na_str = na_str, max_rows = max_rows,
+      breaks = breaks, pg_width = pg_width, pg_height = pg_height,
+      margins = margins
     )
     total_w <- sum(widths_in)
   }
@@ -273,55 +329,6 @@ compute_col_widths <- function(resolved_cols, data, content_width_in,
        col_cont_label_half_w    = col_cont_label_half_w)
 }
 
-# ---------------------------------------------------------------------------
-# .apply_col_wrapping()
-# ---------------------------------------------------------------------------
-
-#' Iteratively narrow wrap-eligible columns until total fits or all at min
-#' @keywords internal
-.apply_col_wrapping <- function(widths_in, resolved_cols, data, tbl,
-                                content_width_in, min_in, h_pad_in,
-                                na_str, max_rows, pg_width, pg_height, margins) {
-  n <- length(widths_in)
-  wrap_eligible <- vapply(resolved_cols, `[[`, logical(1L), "wrap")
-
-  if (!any(wrap_eligible)) return(widths_in)
-
-  scratch_file <- tempfile(fileext = ".pdf")
-  grDevices::pdf(scratch_file, width = pg_width, height = pg_height)
-  outer_vp <- .make_outer_vp(margins)
-  grid::pushViewport(outer_vp)
-  on.exit({
-    grid::popViewport()
-    grDevices::dev.off()
-    unlink(scratch_file)
-  }, add = TRUE)
-
-  # Repeat reduction passes until fits or no more room
-  for (pass in seq_len(100L)) {
-    total <- sum(widths_in)
-    if (total <= content_width_in + 1e-6) break
-
-    excess  <- total - content_width_in
-    # Find widest eligible column that is still above min
-    eligible_above_min <- which(wrap_eligible & widths_in > min_in + 1e-6)
-    if (length(eligible_above_min) == 0L) break
-
-    target_j <- eligible_above_min[which.max(widths_in[eligible_above_min])]
-
-    # Try wrapping text in that column to a narrower target
-    new_w <- max(min_in, widths_in[target_j] - excess)
-    # Re-measure: what is the minimum content width needed after wrapping?
-    cs      <- resolved_cols[[target_j]]
-    cell_gp <- .resolve_table_cell_gp(tbl$gp, cs$is_group_col)
-    strings <- .collect_col_strings(data[[cs$col]], cs$label, na_str, max_rows)
-    # Use new_w as the wrap target: accept it (word-wrap will reflow at draw time)
-    widths_in[target_j] <- new_w
-  }
-
-  widths_in
-}
-
 # ---------------------------------------------------------------------------
 # paginate_cols() — split data column indices into groups
 # ---------------------------------------------------------------------------

R/table_draw.R

@@ -132,6 +132,10 @@ drawDetails.tfl_table_grob <- function(x, recording) {
   na_str   <- tbl$na_string
   gp_tbl   <- tbl$gp
   v_pad_in <- v_top_in + v_bot_in
+  breaks   <- tbl$wrap_breaks %||% wrap_breaks_default()
+  wrap_extra_pad_in <- if (!is.null(tbl$wrap_extra_padding)) {
+    .height_in(tbl$wrap_extra_padding)
+  } else 0
 
   # Use cached heights from the pagination phase (ensures layout consistency).
   # Fall back to re-measurement only when cache is absent.
@@ -140,16 +144,11 @@ drawDetails.tfl_table_grob <- function(x, recording) {
 
   lh <- tbl$line_height %||% 1.05   # defensive fallback for old grob objects
 
-  # Header row height
+  # 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) {
-    hdr_gp <- .gp_with_lineheight(.resolve_table_gp(gp_tbl, "header_row"), lh)
-    max(vapply(page_cols, function(cs) {
-      nlines <- max(1L, length(strsplit(cs$label, "\n", fixed = TRUE)[[1L]]))
-      grob   <- grid::textGrob(cs$label, gp = hdr_gp)
-      h1     <- .height_in(grid::grobHeight(grob))
-      h2     <- nlines * .height_in(grid::stringHeight("M"))
-      max(h1, h2)
-    }, numeric(1L))) + v_pad_in
+    .measure_header_row_height(page_cols, gp_tbl, cp, lh, breaks = breaks,
+                               wrap_extra_pad_in = wrap_extra_pad_in)
   } else 0
 
   # Continuation row height — prefer cached value
@@ -198,14 +197,15 @@ drawDetails.tfl_table_grob <- function(x, recording) {
       )
       for (ri in seq_len(n_rows)) {
         s      <- .fmt_cell(data[[cs$col]][rows[[ri]]], na_str)
-        disp_s <- if (cs$wrap && !is.null(cs$width_in)) {
-          .wrap_text(s, cs$width_in - h_lft_in - h_rgt_in, gp_c)
+        disp_s <- if (isTRUE(cs$wrap) && !is.null(cs$width_in)) {
+          .wrap_string(s, cs$width_in - h_lft_in - h_rgt_in, gp_c, breaks)
         } else s
         nlines <- max(1L, length(strsplit(disp_s, "\n", fixed = TRUE)[[1L]]))
         grob   <- grid::textGrob(disp_s, gp = gp_c)
         h1     <- .height_in(grid::grobHeight(grob))
         h2     <- nlines * .height_in(grid::stringHeight("M"))
-        fallback_mat[ri, j] <- max(h1, h2) + v_pad_in
+        extra  <- if (nlines > 1L) wrap_extra_pad_in else 0
+        fallback_mat[ri, j] <- max(h1, h2) + v_pad_in + extra
       }
     }
     .compute_page_row_heights(
@@ -260,7 +260,8 @@ drawDetails.tfl_table_grob <- function(x, recording) {
     }
     .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)
+                     h_lft_in, h_rgt_in, v_top_in, gp_tbl, lh,
+                     breaks = breaks)
     y_cursor <- y_cursor + header_row_h
 
     # Column header rule — spans table width only
@@ -361,9 +362,13 @@ drawDetails.tfl_table_grob <- function(x, recording) {
       # Resolve cell gpar (with lineheight applied)
       cell_gp <- .gp_with_lineheight(.resolve_table_cell_gp(gp_tbl, cs$is_group_col), lh)
 
-      # For wrap-eligible columns, apply word-wrapping before drawing
-      display_str <- if (cs$wrap && nzchar(cell_str) && !is.null(cs$width_in)) {
-        .wrap_text(cell_str, cs$width_in - h_lft_in - h_rgt_in, cell_gp)
+      # For wrap-eligible columns, apply word-wrapping before drawing using
+      # the table's wrap_breaks spec (which may include keep_before chars
+      # like "-").
+      display_str <- if (isTRUE(cs$wrap) && nzchar(cell_str) &&
+                         !is.null(cs$width_in)) {
+        .wrap_string(cell_str, cs$width_in - h_lft_in - h_rgt_in,
+                     cell_gp, breaks)
       } else {
         cell_str
       }
@@ -470,14 +475,25 @@ drawDetails.tfl_table_grob <- function(x, recording) {
 # Drawing helpers
 # ---------------------------------------------------------------------------
 
-# Draw the column header row
+# Draw the column header row.
+#
+# When `breaks` is non-NULL and a column is wrap-eligible (`cs$wrap == TRUE`)
+# with a resolved width, the label is auto-wrapped to fit the column before
+# drawing, so a long header in a narrow column reflows onto multiple lines
+# rather than overflowing.
 .draw_header_row <- function(page_cols, col_x_left, col_x_right, col_widths_in,
                               y_top_in, row_h, vp_w, vp_h,
-                              h_lft_in, h_rgt_in, v_top_in, gp_tbl, lh) {
+                              h_lft_in, h_rgt_in, v_top_in, gp_tbl, lh,
+                              breaks = NULL) {
   hdr_gp <- .gp_with_lineheight(.resolve_table_gp(gp_tbl, "header_row"), lh)
   for (j in seq_along(page_cols)) {
-    cs <- page_cols[[j]]
-    .draw_cell_text(cs$label, "centre",
+    cs    <- page_cols[[j]]
+    label <- cs$label
+    if (!is.null(breaks) && isTRUE(cs$wrap) && !is.null(cs$width_in)) {
+      label <- .wrap_label_for_width(label, cs$width_in,
+                                      h_lft_in + h_rgt_in, hdr_gp, breaks)
+    }
+    .draw_cell_text(label, "centre",
                     col_x_left[[j]], col_x_right[[j]],
                     y_top_in, row_h, vp_w, vp_h,
                     h_lft_in, h_rgt_in, v_top_in,
@@ -534,14 +550,25 @@ drawDetails.tfl_table_grob <- function(x, recording) {
     just  <- c("centre", "top")
   }
 
-  # Re-measure text width in the current (rendering) device and use the wider
-
-  # of the cached column width and the measured text width.  This prevents
-  # clipping when font metrics differ between the PDF scratch device used for
-  # column-width measurement and the device used for actual rendering (e.g.
-  # a PNG device in knitr/RStudio preview mode).
-  text_w <- .width_in(grid::stringWidth(text))
-  clip_w <- max(col_width_in, text_w + h_lft_in + h_rgt_in)
+  # Re-measure text width in the current (rendering) device using the
+  # actual rendering gpar (grid::stringWidth() picks up only the active
+  # viewport's gp, which is wrong when `gp` is, e.g., a bold header
+  # gpar and the active vp is regular weight).  This corrects font-metric
+  # variance between the PDF scratch device used for column-width
+  # measurement and the device used for actual rendering (e.g. a PNG
+  # device in knitr / RStudio preview mode).
+  #
+  # Important: cap the clip width at a small tolerance past `col_width_in`
+  # so a column that is genuinely too narrow for its content (user set a
+  # fixed width below the longest unbreakable token, or a bold header
+  # whose measured width exceeded the regular-weight column-width pass)
+  # cannot bleed text into the neighboring column and hide its content.
+  # Anything past the tolerance gets visually clipped at the column edge,
+  # which is a far less destructive failure mode than overlap.
+  text_w <- .width_in(grid::grobWidth(grid::textGrob(text, gp = gp)))
+  needed <- text_w + h_lft_in + h_rgt_in
+  bleed_tol_in <- 0.05
+  clip_w <- min(col_width_in + bleed_tol_in, max(col_width_in, needed))
 
   # Clip to column width by using a clipping viewport
   vp_clip <- grid::viewport(

R/table_pagelist.R

@@ -182,14 +182,22 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
     unlink(scratch_file_rh)
   }, add = TRUE)
 
+  breaks <- tbl$wrap_breaks %||% wrap_breaks_default()
+  wrap_extra_pad_in <- if (!is.null(tbl$wrap_extra_padding)) {
+    .height_in(tbl$wrap_extra_padding)
+  } else 0
+
   header_row_h <- if (tbl$show_col_names) {
     .measure_header_row_height(resolved_cols, tbl$gp, tbl$cell_padding,
-                               tbl$line_height)
+                               tbl$line_height, breaks = breaks,
+                               wrap_extra_pad_in = wrap_extra_pad_in)
   } else 0
 
   cell_h_mat <- measure_row_heights_tbl(
     tbl$data, resolved_cols, tbl$gp, tbl$cell_padding,
-    tbl$na_string, tbl$line_height, tbl$max_measure_rows
+    tbl$na_string, tbl$line_height, tbl$max_measure_rows,
+    breaks = breaks,
+    wrap_extra_pad_in = wrap_extra_pad_in
   )
 
   # cont_row_h: height of a (continued) row — measure the cont message text
@@ -209,7 +217,8 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
     tbl$data, cell_h_mat, resolved_cols, tbl$group_vars,
     cont_row_h, header_row_h, ch,
     tbl$row_cont_msg, tbl$group_rule,
-    suppress_repeated_groups = isTRUE(tbl$suppress_repeated_groups)
+    suppress_repeated_groups = isTRUE(tbl$suppress_repeated_groups),
+    overflow_action          = overflow_action
   )
 
   # --- Step 7: Assemble page specs ---