[numfmt] fix forward slash escaping. closes #847 (#848)

* reorder functions for consistency * [numfmt] escape forward slash in date numfmt * [numfmt] cleanup code and fix commaFormat (previously it required "commma" and "commaFormat") * [options] add "openxlsx2.maxWidth" * [tests] add tests
JanMarvin · Nov 12, 2023 · 1d26332 · 1d26332
1 parent 53aef14
commit 1d26332
Show file tree

Hide file tree

Showing 6 changed files with 76 additions and 55 deletions.
diff --git a/R/converters.R b/R/converters.R
@@ -108,5 +108,8 @@ calc_col_width <- function(base_font, col_width) {
   # to the expected widths
   widths <- trunc((as.numeric(col_width) * mdw + 5) / mdw * 256) / 256
   widths <- round(widths, 3)
+  if (any(sel <- widths > getOption("openxlsx2.maxWidth"))) {
+    widths[sel] <- getOption("openxlsx2.maxWidth")
+  }
   widths
 }
diff --git a/R/illegal-characters.R b/R/illegal-characters.R
@@ -1,21 +1,3 @@
-
-#' Clean worksheet name
-#'
-#' Cleans a worksheet name by removing legal characters.
-#'
-#' @details Illegal characters are considered `\`, `/`, `?`, `*`, `:`, `[`, and
-#' `]`.  These must be intentionally removed from worksheet names prior to
-#' creating a new worksheet.
-#'
-#' @param x A vector, coerced to `character`
-#' @param replacement A single value to replace illegal characters by.
-#' @returns x with bad characters removed
-clean_worksheet_name <- function(x, replacement = " ") {
-  stopifnot(length(replacement) == 1, !has_illegal_chars(replacement))
-  replace_illegal_chars(x, replacement = replacement)
-}
-
-
 #' Detect illegal characters
 #' @param x A vector, coerced to character
 #' @returns A `logical` vector
@@ -60,6 +42,22 @@ replace_illegal_chars <- function(x, replacement = " ") {
   stringi::stri_replace_all_fixed(x, illegal_chars(), replacement, vectorize_all = FALSE)
 }
 
+#' Clean worksheet name
+#'
+#' Cleans a worksheet name by removing legal characters.
+#'
+#' @details Illegal characters are considered `\`, `/`, `?`, `*`, `:`, `[`, and
+#' `]`.  These must be intentionally removed from worksheet names prior to
+#' creating a new worksheet.
+#'
+#' @param x A vector, coerced to `character`
+#' @param replacement A single value to replace illegal characters by.
+#' @returns x with bad characters removed
+clean_worksheet_name <- function(x, replacement = " ") {
+  stopifnot(length(replacement) == 1, !has_illegal_chars(replacement))
+  replace_illegal_chars(x, replacement = replacement)
+}
+
 #' converts &amp; to &
 #' @param x some xml string
 #' @noRd
@@ -71,3 +69,11 @@ replaceXMLEntities <- function(x) {
     vectorize_all = FALSE
   )
 }
