[hf] allow updating skipping header / footer as documented

NEWS.md

@@ -3,20 +3,20 @@
 ## New features
 
 * `wb_set_properties()` now has a `datetime_modify` option. [1176](https://github.com/JanMarvin/openxlsx2/pull/1176)
-* Make non consecutive equal sized dims behave similar to non equal sized non consecutive dims. This makes `dims = "A1:A5,C1:D5"` behave similar to `dims = "A1,C1:D1,A2:A5,C2:D5"`.
+* Make non consecutive equal sized dims behave similar to non equal sized non consecutive dims. This makes `dims = "A1:A5,C1:D5"` behave similar to `dims = "A1,C1:D1,A2:A5,C2:D5"`. [1183](https://github.com/JanMarvin/openxlsx2/pull/1183)
 * Improvements to the internal C++ code in `wb_add_data()` to avoid string copies. [1184](https://github.com/JanMarvin/openxlsx2/pull/1184)
   This is a continuation of work started in [1177](https://github.com/JanMarvin/openxlsx2/pull/1177) to speedup `wb_add_data()`/`wb_add_data_table()`.
 * Extend the `bookview` handling. It is now possible to add more than one `bookview` using `wb_set_bookview(view = 2L)` and to remove additional `bookview`s with `wb_remove_bookview()`. Available `bookview`s can be inspected with `wb_get_bookview()`. [1193](https://github.com/JanMarvin/openxlsx2/pull/1193)
 * Actually implement `sep` functionality in `wb_add_data()` and `wb_add_data_table()` for list columns in `x`. [1200](https://github.com/JanMarvin/openxlsx2/pull/1200)
 * `create_sparklines` now allows to add multiple sparklines as a group. ([1205](https://github.com/JanMarvin/openxlsx2/pull/1205), @trekonom)
 
-
 ## Fixes
 
 * Create date is not reset to the present time in each call to `wb_set_properties()`. [1176](https://github.com/JanMarvin/openxlsx2/pull/1176)
 * Improve handling of file headers and footers for a case where `wb_load()` would previously fail. [1186](https://github.com/JanMarvin/openxlsx2/pull/1186)
 * Partial labels were written only over the first element and only if assigned in an ordered fashion. [1189](https://github.com/JanMarvin/openxlsx2/pull/1189)
 * Enable use of `current_sheet()` in `create_sparklines()`. This is the default for the function, but was not supported.
+* When setting headers and footers, elements can now be skipped with `NA` as documented. [1211](https://github.com/JanMarvin/openxlsx2/pull/1211)
 
 ## Breaking changes
 

R/class-workbook-wrappers.R

@@ -1827,6 +1827,29 @@ wb_set_bookview <- function(
 #'   first_header = c("FIRST ONLY L", NA, "FIRST ONLY R"),
 #'   first_footer = c("FIRST ONLY L", NA, "FIRST ONLY R")
 #' )
+#'
+#' # ---- Updating the header ----
+#' ## Variant a
+#' ## this will keep the odd and even header / footer from the original header /
+#' ## footerkeep the first header / footer and will set the first page header /
+#' ## footer and will use the original header / footer for the missing element
+#' wb$set_header_footer(
+#'   header = NA,
+#'   footer = NA,
+#'   even_header = NA,
+#'   even_footer = NA,
+#'   first_header = c("FIRST ONLY L", NA, "FIRST ONLY R"),
+#'   first_footer = c("FIRST ONLY L", NA, "FIRST ONLY R")
+#' )
+#'
+#' ## Variant b
+#' ## this will keep the first header / footer only and will use the missing
+#' ## element from the original header / footer
+#' wb$set_header_footer(
+#'   first_header = c("FIRST ONLY L", NA, "FIRST ONLY R"),
+#'   first_footer = c("FIRST ONLY L", NA, "FIRST ONLY R")
+#' )
+#'
 wb_set_header_footer <- function(
     wb,
     sheet              = current_sheet(),

R/class-workbook.R

@@ -7616,29 +7616,23 @@ wbWorkbook <- R6::R6Class(
 
       sheet <- private$get_sheet_index(sheet)
 
-      if (!is.null(header) && length(header) != 3) {
-        stop("header must have length 3 where elements correspond to positions: left, center, right.")
-      }
-
-      if (!is.null(footer) && length(footer) != 3) {
-        stop("footer must have length 3 where elements correspond to positions: left, center, right.")
-      }
-
-      if (!is.null(even_header) && length(even_header) != 3) {
-        stop("evenHeader must have length 3 where elements correspond to positions: left, center, right.")
-      }
-
-      if (!is.null(even_footer) && length(even_footer) != 3) {
-        stop("evenFooter must have length 3 where elements correspond to positions: left, center, right.")
-      }
+      not_three_or_na <- function(x) {
+        nam <- deparse(substitute(x))
+        msg <- sprintf(
+          "`%s` must have length 3 where elements correspond to positions: left, center, right.",
+          nam
+        )
 
-      if (!is.null(first_header) && length(first_header) != 3) {
-        stop("firstHeader must have length 3 where elements correspond to positions: left, center, right.")
+        if (!is.null(x) && !(length(x) == 3 || (length(x) == 1 && is.na(x))))
+          stop(msg, call. = FALSE)
       }
 
-      if (!is.null(first_footer) && length(first_footer) != 3) {
-        stop("firstFooter must have length 3 where elements correspond to positions: left, center, right.")
-      }
+      not_three_or_na(header)
+      not_three_or_na(footer)
+      not_three_or_na(even_header)
+      not_three_or_na(even_footer)
+      not_three_or_na(first_header)
+      not_three_or_na(first_footer)
 
       # TODO this could probably be moved to the hf assignment
       oddHeader   <- headerFooterSub(header)
@@ -7659,6 +7653,17 @@ wbWorkbook <- R6::R6Class(
 
       if (all(lengths(hf) == 0)) {
         hf <- NULL
+      } else {
+        if (!is.null(old_hf <- self$worksheets[[sheet]]$headerFooter)) {
+          for (nam in names(hf)) {
+            # Update using new_vector if it exists, keeping original values where NA
+            if (length(hf[[nam]]) && length(old_hf[[nam]])) {
+              sel <- if (is.list(hf[[nam]]) && length(hf[[nam]]) == 0) sel <- seq_len(3)
+                      else which(vapply(hf[[nam]], is.null, NA))
+              hf[[nam]][sel] <- old_hf[[nam]][sel]
+            }
+          }
+        }
       }
 
       if (!is.null(scale_with_doc)) {

R/utils.R

@@ -11,6 +11,7 @@ is_integer_ish <- function(x) {
 }
 
 naToNULLList <- function(x) {
+  if (length(x) == 1 && is.na(x)) x <- c(NA, NA, NA)
   lapply(x, function(i) if (is.na(i)) NULL else i)
 }
 

inst/WORDLIST

@@ -57,6 +57,7 @@ TotalCell
 TrafficLights
 VARP
 activeTab
+activeX
 allowBlank
 applyCellStyle
 autoFilterDateGrouping

tests/testthat/test-class-worksheet.R

@@ -210,3 +210,71 @@ test_that("setting and loading header/footer attributes works", {
   expect_true(wb$worksheets[[1]]$scale_with_doc)
   expect_true(wb$worksheets[[1]]$align_with_margins)
 })
+
+test_that("updating page header / footer works", {
+  wb <- wb_workbook()$add_worksheet()$set_sheetview(view = "pageLayout")
+  wb$add_data(x = matrix(1, nrow = 150, ncol = 1))
+
+  first_hf <- wb$worksheets[[1]]$headerFooter
+
+  wb$set_header_footer(
+    header = c("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"),
+    footer = c("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"),
+    even_header = c("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"),
+    even_footer = c("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"),
+    first_header = c("TOP", "OF FIRST", "PAGE"),
+    first_footer = c("BOTTOM", "OF FIRST", "PAGE")
+  )
+
+  second_hf <- wb$worksheets[[1]]$headerFooter
+
+  wb$set_header_footer(
+    header = NA,
+    footer = NA,
+    even_header = NA,
+    even_footer = NA,
+    first_header = c("FIRST ONLY L", NA, "FIRST ONLY R"),
+    first_footer = c("FIRST ONLY L", NA, "FIRST ONLY R")
+  )
+
+  third_hf <- wb$worksheets[[1]]$headerFooter
+
+  wb$set_header_footer(
+    first_header = c("FIRST ONLY L", NA, "FIRST ONLY R"),
+    first_footer = c("FIRST ONLY L", NA, "FIRST ONLY R")
+  )
+
+  fourth_hf <- wb$worksheets[[1]]$headerFooter
+
+
+  expect_equal(NULL, first_hf)
+
+
+  exp <- list(oddHeader = list("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"),
+              oddFooter = list("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"),
+              evenHeader = list("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"),
+              evenFooter = list("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"),
+              firstHeader = list("TOP", "OF FIRST", "PAGE"),
+              firstFooter = list("BOTTOM", "OF FIRST", "PAGE"))
+  expect_equal(exp, second_hf)
+
+
+  exp <- list(oddHeader = list("ODD HEAD LEFT", "ODD HEAD CENTER", "ODD HEAD RIGHT"),
+              oddFooter = list("ODD FOOT RIGHT", "ODD FOOT CENTER", "ODD FOOT RIGHT"),
+              evenHeader = list("EVEN HEAD LEFT", "EVEN HEAD CENTER", "EVEN HEAD RIGHT"),
+              evenFooter = list("EVEN FOOT RIGHT", "EVEN FOOT CENTER", "EVEN FOOT RIGHT"),
+              firstHeader = list("FIRST ONLY L", "OF FIRST", "FIRST ONLY R"),
+              firstFooter = list("FIRST ONLY L", "OF FIRST", "FIRST ONLY R"))
+  expect_equal(exp, third_hf)
+
+
+  exp <- list(oddHeader = list(),
+              oddFooter = list(),
+              evenHeader = list(),
+              evenFooter = list(),
+              firstHeader = list("FIRST ONLY L", "OF FIRST", "FIRST ONLY R"),
+              firstFooter = list("FIRST ONLY L", "OF FIRST", "FIRST ONLY R"))
+  expect_equal(exp, fourth_hf)
+
+  expect_error(wb$set_header_footer(header = c("foo", "bar")), "must have length 3 where elements correspond to positions: left, center, right.")
+})