extra/tools/tree/tree.factor

   1 ! Copyright (C) 2011 John Benediktsson
   2 ! See https://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors command-line continuations formatting io
   5 io.directories io.files.info io.pathnames kernel locals math
   6 namespaces sequences sorting ;
   7 IN: tools.tree
   8
   9 SYMBOL: #files
  10 SYMBOL: #directories
  11
  12 : indent ( indents -- )
  13     unclip-last-slice
  14     [ [ "    " "|   " ? write ] each ]
  15     [ "└── " "├── " ? write ] bi* ;
  16
  17 : write-name ( entry indents -- )
  18     indent name>> write ;
  19
  20 : write-file ( entry indents -- )
  21     write-name #files [ 1 + ] change-global ;
  22
  23 DEFER: write-tree
  24
  25 : write-dir ( entry indents -- )
  26     [ write-name ] [
  27         [ [ name>> ] dip write-tree ]
  28         [ 3drop " [error opening dir]" write ] recover
  29     ] 2bi #directories [ 1 + ] change-global ;
  30
  31 : write-entry ( entry indents -- )
  32     nl over directory? [ write-dir ] [ write-file ] if ;
  33
  34 :: write-tree ( path indents -- )
  35     path [
  36         [ name>> ] sort-with [ ] [
  37             unclip-last [
  38                 f indents push
  39                 [ indents write-entry ] each
  40             ] [
  41                 indents pop* t indents push
  42                 indents write-entry
  43             ] bi* indents pop*
  44         ] if-empty
  45     ] with-directory-entries ;
  46
  47 : tree ( path -- )
  48     0 #directories set-global 0 #files set-global
  49     [ write ] [ V{ } clone write-tree ] bi nl
  50     #directories get-global #files get-global
  51     "\n%d directories, %d files\n" printf ;
  52
  53 : run-tree ( -- )
  54     command-line get [
  55         "." tree
  56     ] [
  57         [ tree ] each
  58     ] if-empty ;
  59
  60 MAIN: run-tree