* add standardize()

* wb_add_chartsheet

R/class-color.R

@@ -43,59 +43,3 @@ wb_color <- function(
 wb_colour <- wb_color
 
 is_wbColour <- function(x) inherits(x, "wbColour")
-
-#' takes colour and returns color
-#' @param ... ...
-#' @returns void. assigns an object in the parent frame
-#' @keywords internal
-#' @noRd
-standardize_color_names <- function(...) {
-
-  # since R 4.1.0: ...names()
-  args <- list(...)
-  got <- names(args)
-  # can be Color or color
-  got_color <- which(grepl("colour", tolower(got)))
-
-  if (length(got_color)) {
-    for (got_col in got_color) {
-      color <- got[got_col]
-      name_color <- stringi::stri_replace_all_fixed(color, "olour", "olor", )
-      # since R 3.5.0: ...elt(got_col)
-      value_color <- args[[got_col]]
-      assign(name_color, value_color, parent.frame())
-    }
-  }
-}
-
-#' takes camelCase and returns camel_case
-#' @param ... ...
-#' @returns void. assigns an object in the parent frame
-#' @keywords internal
-#' @noRd
-standardize_case_names <- function(...) {
-
-  # since R 4.1.0: ...names()
-  args <- list(...)
-  got <- names(args)
-
-  regex <- "(\\G(?!^)|\\b[a-zA-Z][a-z]*)([A-Z][a-z]*|\\d+)"
-
-  got_camel_cases <- which(grepl(regex, got, perl = TRUE))
-
-  if (length(got_camel_cases)) {
-    for (got_camel_case in got_camel_cases) {
-      camel_case <- got[got_camel_case]
-      name_camel_case <- gsub(
-        pattern     = regex,
-        replacement = "\\L\\1_\\2",
-        x           = camel_case,
-        perl        = TRUE
-      )
-      # since R 3.5.0: ...elt(got_col)
-      value_camel_calse <- args[[got_camel_case]]
-      assign(name_camel_case, value_camel_calse, parent.frame())
-    }
-  }
-
-}

R/class-workbook-wrappers.R

@@ -491,16 +491,16 @@ wb_unmerge_cells <- function(wb, sheet = current_sheet(), rows = NULL, cols = NU
 #' @export
 wb_add_chartsheet <- function(
   wb,
-  sheet       = next_sheet(),
-  tabColor    = NULL,
-  zoom        = 100,
-  visible     = c("true", "false", "hidden", "visible", "veryhidden"),
+  sheet     = next_sheet(),
+  tab_color = NULL,
+  zoom      = 100,
+  visible   = c("true", "false", "hidden", "visible", "veryhidden"),
   ...
 ) {
   assert_workbook(wb)
   wb$clone()$add_chartsheet(
     sheet       = sheet,
-    tabColor    = tabColor,
+    tab_color   = tab_color,
     zoom        = zoom,
     visible     = visible,
     ...         = ...

R/class-workbook.R

@@ -361,14 +361,14 @@ wbWorkbook <- R6::R6Class(
     #' @description
     #' Add a chart sheet to the workbook
     #' @param sheet sheet
-    #' @param tabColor tabColor
+    #' @param tab_color tab_color
     #' @param zoom zoom
     #' @param visible visible
     #' @param ... ...
     #' @return The `wbWorkbook` object, invisibly
     add_chartsheet = function(
       sheet     = next_sheet(),
-      tabColor  = NULL,
+      tab_color = NULL,
       zoom      = 100,
       visible   = c("true", "false", "hidden", "visible", "veryhidden"),
       ...
@@ -420,12 +420,13 @@ wbWorkbook <- R6::R6Class(
         )
       )
 
-      standardize_color_names(...)
-      if (!is.null(tabColor)) {
-        if (is_wbColour(tabColor)) {
-          tabColor <- as.character(tabColor)
+      standardize(...)
+
+      if (!is.null(tab_color)) {
+        if (is_wbColour(tab_color)) {
+          tab_color <- as.character(tab_color)
         } else {
-          tabColor <- validateColor(tabColor, "Invalid tabColor in add_chartsheet.")
+          tab_color <- validateColor(tab_color, "Invalid tab_color in add_chartsheet.")
         }
       }
 
@@ -444,7 +445,7 @@ wbWorkbook <- R6::R6Class(
 
       self$append("worksheets",
         wbChartSheet$new(
-          tabColor = tabColor
+          tabColor = tab_color
         )
       )
 

R/standardize.R

@@ -0,0 +1,93 @@
+
+#' takes colour and returns color
+#' @param ... ...
+#' @returns void. assigns an object in the parent frame
+#' @keywords internal
+#' @noRd
+standardize_color_names <- function(..., return = FALSE) {
+
+  # since R 4.1.0: ...names()
+  args <- list(...)
+  if (return) {
+    args <- args[[1]]
+  }
+  got <- names(args)
+  # can be Color or color
+  got_color <- which(grepl("colour", tolower(got)))
+
+  if (length(got_color)) {
+    for (got_col in got_color) {
+      color <- got[got_col]
+      name_color <- stringi::stri_replace_all_fixed(color, "olour", "olor")
+
+      if (return) {
+        names(args)[got_col] <- name_color
+      } else {
+        # since R 3.5.0: ...elt(got_col)
+        value_color <- args[[got_col]]
+        assign(name_color, value_color, parent.frame())
+      }
+    }
+  }
+
+  if (return) args
+}
+
+#' takes camelCase and returns camel_case
+#' @param ... ...
+#' @returns void. assigns an object in the parent frame
+#' @keywords internal
+#' @noRd
+standardize_case_names <- function(..., return = FALSE) {
+
+  # since R 4.1.0: ...names()
+  args <- list(...)
+  if (return) {
+    args <- args[[1]]
+  }
+  got <- names(args)
+
+  regex <- "(\\G(?!^)|\\b[a-zA-Z][a-z]*)([A-Z][a-z]*|\\d+)"
+
+  got_camel_cases <- which(grepl(regex, got, perl = TRUE))
+
+  if (length(got_camel_cases)) {
+    for (got_camel_case in got_camel_cases) {
+      camel_case <- got[got_camel_case]
+      name_camel_case <- gsub(
+        pattern     = regex,
+        replacement = "\\L\\1_\\2",
+        x           = camel_case,
+        perl        = TRUE
+      )
+      # since R 3.5.0: ...elt(got_col)
+      if (return) {
+        names(args)[got_camel_case] <- name_camel_case
+      } else {
+        value_camel_calse <- args[[got_camel_case]]
+        assign(name_camel_case, value_camel_calse, parent.frame())
+      }
+    }
+  }
+
+  if (return) args
+
+}
+
+#' takes camelCase and colour returns camel_case and color
+#' @param ... ...
+#' @returns void. assigns an object in the parent frame
+#' @keywords internal
+#' @noRd
+standardize <- function(...) {
+
+  nms <- list(...)
+
+  rtns <- standardize_color_names(nms, return = TRUE)
+  rtns <- standardize_case_names(rtns, return = TRUE)
+
+  nms <- names(rtns)
+  for (i in seq_along(nms)) {
+    assign(nms[[i]], rtns[[i]], parent.frame())
+  }
+}

tests/testthat/test-standardize.R

@@ -0,0 +1,19 @@
+test_that("standardize works", {
+
+  color <- NULL
+  standardize_color_names(colour = "green")
+  expect_equal(get("color"), "green")
+
+  tabColor <- NULL
+  standardize_color_names(tabColour = "green")
+  expect_equal(get("tabColor"), "green")
+
+  camelCase <- NULL
+  standardize_case_names(camelCase = "green")
+  expect_equal(get("camel_case"), "green")
+
+  tab_color <- NULL
+  standardize(tabColour = "green")
+  expect_equal(get("tab_color"), "green")
+
+})