fix: apply defined text-format to empty cells

fix #153
fix #661

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: flextable
 Title: Functions for Tabular Reporting
-Version: 0.9.7.014
+Version: 0.9.7.015
 Authors@R: c(
     person("David", "Gohel", , "[email protected]", role = c("aut", "cre")),
     person("ArData", role = "cph"),

NEWS.md

@@ -18,6 +18,7 @@ rmarkdown (issue #632)
 - `proc_freq` can now display only the table percentages without the count 
 using `include.table_count = FALSE`.
 - bring back support for 'pagedown' with `pagedown >= 0.20.2`
+- apply defined text-format to empty cells  
 
 # flextable 0.9.6
 

R/docx_str.R

@@ -203,6 +203,29 @@ wml_cells <- function(value, cell_data) {
   cell_data
 }
 
+default_fp_text_wml <- function(value) {
+  default_chunks_properties <- information_data_default_chunk(value)
+  unique_text_props <- distinct_text_properties(default_chunks_properties)
+  rpr <- sapply(
+    split(unique_text_props[setdiff(colnames(unique_text_props), "classname")], unique_text_props$classname),
+    function(x) {
+      z <- do.call(officer::fp_text_lite, x)
+      format(z, type = "wml")
+    }
+  )
+
+  unique_text_props$fp_txt_default <- unname(rpr[unique_text_props$classname])
+  setDT(default_chunks_properties)
+  default_chunks_properties <- merge(
+    default_chunks_properties, unique_text_props,
+    by = c("color", "font.size", "bold", "italic", "underlined", "font.family",
+           "hansi.family", "eastasia.family", "cs.family", "vertical.align",
+           "shading.color")
+  )
+  setDF(default_chunks_properties)
+  default_chunks_properties <- default_chunks_properties[, c(".part", ".row_id", ".col_id", "fp_txt_default")]
+  default_chunks_properties
+}
 
 
 wml_rows <- function(value, split = FALSE) {
@@ -234,7 +257,14 @@ wml_rows <- function(value, split = FALSE) {
   cell_hrule <- fortify_hrule(value)
 
   setDT(cell_data)
+
+  default_chunks_properties <- default_fp_text_wml(value)
   tab_data <- merge(cell_data, ooxml_ppr(paragraphs_properties), by = c(".part", ".row_id", ".col_id"))
+  tab_data <- merge(tab_data, default_chunks_properties, by = c(".part", ".row_id", ".col_id"))
+  tab_data[, c("fp_par_xml", "fp_txt_default") := list(
+    paste0(substr(.SD$fp_par_xml, 1, nchar(.SD$fp_par_xml)-8), .SD$fp_txt_default, "</w:pPr>"),
+    NULL
+  )]
   tab_data <- merge(tab_data, run_data, by = c(".part", ".row_id", ".col_id"))
   tab_data <- merge(tab_data, span_data, by = c(".part", ".row_id", ".col_id"))
   setorderv(tab_data, cols = c(".part", ".row_id", ".col_id"))

R/read_structure.R

@@ -227,6 +227,28 @@ fortify_content <- function(x, default_chunk_fmt, ..., expand_special_chars = TR
   out
 }
 
+information_data_default_chunk <- function(x) {
+  dat <- list()
+  if (nrow_part(x, "header") > 0) {
+    dat$header <- text_struct_to_df(x$header$styles[["text"]])
+  }
+  if (nrow_part(x, "body") > 0) {
+    dat$body <- text_struct_to_df(x$body$styles[["text"]])
+  }
+  if (nrow_part(x, "footer") > 0) {
+    dat$footer <- text_struct_to_df(x$footer$styles[["text"]])
+  }
+  dat <- rbindlist(dat, use.names = TRUE, idcol = ".part")
+
+  dat$.part <- factor(dat$.part, levels = c("header", "body", "footer"))
+  dat$.col_id <- factor(dat$.col_id, levels = x$col_keys)
+  setorderv(dat, cols = c(".part", ".row_id", ".col_id"))
+  setcolorder(dat, neworder = c(".part", ".row_id", ".col_id"))
+
+  setDF(dat)
+
+  dat
+}
 
 #' @importFrom data.table rbindlist setDF setcolorder
 #' @export