Show names of missing nested columns

R/ctl_colonnade.R

@@ -56,11 +56,15 @@ ctl_colonnade <- function(x, has_row_id = TRUE, width = NULL,
     # print(extra_cols)
 
     # FIXME: Show for all levels
-    is_top_level <- map_lgl(my_extra_cols$x, identical, x)
-    if (any(is_top_level)) {
-      extra_cols <<- as.list(x)[my_extra_cols$cols[is_top_level][[1]]]
-      names(extra_cols) <<- tick_if_needed(names(extra_cols))
-    }
+    out <- pmap(my_extra_cols, function(x, title, cols) {
+      out <- as.list(x)[cols]
+      if (!is.null(title)) {
+        names(out) <- paste0(paste0(title, "$", collapse = ""), names(out))
+      }
+      out
+    })
+
+    extra_cols <<- unlist(out, recursive = FALSE)
   }
 
   cb <- new_emit_tiers_callbacks(
@@ -69,10 +73,6 @@ ctl_colonnade <- function(x, has_row_id = TRUE, width = NULL,
   )
   do_emit_tiers(x_focus, tier_widths, length(focus), cb)
 
-  if (length(extra_cols) == 0) {
-    extra_cols <- list()
-  }
-
   new_colonnade_body(formatted_tiers, split_after = split_after, extra_cols = extra_cols)
 }
 
@@ -156,9 +156,11 @@ do_emit_tiers <- function(x, tier_widths, n_focus, cb) {
     # message("extra_cols()")
     # print(title)
     # print(cols)
-    extra_cols <<- vec_rbind(extra_cols, data_frame(
+    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:
+    extra_cols <<- vec_rbind(new_extra_cols, extra_cols)
   }
 
   cb_pillars <- new_emit_pillars_callbacks(
@@ -206,8 +208,10 @@ do_emit_pillars <- function(x, tier_widths, cb, title = NULL, first_pillar = NUL
   # Extra columns are known early on, and remain fixed
   extra <- attr(pillar_list, "extra")
 
+  # We emit early, this means that top-level columns are emitted before
+  # nested columns. We reverse in the callback.
   if (length(extra) > 0) {
-    cb$on_extra_cols(x, title, extra)
+    cb$on_extra_cols(tick_names_if_needed(x), title, tick_if_needed(extra))
   }
 
   if (length(pillar_list) == 0) {

R/tick.R

@@ -22,6 +22,11 @@ format_title <- function(x, width) {
   out
 }
 
+tick_names_if_needed <- function(x) {
+  names(x) <- tick_if_needed(names(x))
+  x
+}
+
 tick_if_needed <- function(x) {
   needs_ticks <- !is_syntactic(x)
   x[needs_ticks] <- tick(x[needs_ticks])