diff --git a/R/ctl_colonnade.R b/R/ctl_colonnade.R index 41c584fbb..f0537c48f 100644 --- a/R/ctl_colonnade.R +++ b/R/ctl_colonnade.R @@ -194,7 +194,7 @@ do_emit_focus_pillars <- function(x, tier_widths, cb, focus) { focus_formatted_list <- list() focus_top_level_end_idx <- integer() - focus_extra_cols <- data_frame(x = list(), title = list(), cols = list()) + focus_extra_cols <- list() on_focus_pillar <- function(formatted) { # message("pillar()") @@ -211,11 +211,14 @@ do_emit_focus_pillars <- function(x, tier_widths, cb, focus) { # message("extra_cols()") # print(title) # print(cols) - new_extra_cols <- data_frame( - x = list(x), title = list(title), cols = list(cols) - ) - # Add to the front, because top-level columns are emitted first: - focus_extra_cols <<- vec_rbind(new_extra_cols, focus_extra_cols) + new_extra_cols <- data_frame(x = list(x), title = list(title), cols = list(cols)) + n_focus_formatted_list <- length(focus_formatted_list) + + if (n_focus_formatted_list <= length(focus_extra_cols)) { + focus_extra_cols[[n_focus_formatted_list]] <<- vec_rbind(focus_extra_cols[[n_focus_formatted_list]], new_extra_cols) + } else { + focus_extra_cols[[n_focus_formatted_list]] <<- new_extra_cols + } } cb_focus <- new_emit_pillars_callbacks( @@ -230,8 +233,10 @@ do_emit_focus_pillars <- function(x, tier_widths, cb, focus) { # Side effect: populates focus_formatted_list and focus_extra_cols do_emit_pillars(x[focus], tier_widths, cb_focus, is_focus = TRUE) - # Can't show focus pillars that don't fit - focus <- focus[seq_along(focus_top_level_end_idx)] + # Can't show focus pillars that don't fit, but need to iterate + # to emit extra columns in the correct order + length(focus_extra_cols) <- length(focus) + n_focus_shown <- length(focus_top_level_end_idx) before_start_idx <- vec_lag(focus + 1L, default = 1L) before_end_idx <- focus - 1L @@ -244,13 +249,24 @@ do_emit_focus_pillars <- function(x, tier_widths, cb, focus) { rev <- distribute_pillars_rev(widths_focus, tier_widths) stopifnot(!anyNA(rev$tier)) rev <- rev[focus_top_level_end_idx, ] - stopifnot(nrow(rev) == length(focus)) + stopifnot(nrow(rev) == n_focus_shown) rev$offset_before <- pmax(rev$offset_after - rev$width - 1L, 0L) x_pos <- 0L tier_pos <- 1L for (col in seq_along(focus)) { + # Emit extra columns for focus pillars before processing non-focus pillars, + # to keep extra columns in order between focus and non-focus pillars: + my_extra_cols <- focus_extra_cols[[col]] + for (extra_cols_row in seq_len(NROW(my_extra_cols))) { + cb$on_extra_cols( + my_extra_cols$x[[extra_cols_row]], + my_extra_cols$title[[extra_cols_row]], + my_extra_cols$cols[[extra_cols_row]] + ) + } + start <- before_start_idx[[col]] end <- before_end_idx[[col]] @@ -266,8 +282,14 @@ do_emit_focus_pillars <- function(x, tier_widths, cb, focus) { tier_pos <- adv$tier_pos } - # Emit already formatted focus pillar(s) - for (focus_pillar in seq2(focus_top_level_start_idx[[col]], focus_top_level_end_idx[[col]])) { + # Emit already formatted focus pillar(s): + if (col <= length(focus_top_level_start_idx)) { + focus_pillars <- seq2(focus_top_level_start_idx[[col]], focus_top_level_end_idx[[col]]) + } else { + focus_pillars <- integer() + } + + for (focus_pillar in focus_pillars) { # Deduct widths: use offset_after sub_tier_widths <- compute_sub_tier_widths( tier_widths, x_pos, tier_pos, diff --git a/tests/testthat/_snaps/unicode/ctl_colonnade.md b/tests/testthat/_snaps/unicode/ctl_colonnade.md index 4c16cddff..d5ab39dbe 100644 --- a/tests/testthat/_snaps/unicode/ctl_colonnade.md +++ b/tests/testthat/_snaps/unicode/ctl_colonnade.md @@ -227,9 +227,10 @@ 1 1  # … with - # 1 + # 2 # more - # variable: + # variables: + # a$y , # b  Code tbl_format_setup(x, width = 30, focus = c("a", "b")) @@ -255,6 +256,10 @@    1 1 long e…  + # … with 1 + # more + # variable: + # a$y  Code tbl_format_setup(x, width = 10, focus = c("a", "b")) Output @@ -269,9 +274,10 @@ 1 1  # … with - # 1 + # 2 # more - # variable: + # variables: + # a$y , # b  Code tbl_format_setup(x[2:1], width = 30, focus = c("a", "b")) @@ -297,6 +303,10 @@    1 long e… 1  + # … with 1 + # more + # variable: + # a$y  Code tbl_format_setup(x[2:1], width = 10, focus = c("a", "b")) Output