diff --git a/R/class-color.R b/R/class-color.R index 7e4b6ed45..444764a20 100644 --- a/R/class-color.R +++ b/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()) - } - } - -} diff --git a/R/class-workbook-wrappers.R b/R/class-workbook-wrappers.R index 9703c33c6..595937b37 100644 --- a/R/class-workbook-wrappers.R +++ b/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, ... = ... diff --git a/R/class-workbook.R b/R/class-workbook.R index 9c7fac608..4da1cbfc0 100644 --- a/R/class-workbook.R +++ b/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 ) ) diff --git a/R/standardize.R b/R/standardize.R new file mode 100644 index 000000000..ebb39379f --- /dev/null +++ b/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()) + } +} diff --git a/man/wbWorkbook.Rd b/man/wbWorkbook.Rd index c239d49e5..0022cc2da 100644 --- a/man/wbWorkbook.Rd +++ b/man/wbWorkbook.Rd @@ -438,7 +438,7 @@ Add a chart sheet to the workbook \subsection{Usage}{ \if{html}{\out{
}}\preformatted{wbWorkbook$add_chartsheet( sheet = next_sheet(), - tabColor = NULL, + tab_color = NULL, zoom = 100, visible = c("true", "false", "hidden", "visible", "veryhidden"), ... @@ -450,7 +450,7 @@ Add a chart sheet to the workbook \describe{ \item{\code{sheet}}{sheet} -\item{\code{tabColor}}{tabColor} +\item{\code{tab_color}}{tab_color} \item{\code{zoom}}{zoom} diff --git a/man/wb_add_chartsheet.Rd b/man/wb_add_chartsheet.Rd index fcc8baaa1..fd0a375a0 100644 --- a/man/wb_add_chartsheet.Rd +++ b/man/wb_add_chartsheet.Rd @@ -7,7 +7,7 @@ wb_add_chartsheet( wb, sheet = next_sheet(), - tabColor = NULL, + tab_color = NULL, zoom = 100, visible = c("true", "false", "hidden", "visible", "veryhidden"), ... @@ -18,15 +18,15 @@ wb_add_chartsheet( \item{sheet}{A name for the new worksheet} -\item{tabColor}{Color of the worksheet tab. A valid color (belonging to -colors()) or a valid hex color beginning with "#"} - \item{zoom}{A numeric between 10 and 400. Worksheet zoom level as a percentage.} \item{visible}{If FALSE, sheet is hidden else visible.} \item{...}{...} + +\item{tabColor}{Color of the worksheet tab. A valid color (belonging to +colors()) or a valid hex color beginning with "#"} } \description{ Add a chartsheet to a workbook diff --git a/tests/testthat/test-standardize.R b/tests/testthat/test-standardize.R new file mode 100644 index 000000000..c8a04c605 --- /dev/null +++ b/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") + +})