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

file-trees: file? restriction blocking selected

db4
Sam Anklesaria 2009-05-09 08:02:35 -05:00
parent 06f0b0b98f
commit 7eefdfa79b
2 changed files with 39 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,5 @@
USING: accessors arrays delegate delegate.protocols
io.pathnames kernel locals models.arrow namespaces prettyprint sequences
io.pathnames kernel locals sequences
ui.frp vectors make ;
IN: file-trees
@ -12,6 +12,8 @@ M: walkable-vector set-nth [ vector>> set-nth ] 3keep nip
TUPLE: tree node comment children ;
CONSULT: sequence-protocol tree children>> ;
: file? ( tree -- ? ) children>> [ node>> ".." = not ] filter empty? ;
: <dir-tree> ( {start,comment} -- tree ) first2 walkable-vector new vector new >>vector
[ tree boa dup children>> ] [ ".." -rot tree boa ] 2bi swap (>>father) ;
@ -26,7 +28,6 @@ DEFER: (tree-insert)
path-rest [ path-head tree-insert ] unless-empty
] if* ;
! Use an accumulator for this
: add-paths ( pathseq -- {{name,path}} )
"" [ [ "/" glue dup ] keep swap 2array , ] [ reduce drop ] f make ;
@ -35,6 +36,5 @@ DEFER: (tree-insert)
: <dir-table> ( tree-model -- table )
<frp-list*> [ node>> 1array ] >>quot
[ selected-value>> [ dup [ first ] when ] <arrow> <switch> ]
[ swap >>model ] bi
[ dup comment>> 2array ] >>val-quot ;
[ selected-value>> <switch> ]
[ swap >>model ] bi ;

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

@ -0,0 +1,34 @@
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 ;