Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Colour color pt1 #501

Merged
merged 5 commits into from
Dec 31, 2022
Merged

Colour color pt1 #501

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
0621e70
use ... to pass color to colour
JanMarvin Dec 28, 2022
24597d0
use ... to pass colour to color
JanMarvin Dec 28, 2022
a42331e
add test
JanMarvin Dec 28, 2022
af8d0b5
fix check
JanMarvin Dec 28, 2022
e14ece9
missing newline at EOF
JanMarvin Dec 28, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
50 changes: 48 additions & 2 deletions R/class-color.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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.
Expand Down Expand Up @@ -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(...) {
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Do I understand this correctly?

foo <- function(color, ...) {
  standardized_color_name(...)  
  color
}

foo(color = 1)
#> [1] 1

foo(colour = 1)
#> [1] 1

Not sure how much I like messing around with re-assigning values. A simpler implementation could be:

foo <- function(color = colour, colour) {
  check_color_colour(color, colour)
  color
}

check_color_colour <- function(color, colour) {
  if (missing(colour)) {
    return(invisible())
  }
  
  if (!identical(color, colour)) {
    stop("both `color` and `colour` cannot be set")
  }
}

# setting only color
foo(1)
#> [1] 1

# setting only colour (turns into color)
foo(colour = 1)
#> [1] 1

# both are identical, that's fine
foo(color = 1, colour = 1)
#> [1] 1

# difference, we have a problem
try(foo(color = 1, colour = 2)) 
#> Error in check_color_colour(color, colour) : 
#>   both `color` and `colour` cannot be set

Created on 2022-12-28 with reprex v2.0.2
We'd have to include @params color, colour but it would keep it explicitly clear to the user.

Copy link
Owner Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

  1. Yes, that is all it does.
  2. I don't like duplicating all arguments. It creates visual confusion, especially with the border stuff and all the different colors. We'll end up with 10 different color arguments and a bunch of comparison functions. Therefore I mimicked the ggplot2::aes() approach. The difference to their approach is that they only have a single argument to care about, while we have various. But true, I haven't considered the foo(color = 1, colour = 2) approach. Might want to throw a warning if this exists in parent.frame()

Copy link
Owner Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Update: 12 different colors ... we have two for the inner grid and checking with exists() is not enough, because they all exist at this stage. Maybe this will change once you get to #226 *winkwink*.
Therefore I consider keeping it the way it is. After all no harm is done this way. If the user ends up with a unexpected color ... there are more important things to worry about. If their input creates no color at all, fine too. I'd love for R to have a dynamic way to handle this case. Otherwise I simply strive for a consistent user interface.


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())
}
}
}
47 changes: 35 additions & 12 deletions R/class-workbook-wrappers.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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,
... = ...
)
}

Expand Down Expand Up @@ -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}
Expand Down Expand Up @@ -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(
Expand All @@ -492,7 +497,8 @@ wb_add_worksheet <- function(
paperSize = paperSize,
orientation = orientation,
vdpi = vdpi,
hdpi = hdpi
hdpi = hdpi,
... = ...
)
}

Expand Down Expand Up @@ -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
Expand All @@ -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,
... = ...
)
}

Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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(
Expand All @@ -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,
... = ...
)

}
Expand All @@ -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"))
Expand Down Expand Up @@ -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(
Expand All @@ -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,
... = ...
)
}

Expand All @@ -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"))
Expand All @@ -2332,7 +2353,8 @@ wb_add_font <- function(
family = "",
scheme = "",
shadow = "",
vertAlign = ""
vertAlign = "",
...
) {
assert_workbook(wb)
wb$clone()$add_font(
Expand All @@ -2353,7 +2375,8 @@ wb_add_font <- function(
family = family,
scheme = scheme,
shadow = shadow,
vertAlign = vertAlign
vertAlign = vertAlign,
... = ...
)
}

Expand Down
32 changes: 26 additions & 6 deletions R/class-workbook.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -379,6 +381,7 @@ wbWorkbook <- R6::R6Class(
)
)

standardise_color_names(...)
if (!is.null(tabColour)) {
if (is_wbColour(tabColour)) {
tabColour <- as.character(tabColour)
Expand Down Expand Up @@ -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(),
Expand All @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
},
Expand Down Expand Up @@ -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
#'
Expand Down Expand Up @@ -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
Expand All @@ -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)

Expand Down Expand Up @@ -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\">
Expand All @@ -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)
Expand All @@ -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"]

Expand Down Expand Up @@ -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"))
Expand All @@ -5314,7 +5331,8 @@ wbWorkbook <- R6::R6Class(
family = "",
scheme = "",
shadow = "",
vertAlign = ""
vertAlign = "",
...
) {
sheet <- private$get_sheet_index(sheet)
private$do_cell_init(sheet, dims)
Expand All @@ -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"]

Expand Down
Loading