diff --git a/NEWS.md b/NEWS.md index 2dd7087..8f6fd92 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # clinify (development version) +- Fixed a second call to `clin_row_height()`, `clin_header_pad()` or `clin_spanner_rule()` replacing the first instead of refining it. Arguments the later call does not name now keep whatever the earlier one set, so a house wide setting and a per table exception can both be stated without restating the rest. Previously the earlier values reverted to their defaults with no error or warning ([#119](https://github.com/atorus-research/clinify/issues/119)) - `clin_row_height()` gained `header` and `header_leading`, completing the vertical pitch controls asked for in #97. `header` bounds the column header rows the way `body` bounds the body rows, and `header_leading` closes the gap between the lines *within* a header cell, which is what a wrapped arm label sitting looser than a reference output actually needs. Leading is a multiple of single spacing rather than a length, since that is how flextable and Word express it ([#117](https://github.com/atorus-research/clinify/issues/117)) - Fixed `clintable()` erroring on data carrying haven value labels. `attr()` partial matches, so a `labels` attribute of value labels - which `haven::read_xpt()` attaches to coded variables - was answering a request for `label` and being read as header text ([#107](https://github.com/atorus-research/clinify/issues/107)) - Fixed `use_labels = FALSE` not actually leaving column labels alone. flextable reads labels of its own accord and was never told not to, so the raw label string went into the header, `||` delimiter and all. This also gives a way past the flextable side of #107, since labels can now be turned off ([#107](https://github.com/atorus-research/clinify/issues/107)) diff --git a/R/header_pad.R b/R/header_pad.R index 63a5645..96642fc 100644 --- a/R/header_pad.R +++ b/R/header_pad.R @@ -30,6 +30,9 @@ #' added above the header it keeps its own spacing, since it is put there as #' the table renders. #' +#' Called a second time, this refines what the first call set rather than +#' replacing it: arguments this call does not name keep their earlier value. +#' #' Spacing is given in points, which is what flextable measures cell padding #' in. Whatever is set here replaces the header padding clinify starts with. #' @@ -80,9 +83,23 @@ clin_header_pad <- function( stop("`rule_to_body` must be a single number of points") } - pad$rows <- check_header_pad_rows_(rows) + # Only what this call actually named, so a second call refines the first + named <- c( + if (!missing(above)) "above", + if (!missing(below)) "below", + if (!missing(rule_to_body)) "rule_to_body" + ) + + supplied <- pad[named] - x$clinify_config$header_pad <- pad + if (!missing(rows)) { + supplied$rows <- check_header_pad_rows_(rows) + } + + x$clinify_config$header_pad <- merge_config_( + x$clinify_config$header_pad, + supplied + ) x } @@ -175,7 +192,10 @@ apply_header_pad_ <- function(x) { rows <- seq_len(depth) } else if (!all(rows <= depth)) { stop(sprintf( - "`rows` must be header row numbers between 1 and %s, the number of rows this header has", + paste( + "`rows` must be header row numbers between 1 and %s, the number of", + "rows this header has" + ), depth )) } @@ -204,7 +224,10 @@ pad_header_rows_ <- function(x, rows, value, side) { if (!length(value) %in% c(1, length(rows))) { stop(sprintf( - "Header spacing must be one value, or one for each of the %s rows it is aimed at, not %s", + paste( + "Header spacing must be one value, or one for each of the %s rows it", + "is aimed at, not %s" + ), length(rows), length(value) )) diff --git a/R/row_height.R b/R/row_height.R index aea0359..0a19290 100644 --- a/R/row_height.R +++ b/R/row_height.R @@ -18,6 +18,11 @@ #' gap *between* those lines, so it is the one to reach for when a wrapped arm #' label sits looser than a reference output. They can be used together. #' +#' Called a second time, this refines what the first call set rather than +#' replacing it: arguments this call does not name keep their earlier value. So +#' a house wide pitch can be set once and a single table can add an exception +#' without restating the rest. +#' #' The height is applied to whole parts, so it is a pitch for every row of the #' surface rather than a per-row height. Anything already set with #' `flextable::height()` or `flextable::height_all()` is replaced. Because the @@ -70,6 +75,11 @@ clin_row_height <- function( unit = c("pt", "in", "cm", "mm") ) { stopifnot(inherits(x, "clintable") || inherits(x, "clindoc")) + + # Captured before match.arg() assigns to them, which would clear their + # missing status and make a second call look like it had asked for the default + rule_given <- !missing(rule) + rule <- match.arg(rule) unit <- match.arg(unit) @@ -95,10 +105,38 @@ clin_row_height <- function( ) } - x$clinify_config$row_height <- c( - heights, - list(rule = rule, header_leading = check_header_leading_(header_leading)) + # Only what this call actually named, so a second call refines the first + # rather than replacing it. `rule` has a default, so being NULL cannot tell + # us whether the caller asked for it + named <- c( + if (!missing(body)) "body", + if (!missing(title)) "title", + if (!missing(footnote)) "footnote", + if (!missing(header)) "header" + ) + + supplied <- heights[named] + + if (!missing(header_leading)) { + supplied$header_leading <- check_header_leading_(header_leading) + } + + if (rule_given) { + supplied$rule <- rule + } + + # A second call refines the first rather than replacing it, so a house wide + # pitch and a per table exception can both be stated + x$clinify_config$row_height <- merge_config_( + x$clinify_config$row_height, + supplied ) + + # Whatever ends up configured still needs a rule to be applied with + if (is.null(x$clinify_config$row_height$rule)) { + x$clinify_config$row_height$rule <- rule + } + x } @@ -313,3 +351,31 @@ apply_header_leading_ <- function(x) { flextable::line_spacing(x, space = leading, part = "header") } + +#' Fold a verb's arguments into whatever it was given before +#' +#' The verbs that carry several settings are meant to be usable twice - a house +#' wide call, then a per table exception - so a second call refines the first +#' rather than replacing it. Only the arguments actually supplied are taken +#' from the new call; the rest keep what the earlier one set. +#' +#' Arguments whose default is not NULL, like `rule`, cannot be recognised by +#' being NULL, so the caller passes the names it actually saw with +#' `missing()`. +#' +#' @param previous The configuration already on the clintable, or NULL +#' @param supplied A named list of the values this call is setting +#' +#' @return The merged configuration +#' +#' @noRd +merge_config_ <- function(previous, supplied) { + if (is.null(previous)) { + return(supplied) + } + + # A name present in `supplied` wins, even where its value is NULL, so that + # nothing the caller asked for is quietly dropped + previous[names(supplied)] <- supplied + previous +} diff --git a/R/spanner_rule.R b/R/spanner_rule.R index bf2abb6..0685865 100644 --- a/R/spanner_rule.R +++ b/R/spanner_rule.R @@ -19,6 +19,9 @@ #' rather than a spanner, and the rule under the bottom row is the one the #' styling function draws across the whole table. #' +#' Called a second time, this refines what the first call set rather than +#' replacing it: arguments this call does not name keep their earlier value. +#' #' The rule is drawn as the table renders, after the default styling function #' has run. That is what makes it survive a house style: the stock #' `clinify_table_default()` opens with `flextable::border_remove()`, which @@ -65,10 +68,28 @@ clin_spanner_rule <- function(x, border = TRUE, rows = NULL) { stopifnot(inherits(x, "clintable")) - x$clinify_config$spanner_rule <- list( - border = check_spanner_border_(border), - rows = check_spanner_rows_(rows) + # Only what this call actually named, so a second call refines the first. + # `border` has a default, so being NULL cannot say if it was asked for + supplied <- list() + + if (!missing(border)) { + supplied$border <- check_spanner_border_(border) + } + + if (!missing(rows)) { + supplied$rows <- check_spanner_rows_(rows) + } + + x$clinify_config$spanner_rule <- merge_config_( + x$clinify_config$spanner_rule, + supplied ) + + # A first call that named nothing still means "rule the spanners" + if (is.null(x$clinify_config$spanner_rule$border)) { + x$clinify_config$spanner_rule$border <- check_spanner_border_(border) + } + x } diff --git a/man/clin_header_pad.Rd b/man/clin_header_pad.Rd index 69acdc8..0719306 100644 --- a/man/clin_header_pad.Rd +++ b/man/clin_header_pad.Rd @@ -64,6 +64,9 @@ over pages keeps the same gap under the rule throughout. If a group label is added above the header it keeps its own spacing, since it is put there as the table renders. +Called a second time, this refines what the first call set rather than +replacing it: arguments this call does not name keep their earlier value. + Spacing is given in points, which is what flextable measures cell padding in. Whatever is set here replaces the header padding clinify starts with. } diff --git a/man/clin_row_height.Rd b/man/clin_row_height.Rd index 6876e0a..33c208c 100644 --- a/man/clin_row_height.Rd +++ b/man/clin_row_height.Rd @@ -64,6 +64,11 @@ holding three lines still grows past it. \code{header_leading} is what closes th gap \emph{between} those lines, so it is the one to reach for when a wrapped arm label sits looser than a reference output. They can be used together. +Called a second time, this refines what the first call set rather than +replacing it: arguments this call does not name keep their earlier value. So +a house wide pitch can be set once and a single table can add an exception +without restating the rest. + The height is applied to whole parts, so it is a pitch for every row of the surface rather than a per-row height. Anything already set with \code{flextable::height()} or \code{flextable::height_all()} is replaced. Because the diff --git a/man/clin_spanner_rule.Rd b/man/clin_spanner_rule.Rd index 87c44bf..7485b05 100644 --- a/man/clin_spanner_rule.Rd +++ b/man/clin_spanner_rule.Rd @@ -44,6 +44,9 @@ rather than a spanner, and the rule under the bottom row is the one the styling function draws across the whole table. } +Called a second time, this refines what the first call set rather than +replacing it: arguments this call does not name keep their earlier value. + The rule is drawn as the table renders, after the default styling function has run. That is what makes it survive a house style: the stock \code{clinify_table_default()} opens with \code{flextable::border_remove()}, which diff --git a/tests/testthat/test-header_pad.R b/tests/testthat/test-header_pad.R index 9ed81a5..cf0ec57 100644 --- a/tests/testthat/test-header_pad.R +++ b/tests/testthat/test-header_pad.R @@ -284,3 +284,24 @@ test_that("Per row header spacing is validated", { "single number of points" ) }) + +test_that("A second call refines the first rather than replacing it", { + # Same silent loss as #119, in the other verb that carries several settings + base <- clintable(head(mtcars[, 1:2], 2)) |> + clin_column_headers(mpg = c("Sp", "x"), cyl = c("Sp", "y")) + + refined <- base |> + clin_header_pad(above = 18, below = 4) |> + clin_header_pad(rule_to_body = 6) + + pad <- refined$clinify_config$header_pad + expect_equal(pad$above, 18) + expect_equal(pad$below, 4) + expect_equal(pad$rule_to_body, 6) + + # A value named again is replaced + expect_equal( + clin_header_pad(clin_header_pad(base, above = 18, below = 4), below = 9)$clinify_config$header_pad$below, + 9 + ) +}) diff --git a/tests/testthat/test-row_height.R b/tests/testthat/test-row_height.R index e37911f..54a8fa5 100644 --- a/tests/testthat/test-row_height.R +++ b/tests/testthat/test-row_height.R @@ -336,3 +336,66 @@ test_that("Header pitch is validated", { # The "nothing asked for" message now names all five expect_error(clin_row_height(ct), "header_leading needs") }) + +test_that("A second call refines the first rather than replacing it", { + # A house wide pitch plus a per table exception is the natural pattern, and a + # second call used to silently revert everything the first had set (#119) + base <- clintable(head(mtcars[, 1:2], 2)) |> + clin_column_headers(mpg = "A", cyl = "B") + + house <- clin_row_height( + base, + body = 15.35, + title = 11.4, + footnote = 11.4, + rule = "atleast", + unit = "pt" + ) + + refined <- clin_row_height(house, header_leading = 0.75) + cfg <- refined$clinify_config$row_height + + expect_equal(cfg$body, 15.35 / 72) + expect_equal(cfg$title, 11.4 / 72) + expect_equal(cfg$footnote, 11.4 / 72) + expect_equal(cfg$header_leading, 0.75) + + # And it reaches the rendered table, which is where it bit + expect_equal( + unique(finish_table_(refined)$body$rowheights), + 15.35 / 72 + ) + + # A value named again is replaced, as it should be + expect_equal( + clin_row_height(house, body = 20)$clinify_config$row_height$body, + 20 / 72 + ) +}) + +test_that("A rule set by an earlier call is not reset by a later one", { + # `rule` has a default, so being NULL cannot say whether the caller asked for + # it - and match.arg() assigns to the formal, which clears missing() + base <- clintable(head(mtcars[, 1:2], 2)) + + exact <- clin_row_height(base, body = 15.35, rule = "exact") + expect_equal(exact$clinify_config$row_height$rule, "exact") + + # A later call that says nothing about the rule keeps it + expect_equal( + clin_row_height(exact, title = 11.4)$clinify_config$row_height$rule, + "exact" + ) + + # A later call that does name it wins + expect_equal( + clin_row_height(exact, title = 11.4, rule = "atleast")$clinify_config$row_height$rule, + "atleast" + ) + + # And a first call with no rule still gets the default + expect_equal( + clin_row_height(base, body = 15.35)$clinify_config$row_height$rule, + "atleast" + ) +}) diff --git a/tests/testthat/test-spanner_rule.R b/tests/testthat/test-spanner_rule.R index 1c8305e..a76730d 100644 --- a/tests/testthat/test-spanner_rule.R +++ b/tests/testthat/test-spanner_rule.R @@ -428,3 +428,31 @@ test_that("The HTML preview survives a configured spanner rule", { clin_spanner_rule(border = officer::fp_border(style = "dashed")) expect_no_error(clintable_as_html(paged)) }) + +test_that("A second call refines the first rather than replacing it", { + # `border` has a default, so a later call naming only `rows` used to reset the + # pen back to it (#119) + base <- clintable(head(mtcars[, 1:3], 2)) |> + clin_column_headers( + mpg = c("Spanner", "x"), + cyl = c("Spanner", "y"), + disp = c("", "z") + ) + + dashed <- officer::fp_border(style = "dashed", width = 2) + refined <- clin_spanner_rule(clin_spanner_rule(base, dashed), rows = 1) + + cfg <- refined$clinify_config$spanner_rule + expect_equal(cfg$border$style, "dashed") + expect_equal(cfg$border$width, 2) + expect_equal(cfg$rows, 1L) + + # A bare first call still means "rule the spanners", and border = FALSE still + # means do not - "no rule" is carried as a zero width pen rather than a FALSE + bare <- clin_spanner_rule(base)$clinify_config$spanner_rule$border + expect_gt(bare$width, 0) + + none <- clin_spanner_rule(base, border = FALSE)$clinify_config$spanner_rule$border + expect_equal(none$width, 0) + expect_equal(none$style, "none") +})