Support pagination of lists of rtables/rlistings objects

NEWS.md

@@ -10,6 +10,7 @@
  * Fixed mismatch between pagination and exports regarding the value assigned to parameter `max_width`. Introduced general handler `.handle_max_width` for pagination, exports, and `toString`.
  * Fixed bug in `format_value` causing a warning for vectors containing both NA and non-NA values.
  * Fixed issue with `var_label` assignment that needed to be of non-named strings.
+ * Updated `export_as_txt` to allow lists of tables/listings as input. This enables listing pagination with pages by parameter.
 
 ## formatters 0.5.5
  * Applied `styler` and resolved package lint. Changed default indentation from 4 spaces to 2.

R/mpf_exporters.R

@@ -62,6 +62,13 @@ export_as_txt <- function(x,
                           verbose = FALSE,
                           page_break = "\\s\\n",
                           page_num = default_page_number()) {
+  # Processing lists of tables or listings
+  if (.is_list_of_tables_or_listings(x)) {
+    if (isFALSE(paginate)) {
+      warning("paginate is FALSE, but x is a list of tables or listings, so paginate will be set to TRUE")
+    }
+    paginate <- TRUE
+  }
 
   if (paginate) {
     pages <- paginate_to_mpfs(
@@ -101,7 +108,7 @@ export_as_txt <- function(x,
     )
   }
 
-  ## we dont' set widths here because we already but that info on mpf
+  ## we don't set widths here because we already put that info in mpf
   ## so its on each of the pages.
   strings <- vapply(
     pages, toString, "",
@@ -118,7 +125,17 @@ export_as_txt <- function(x,
   }
 }
 
+.is_list_of_tables_or_listings <- function(a_list) {
+  obj_are_tables_or_listings <- all(
+    sapply(a_list, function(list_i) {
+      is(list_i, "listing_df") || is(list_i, "VTableTree")
+    })
+  )
+
+  all_matrix_forms <- all(sapply(a_list, is, class2 = "MatrixPrintForm"))
 
+  is(a_list, "list") && (obj_are_tables_or_listings || all_matrix_forms)
+}
 
 ##     ## TODO this needs to be in terms of a MPF, so ncol(tt) needs to change
 
@@ -543,16 +560,33 @@ export_as_pdf <- function(x,
                           cpp = NULL,
                           hsep = "-",
                           indent_size = 2,
+                          rep_cols = num_rep_cols(x),
                           tf_wrap = TRUE,
                           max_width = NULL,
-                          colwidths = propose_column_widths(x)) {
+                          colwidths = NULL) {
   stopifnot(tools::file_ext(file) != ".pdf")
-  if (!is.null(colwidths) && length(colwidths) != ncol(x) + 1) {
-    stop(
-      "non-null colwidths argument must have length ncol(x) + 1 [",
-      ncol(x) + 1, "], got length ", length(colwidths)
-    )
+
+  # Processing lists of tables or listings
+  if (.is_list_of_tables_or_listings(x)) {
+    if (isFALSE(paginate)) {
+      warning("paginate is FALSE, but x is a list of tables or listings, so paginate will be set to TRUE")
+    }
+    paginate <- TRUE
+
+
+  } else if (is.null(colwidths)) {
+    colwidths <- propose_column_widths(x)
+    ncol_x <- ncol(x)
+
+    # This check will be done inside paginate_to_mpfs in case of lists
+    if (!is.null(colwidths) && length(colwidths) != ncol_x + 1) {
+      stop(
+        "non-null colwidths argument must have length ncol(x) + 1 [",
+        ncol_x + 1, "], got length ", length(colwidths)
+      )
+    }
   }
+
   gp_plot <- grid::gpar(fontsize = font_size, fontfamily = font_family)
 
   if (!is.null(height)) {
@@ -604,7 +638,7 @@ export_as_pdf <- function(x,
       max_width = max_width,
       indent_size = indent_size,
       verbose = FALSE,
-      rep_cols = num_rep_cols(x),
+      rep_cols = rep_cols,
       page_num = page_num
     )
   } else {

R/pagination.R

@@ -1076,6 +1076,41 @@
                              rep_cols = num_rep_cols(obj),
                              col_gap = 2,
                              verbose = FALSE) {
+  if (isTRUE(page_num)) {
+    page_num <- "page {i}/{n}"
+  }
+  checkmate::assert_string(page_num, null.ok = TRUE)
+
+  # We can return a list of paginated tables and listings
+  if (.is_list_of_tables_or_listings(obj)) {
+    cur_call <- match.call(expand.dots = FALSE)
+    # if (!"rep_cols" %in% names(cur_call)) cur_call[["rep_cols"]] <- max(sapply(x, num_rep_cols))
+    mpfs <- unlist(
+      lapply(obj, function(obj_i) {
+        cur_call[["obj"]] <- obj_i
+        eval(cur_call)
+      }),
+      recursive = FALSE
+    )
+
+    if (!is.null(page_num)) {
+      extracted_cpp <- max(
+        sapply(mpfs, function(mpf) {
+          pf <- prov_footer(mpf)
+          nchar(pf[length(pf)])
+        })
+      )
+      mpfs <- .modify_footer_for_page_numbers(mpfs, page_num, extracted_cpp)
+    }
+
+    return(mpfs)
+  }
+
+  if (!is.null(page_num)) {
+    # Only adding a line for pagination -> lpp - 1 would have worked too
+    prov_footer(obj) <- c(prov_footer(obj), page_num)
+  }
+
   mpf <- matrix_form(obj, TRUE, TRUE, indent_size = indent_size)
 
   # Turning off min_siblings for listings
@@ -1092,18 +1127,6 @@
     mpf <- mpf_infer_cinfo(mpf, colwidths, rep_cols)
   }
 
-  # Page numbers
-  if (isTRUE(page_num)) {
-    page_num <- "page {i}/{n}"
-  }
-  checkmate::assert_string(page_num, null.ok = TRUE)
-
-  if (!is.null(page_num)) {
-    # Only adding a line for pagination -> lpp - 1 would have worked too
-    prov_footer(obj) <- c(prov_footer(obj), page_num)
-    prov_footer(mpf) <- c(prov_footer(mpf), page_num)
-  }
-
   if (is.null(pg_size_spec)) {
     pg_size_spec <- calc_lcpp(
       page_type = page_type,
@@ -1199,29 +1222,37 @@
 
   # Adding page numbers if needed
   if (!is.null(page_num)) {
-    total_pages <- length(res)
-    page_str <- gsub("\\{n\\}", total_pages, page_num)
-    page_nums <- vapply(
-      seq_len(total_pages),
-      function(x) {
-        gsub("\\{i\\}", x, page_str)
-      },
-      FUN.VALUE = character(1)
+    res <- .modify_footer_for_page_numbers(
+      mf_list = res,
+      page_num_format = page_num,
+      current_cpp = pg_size_spec$cpp
     )
-    page_footer <- sprintf(paste0("%", pg_size_spec$cpp, "s"), page_nums)
-    if (any(nchar(page_footer) > pg_size_spec$cpp)) {
-      stop("Page numbering string (page_num) is too wide to fit the desired page (inserted cpp).")
-    }
-
-    res <- lapply(seq_along(res), function(pg_i) {
-      prov_footer(res[[pg_i]]) <- c(head(prov_footer(res[[pg_i]]), -1), page_footer[pg_i])
-      res[[pg_i]]
-    })
   }
 
   res
 }
 
+.modify_footer_for_page_numbers <- function(mf_list, page_num_format, current_cpp) {
+  total_pages <- length(mf_list)
+  page_str <- gsub("\\{n\\}", total_pages, page_num_format)
+  page_nums <- vapply(
+    seq_len(total_pages),
+    function(x) {
+      gsub("\\{i\\}", x, page_str)
+    },
+    FUN.VALUE = character(1)
+  )
+  page_footer <- sprintf(paste0("%", current_cpp, "s"), page_nums)
+  if (any(nchar(page_footer) > current_cpp)) {
+    stop("Page numbering string (page_num) is too wide to fit the desired page (inserted cpp).")
+  }
+
+  lapply(seq_along(mf_list), function(pg_i) {
+    prov_footer(mf_list[[pg_i]]) <- c(head(prov_footer(mf_list[[pg_i]]), -1), page_footer[pg_i])
+    mf_list[[pg_i]]
+  })
+}
+
 .is_listing <- function(mpf) {
   all(mf_rinfo(mpf)$node_class == "listing_df")
 }

tests/testthat/test-exporters.R

@@ -87,8 +87,6 @@ test_that("exporters work", {
       file.remove("Rplots.pdf") # coming probably from rtf::
     }
   }
-
-
 })
 
 test_that("mpf_subset_rows works when there are newlines/wrapping in column labels", {
@@ -183,3 +181,35 @@ test_that("export_as_pdf works", {
 
   expect_equal(res$npages, 2)
 })
+
+test_that("exporting lists of tables and listings works", {
+  bmf <- basic_matrix_form(mtcars)
+  blmf <- basic_listing_mf(mtcars)
+  l_mf <- list(bmf, blmf)
+
+  output <- export_as_txt(l_mf, page_num = "page {i} of {n}", cpp = 90)
+  last_line_last_page <- strsplit(output, "\n")[[1]][168]
+
+  expect_true(grepl(last_line_last_page, pattern = "page 4 of 4"))
+  expect_equal(nchar(last_line_last_page), 90)
+
+  suppressWarnings(expect_warning(
+    export_as_txt(l_mf, paginate = FALSE),
+    "paginate is FALSE, but x is a list of tables or listings, so paginate will be set to TRUE"
+  ))
+
+  # export_as_pdf
+  tmpf <- tempfile(fileext = ".pdf")
+  tmpf <- "to_delete.pdf"
+  output <- export_as_pdf(l_mf, file = tmpf, page_num = "page {i} of {n}", cpp = 90)
+  expect_true(file.exists(tmpf))
+  file.remove(tmpf)
+
+  tmpf <- tempfile(fileext = ".pdf")
+  suppressWarnings(expect_warning(
+    export_as_pdf(l_mf, file = tmpf, paginate = FALSE),
+    "paginate is FALSE, but x is a list of tables or listings, so paginate will be set to TRUE"
+  ))
+  expect_true(file.exists(tmpf))
+  file.remove(tmpf)
+})

tests/testthat/test-txt_wrap.R

@@ -51,7 +51,10 @@ test_that("tf_wordwrap and table inset work (including together)", {
   )
 })
 
-test_that("toString() is silent when newline is in decorations (footnotes, titles) as matrix_form constructor expands all newlines", {
+test_that(paste(
+  "toString() is silent when newline is in decorations (footnotes, titles)",
+  "as matrix_form constructor expands all newlines"
+), {
   bmf <- basic_matrix_form(iris)
   main_title(bmf) <- "some\nvery\nspacious\ntitle"
   prov_footer(bmf) <- "some\nvery\nspacious\nfooter"