read cell attributes cm, ph, and vm

NEWS.md

@@ -1,5 +1,7 @@
 # openxlsx2 (development version)
 
+* Cell fields cm, ph and vm are now implemented for reading and writing. This is the first step to handle functions that use metadata. [173](https://github.com/JanMarvin/openxlsx2/pull/173)
+
 * `openxlsx2Coerce()` (which was called on `x` objects when adding data to a workbook) has been removed.  Users can no longer pass some arbitrary objects and will need to format these objects appropriately or rely on `as.data.frame` methods  [167](https://github.com/JanMarvin/openxlsx2/issues/167)
 
 # openxlsx2 0.2.0

R/class-workbook.R

@@ -66,6 +66,9 @@ wbWorkbook <- R6::R6Class(
     #' @field media media
     media = NULL,
 
+    #' @field metadata metadata
+    metadata = NULL,
+
     #' @field persons persons
     persons = NULL,
 
@@ -209,6 +212,7 @@ wbWorkbook <- R6::R6Class(
       self$headFoot <- NULL
 
       self$media <- list()
+      self$metadata <- NULL
 
       self$persons <- NULL
 
@@ -1410,6 +1414,16 @@ wbWorkbook <- R6::R6Class(
         )
       }
 
+      # write metadata file. required if cm attribut is set.
+      if (length(self$metadata)) {
+        write_file(
+          head = '',
+          body = self$metadata,
+          tail = '',
+          fl = file.path(xlDir, "metadata.xml")
+        )
+      }
+
       ## write workbook.xml
       workbookXML <- self$workbook
       workbookXML$sheets <- stri_join("<sheets>", pxml(workbookXML$sheets), "</sheets>")
@@ -4318,7 +4332,7 @@ wbWorkbook <- R6::R6Class(
             ws$sheet_data$row_attr <- rows_attr[order(as.numeric(rows_attr[, "r"])),]
 
             cc_rows <- ws$sheet_data$row_attr$r
-            cc_out <- cc[cc$row_r %in% cc_rows, c("row_r", "c_r",  "r", "v", "c_t", "c_s", "f", "f_t", "f_ref", "f_ca", "f_si", "is")]
+            cc_out <- cc[cc$row_r %in% cc_rows, c("row_r", "c_r",  "r", "v", "c_t", "c_s", "c_cm", "c_ph", "c_vm", "f", "f_t", "f_ref", "f_ca", "f_si", "is")]
 
             ws$sheet_data$cc_out <- cc_out[order(as.integer(cc_out[,"row_r"]), col2int(cc_out[, "c_r"])),]
           } else {
@@ -4637,6 +4651,15 @@ wbWorkbook <- R6::R6Class(
 
       self$append("workbook.xml.rels", c(pivotNode, slicerNode))
 
+      if (length(self$metadata)) {
+        self$append("workbook.xml.rels",
+          sprintf(
+            '<Relationship Id="rId%s" Type="http://schemas.openxmlformats.org/officeDocument/2006/relationships/sheetMetadata" Target="metadata.xml"/>',
+            1L + length(self$workbook.xml.rels)
+          )
+        )
+      }
+
       if (!is.null(self$vbaProject)) {
         self$append("workbook.xml.rels",
           sprintf(

R/wb_functions.R

@@ -741,7 +741,7 @@ update_cell <- function(x, wb, sheet, cell, data_class,
         c_s <- NULL
         if (removeCellStyle) c_s <- "c_s"
 
-        cc[sel, c(c_s, "c_t", "v", "f", "f_t", "f_ref", "f_ca", "f_si", "is")] <- "_openxlsx_NA_"
+        cc[sel, c(c_s, "c_t", "c_cm", "c_ph", "c_vm", "v", "f", "f_t", "f_ref", "f_ca", "f_si", "is")] <- "_openxlsx_NA_"
 
         # for now convert all R-characters to inlineStr (e.g. names() of a dataframe)
         if ((data_class[m] == openxlsx2_celltype[["character"]]) || ((colNames == TRUE) && (n == 1))) {
@@ -947,9 +947,10 @@ write_data2 <-function(wb, sheet, data, name = NULL,
 
     # original cc dataframe
     # TODO should be empty_sheet_data(n = nrow(data) * ncol(data))
-    nams <- c("row_r", "c_r", "c_s", "c_t", "v",
-              "f", "f_t", "f_ref", "f_ca", "f_si",
-              "is", "typ", "r")
+    nams <- c("row_r", "c_r", "c_s", "c_t", "c_cm",
+              "c_ph", "c_vm", "v", "f", "f_t",
+              "f_ref", "f_ca", "f_si", "is", "typ",
+              "r")
     cc <- as.data.frame(
       matrix(data = "_openxlsx_NA_",
              nrow = nrow(data) * ncol(data),

R/wb_load.R

@@ -59,6 +59,7 @@ wb_load <- function(file, xlsxFile = NULL, sheet) {
   workbookXML       <- grep_xml("workbook.xml$")
   stylesXML         <- grep_xml("styles.xml$")
   sharedStringsXML  <- grep_xml("sharedStrings.xml$")
+  metadataXML       <- grep_xml("metadata.xml$")
   themeXML          <- grep_xml("theme[0-9]+.xml$")
   drawingRelsXML    <- grep_xml("drawing[0-9]+.xml.rels$")
   sheetRelsXML      <- grep_xml("sheet[0-9]+.xml.rels$")
@@ -228,6 +229,11 @@ wb_load <- function(file, xlsxFile = NULL, sheet) {
       wb$workbook$calcPr <- calcPr
     }
 
+    extLst <- xml_node(workbook_xml, "workbook", "extLst")
+    if (length(extLst)) {
+      wb$workbook$extLst <- extLst
+    }
+
     workbookPr <- xml_node(workbook_xml, "workbook", "workbookPr")
     if (length(workbookPr)) {
       wb$workbook$workbookPr <- workbookPr
@@ -327,6 +333,17 @@ wb_load <- function(file, xlsxFile = NULL, sheet) {
     wb$sharedStrings <- vals
   }
 
+
+  ## xl\sharedStrings
+  if (length(metadataXML)) {
+    wb$Content_Types <- c(
+      wb$Content_Types,
+      '<Override PartName="/xl/metadata.xml" ContentType="application/vnd.openxmlformats-officedocument.spreadsheetml.sheetMetadata+xml"/>'
+    )
+    metadata <- read_xml(metadataXML, pointer = FALSE)
+    wb$metadata <- metadata
+  }
+
   ## xl\pivotTables & xl\pivotCache
   if (length(pivotTableXML)) {
 
@@ -1112,8 +1129,13 @@ wb_load <- function(file, xlsxFile = NULL, sheet) {
     #     wb$workbook.xml.rels <- wb$workbook.xml.rels[!grepl(toRemove, wb$workbook.xml.rels)]
     #   }
     # }
+  } else {
+    # If workbook contains no sheetRels, create empty workbook.xml.rels.
+    # Otherwise spreadsheet software will stumble over missing rels to drwaing.
+    wb$worksheets_rels <- lapply(seq_along(wb$sheet_names), FUN = function(x) character())
   } ## end of worksheetRels
 
+
   ## convert hyperliks to hyperlink objects
   for (i in seq_len(nSheets)) {
     wb$worksheets[[i]]$hyperlinks <- xml_to_hyperlink(wb$worksheets[[i]]$hyperlinks)

src/load_workbook.cpp

@@ -199,9 +199,12 @@ void loadvals(Rcpp::Environment sheet_data, XPtrXML doc) {
   const std::string s_str = "s";
   const std::string t_str = "t";
   const std::string v_str = "v";
-  const std::string is_str = "is";
   const std::string ca_str = "ca";
+  const std::string cm_str = "cm";
+  const std::string is_str = "is";
+  const std::string ph_str = "ph";
   const std::string si_str = "si";
+  const std::string vm_str = "vm";
   const std::string ref_str = "ref";
 
 
@@ -232,6 +235,9 @@ void loadvals(Rcpp::Environment sheet_data, XPtrXML doc) {
         openxlsxNA, // c_r
         openxlsxNA, // c_s
         openxlsxNA, // c_t
+        openxlsxNA, // c_cm
+        openxlsxNA, // c_ph
+        openxlsxNA, // c_vm
         openxlsxNA, // v
         openxlsxNA, // f
         openxlsxNA, // f_t
@@ -276,6 +282,9 @@ void loadvals(Rcpp::Environment sheet_data, XPtrXML doc) {
 
         if (attr_name == s_str) single_xml_col.c_s = buffer;
         if (attr_name == t_str) single_xml_col.c_t = buffer;
+        if (attr_name == cm_str) single_xml_col.c_cm = buffer;
+        if (attr_name == ph_str) single_xml_col.c_ph = buffer;
+        if (attr_name == vm_str) single_xml_col.c_vm = buffer;
 
         ++attr_itr;
       }

src/openxlsx2_types.h

@@ -10,17 +10,20 @@
 const std::string openxlsxNA = "_openxlsx_NA_";
 
 typedef struct {
-  std::string row_r ;
-  std::string c_r;
-  std::string c_s;
-  std::string c_t;
-  std::string v;
-  std::string f;
+  std::string row_r;
+  std::string c_r;   // CellReference
+  std::string c_s;   // StyleIndex
+  std::string c_t;   // DataType
+  std::string c_cm;  // CellMetaIndex
+  std::string c_ph;  // ShowPhonetic
+  std::string c_vm;  // ValueMetaIndex
+  std::string v;     // CellValue
+  std::string f;     // CellFormula
   std::string f_t;
   std::string f_ref;
   std::string f_ca;
   std::string f_si;
-  std::string is;
+  std::string is;    // inlineStr
 } xml_col;
 
 
@@ -70,6 +73,9 @@ inline SEXP wrap(const std::vector<xml_col> &x) {
   Rcpp::CharacterVector c_r(no_init(n));       // col name: A, B, ..., ZZ
   Rcpp::CharacterVector c_s(no_init(n));       // cell style
   Rcpp::CharacterVector c_t(no_init(n));       // cell type
+  Rcpp::CharacterVector c_cm(no_init(n));
+  Rcpp::CharacterVector c_ph(no_init(n));
+  Rcpp::CharacterVector c_vm(no_init(n));
 
   Rcpp::CharacterVector v(no_init(n));         // <v> tag
   Rcpp::CharacterVector f(no_init(n));         // <f> tag
@@ -85,6 +91,9 @@ inline SEXP wrap(const std::vector<xml_col> &x) {
     c_r[i]   = x[i].c_r;
     c_s[i]   = x[i].c_s;
     c_t[i]   = x[i].c_t;
+    c_cm[i]  = x[i].c_cm;
+    c_ph[i]  = x[i].c_ph;
+    c_vm[i]  = x[i].c_vm;
     v[i]     = x[i].v;
     f[i]     = x[i].f;
     f_t[i]   = x[i].f_t;
@@ -100,6 +109,9 @@ inline SEXP wrap(const std::vector<xml_col> &x) {
       Rcpp::Named("c_r")   = c_r,
       Rcpp::Named("c_s")   = c_s,
       Rcpp::Named("c_t")   = c_t,
+      Rcpp::Named("c_cm")  = c_cm,
+      Rcpp::Named("c_ph")  = c_ph,
+      Rcpp::Named("c_vm")  = c_vm,
       Rcpp::Named("v")     = v,
       Rcpp::Named("f")     = f,
       Rcpp::Named("f_t")   = f_t,

src/write_file.cpp

@@ -56,6 +56,9 @@ std::string xml_sheet_data(Rcpp::DataFrame row_attr, Rcpp::DataFrame cc) {
   Rcpp::CharacterVector cc_v     = cc["v"];
   Rcpp::CharacterVector cc_c_t   = cc["c_t"];
   Rcpp::CharacterVector cc_c_s   = cc["c_s"];
+  Rcpp::CharacterVector cc_c_cm  = cc["c_cm"];
+  Rcpp::CharacterVector cc_c_ph  = cc["c_ph"];
+  Rcpp::CharacterVector cc_c_vm  = cc["c_vm"];
   Rcpp::CharacterVector cc_f     = cc["f"];
   Rcpp::CharacterVector cc_f_t   = cc["f_t"];
   Rcpp::CharacterVector cc_f_ref = cc["f_ref"];
@@ -115,6 +118,18 @@ std::string xml_sheet_data(Rcpp::DataFrame row_attr, Rcpp::DataFrame cc) {
     if (to_string(cc_c_t[i]).compare(openxlsxNA.c_str()) != 0)
       cell.append_attribute("t") = to_string(cc_c_t[i]).c_str();
 
+    // CellMetaIndex: suppress curly brackets in spreadsheet software
+    if (to_string(cc_c_cm[i]).compare(openxlsxNA.c_str()) != 0)
+      cell.append_attribute("cm") = to_string(cc_c_cm[i]).c_str();
+
+    // phonetics spelling
+    if (to_string(cc_c_ph[i]).compare(openxlsxNA.c_str()) != 0)
+      cell.append_attribute("ph") = to_string(cc_c_ph[i]).c_str();
+
+    // suppress curly brackets in spreadsheet software
+    if (to_string(cc_c_vm[i]).compare(openxlsxNA.c_str()) != 0)
+      cell.append_attribute("vm") = to_string(cc_c_vm[i]).c_str();
+
     // append nodes <c r="A1" ...><v>...</v></c>
 
     bool f_si = false;

tests/testthat/test-formulas.R

@@ -0,0 +1,28 @@
+test_that("load various formulas", {
+
+  fl <- system.file("extdata", "formula.xlsx", package = "openxlsx2")
+  wb <- wb_load(fl)
+
+  expect_true(!is.null(wb$metadata))
+
+  cc <- wb$worksheets[[1]]$sheet_data$cc
+
+  expect_identical(cc[1, "c_cm"], "1")
+  expect_identical(cc[1, "f_t"], "array")
+
+  tmp <- temp_xlsx()
+  expect_silent(wb$save(tmp))
+
+  wb1 <- wb_load(tmp)
+
+  expect_identical(
+    wb$worksheets[[1]]$sheet_data$cc,
+    wb1$worksheets[[1]]$sheet_data$cc
+  )
+
+  expect_identical(
+    wb$metadata,
+    wb1$metadata
+  )
+
+})

tests/testthat/test-writeData.R

@@ -6,8 +6,10 @@ test_that("write_formula", {
   # array formula for a single cell
   exp <- structure(
     list(row_r = "2", c_r = "E", c_s = "_openxlsx_NA_",
-         c_t = "_openxlsx_NA_", v = "_openxlsx_NA_",
-         f = "SUM(C2:C11*D2:D11)",  f_t = "array", f_ref = "E2:E2",
+         c_t = "_openxlsx_NA_", c_cm = "_openxlsx_NA_",
+         c_ph = "_openxlsx_NA_", c_vm = "_openxlsx_NA_",
+         v = "_openxlsx_NA_", f = "SUM(C2:C11*D2:D11)",
+         f_t = "array", f_ref = "E2:E2",
          f_ca = "_openxlsx_NA_", f_si = "_openxlsx_NA_",
          is = "_openxlsx_NA_", typ = NA_character_, r = "E2"),
     row.names = "3", class = "data.frame")
@@ -22,7 +24,7 @@ test_that("write_formula", {
 
   cc <- wb$worksheets[[1]]$sheet_data$cc
   got <- cc[cc$row_r == "2" & cc$c_r == "E",]
-  expect_equal(exp[1:11], got[1:11])
+  expect_equal(exp[1:16], got[1:16])
 
 
   rownames(exp) <- "31"