add page number

DESCRIPTION

@@ -58,3 +58,4 @@ Collate:
     'pagination.R'
     'tostring.R'
     'utils.R'
+    'zzz.R'

NAMESPACE

@@ -34,6 +34,7 @@ export(basic_pagdf)
 export(check_aligns)
 export(decimal_align)
 export(default_hsep)
+export(default_page_number)
 export(diagnose_pagination)
 export(divider_height)
 export(do_forced_paginate)
@@ -89,6 +90,7 @@ export(prov_footer)
 export(ref_df_row)
 export(round_fmt)
 export(set_default_hsep)
+export(set_default_page_number)
 export(spans_to_viscell)
 export(spread_integer)
 export(sprintf_format)

R/mpf_exporters.R

@@ -21,6 +21,8 @@
 #' @param paginate logical(1). Whether pagination should be performed,
 #'     defaults to \code{TRUE} if page size is specified (including
 #'     the default).
+#' @param ...  Further parameters to be passed to [paginate_to_mpfs()].
+#'
 #' @details if  \code{x} has an \code{num_rep_cols}  method, the value
 #'     returned by it will be  used for \code{rep_cols} by default, if
 #'     not, 0 will be used.
@@ -30,9 +32,11 @@
 #'
 #' @return if \code{file} is NULL, the total paginated and then concatenated
 #' string value, otherwise the file that was written.
-#' @export
+#'
 #' @examples
 #' export_as_txt(basic_matrix_form(mtcars), pg_height = 5, pg_width = 4)
