extra/tools/tree/tree.factor

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