1# Extract from cli::tree
2# Modifications:
3# * Remove assertions (requires assertthat)
4# * Remove width triming (requires ansistrings or similar)
5# * Use map_chr() instead of vcapply()
6# Additional functions inlined:
7# * is_utf8_output()
8# * is_latex_output()
9
10cli_tree <- function(data, root = data[[1]][[1]], style = NULL, indices = NULL) {
11  style <- style %||% cli_box_chars()
12
13  labels <- if (ncol(data) >= 3) data[[3]] else data[[1]]
14  res <- character()
15
16  pt <- function(root, n = integer(), mx = integer()) {
17
18    num_root <- match(root, data[[1]])
19
20    level <- length(n) - 1
21    prefix <- map_chr(seq_along(n), function(i) {
22      if (n[i] < mx[i]) {
23        if (i == length(n)) {
24          paste0(style$j, style$h)
25        } else {
26          paste0(style$v, " ")
27        }
28      } else if (n[i] == mx[i] && i == length(n)) {
29        paste0(style$l, style$h)
30      } else {
31        "  "
32      }
33    })
34
35    res <<- c(res, paste0(paste(prefix, collapse = ""), labels[[num_root]]))
36
37    children <- data[[2]][[num_root]]
38    for (d in seq_along(children)) {
39      pt(children[[d]], c(n, d), c(mx, length(children)))
40    }
41  }
42
43  if (nrow(data)) {
44    pt(root)
45  }
46
47  if (length(indices)) {
48    indices <- pad_spaces(as.character(indices))
49    indices <- paste0(" ", indices, ". ")
50
51    # The root isn't numbered
52    root_padding <- spaces(nchar(indices[[1]]))
53    indices <- c(root_padding, indices)
54
55    res <- paste0(silver(indices), res)
56  }
57
58  res
59}
60
61cli_box_chars <- function() {
62  if (cli_is_utf8_output()) {
63    list(
64      "h" = "\u2500",                   # horizontal
65      "v" = "\u2502",                   # vertical
66      "l" = "\u2514",                   # leaf
67      "j" = "\u251C"                    # junction
68    )
69  } else {
70    list(
71      "h" = "-",                        # horizontal
72      "v" = "|",                        # vertical
73      "l" = "\\",                       # leaf
74      "j" = "+"                         # junction
75    )
76  }
77}
78
79cli_is_utf8_output <- function() {
80  opt <- getOption("cli.unicode", NULL)
81  if (!is.null(opt)) {
82    isTRUE(opt)
83  } else {
84    l10n_info()$`UTF-8` && !cli_is_latex_output()
85  }
86}
87
88cli_is_latex_output <- function() {
89  if (!("knitr" %in% loadedNamespaces())) return(FALSE)
90  get("is_latex_output", asNamespace("knitr"))()
91}
92