Fast-path cell drawing + position-based tokenizer

CLAUDE.md

@@ -263,18 +263,39 @@ draw_content <- function(content, vp, gp = gpar(), content_just = "left") {
 same `match.arg(., c("left", "right", "centre"))` pattern as `caption_just` /
 `footnote_just` and supports per-page override via `x$content_just`.
 
-### Device lifecycle
+### Device lifecycle (D-48)
+
+Every `export_tfl()` call opens exactly **one** PDF device, which covers
+both pagination measurements and (in normal mode) the per-page draw loop.
 
 ```r
-export_tfl <- function(...) {
-  # validate first, before opening device
-  pdf(file, width = pg_width, height = pg_height)
-  on.exit(dev.off(), add = TRUE)
-  # loop
+export_tfl.<method> <- function(x, file, pg_width, pg_height,
+                                 page_num, preview, ...) {
+  .validate_export_args(page_num, preview, file)
+
+  # Normal mode: pdf(file).   Preview mode: pdf(NULL).
+  md <- .open_metric_device(file, pg_width, pg_height, preview)
+  # on.exit(dev.off()) is registered on THIS frame by .open_metric_device(),
+  # so the device closes cleanly even on mid-pagination error.
+
+  # ... call *_to_pagelist() with a `text_dim_cache` env that
+  #     pagination populates and (in normal mode) drawing reuses ...
+
+  # Preview: close the transient pdf(NULL) so user's device is active.
+  if (!isFALSE(preview)) .close_metric_device(md)
+
+  # Drawing phase.  Reuses the same device in normal mode.
+  .export_tfl_pages(..., pdf_already_open = TRUE)
 }
 ```
 
-`on.exit(dev.off(), add = TRUE)` ensures the device closes even if a page errors.
+Internal measurement helpers (`compute_table_content_area`,
+`.resolve_natural_widths`, `.run_pagination_iter`,
+`.compute_col_min_widths`, `.compute_wrapped_widths`,
+`.height_balance_widths`, `.gt_grob_height`, `.rtables_lpp_cpp`) **require**
+an active device; a safety guard inside `.measure_text_dims_in()`
+(`dev.cur() == 1L` → `rlang::abort()`) catches regressions that violate
+this.
 
 ### Return value
 

DESCRIPTION

@@ -17,7 +17,6 @@ License: AGPL-3
 Encoding: UTF-8
 Depends: R (>= 4.1.0)
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.3
 Imports:
     checkmate,
     dplyr,
@@ -42,3 +41,4 @@ Suggests:
 VignetteBuilder: knitr
 Config/testthat/edition: 3
 URL: https://humanpred.github.io/writetfl/
+Config/roxygen2/version: 8.0.0

R/export_tfl.R

@@ -140,8 +140,11 @@ export_tfl.default <- function(
 ) {
   dots <- list(...)
   .validate_export_args(page_num, preview, file)
+  md <- .open_metric_device(file, pg_width, pg_height, preview)
   x <- coerce_x_to_pagelist(x)
-  .export_tfl_pages(x, file, pg_width, pg_height, page_num, preview, dots)
+  if (!isFALSE(preview)) .close_metric_device(md)
+  .export_tfl_pages(x, file, pg_width, pg_height, page_num, preview, dots,
+                    pdf_already_open = TRUE)
 }
 
 #' @export
@@ -156,9 +159,46 @@ export_tfl.tfl_table <- function(
 ) {
   dots <- list(...)
   .validate_export_args(page_num, preview, file)
+
+  # Open the metric device BEFORE pagination so measurement runs on the
+  # same device the drawing phase will use (normal mode) or a transient
+  # pdf(NULL) with matching settings (preview mode).  The helper
+  # registers on.exit on THIS frame, so a mid-pagination or mid-drawing
+  # error still closes the device cleanly.
+  md <- .open_metric_device(file, pg_width, pg_height, preview)
+
+  # Cross-phase text-dimension cache.  Pagination populates it with
+  # (width, height) per (gp_key, string).  In PDF mode (preview = FALSE),
+  # pagination and drawing share `md$dev`, so cached values are
+  # authoritative for the render pass without re-measurement.  In preview
+  # mode, the user's render device differs from `md$dev`, so drawing
+  # gets a fresh empty cache and falls back to per-cell measurement --
+  # preserving today's preview behaviour exactly.
+  pagination_cache <- new.env(hash = TRUE, parent = emptyenv())
   x <- tfl_table_to_pagelist(x, pg_width = pg_width, pg_height = pg_height,
-                              dots = dots, page_num = page_num)
-  .export_tfl_pages(x, file, pg_width, pg_height, page_num, preview, dots)
+                              dots = dots, page_num = page_num,
+                              text_dim_cache = pagination_cache)
+
+  drawing_cache <- if (isFALSE(preview)) pagination_cache else
+    new.env(hash = TRUE, parent = emptyenv())
+
+  # Attach the drawing cache to every tfl_table grob in the pagelist so
+  # drawDetails can reach it.  Loops are O(n_pages); each assignment is
+  # a reference copy, not a data copy.
+  for (i in seq_along(x)) {
+    if (inherits(x[[i]]$content, "tfl_table_grob")) {
+      x[[i]]$content$text_dim_cache <- drawing_cache
+    }
+  }
+
+  # Preview mode: close the transient pagination device so the user's
+  # device is active for drawing.  The on.exit guard installed by
+  # `.open_metric_device()` will see this device already closed (via
+  # `.close_metric_device`'s idempotency check) and no-op.
+  if (!isFALSE(preview)) .close_metric_device(md)
+
+  .export_tfl_pages(x, file, pg_width, pg_height, page_num, preview, dots,
+                    pdf_already_open = TRUE)
 }
 
 #' @export
