steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

file-trees: backwords browsing, path in selection

db4
Sam Anklesaria 2009-05-06 21:36:06 -05:00
parent 23a7ff35af
commit d590e87e26
1 changed files with 24 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
extra/file-trees/file-trees.factor
View File

@ -1,17 +1,25 @@
USING: accessors arrays delegate delegate.protocols USING: accessors arrays delegate delegate.protocols
io.pathnames kernel locals namespaces prettyprint sequences io.pathnames kernel locals models.arrow namespaces prettyprint sequences
ui.frp vectors ; ui.frp vectors tools.continuations make ;
IN: file-trees IN: file-trees
TUPLE: tree node children ; TUPLE: walkable-vector vector father ;
CONSULT: sequence-protocol walkable-vector vector>> ;
M: walkable-vector set-nth [ vector>> set-nth ] 3keep nip
father>> swap children>> vector>> push ;
TUPLE: tree node comment children ;
CONSULT: sequence-protocol tree children>> ; CONSULT: sequence-protocol tree children>> ;
: <tree> ( start -- tree ) V{ } clone : <dir-tree> ( {start,comment} -- tree ) first2 walkable-vector new vector new >>vector
[ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ; [ tree boa dup children>> ] [ ".." -rot tree boa ] 2bi swap (>>father) ;
! If this was added to all grandchildren
DEFER: (tree-insert) DEFER: (tree-insert)
: tree-insert ( path tree -- ) [ unclip <tree> ] [ children>> ] bi* (tree-insert) ; : tree-insert ( path tree -- ) [ unclip <dir-tree> ] [ children>> ] bi* (tree-insert) ;
:: (tree-insert) ( path-rest path-head tree-children -- ) :: (tree-insert) ( path-rest path-head tree-children -- )
tree-children [ node>> path-head node>> = ] find nip tree-children [ node>> path-head node>> = ] find nip
[ path-rest swap tree-insert ] [ path-rest swap tree-insert ]
@ -19,10 +27,16 @@ DEFER: (tree-insert)
path-head tree-children push path-head tree-children push
path-rest [ path-head tree-insert ] unless-empty path-rest [ path-head tree-insert ] unless-empty
] if* ; ] if* ;
: create-tree ( file-list -- tree ) [ path-components ] map
t <tree> [ [ tree-insert ] curry each ] keep ; ! Use an accumulator for this
: 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 ;
: <dir-table> ( tree-model -- table ) : <dir-table> ( tree-model -- table )
<frp-list*> [ node>> 1array ] >>quot <frp-list*> [ node>> 1array ] >>quot
[ selected-value>> <switch> ] [ selected-value>> [ dup [ first ] when ] <arrow> <switch> ]
[ swap >>model ] bi ; [ swap >>model ] bi
[ dup comment>> 2array ] >>val-quot ;