Merge branch 'master' into latex_stub_separator

Author: rich-iannone

R/helpers.R

@@ -1687,7 +1687,6 @@ cells_group <- function(groups = everything()) {
 #' with a table that has multiple stub columns:
 #'
 #' ```r
-#' # Create a table with multi-column stub
 #' dplyr::tibble(
 #'   country = rep(c("USA", "Canada"), each = 3),
 #'   region = rep(c("North", "South", "West"), 2),
@@ -1705,11 +1704,14 @@ cells_group <- function(groups = everything()) {
 #'   )
 #' ```
 #'
+#' \if{html}{\out{
+#' `r man_get_image_tag(file = "man_cells_stub_2.png")`
+#' }}
+#'
 #' You can also use content-based targeting to target rows by their actual values
 #' rather than calculating row indices:
 #'
 #' ```r
-#' # Content-based targeting example
 #' gtcars |>
 #'   dplyr::select(mfr, model, year, hp, msrp) |>
 #'   dplyr::slice(1:8) |>
@@ -1724,6 +1726,10 @@ cells_group <- function(groups = everything()) {
 #'   )
 #' ```
 #'
+#' \if{html}{\out{
+#' `r man_get_image_tag(file = "man_cells_stub_3.png")`
+#' }}
+#'
 #' @family location helper functions
 #' @section Function ID:
 #' 8-17

R/tab_footnote.R

@@ -703,8 +703,13 @@ set_footnote.cells_stub <- function(
   # vs. new usage (explicit columns parameter provided)
   is_traditional_usage <- is.null(loc$columns)
 
-  if (is_traditional_usage) {
-    # For backward compatibility: traditional cells_stub() usage without columns parameter
+  # For multi-column stubs, we need to apply footnotes to all stub columns
+  # even in traditional usage mode (when columns = NULL means "all columns")
+  has_multicolumn_stub <- length(stub_vars) > 1 && !all(is.na(stub_vars))
+
+  if (is_traditional_usage && !has_multicolumn_stub) {
+    # For backward compatibility with single-column stubs: traditional
+    # cells_stub() usage without columns parameter
     # Use the original "stub" locname for compatibility with existing code
     data <-
       dt_footnotes_add(
@@ -719,7 +724,8 @@ set_footnote.cells_stub <- function(
       )
   } else {
     # New usage: per-column stub footnotes
-    # If no stub columns are resolved, apply to all stub columns (backward compatibility)
+    # If no stub columns are resolved (traditional usage with multi-column stub,
+    # or columns = NULL was explicitly provided), apply to all stub columns
     if (length(columns) == 0) {
       if (!all(is.na(stub_vars))) {
         columns <- stub_vars

R/tab_style.R

@@ -840,6 +840,7 @@ set_style.cells_body <- function(loc, data, style) {
 set_style.cells_stub <- function(loc, data, style) {
 
   call <- call("cells_stub")
+
   resolved <- resolve_cells_stub(data = data, object = loc, call = call)
 
   columns <- resolved$columns
@@ -850,10 +851,17 @@ set_style.cells_stub <- function(loc, data, style) {
 
   # Check if this is traditional usage (no columns parameter)
   # vs. new usage (explicit columns parameter provided)
+
   is_traditional_usage <- is.null(loc$columns)
 
-  if (is_traditional_usage) {
-    # For backward compatibility: traditional cells_stub() usage without columns parameter
+  # For multi-column stubs, we need to apply styles to all stub columns
+
+  # even in traditional usage mode (when columns = NULL means "all columns")
+  has_multicolumn_stub <- length(stub_vars) > 1 && !all(is.na(stub_vars))
+
+  if (is_traditional_usage && !has_multicolumn_stub) {
+    # For backward compatibility with single-column stubs: traditional
+    # cells_stub() usage without columns parameter
     # Use the original "stub" locname for compatibility with existing code
     data <-
       dt_styles_add(
@@ -867,7 +875,8 @@ set_style.cells_stub <- function(loc, data, style) {
       )
   } else {
     # New usage: per-column stub styling
-    # If no stub columns are resolved, apply to all stub columns (backward compatibility)
+    # If no stub columns are resolved (traditional usage with multi-column stub,
+    # or columns = NULL was explicitly provided), apply to all stub columns
     if (length(columns) == 0) {
       if (!all(is.na(stub_vars))) {
         columns <- stub_vars

man/cells_stub.Rd

@@ -1016,10 +1016,12 @@ test_that("Enhanced stub targeting: content-based targeting works", {
     )
 
   # Check that styles are applied correctly
+  # With multi-column stub, styles are applied to all 3 columns for each targeted row
   styles <- gt:::dt_styles_get(styled_table)
-  expect_equal(nrow(styles), 2)  # Should target 2 Ford rows
-  expect_equal(unique(styles$rownum), c(1, 2))
-  expect_equal(unique(styles$locname), "stub")
+  expect_equal(nrow(styles), 6)  # 2 Ford rows * 3 columns
+  expect_setequal(unique(styles$rownum), c(1, 2))
+  expect_equal(unique(styles$locname), "stub_column")
+  expect_setequal(unique(styles$colname), c("mfr", "model", "trim"))
 
   # Test table renders without error
   expect_no_error(as_raw_html(styled_table))
@@ -1043,10 +1045,12 @@ test_that("Enhanced stub targeting: multi-value targeting works", {
     )
 
   # Check that styles are applied correctly
+  # With multi-column stub, styles are applied to all 3 columns for each targeted row
   styles <- gt:::dt_styles_get(styled_table)
-  expect_equal(nrow(styles), 4)  # Should target 4 rows (2 Ford + 2 BMW)
-  expect_equal(unique(styles$rownum), c(1, 2, 3, 4))
-  expect_equal(unique(styles$locname), "stub")
+  expect_equal(nrow(styles), 12)  # 4 rows (2 Ford + 2 BMW) * 3 columns
+  expect_setequal(unique(styles$rownum), c(1, 2, 3, 4))
+  expect_equal(unique(styles$locname), "stub_column")
+  expect_setequal(unique(styles$colname), c("mfr", "model", "trim"))
 })
 
 test_that("Enhanced stub targeting: column-specific targeting works", {
@@ -1092,10 +1096,12 @@ test_that("Enhanced stub targeting: model-specific targeting works", {
     )
 
   # Check that styles are applied correctly
+  # With multi-column stub, styles are applied to all 3 columns for each targeted row
   styles <- gt:::dt_styles_get(styled_table)
-  expect_equal(nrow(styles), 2)  # Should target 2 rows (GT and A4)
-  expect_equal(unique(styles$rownum), c(1, 5))
-  expect_equal(unique(styles$locname), "stub")
+  expect_equal(nrow(styles), 6)  # 2 rows (GT and A4) * 3 columns
+  expect_setequal(unique(styles$rownum), c(1, 5))
+  expect_equal(unique(styles$locname), "stub_column")
+  expect_setequal(unique(styles$colname), c("mfr", "model", "trim"))
 })
 
 test_that("Enhanced stub targeting: backward compatibility with numeric indices", {
@@ -1117,9 +1123,100 @@ test_that("Enhanced stub targeting: backward compatibility with numeric indices"
 
   # Check that styles are applied correctly
   styles <- gt:::dt_styles_get(styled_table)
-  expect_equal(nrow(styles), 3)  # Should target 3 rows
-  expect_equal(unique(styles$rownum), c(1, 3, 5))
-  expect_equal(unique(styles$locname), "stub")
+  # With multi-column stub, styles should be applied to all 3 columns for each of 3 rows
+  expect_equal(nrow(styles), 9)  # 3 rows * 3 columns
+  expect_setequal(unique(styles$rownum), c(1, 3, 5))
+  expect_equal(unique(styles$locname), "stub_column")
+  expect_setequal(unique(styles$colname), c("mfr", "model", "trim"))
+})
+
+test_that("cells_stub(columns = NULL) targets all stub columns", {
+
+  # `cells_stub(columns = NULL)` should target all stub columns in a multi-column stub
+  # Test with explicit columns = NULL
+  styled_table_null <-
+    exibble |>
+    gt(rowname_col = c("group", "char")) |>
+    tab_style(
+      style = cell_text(align = "right"),
+      locations = cells_stub(columns = NULL)
+    )
+
+  # Check that styles are applied to both stub columns
+  styles_null <- gt:::dt_styles_get(styled_table_null)
+  expect_equal(unique(styles_null$locname), "stub_column")
+  expect_setequal(unique(styles_null$colname), c("group", "char"))
+  expect_equal(nrow(styles_null), 16)  # 8 rows * 2 columns
+
+  # Test with default (no columns argument)
+  styled_table_default <-
+    exibble |>
+    gt(rowname_col = c("group", "char")) |>
+    tab_style(
+      style = cell_fill(color = "steelblue"),
+      locations = cells_stub()
+    )
+
+  # Check that styles are applied to both stub columns
+  styles_default <- gt:::dt_styles_get(styled_table_default)
+  expect_equal(unique(styles_default$locname), "stub_column")
+  expect_setequal(unique(styles_default$colname), c("group", "char"))
+  expect_equal(nrow(styles_default), 16)  # 8 rows * 2 columns
+
+  # Check that rendered HTML contains the styles for both columns
+  html_output <- as_raw_html(styled_table_default)
+  # The style should be applied to multiple stub cells (not just the first column)
+  expect_true(grepl("#4682B4", html_output))  # steelblue
+
+  # Compare with single-column stub (backward compatibility)
+  styled_table_single <-
+    sza |>
+    dplyr::filter(latitude == 20 & tst <= "1000") |>
+    dplyr::select(-latitude) |>
+    dplyr::filter(!is.na(sza)) |>
+    tidyr::pivot_wider(
+      names_from = "tst",
+      values_from = sza,
+      names_sort = TRUE
+    ) |>
+    gt(rowname_col = "month") |>
+    sub_missing(missing_text = "") |>
+    tab_style(
+      style = list(
+        cell_fill(color = "darkblue"),
+        cell_text(color = "white")
+      ),
+      locations = cells_stub()
+    )
+
+  # Single-column stub should use "stub" locname for backward compatibility
+  styles_single <- gt:::dt_styles_get(styled_table_single)
+  expect_equal(unique(styles_single$locname), "stub")
+})
+
+test_that("cells_stub() footnotes target all stub columns in multi-column stub", {
+
+  # cells_stub() should apply footnotes to all stub columns in a multi-column stub
+  footnoted_table <-
+    head(exibble, 4) |>
+    gt(rowname_col = c("group", "char")) |>
+    tab_footnote(
+      footnote = "Test",
+      locations = cells_stub()
+    )
+
+  # Check that footnotes are applied to both stub columns
+  footnotes <- gt:::dt_footnotes_get(footnoted_table)
+  expect_setequal(unique(footnotes$colname), c("group", "char"))
+  expect_equal(nrow(footnotes), 8)
+  # 4 rows * 2 columns
+
+  # Check that rendered HTML contains footnote marks in all stub cells
+  html_output <- as_raw_html(footnoted_table)
+
+  # The footnote mark "1" should appear multiple times (once per stub cell)
+  # Count occurrences of the footnote mark class in stub cells
+  expect_true(grepl("Test", html_output))  # Footnote text is present
 })
 
 test_that("Enhanced stub targeting: error handling for invalid targets", {