+#'
+#' @export
 export_as_txt <- function(x,
                           file = NULL,
                           page_type = NULL,
@@ -56,7 +60,9 @@ export_as_txt <- function(x,
                           nosplitin = character(),
                           rep_cols = num_rep_cols(x),
                           verbose = FALSE,
-                          page_break = "\\s\\n") {
+                          page_break = "\\s\\n",
+                          page_num = default_page_number()) {
+
   if (paginate) {
     pages <- paginate_to_mpfs(
       x,
@@ -77,7 +83,8 @@ export_as_txt <- function(x,
       max_width = max_width,
       indent_size = indent_size,
       verbose = verbose,
-      rep_cols = rep_cols
+      rep_cols = rep_cols,
+      page_num = page_num
     )
   } else {
     mf <- matrix_form(x, TRUE, TRUE, indent_size = indent_size)
@@ -101,6 +108,7 @@ export_as_txt <- function(x,
     widths = NULL,
     hsep = hsep, tf_wrap = tf_wrap, max_width = max_width
   )
+
   res <- paste(strings, collapse = page_break)
 
   if (is.null(file)) {
@@ -530,6 +538,7 @@ export_as_pdf <- function(x,
                           font_size = 8,
                           fontsize = font_size,
                           paginate = TRUE,
+                          page_num = default_page_number(),
                           lpp = NULL,
                           cpp = NULL,
                           hsep = "-",
@@ -595,7 +604,8 @@ export_as_pdf <- function(x,
       max_width = max_width,
       indent_size = indent_size,
       verbose = FALSE,
-      rep_cols = num_rep_cols(x)
+      rep_cols = num_rep_cols(x),
+      page_num = page_num
     )
   } else {
     mf <- matrix_form(x, TRUE, TRUE, indent_size = indent_size)

R/pagination.R

@@ -860,23 +860,28 @@ splice_idx_lists <- function(lsts) {
 #' @param cpp numeric(1) or NULL. Width in characters per page. if NA (the default,
 #'     this is calculated automatically based on the specified page
 #'     size). `NULL` indicates no horizontal pagination should occur.
-
 #' @param pg_size_spec page_size_spec. A pre-calculated page
 #'     size specification. Typically this is not set in end user code.
 #' @param col_gap numeric(1). Currently unused.
+#' @param page_num character(1). Placeholder string for page numbers. Check
+#'     [default_page_number] for more information. Defaults to `NULL`.
+#'
 #' @return for `paginate_indices` a list with two elements of the same
 #'     length:   `pag_row_indices`,    and   `pag_col_indices`.    For
 #'     `paginate_to_mpfs`,   a  list   of  `MatrixPrintForm` objects
 #'     representing each individual page after pagination (including
 #'     forced pagination if necessary).
-#' @export
+#'
 #' @aliases paginate pagination
+#'
 #' @examples
 #' mpf <- basic_matrix_form(mtcars)
 #'
 #' paginate_indices(mpf, pg_width = 5, pg_height = 3)
 #'
 #' paginate_to_mpfs(mpf, pg_width = 5, pg_height = 3)
+#'
+#' @export
 paginate_indices <- function(obj,
                              page_type = "letter",
                              font_family = "Courier",
@@ -1067,6 +1072,7 @@ paginate_to_mpfs <- function(obj,
                              max_width = NULL,
                              indent_size = 2,
                              pg_size_spec = NULL,
+                             page_num = default_page_number(),
                              rep_cols = num_rep_cols(obj),
                              col_gap = 2,
                              verbose = FALSE) {
@@ -1086,6 +1092,17 @@ paginate_to_mpfs <- function(obj,
     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(
@@ -1178,7 +1195,31 @@ paginate_to_mpfs <- function(obj,
     })
   })
 
-  unlist(res, recursive = FALSE)
+  res <- unlist(res, recursive = FALSE)
+
+  # 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)
+    )
+    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
 }
 
 .is_listing <- function(mpf) {

R/tostring.R

@@ -1,53 +1,3 @@
-#' @title Default horizontal separator
-#'
-#' @description The default horizontal separator character which can be
-#' displayed in the current `charset` for use in rendering table-likes.
-#'
-#' @param hsep_char character(1). Character that will be set in the R environment
-#'   options as default for creating the horizontal separator. It needs to be
-#'   single character. Use `getOption("formatters_default_hsep")` to get its current
-#'   value (`NULL` if not set).
-#'
-#' @return `unicode` 2014 (long dash for generating solid horizontal line)
-#' if in a locale that uses a UTF character set, otherwise an ASCII hyphen
-#' with a once-per-session warning.
-#'
-#' @examples
-#' default_hsep()
-#' set_default_hsep("o")
-#' default_hsep()
-#'
-#' @name default_horizontal_sep
-#' @export
-default_hsep <- function() {
-  system_default_hsep <- getOption("formatters_default_hsep")
-
-  if (is.null(system_default_hsep)) {
-    if (any(grepl("^UTF", utils::localeToCharset()))) {
-      hsep <- "\u2014"
-    } else {
-      if (interactive()) {
-        warning(
-          "Detected non-UTF charset. Falling back to '-' ",
-          "as default header/body separator. This warning ",
-          "will only be shown once per R session."
-        ) # nocov
-      } # nocov
-      hsep <- "-" # nocov
-    }
-  } else {
-    hsep <- system_default_hsep
-  }
-  hsep
-}
-
-#' @name default_horizontal_sep
-#' @export
-set_default_hsep <- function(hsep_char) {
-  checkmate::assert_character(hsep_char, n.chars = 1, len = 1, null.ok = TRUE)
-  options("formatters_default_hsep" = hsep_char)
-}
-
 .calc_cell_widths <- function(mat, colwidths, col_gap) {
   spans <- mat$spans
   keep_mat <- mat$display

R/zzz.R

@@ -0,0 +1,79 @@
+#' @title Default horizontal separator
+#'
+#' @description The default horizontal separator character which can be
+#' displayed in the current `charset` for use in rendering table-likes.
+#'
+#' @param hsep_char character(1). Character that will be set in the R environment
+#'   options as default for creating the horizontal separator. It needs to be
+#'   single character. Use `getOption("formatters_default_hsep")` to get its current
+#'   value (`NULL` if not set).
+#'
+#' @return `unicode` 2014 (long dash for generating solid horizontal line)
+#' if in a locale that uses a UTF character set, otherwise an ASCII hyphen
+#' with a once-per-session warning.
+#'
+#' @examples
+#' default_hsep()
+#' set_default_hsep("o")
+#' default_hsep()
+#'
+#' @name default_horizontal_sep
+#' @export
+default_hsep <- function() {
+  system_default_hsep <- getOption("formatters_default_hsep")
+
+  if (is.null(system_default_hsep)) {
+    if (any(grepl("^UTF", utils::localeToCharset()))) {
+      hsep <- "\u2014"
+    } else {
+      if (interactive()) {
+        warning(
+          "Detected non-UTF charset. Falling back to '-' ",
+          "as default header/body separator. This warning ",
+          "will only be shown once per R session."
+        ) # nocov
+      } # nocov
+      hsep <- "-" # nocov
+    }
+  } else {
+    hsep <- system_default_hsep
+  }
+  hsep
+}
+
+#' @name default_horizontal_sep
+#' @export
+set_default_hsep <- function(hsep_char) {
+  checkmate::assert_string(hsep_char, n.chars = 1, null.ok = TRUE)
+  options("formatters_default_hsep" = hsep_char)
+}
+
+#' @title Default page number format
+#'
+#' @description If set the default page number string will appear on the bottom right of
+#'   every paginated table. It uses the current `cpp` to position the string.
+#'
+#' @param page_number character(1). Single string value to set the page number format.
+#'   It should be like the following format: `"page {i}/{n}"`. `{i}` will be replaced with
+#'   current page number, `{n}` will be replaced with total page number. It uses current `cpp`
+#'   to position the string on the bottom right corner.
+#'
+#' @return The page number format string. If not set, it returns `NULL`.
+#'
+#' @examples
+#' default_page_number()
+#' set_default_page_number("page {i} of {n}")
+#' default_page_number()
+#'
+#' @name default_page_number
+#'@export
+default_page_number <- function() {
+  getOption("formatter_default_page_number", default = NULL)
+}
+
+#' @name default_page_number
+#' @export
+set_default_page_number <- function(page_number) {
+  checkmate::assert_string(page_number, null.ok = TRUE)
+  options("formatter_default_page_number" = page_number)
+}

_pkgdown.yml

@@ -107,3 +107,5 @@ reference:
       - page_lcpp
       - page_types
       - ref_df_row
+      - default_page_number
+      - set_default_page_number