1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
#' Print contents of directories in a tree-like format
#'
#' @param path A path to print the tree from
#' @inheritParams dir_ls
#' @param ... Additional arguments passed to [dir_ls].
#'
#' @export
dir_tree <- function(path = ".", recurse = TRUE, ...) {
files <- dir_ls(path, recurse = recurse, ...)
by_dir <- split(files, path_dir(files))
ch <- box_chars()
get_coloured_name <- function(x) {
coloured <- colourise_fs_path(x)
sub(x, path_file(x), coloured, fixed = TRUE)
}
print_leaf <- function(x, indent) {
leafs <- by_dir[[x]]
for (i in seq_along(leafs)) {
if (i == length(leafs)) {
cat(indent, pc(ch$l, ch$h, ch$h, " "), get_coloured_name(leafs[[i]]), "\n", sep = "")
print_leaf(leafs[[i]], paste0(indent, " "))
} else {
cat(indent, pc(ch$j, ch$h, ch$h, " "), get_coloured_name(leafs[[i]]), "\n", sep = "")
print_leaf(leafs[[i]], paste0(indent, pc(ch$v, " ")))
}
}
}
cat(colourise_fs_path(path), "\n", sep = "")
print_leaf(path_expand(path), "")
invisible(files)
}
pc <- function(...) {
paste0(..., collapse = "")
}
# These are derived from https://github.com/r-lib/cli/blob/e9acc82b0d20fa5c64dd529400b622c0338374ed/R/tree.R#L111
box_chars <- function() {
if (is_utf8_output()) {
list(
"h" = "\u2500", # horizontal
"v" = "\u2502", # vertical
"l" = "\u2514",
"j" = "\u251C"
)
} else {
list(
"h" = "-", # horizontal
"v" = "|", # vertical
"l" = "\\",
"j" = "+"
)
}
}
is_latex_output <- function() {
if (!("knitr" %in% loadedNamespaces())) return(FALSE)
get("is_latex_output", asNamespace("knitr"))()
}
is_utf8_output <- function() {
opt <- getOption("cli.unicode", NULL)
if (! is.null(opt)) {
isTRUE(opt)
} else {
l10n_info()$`UTF-8` && !is_latex_output()
}
}
|