@@ -174,6 +214,8 @@ export_tfl.list <- function(
   dots <- list(...)
   .validate_export_args(page_num, preview, file)
 
+  md <- .open_metric_device(file, pg_width, pg_height, preview)
+
   # Check if this is a list of gt_tbl objects
   all_gt <- length(x) > 0L &&
     all(vapply(x, inherits, logical(1L), "gt_tbl"))
@@ -215,7 +257,9 @@ export_tfl.list <- function(
       }
     }
   }
-  .export_tfl_pages(pages, file, pg_width, pg_height, page_num, preview, dots)
+  if (!isFALSE(preview)) .close_metric_device(md)
+  .export_tfl_pages(pages, file, pg_width, pg_height, page_num, preview, dots,
+                    pdf_already_open = TRUE)
 }
 
 
@@ -234,9 +278,78 @@ export_tfl.list <- function(
   invisible(NULL)
 }
 
-# Render a list of page specs to PDF or the current device
+# Open the metric device for an export_tfl() call.  D-48 establishes
+# that one device covers both pagination measurements and (in normal
+# mode) drawing, rather than each measurement helper opening its own
+# scratch device.
+#
+# Normal mode (`isFALSE(preview)`): opens `grDevices::pdf(file)` -- the
+# final output PDF.  Pagination uses it for `convertWidth` / `grobWidth`
+# resolution; subsequent drawing reuses the same device.
+#
+# Preview mode: opens a transient `grDevices::pdf(NULL)` so pagination
+# uses identical PDF font metrics to normal mode (preserving today's
+# pagination decisions).  The caller is responsible for invoking
+# `.close_metric_device()` AFTER pagination so the user's pre-existing
+# device becomes active again for drawing.
+#
+# Safety:
+# * The helper registers an `on.exit()` handler on the CALLER's frame
+#   (`envir`) so any error during pagination or drawing still closes
+#   the device.  Without that, an interrupted run would leak the
+#   device; running export_tfl() again would then open another and
+#   eventually exhaust the per-session limit of 64.
+# * `.close_metric_device()` is idempotent: calling it explicitly in
+#   preview mode and then letting `on.exit` run is harmless because
+#   the second call sees a different `dev.cur()` and no-ops.
+#
+# @keywords internal
+.open_metric_device <- function(file, pg_width, pg_height, preview,
+                                 envir = parent.frame()) {
+  if (isFALSE(preview)) {
+    grDevices::pdf(file, width = pg_width, height = pg_height)
+  } else {
+    grDevices::pdf(NULL, width = pg_width, height = pg_height)
+  }
+  dev <- grDevices::dev.cur()
+  md  <- list(dev = dev)
+  # Register on.exit on the caller's frame so the device closes even
+  # if the caller errors out mid-execution.  bquote inlines `dev` so
+  # the on.exit body does not need to reach back to `md`.
+  do.call("on.exit",
+          list(bquote({
+            if (grDevices::dev.cur() == .(dev)) grDevices::dev.off()
+          }), add = TRUE),
+          envir = envir)
+  md
+}
+
+# Close a metric device opened by `.open_metric_device()`.
+#
+# Idempotent: a second call (or a call when the device has already been
+# closed by something else) is a no-op.  Idempotency matters because
+# preview-mode callers close explicitly after pagination AND register
+# the same close via the helper's `on.exit` handler.
+#
+# @keywords internal
+.close_metric_device <- function(md) {
+  if (!is.null(md$dev) && grDevices::dev.cur() == md$dev) {
+    grDevices::dev.off()
+  }
+  invisible(NULL)
+}
+
+# Render a list of page specs to PDF or the current device.
+#
+# `pdf_already_open` signals that the CALLER has already opened the
+# render device (via `.open_metric_device()`) and owns its lifecycle.
+# In that case this function skips its own `pdf()` open / on.exit
+# close and just iterates pages.  When the caller does not pass the
+# flag (e.g. `export_tfl.default()` for ggplot pages), the legacy
+# self-open path is preserved.
 .export_tfl_pages <- function(pages, file, pg_width, pg_height,
-                               page_num, preview, dots) {
+                               page_num, preview, dots,
+                               pdf_already_open = FALSE) {
   n <- length(pages)
 
   # ------------------------------------------------------------------
@@ -263,8 +376,10 @@ export_tfl.list <- function(
   # ------------------------------------------------------------------
   # Normal mode: write PDF
   # ------------------------------------------------------------------
-  grDevices::pdf(file, width = pg_width, height = pg_height)
-  on.exit(grDevices::dev.off(), add = TRUE)
+  if (!pdf_already_open) {
+    grDevices::pdf(file, width = pg_width, height = pg_height)
+    on.exit(grDevices::dev.off(), add = TRUE)
+  }
 
   for (i in seq_along(pages)) {
     page_args <- build_page_args(pages[[i]], dots, page_num, i, n)

R/flextable.R

@@ -25,8 +25,11 @@ export_tfl.flextable <- function(
   rlang::check_installed("flextable", reason = "to export flextable tables")
   dots <- list(...)
   .validate_export_args(page_num, preview, file)
+  md <- .open_metric_device(file, pg_width, pg_height, preview)
   pages <- flextable_to_pagelist(x, pg_width, pg_height, dots, page_num)
-  .export_tfl_pages(pages, file, pg_width, pg_height, page_num, preview, dots)
+  if (!isFALSE(preview)) .close_metric_device(md)
+  .export_tfl_pages(pages, file, pg_width, pg_height, page_num, preview, dots,
+                    pdf_already_open = TRUE)
 }
 
 #' Convert a flextable object to a list of page specification lists

R/ggtibble.R

@@ -20,10 +20,13 @@ export_tfl.ggtibble <- function(
 ) {
   dots <- list(...)
   .validate_export_args(page_num, preview, file)
+  md <- .open_metric_device(file, pg_width, pg_height, preview)
   x <- ggtibble_to_pagelist(x, sub_tfl = sub_tfl, sub_tfl_sep = sub_tfl_sep,
                             sub_tfl_collapse = sub_tfl_collapse,
                             sub_tfl_prefix = sub_tfl_prefix)
-  .export_tfl_pages(x, file, pg_width, pg_height, page_num, preview, dots)
+  if (!isFALSE(preview)) .close_metric_device(md)
+  .export_tfl_pages(x, file, pg_width, pg_height, page_num, preview, dots,
+                    pdf_already_open = TRUE)
 }
 
 # Page-spec arg names recognised on a ggtibble row.

R/gt.R

@@ -24,8 +24,11 @@ export_tfl.gt_tbl <- function(
   rlang::check_installed("gt", reason = "to export gt tables")
   dots <- list(...)
   .validate_export_args(page_num, preview, file)
+  md <- .open_metric_device(file, pg_width, pg_height, preview)
   pages <- gt_to_pagelist(x, pg_width, pg_height, dots, page_num)
-  .export_tfl_pages(pages, file, pg_width, pg_height, page_num, preview, dots)
+  if (!isFALSE(preview)) .close_metric_device(md)
+  .export_tfl_pages(pages, file, pg_width, pg_height, page_num, preview, dots,
+                    pdf_already_open = TRUE)
 }
 
 #' Convert a gt_tbl object to a list of page specification lists
@@ -176,19 +179,20 @@ gt_to_pagelist <- function(gt_obj, pg_width = 11, pg_height = 8.5,
   dims$height
 }
 
-#' Measure a gt grob's height in a scratch device
+#' Measure a gt grob's height
+#'
+#' D-48: requires an active graphics device with matching page
+#' dimensions; `export_tfl.gt_tbl()` opens the metric device via
+#' `.open_metric_device()` before invoking the pagelist conversion
+#' pipeline, so `convertHeight()` here resolves against that device's
+#' font metrics.
 #'
 #' @param grob A gtable grob from [gt::as_gtable()].
-#' @param pg_width,pg_height Page dimensions for the scratch device.
+#' @param pg_width,pg_height Page dimensions (advisory; the active
+#'   metric device's dimensions are what `convertHeight` uses).
 #' @return Numeric scalar: grob height in inches.
 #' @keywords internal
 .gt_grob_height <- function(grob, pg_width, pg_height) {
-  scratch <- tempfile(fileext = ".pdf")
-  grDevices::pdf(scratch, width = pg_width, height = pg_height)
-  on.exit({
-    grDevices::dev.off()
-    unlink(scratch)
-  })
   grid::convertHeight(grid::grobHeight(grob), "inches", valueOnly = TRUE)
 }
 

R/rtables.R

@@ -22,8 +22,11 @@ export_tfl.VTableTree <- function(
   rlang::check_installed("rtables", reason = "to export rtables tables")
   dots <- list(...)
   .validate_export_args(page_num, preview, file)
+  md <- .open_metric_device(file, pg_width, pg_height, preview)
   pages <- rtables_to_pagelist(x, pg_width, pg_height, dots, page_num)
-  .export_tfl_pages(pages, file, pg_width, pg_height, page_num, preview, dots)
+  if (!isFALSE(preview)) .close_metric_device(md)
+  .export_tfl_pages(pages, file, pg_width, pg_height, page_num, preview, dots,
+                    pdf_already_open = TRUE)
 }
 
 #' Convert a VTableTree object to a list of page specification lists
@@ -207,19 +210,17 @@ rtables_to_pagelist <- function(rt_obj, pg_width = 11, pg_height = 8.5,
   line_h_in <- (font_size / 72) * lineheight
   lpp <- floor(content_h / line_h_in)
 
-  # Character width: measure "M" in the target font using a scratch device
-  scratch <- tempfile(fileext = ".pdf")
-  grDevices::pdf(scratch, width = 10, height = 10)
-  on.exit({
-    grDevices::dev.off()
-    unlink(scratch)
-  })
+  # Character width: measure "M" in the target font.  D-48: relies on
+  # the metric device opened upstream by `.open_metric_device()`
+  # rather than opening a scratch PDF here.  The viewport is pushed
+  # and popped on exit so an error mid-measurement does not leave the
+  # font-context viewport on the stack.
   grid::pushViewport(grid::viewport(
     gp = grid::gpar(fontfamily = font_family, fontsize = font_size)
   ))
+  on.exit(grid::popViewport(), add = TRUE)
   char_w_in <- grid::convertWidth(grid::stringWidth("M"), "inches",
                                   valueOnly = TRUE)
-  grid::popViewport()
 
   cpp <- floor(content_w / char_w_in)
 

R/table1.R

@@ -21,8 +21,11 @@ export_tfl.table1 <- function(
   rlang::check_installed("flextable", reason = "to export table1 tables")
   dots <- list(...)
   .validate_export_args(page_num, preview, file)
+  md <- .open_metric_device(file, pg_width, pg_height, preview)
   pages <- table1_to_pagelist(x, pg_width, pg_height, dots, page_num)
-  .export_tfl_pages(pages, file, pg_width, pg_height, page_num, preview, dots)
+  if (!isFALSE(preview)) .close_metric_device(md)
+  .export_tfl_pages(pages, file, pg_width, pg_height, page_num, preview, dots,
+                    pdf_already_open = TRUE)
 }
 
 #' Convert a table1 object to a list of page specification lists