[styles] allow updates of font elements

R/class-workbook-wrappers.R

@@ -3321,6 +3321,7 @@ wb_add_fill <- function(
 #' @param shadow shadow
 #' @param extend extend
 #' @param vert_align vertical alignment
+#' @param update update
 #' @param ... ...
 #' @examples
 #'  wb <- wb_workbook() %>% wb_add_worksheet("S1") %>% wb_add_data("S1", mtcars)
@@ -3351,6 +3352,7 @@ wb_add_font <- function(
       scheme     = "",
       shadow     = "",
       vert_align = "",
+      update     = FALSE,
       ...
 ) {
   assert_workbook(wb)
@@ -3373,6 +3375,7 @@ wb_add_font <- function(
     scheme     = scheme,
     shadow     = shadow,
     vert_align = vert_align,
+    update     = update,
     ...        = ...
   )
 }

R/class-workbook.R

@@ -8442,6 +8442,7 @@ wbWorkbook <- R6::R6Class(
     #' @param shadow shadow
     #' @param extend extend
     #' @param vert_align vertical alignment
+    #' @param update update
     #' @return The `wbWorkbook`, invisibly
     add_font = function(
         sheet      = current_sheet(),
@@ -8462,6 +8463,7 @@ wbWorkbook <- R6::R6Class(
         scheme     = "",
         shadow     = "",
         vert_align = "",
+        update     = FALSE,
         ...
     ) {
       sheet <- private$get_sheet_index(sheet)
@@ -8496,9 +8498,27 @@ wbWorkbook <- R6::R6Class(
           u = underline,
           vertAlign = vert_align
         )
-        self$styles_mgr$add(new_font, new_font)
 
         xf_prev <- get_cell_styles(self, sheet, dim[[1]])
+
+        if (update) {
+          font_id  <- as.integer(sapply(xml_attr(xf_prev, "xf"), "[[", "fontId")) + 1L
+          font_xml <- self$styles_mgr$styles$fonts[[font_id]]
+
+          # read as data frame with xml elements
+          old_font <- read_font(read_xml(font_xml))
+          new_font <- read_font(read_xml(new_font))
+
+          # update elements
+          sel <- new_font != ""
+          old_font[sel] <- new_font[sel]
+
+          # write as xml font
+          new_font <- write_font(old_font)
+        }
+
+        self$styles_mgr$add(new_font, new_font)
+
         xf_new_font <- set_font(xf_prev, self$styles_mgr$get_font_id(new_font))
 
         self$styles_mgr$add(xf_new_font, xf_new_font)