extra/file-trees/file-trees.factor

   1 USING: accessors arrays delegate delegate.protocols
   2 io.pathnames kernel locals namespaces prettyprint sequences
   3 ui.frp vectors ;
   4 IN: file-trees
   5
   6 TUPLE: tree node children ;
   7 CONSULT: sequence-protocol tree children>> ;
   8
   9 : <tree> ( start -- tree ) V{ } clone
  10    [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ;
  11
  12 DEFER: (tree-insert)
  13
  14 : tree-insert ( path tree -- ) [ unclip <tree> ] [ children>> ] bi* (tree-insert) ;
  15 :: (tree-insert) ( path-rest path-head tree-children -- )
  16    tree-children [ node>> path-head node>> = ] find nip
  17    [ path-rest swap tree-insert ]
  18    [
  19       path-head tree-children push
  20       path-rest [ path-head tree-insert ] unless-empty
  21    ] if* ;
  22 : create-tree ( file-list -- tree ) [ path-components ] map
  23    t <tree> [ [ tree-insert ] curry each ] keep ;
  24
  25 : <dir-table> ( tree-model -- table )
  26    <frp-list*> [ node>> 1array ] >>quot
  27    [ selected-value>> <switch> ]
  28    [ swap >>model ] bi ;