fix: apply defined text-format to empty cells in pptx

fix #153

DESCRIPTION

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

NEWS.md

@@ -22,7 +22,8 @@ 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`
-- flextable now applies defined text-format to empty cells  
+- flextable now applies defined text-format to empty cells for Word and
+Powerpoint outputs.
 
 # flextable 0.9.6
 

R/pptx_str.R

@@ -10,6 +10,33 @@ pml_spans <- function(value) {
   )
   span_data
 }
+default_fp_text_pml <- 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)
+      val <- format(z, type = "pml")
+      val <- gsub("<a:rPr", "<a:endParaRPr", val, fixed = TRUE)
+      val <- gsub("</a:rPr>", "</a:endParaRPr>", val, fixed = TRUE)
+      val
+    }
+  )
+
+  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
+}
+
 
 #' @importFrom data.table shift
 pml_cells <- function(value, cell_data) {
@@ -114,10 +141,19 @@ gen_raw_pml <- function(value, uid = 99999L, offx = 0, offy = 0, cx = 0, cy = 0)
   cell_data <- pml_cells(value, cell_attributes)
   cell_heights <- fortify_height(value)
 
+  default_chunks_properties <- default_fp_text_pml(value)
+
   setDT(cell_data)
 
   tab_data <- merge(cell_data, par_data, by = c(".part", ".row_id", ".col_id"))
+  tab_data <- merge(tab_data, default_chunks_properties, by = c(".part", ".row_id", ".col_id"))
   tab_data <- merge(tab_data, txt_data, by = c(".part", ".row_id", ".col_id"))
+
+  tab_data[tab_data$is_empty %in% TRUE, c("fp_par_xml") := list(
+    paste0(.SD$fp_par_xml, .SD$fp_txt_default)
+  )]
+  tab_data[, c("fp_txt_default", "is_empty") := list(NULL, NULL)]
+
   tab_data <- merge(tab_data, span_data, by = c(".part", ".row_id", ".col_id"))
   tab_data$.col_id <- factor(tab_data$.col_id, levels = value$col_keys)
   setorderv(tab_data, cols = c(".part", ".row_id", ".col_id"))

R/runs_as_functions.R

@@ -382,6 +382,7 @@ runs_as_pml <- function(value) {
   txt_data[runs_types_lst$is_equation, c("opening_tag", "closing_tag") := list("", "")]
   txt_data[runs_types_lst$is_soft_return, c("opening_tag", "closing_tag") := list("<a:br>", "</a:br>")]
 
+  txt_data_is_empty <- txt_data[, list(is_empty = all(.SD$text_nodes_str %in% "<a:t></a:t>")) ,by = c(".part", ".row_id", ".col_id")]
   txt_data[, c("par_nodes_str") := list(
     paste0(.SD$opening_tag, .SD$rpr, .SD$text_nodes_str, .SD$closing_tag)
   )]
@@ -398,6 +399,7 @@ runs_as_pml <- function(value) {
     by = c(".part", ".row_id", ".col_id"),
     .SDcols = "par_nodes_str"
   ]
+  txt_data <- merge(txt_data, txt_data_is_empty, by = c(".part", ".row_id", ".col_id"))
   setDF(txt_data)
   txt_data
 }