USING: accessors arrays delegate delegate.protocols
io.pathnames kernel locals sequences
-ui.frp vectors make ;
+ui.frp vectors make strings ;
IN: file-trees
TUPLE: walkable-vector vector father ;
: add-paths ( pathseq -- {{name,path}} )
"" [ [ "/" glue dup ] keep swap 2array , ] [ reduce drop ] f make ;
-: create-tree ( file-list -- tree ) [ path-components add-paths ] map
- { "/" "/" } <dir-tree> [ [ tree-insert ] curry each ] keep ;
+: go-to-path ( path tree -- tree' ) over empty? [ nip ]
+ [ [ unclip ] [ children>> ] bi* swap [ swap node>> = ] curry find nip go-to-path ] if ;
+
+: find-root ( pathseq -- root ) dup flip
+ [ [ dupd = [ ] [ drop f ] if ] reduce1 ] find-last drop
+ [ first ] dip head-slice >string path-components ;
+
+: create-tree ( file-list -- tree ) [ find-root ]
+ [ [ path-components add-paths ] map { "/" "/" } <dir-tree> [ [ tree-insert ] curry each ] keep ] bi
+ go-to-path ;
: <dir-table> ( tree-model -- table )
<frp-list*> [ node>> 1array ] >>quot
+++ /dev/null
-USING: accessors arrays delegate delegate.protocols
-io.pathnames kernel locals namespaces prettyprint sequences
-ui.frp vectors ;
-IN: file-trees
-
-! There should be optional extra information you can provide
-TUPLE: tree node children ;
-CONSULT: sequence-protocol tree children>> ;
-
-: <dir-tree> ( start -- tree ) V{ } clone
- [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ;
-
-DEFER: (tree-insert)
-
-: tree-insert ( path tree -- ) [ unclip <dir-tree> ] [ children>> ] bi* (tree-insert) ;
-:: (tree-insert) ( path-rest path-head tree-children -- )
- tree-children [ node>> path-head node>> = ] find nip
- [ path-rest swap tree-insert ]
- [
- path-head tree-children push
- path-rest [ path-head tree-insert ] unless-empty
- ] if* ;
-
-: create-tree ( file-list -- tree ) [ path-components ] map
- t <dir-tree> [ [ tree-insert ] curry each ] keep ;
-
-: find-path ( tree -- string ) dup node>> tuck t =
- [ 2drop f ] [ children>> first find-path "/" glue ] if ;
-
-: <dir-table> ( tree-model -- table )
- <frp-list*> [ node>> 1array ] >>quot
- [ selected-value>> <switch> ]
- [ swap >>model ] bi
- [ find-path ] >>val-quot ;
\ No newline at end of file