+
+# for dateFormats
+escape_forward_slashes <- function(string) {
+  if (!grepl("\\\\/", string)) {
+    string <- gsub("/", "\\\\/", string)
+  }
+  string
+}
diff --git a/R/wb_styles.R b/R/wb_styles.R
@@ -171,6 +171,9 @@ create_border <- function(
 #' @export
 create_numfmt <- function(numFmtId, formatCode) {
 
+  # maybe only required in dates
+  formatCode <- escape_forward_slashes(formatCode)
+
   df_numfmt <- data.frame(
     numFmtId         = as_xml_attr(numFmtId),
     formatCode       = as_xml_attr(formatCode),

diff --git a/R/write.R b/R/write.R
@@ -486,9 +486,9 @@ write_data2 <- function(
 
     # options("openxlsx2.numFmt" = NULL)
     if (any(dc == openxlsx2_celltype[["numeric"]])) { # numeric or integer
-      if (!is.null(unlist(options("openxlsx2.numFmt")))) {
+      if (!is.null(getOption("openxlsx2.numFmt"))) {
 
-        numfmt_numeric <- unlist(options("openxlsx2.numFmt"))
+        numfmt_numeric <- getOption("openxlsx2.numFmt")
 
         dim_sel <- get_data_class_dims("numeric")
         # message("numeric: ", dim_sel)
@@ -501,11 +501,7 @@ write_data2 <- function(
       }
     }
     if (any(dc == openxlsx2_celltype[["short_date"]])) { # Date
-      if (is.null(unlist(options("openxlsx2.dateFormat")))) {
-        numfmt_dt <- 14
-      } else {
-        numfmt_dt <- unlist(options("openxlsx2.dateFormat"))
-      }
+      numfmt_dt <- getOption("openxlsx2.dateFormat") %||% 14
 
       dim_sel <- get_data_class_dims("short_date")
       # message("short_date: ", dim_sel)
@@ -517,11 +513,7 @@ write_data2 <- function(
       )
     }
     if (any(dc == openxlsx2_celltype[["long_date"]])) {
-      if (is.null(unlist(options("openxlsx2.datetimeFormat")))) {
-        numfmt_posix <- 22
-      } else {
-        numfmt_posix <- unlist(options("openxlsx2.datetimeFormat"))
-      }
+      numfmt_posix <- getOption("openxlsx2.datetimeFormat") %||% 22
 
       dim_sel <- get_data_class_dims("long_date")
       # message("long_date: ", dim_sel)
@@ -533,11 +525,7 @@ write_data2 <- function(
       )
     }
     if (any(dc == openxlsx2_celltype[["hms_time"]])) {
-      if (is.null(unlist(options("openxlsx2.hmsFormat")))) {
-        numfmt_hms <- 21
-      } else {
-        numfmt_hms <- unlist(options("openxlsx2.hmsFormat"))
-      }
+      numfmt_hms <- getOption("openxlsx2.hmsFormat") %||% 21
 
       dim_sel <- get_data_class_dims("hms_time")
       # message("hms: ", dim_sel)
@@ -549,11 +537,7 @@ write_data2 <- function(
       )
     }
     if (any(dc == openxlsx2_celltype[["accounting"]])) { # accounting
-      if (is.null(unlist(options("openxlsx2.accountingFormat")))) {
-        numfmt_accounting <- 4
-      } else {
-        numfmt_accounting <- unlist(options("openxlsx2.accountingFormat"))
-      }
+      numfmt_accounting <- getOption("openxlsx2.accountingFormat") %||% 4
 
       dim_sel <- get_data_class_dims("accounting")
       # message("accounting: ", dim_sel)
@@ -564,11 +548,7 @@ write_data2 <- function(
       )
     }
     if (any(dc == openxlsx2_celltype[["percentage"]])) { # percentage
-      if (is.null(unlist(options("openxlsx2.percentageFormat")))) {
-        numfmt_percentage <- 10
-      } else {
-        numfmt_percentage <- unlist(options("openxlsx2.percentageFormat"))
-      }
+      numfmt_percentage <- getOption("openxlsx2.percentageFormat") %||% 10
 
       dim_sel <- get_data_class_dims("percentage")
       # message("percentage: ", dim_sel)
@@ -580,11 +560,7 @@ write_data2 <- function(
       )
     }
     if (any(dc == openxlsx2_celltype[["scientific"]])) {
-      if (is.null(unlist(options("openxlsx2.scientificFormat")))) {
-        numfmt_scientific <- 48
-      } else {
-        numfmt_scientific <- unlist(options("openxlsx2.scientificFormat"))
-      }
+      numfmt_scientific <- getOption("openxlsx2.scientificFormat") %||% 48
 
       dim_sel <- get_data_class_dims("scientific")
       # message("scientific: ", dim_sel)
@@ -596,11 +572,7 @@ write_data2 <- function(
       )
     }
     if (any(dc == openxlsx2_celltype[["comma"]])) {
-      if (is.null(unlist(options("openxlsx2.comma")))) {
-        numfmt_comma <- 3
-      } else {
-        numfmt_comma <- unlist(options("openxlsx2.commaFormat"))
-      }
+      numfmt_comma <- getOption("openxlsx2.commaFormat") %||% 3
 
       dim_sel <- get_data_class_dims("comma")
       # message("comma: ", dim_sel)

diff --git a/tests/testthat/test-class-workbook.R b/tests/testthat/test-class-workbook.R
@@ -73,6 +73,22 @@ test_that("wb_set_col_widths", {
 
 })
 
+test_that("option maxWidth works", {
+
+  op <- options("openxlsx2.maxWidth" = 6)
+  on.exit(options(op), add = TRUE)
+
+  wb <- wb_workbook()$add_worksheet()$add_data(x = data.frame(
+      x = paste0(letters, collapse = ""),
+      y = paste0(letters, collapse = "")
+  ))$set_col_widths(cols = 1:2, widths = "auto")
+
+  exp <- "<col min=\"1\" max=\"2\" bestFit=\"1\" customWidth=\"1\" hidden=\"false\" width=\"6\"/>"
+  got <- wb$worksheets[[1]]$cols_attr
+  expect_equal(exp, got)
+
+})
+
 
 # order -------------------------------------------------------------------
 

diff --git a/tests/testthat/test-writing_posixct.R b/tests/testthat/test-writing_posixct.R
@@ -70,3 +70,24 @@ test_that("Writing mixed EDT/EST Posixct with write_data & write_datatable", {
   expect_equal(exp, got)
 
 })
+
+test_that("numfmt escaping works", {
+
+  op <- options(
+    "openxlsx2.datetimeFormat" = "yyyy\\/mm\\/dd",
+    "openxlsx2.dateFormat" = "mm/dd/yyyy"
+  )
+  on.exit(options(op), add = TRUE)
+
+  test_data <- data.frame(
+    datetime_col = as.POSIXct("2023-12-31 00:00:00"),
+    date_col = as.Date("2023-12-31")
+  )
+  wb <- wb_workbook()$add_worksheet()$add_data(x = test_data)
+
+  exp <- c("<numFmt numFmtId=\"165\" formatCode=\"mm\\/dd\\/yyyy\"/>",
+          "<numFmt numFmtId=\"166\" formatCode=\"yyyy\\/mm\\/dd\"/>")
+  got <- wb$styles_mgr$styles$numFmts
+  expect_equal(exp, got)
+
+})