[style] update hyperlink to use theme and base size

R/class-workbook.R

@@ -3120,7 +3120,9 @@ wbWorkbook <- R6::R6Class(
       font_name  = "Aptos Narrow",
        ...
     ) {
-      standardize(...)
+      arguments <- c("font_size", "font_color", "font_name",
+        "font_type", "font_panose")
+      standardize(..., arguments = arguments)
       if (font_size < 0) stop("Invalid font_size")
       if (!is_wbColour(font_color)) font_color <- wb_color(font_color)
 
@@ -3132,9 +3134,11 @@ wbWorkbook <- R6::R6Class(
         if (!exists("font_type")) font_type <- "Regular"
 
         sel <- panose$family == font_name & panose$type == font_type
-        if (!any(sel)) {
-          warning("Could not find font in panose table. Ignoring panose entry.")
+        if (!any(sel) && !exists("font_panose")) {
           panose_hex <- NULL
+        } else if (exists("font_panose")) {
+          # the input provides a panose value
+          panose_hex <- font_panose
         } else {
           panose_hex <- panose[sel, "panose"]
         }

R/write.R

@@ -467,12 +467,27 @@ write_data2 <- function(
       dim_sel <- get_data_class_dims("hyperlink")
       # message("hyperlink: ", dim_sel)
 
+      # get hyperlink color from template
+      if (is.null(wb$theme)) {
+        has_hlink <- 11
+      } else {
+        clrs <- xml_node(wb$theme, "a:theme", "a:themeElements", "a:clrScheme")
+        has_hlink <- which(xml_node_name(clrs, "a:clrScheme") == "a:hlink")
+      }
+
+      if (has_hlink) {
+        hyperlink_col <- wb_color(theme = has_hlink - 1L)
+      } else {
+        hyperlink_col <- wb_color(hex = "FF0000FF")
+      }
+
       wb$add_font(
         sheet = sheetno,
-        dims = dim_sel,
-        color = wb_color(hex = "FF0000FF"),
-        name = wb_get_base_font(wb)$name$val,
-        u = "single"
+        dims  = dim_sel,
+        color = hyperlink_col,
+        name  = wb_get_base_font(wb)$name$val,
+        size  = wb_get_base_font(wb)$size$val,
+        u     = "single"
       )
     }
 

tests/testthat/test-base_font.R

@@ -72,4 +72,42 @@ test_that("wb_set_base_font() actually alters the base font", {
   fS <- xml_node(wb$theme, "a:theme", "a:themeElements", "a:fontScheme")
   expect_equal(character(), fS)
 
+  # custom panose values are possible
+  wb <- wb_workbook()$
+    set_base_font(font_name = "Monaco", font_panose = "xxxxxxxxxxxxxx")
+  fS <- xml_node(wb$theme, "a:theme", "a:themeElements", "a:fontScheme")
+
+  exp <- "<a:latin typeface=\"Monaco\" panose=\"xxxxxxxxxxxxxx\"/>"
+  got <- xml_node(fS, "a:fontScheme", "a:majorFont", "a:latin")
+  expect_equal(exp, got)
+  got <- xml_node(fS, "a:fontScheme", "a:minorFont", "a:latin")
+  expect_equal(exp, got)
+
+  # different font types are possible for panose, not sure how useful this is
+  wb <- wb_workbook()$
+    set_base_font(font_name = "Arial", font_type = "Italic")
+  fS <- xml_node(wb$theme, "a:theme", "a:themeElements", "a:fontScheme")
+
+  exp <- "<a:latin typeface=\"Arial\" panose=\"020B0604020202090204\"/>"
+  got <- xml_node(fS, "a:fontScheme", "a:majorFont", "a:latin")
+  expect_equal(exp, got)
+  got <- xml_node(fS, "a:fontScheme", "a:minorFont", "a:latin")
+  expect_equal(exp, got)
+
+})
+
+test_that("hyperlink font size works", {
+
+  wb <- wb_workbook()$
+    set_base_font(font_size = 13, font_name = "Monaco")$
+    add_worksheet()$
+    add_formula(x = create_hyperlink(text = "foo", file = "bar"))
+
+  exp <- c(
+    "<font><color theme=\"1\"/><family val=\"2\"/><name val=\"Monaco\"/><scheme val=\"minor\"/><sz val=\"13\"/></font>",
+    "<font><color theme=\"10\"/><name val=\"Monaco\"/><sz val=\"13\"/><u val=\"single\"/></font>"
+  )
+  got <- wb$styles_mgr$styles$fonts
+  expect_equal(exp, got)
+
 })