Merge pull request #501 from JanMarvin/colour_color

Colour color pt1
JanMarvin · Dec 31, 2022 · cf3f888 · cf3f888
2 parents 3e9a0d5 + e14ece9
commit cf3f888
Show file tree

Hide file tree

Showing 19 changed files with 230 additions and 42 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -68,6 +68,7 @@ export(wb_add_worksheet)
 export(wb_clean_sheet)
 export(wb_clone_sheet_style)
 export(wb_clone_worksheet)
+export(wb_color)
 export(wb_colour)
 export(wb_conditional_formatting)
 export(wb_data)

diff --git a/R/class-color.R b/R/class-color.R
@@ -1,5 +1,4 @@
-
-#' Create a new hyperlink object
+#' Create a new wbColour object
 #' @param name A name of a color known to R
 #' @param auto A boolean.
 #' @param indexed An indexed color values.
@@ -35,4 +34,51 @@ wb_colour <- function(
   z
 }
 
+#' @export
+#' @rdname wbColour
+#' @usage NULL
+wb_color <- wb_colour
+
 is_wbColour <- function(x) inherits(x, "wbColour")
+
+#' takes color and returns colour
+#' @param ... ...
+#' @returns named colour argument
+#' @keywords internal
+#' @noRd
+standardise_color_names <- function(...) {
+
+  got <- ...names()
+  # can be Colour or colour
+  got_colour <- which(grepl("color", tolower(got)))
+
+  if (length(got_colour)) {
+    for (got_col in got_colour) {
+      colour <- got[got_col]
+      name_color <- stringi::stri_replace_all_fixed(colour, "olor", "olour", )
+      value_color <- ...elt(got_col)
+      assign(name_color, value_color, parent.frame())
+    }
+  }
+}
+
+#' takes colour and returns color
+#' @param ... ...
+#' @returns named color argument
+#' @keywords internal
+#' @noRd
+standardize_colour_names <- function(...) {
+
+  got <- ...names()
+  # can be Colour or colour
+  got_colour <- which(grepl("colour", tolower(got)))
+
+  if (length(got_colour)) {
+    for (got_col in got_colour) {
+      colour <- got[got_col]
+      name_color <- stringi::stri_replace_all_fixed(colour, "olour", "olor", )
+      value_color <- ...elt(got_col)
+      assign(name_color, value_color, parent.frame())
+    }
+  }
+}
diff --git a/R/class-workbook-wrappers.R b/R/class-workbook-wrappers.R
@@ -354,6 +354,7 @@ wb_unmerge_cells <- function(wb, sheet = current_sheet(), rows = NULL, cols = NU
 #' @param zoom A numeric between 10 and 400. Worksheet zoom level as a
 #'   percentage.
 #' @param visible If FALSE, sheet is hidden else visible.
+#' @param ... ...
 #' @details After chartsheet creation a chart must be added to the sheet.
 #' Otherwise the chartsheet will break the workbook.
 #' @family workbook wrappers
@@ -364,14 +365,16 @@ wb_add_chartsheet <- function(
   sheet       = next_sheet(),
   tabColour   = NULL,
   zoom        = 100,
-  visible     = c("true", "false", "hidden", "visible", "veryhidden")
+  visible     = c("true", "false", "hidden", "visible", "veryhidden"),
+  ...
 ) {
   assert_workbook(wb)
   wb$clone()$add_chartsheet(
     sheet       = sheet,
     tabColour   = tabColour,
     zoom        = zoom,
-    visible     = visible
+    visible     = visible,
+    ...         = ...
   )
 }
 
@@ -401,6 +404,7 @@ wb_add_chartsheet <- function(
 #'   options("openxlsx2.hdpi" = X)
 #' @param vdpi Vertical DPI. Can be set with options("openxlsx2.dpi" = X) or
 #'   options("openxlsx2.vdpi" = X)
+#' @param ... ...
 #' @details Headers and footers can contain special tags \itemize{
 #'   \item{**&\[Page\]**}{ Page number} \item{**&\[Pages\]**}{ Number of pages}
 #'   \item{**&\[Date\]**}{ Current date} \item{**&\[Time\]**}{ Current time}
@@ -473,7 +477,8 @@ wb_add_worksheet <- function(
   paperSize   = getOption("openxlsx2.paperSize", default = 9),
   orientation = getOption("openxlsx2.orientation", default = "portrait"),
   hdpi        = getOption("openxlsx2.hdpi", default = getOption("openxlsx2.dpi", default = 300)),
-  vdpi        = getOption("openxlsx2.vdpi", default = getOption("openxlsx2.dpi", default = 300))
+  vdpi        = getOption("openxlsx2.vdpi", default = getOption("openxlsx2.dpi", default = 300)),
+  ...
 ) {
   assert_workbook(wb)
   wb$clone()$add_worksheet(
@@ -492,7 +497,8 @@ wb_add_worksheet <- function(
     paperSize   = paperSize,
     orientation = orientation,
     vdpi        = vdpi,
-    hdpi        = hdpi
+    hdpi        = hdpi,
+    ...         = ...
   )
 }
 
@@ -837,6 +843,7 @@ wb_remove_worksheet <- function(wb, sheet = current_sheet()) {
 #' @param fontSize font size
 #' @param fontColour font colour
 #' @param fontName Name of a font
+#' @param ... ...
 #' @details The font name is not validated in anyway.  Excel replaces unknown font names
 #' with Arial. Base font is black, size 11, Calibri.
 #' @export
@@ -849,12 +856,19 @@ wb_remove_worksheet <- function(wb, sheet = current_sheet()) {
 #'
 #' wb$add_data("S1", iris)
 #' wb$add_data_table("S1", x = iris, startCol = 10) ## font colour does not affect tables
-wb_set_base_font <- function(wb, fontSize = 11, fontColour = wb_colour(theme = "1"), fontName = "Calibri") {
+wb_set_base_font <- function(
+  wb,
+  fontSize = 11,
+  fontColour = wb_colour(theme = "1"),
+  fontName = "Calibri",
+  ...
+) {
   assert_workbook(wb)
   wb$clone()$set_base_font(
     fontSize   = fontSize,
     fontColour = fontColour,
-    fontName   = fontName
+    fontName   = fontName,
+    ...        = ...
   )
 }
 
@@ -2171,6 +2185,7 @@ wb_set_cell_style <- function(wb, sheet = current_sheet(), dims, style) {
 #' @param dims dimensions on the worksheet e.g. "A1", "A1:A5", "A1:H5"
 #' @param bottom_color,left_color,right_color,top_color,inner_hcolor,inner_vcolor a color, either something openxml knows or some RGB color
 #' @param left_border,right_border,top_border,bottom_border,inner_hgrid,inner_vgrid the border style, if NULL no border is drawn. See create_border for possible border styles
+#' @param ... ...
 #' @seealso [create_border()]
 #' @examples
 #' wb <- wb_workbook() %>% wb_add_worksheet("S1") %>%  wb_add_data("S1", mtcars)
@@ -2207,7 +2222,8 @@ wb_add_border <- function(
     inner_hgrid    = NULL,
     inner_hcolor   = NULL,
     inner_vgrid    = NULL,
-    inner_vcolor   = NULL
+    inner_vcolor   = NULL,
+    ...
 ) {
   assert_workbook(wb)
   wb$clone()$add_border(
@@ -2224,7 +2240,8 @@ wb_add_border <- function(
     inner_hgrid   = inner_hgrid,
     inner_hcolor  = inner_hcolor,
     inner_vgrid   = inner_vgrid,
-    inner_vcolor  = inner_vcolor
+    inner_vcolor  = inner_vcolor,
+    ...           = ...
   )
 
 }
@@ -2244,6 +2261,7 @@ wb_add_border <- function(
 #' @param gradient_fill a gradient fill xml pattern.
 #' @param every_nth_col which col should be filled
 #' @param every_nth_row which row should be filled
+#' @param ... ...
 #' @examples
 #' wb <- wb_workbook() %>% wb_add_worksheet("S1") %>% wb_add_data("S1", mtcars)
 #' wb <- wb %>% wb_add_fill("S1", dims = "D5:J23", color = wb_colour(hex = "FFFFFF00"))
@@ -2273,7 +2291,8 @@ wb_add_fill <- function(
     pattern       = "solid",
     gradient_fill = "",
     every_nth_col = 1,
-    every_nth_row = 1
+    every_nth_row = 1,
+    ...
 ) {
   assert_workbook(wb)
   wb$clone()$add_fill(
@@ -2283,7 +2302,8 @@ wb_add_fill <- function(
     pattern       = pattern,
     gradient_fill = gradient_fill,
     every_nth_col = every_nth_col,
-    every_nth_row = every_nth_row
+    every_nth_row = every_nth_row,
+    ...           = ...
   )
 }
 
@@ -2307,6 +2327,7 @@ wb_add_fill <- function(
 #' @param shadow shadow
 #' @param extend extend
 #' @param vertAlign vertical alignment
+#' @param ... ...
 #' @examples
 #'  wb <- wb_workbook() %>% wb_add_worksheet("S1") %>% wb_add_data("S1", mtcars)
 #'  wb %>% wb_add_font("S1", "A1:K1", name = "Arial", color = wb_colour(theme = "4"))
@@ -2332,7 +2353,8 @@ wb_add_font <- function(
       family    = "",
       scheme    = "",
       shadow    = "",
-      vertAlign = ""
+      vertAlign = "",
+      ...
 ) {
   assert_workbook(wb)
   wb$clone()$add_font(
@@ -2353,7 +2375,8 @@ wb_add_font <- function(
     family    = family,
     scheme    = scheme,
     shadow    = shadow,
-    vertAlign = vertAlign
+    vertAlign = vertAlign,
+    ...       = ...
   )
 }
 

diff --git a/R/class-workbook.R b/R/class-workbook.R
@@ -331,12 +331,14 @@ wbWorkbook <- R6::R6Class(
     #' @param tabColour tabColour
     #' @param zoom zoom
     #' @param visible visible
+    #' @param ... ...
     #' @return The `wbWorkbook` object, invisibly
     add_chartsheet = function(
       sheet     = next_sheet(),
       tabColour = NULL,
       zoom      = 100,
-      visible   = c("true", "false", "hidden", "visible", "veryhidden")
+      visible   = c("true", "false", "hidden", "visible", "veryhidden"),
+      ...
     ) {
       visible <- tolower(as.character(visible))
       visible <- match.arg(visible)
@@ -379,6 +381,7 @@ wbWorkbook <- R6::R6Class(
         )
       )
 
+      standardise_color_names(...)
       if (!is.null(tabColour)) {
         if (is_wbColour(tabColour)) {
           tabColour <- as.character(tabColour)
@@ -475,6 +478,7 @@ wbWorkbook <- R6::R6Class(
     #' @param orientation orientation
     #' @param hdpi hdpi
     #' @param vdpi vdpi
+    #' @param ... ...
     #' @return The `wbWorkbook` object, invisibly
     add_worksheet = function(
       sheet       = next_sheet(),
@@ -495,7 +499,8 @@ wbWorkbook <- R6::R6Class(
       paperSize   = getOption("openxlsx2.paperSize", default = 9),
       orientation = getOption("openxlsx2.orientation", default = "portrait"),
       hdpi        = getOption("openxlsx2.hdpi", default = getOption("openxlsx2.dpi", default = 300)),
-      vdpi        = getOption("openxlsx2.vdpi", default = getOption("openxlsx2.dpi", default = 300))
+      vdpi        = getOption("openxlsx2.vdpi", default = getOption("openxlsx2.dpi", default = 300)),
+      ...
     ) {
       visible <- tolower(as.character(visible))
       visible <- match.arg(visible)
@@ -529,6 +534,7 @@ wbWorkbook <- R6::R6Class(
         msg <- c(msg, "gridLines must be a logical of length 1.")
       }
 
+      standardise_color_names(...)
       if (!is.null(tabColour)) {
         if (is_wbColour(tabColour)) {
           tabColour <- as.character(tabColour)
@@ -2001,9 +2007,11 @@ wbWorkbook <- R6::R6Class(
     #' @param fontSize fontSize
     #' @param fontColour fontColour
     #' @param fontName fontName
+    #' @param ... ...
     #' @return The `wbWorkbook` object
-    set_base_font = function(fontSize = 11, fontColour = wb_colour(theme = "1"), fontName = "Calibri") {
+    set_base_font = function(fontSize = 11, fontColour = wb_colour(theme = "1"), fontName = "Calibri", ...) {
       if (fontSize < 0) stop("Invalid fontSize")
+      standardise_color_names(...)
       if (is.character(fontColour) && is.null(names(fontColour))) fontColour <- wb_colour(fontColour)
       self$styles_mgr$styles$fonts[[1]] <- create_font(sz = as.character(fontSize), color = fontColour, name = fontName)
     },
@@ -4791,6 +4799,7 @@ wbWorkbook <- R6::R6Class(
     #' @param dims dimensions on the worksheet e.g. "A1", "A1:A5", "A1:H5"
     #' @param bottom_color,left_color,right_color,top_color,inner_hcolor,inner_vcolor a color, either something openxml knows or some RGB color
     #' @param left_border,right_border,top_border,bottom_border,inner_hgrid,inner_vgrid the border style, if NULL no border is drawn. See create_border for possible border styles
+    #' @param ... ...
     #' @seealso create_border
     #' @examples
     #'
@@ -4832,7 +4841,8 @@ wbWorkbook <- R6::R6Class(
       inner_hgrid   = NULL,
       inner_hcolor  = NULL,
       inner_vgrid   = NULL,
-      inner_vcolor  = NULL
+      inner_vcolor  = NULL,
+      ...
     ) {
 
       # TODO merge styles and if a style is already present, only add the newly
@@ -4841,6 +4851,8 @@ wbWorkbook <- R6::R6Class(
       # cc <- wb$worksheets[[sheet]]$sheet_data$cc
       # df_s <- as.data.frame(lapply(df, function(x) cc$c_s[cc$r %in% x]))
 
+      standardize_colour_names(...)
+
       df <- dims_to_dataframe(dims, fill = TRUE)
       sheet <- private$get_sheet_index(sheet)
 
@@ -5223,6 +5235,7 @@ wbWorkbook <- R6::R6Class(
     #' @param gradient_fill a gradient fill xml pattern.
     #' @param every_nth_col which col should be filled
     #' @param every_nth_row which row should be filled
+    #' @param ... ...
     #' @examples
     #'  # example from the gradient fill manual page
     #'  gradient_fill <- "<gradientFill degree=\"90\">
@@ -5237,7 +5250,8 @@ wbWorkbook <- R6::R6Class(
         pattern       = "solid",
         gradient_fill = "",
         every_nth_col = 1,
-        every_nth_row = 1
+        every_nth_row = 1,
+        ...
     ) {
       sheet <- private$get_sheet_index(sheet)
       private$do_cell_init(sheet, dims)
@@ -5254,6 +5268,8 @@ wbWorkbook <- R6::R6Class(
       cc <- cc[cc$r %in% dims, ]
       styles <- unique(cc[["c_s"]])
 
+      standardize_colour_names(...)
+
       for (style in styles) {
         dim <- cc[cc$c_s == style, "r"]
 
@@ -5292,6 +5308,7 @@ wbWorkbook <- R6::R6Class(
     #' @param shadow shadow
     #' @param extend extend
     #' @param vertAlign vertical alignment
+    #' @param ... ...
     #' @examples
     #'  wb <- wb_workbook()$add_worksheet("S1")$add_data("S1", mtcars)
     #'  wb$add_font("S1", "A1:K1", name = "Arial", color = wb_colour(theme = "4"))
@@ -5314,7 +5331,8 @@ wbWorkbook <- R6::R6Class(
         family    = "",
         scheme    = "",
         shadow    = "",
-        vertAlign = ""
+        vertAlign = "",
+        ...
     ) {
       sheet <- private$get_sheet_index(sheet)
       private$do_cell_init(sheet, dims)
@@ -5326,6 +5344,8 @@ wbWorkbook <- R6::R6Class(
       cc <- cc[cc$r %in% dims, ]
       styles <- unique(cc[["c_s"]])
 
+      standardize_colour_names(...)
+
       for (style in styles) {
         dim <- cc[cc$c_s == style, "r"]