tree(): support multi-line labels

Author: gaborcsardi

R/tree.R

@@ -141,7 +141,6 @@ tree <- function(
     num_root <- match(root, data[[1]])
     if (is.na(num_root)) return()
 
-    level <- length(n) - 1
     prefix <- vcapply(seq_along(n), function(i) {
       if (n[i] < mx[i]) {
         if (i == length(n)) {
@@ -159,7 +158,37 @@ tree <- function(
     root_seen <- root %in% seen
     root_lab <- if (trim && root_seen) trimlabs[[num_root]] else
       labels[[num_root]]
-    res <<- c(res, paste0(paste(prefix, collapse = ""), root_lab))
+
+    # multi-line labels
+    prefix2 <- if (grepl("\n", root_lab, fixed = TRUE)) {
+      root_lab <- ansi_strsplit(root_lab, "\n", fixed = TRUE)[[1]]
+      vcapply(seq_along(n), function(i) {
+        if (n[i] < mx[i]) {
+          if (i == length(n)) {
+            paste0(style$v, " ")
+          } else {
+            paste0(style$v, " ")
+          }
+        } else if (n[i] == mx[i] && i == length(n)) {
+          "  "
+        } else {
+          "  "
+        }
+      })
+    }
+
+    res <<- c(
+      res,
+      paste0(
+        c(
+          paste(prefix, collapse = ""),
+          if (length(root_lab) > 1) {
+            rep(paste(prefix2, collapse = ""), length(root_lab) - 1)
+          }
+        ),
+        root_lab
+      )
+    )
 
     # Detect infinite loops
     if (!trim && root %in% used) {

tests/testthat/_snaps/tree.md

@@ -22,6 +22,25 @@
       \-rprojroot
         \-backports
 
+---
+
+    Code
+      tree(data, root = "callr")
+    Output
+      callr
+      +-processx
+      | +-assertthat
+      | | still going
+      | | third row
+      | +-crayon
+      | | and some more
+      | +-debugme
+      | | more debug
+      | | \-crayon
+      | |   and some more
+      | \-R6
+      \-R6
+
 # tree [ansi]
 
     Code
@@ -46,6 +65,25 @@
       \-rprojroot
         \-backports
 
+---
+
+    Code
+      tree(data, root = "callr")
+    Output
+      callr
+      +-processx
+      | +-assertthat
+      | | still going
+      | | third row
+      | +-crayon
+      | | and some more
+      | +-debugme
+      | | more debug
+      | | \-crayon
+      | |   and some more
+      | \-R6
+      \-R6
+
 # tree [unicode]
 
     Code
@@ -70,6 +108,25 @@
       └─rprojroot
         └─backports
 
+---
+
+    Code
+      tree(data, root = "callr")
+    Output
+      callr
+      ├─processx
+      │ ├─assertthat
+      │ │ still going
+      │ │ third row
+      │ ├─crayon
+      │ │ and some more
+      │ ├─debugme
+      │ │ more debug
+      │ │ └─crayon
+      │ │   and some more
+      │ └─R6
+      └─R6
+
 # tree [fancy]
 
     Code
@@ -94,6 +151,25 @@
       └─rprojroot
         └─backports
 
+---
+
+    Code
+      tree(data, root = "callr")
+    Output
+      callr
+      ├─processx
+      │ ├─assertthat
+      │ │ still going
+      │ │ third row
+      │ ├─crayon
+      │ │ and some more
+      │ ├─debugme
+      │ │ more debug
+      │ │ └─crayon
+      │ │   and some more
+      │ └─R6
+      └─R6
+
 # trimming [plain]
 
     Code

tests/testthat/test-tree.R

@@ -61,6 +61,14 @@ test_that_cli("tree", {
 
   expect_snapshot(tree(data, root = "desc"))
 
+  # multi-line labels
+  data$label <- data$package
+  data$label[3] <- "assertthat\nstill going\nthird row"
+  data$label[13] <- col_red("crayon\nand some more")
+  data$label[14] <- "debugme\nmore debug"
+
+  expect_snapshot(tree(data, root = "callr"))
+
   # Check that trees with apparent circularity error nicely
   data <- data.frame(
     stringsAsFactors = FALSE,