Skip to content

Instantly share code, notes, and snippets.

@iArnold
Forked from toomasv/dir-tree.red
Created May 8, 2017 09:46
Show Gist options
  • Save iArnold/283dec35160f9c42d091a7a104996f9f to your computer and use it in GitHub Desktop.
Save iArnold/283dec35160f9c42d091a7a104996f9f to your computer and use it in GitHub Desktop.
Print a directory tree
Red [
Author: "Toomas Vooglaid"
Date: "2017-05-07"
Changed: "2017-05-08"
Purpose: "Print a directory tree"
File: "%dir-tree.red"
]
context [
; Some helpers
get-char: func [hex][to-char to-integer hex]
map: func [series [series!] fn [any-function!]][
out: make type? series []
foreach i series [append out fn i]
]
filter: func [series [series!] fn [any-function!]][
out: make type? series []
foreach i series [if fn i [append out i]]
out
]
set 'dir-tree func [
{Prints a directory tree}
value "Main value"
; Public refinements
/expand levels "How many levels to print? ('all, 0, 1, 2,... Default: 1)"
/dep depth "Keep track of depth for internal recursion"
/only "Are we considering directories only?"
; Refinements for internal use
/only-dirs dirs "For internal use, to carry the previous decision value around between calls"
/pref prefix "For internal use, to carry on the current prefix"
/chpref changeprefix "For internal use, to carry on the next item's prefix"
/dir directory "For internal use, to keep track of directories"
/local index length str
][
; Tree-building material
;"├─" ; to-string map [#{251C} #{2500}] :get-char
;"└─" ; to-string map [#{2514} #{2500}] :get-char
;"│ " ; to-string map [#{2502} #" "] :get-char
str: ["├─" "└─" "│ " " "]
prefix: any [prefix ""]
changeprefix: any [changeprefix ""]
directory: any [directory none]
levels: any [levels 1]
depth: any [depth 0]
dirs: any [dirs only]
switch type?/word value [
file! [
; if directory is not set, set it to absolute path - 1 and value to the last element of this path
unless directory [set [directory value] split-path normalize-dir value]
all [
any [not dirs dir? value] ; whether only directories are printed
any [levels = 'all levels >= depth] ; is depth limited?
print append copy prefix mold value ; print current line of tree
]
all [
dir? value ; if this is directory
any [levels = 'all levels > depth] ; and and we have to dig deeper
if contents: attempt [read directory/:value][ ; and it is not a fake directory
; recursive call to myself with directory contents - send items to preprinting preparation
dir-tree/pref/dir/only-dirs/expand/dep contents copy changeprefix directory/:value dirs levels depth + 1
]
]
]
block! [
index: 1 ; initial position
if dirs [value: filter value :dir?] ; are we considering directories only?
length: length? value ; how many elements?
foreach item value [
either index = length [ ; if this is last element
newprefix: copy str/2 ; set new prefix to 'corner'
if dir? item [ ; and if this is a directory
changeprefix: append copy prefix copy str/4 ; append some empty space to previous prefix for next items
]
][ ; if this is not last piece
newprefix: copy str/1 ; set new prefix to '|-'
if dir? item [ ; and if this is a directory
changeprefix: append copy prefix copy str/3 ; append '| ' to previous prefix for next items
]
]
addprefix: append copy prefix copy newprefix ; this is printed before the current item
index: index + 1 ; keep counting
; send current item to the printing house
dir-tree/pref/chpref/dir/only-dirs/expand/dep item copy addprefix copy changeprefix directory dirs levels depth
]
]
]
]
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment