file-trees: file? restriction blocking selected

diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
index 52b1de7f96df803309085c7a215bcc0ba9666664..90916baa5609e14531206e979ef1800413347412 100644 (file)
--- a/extra/file-trees/file-trees.factor
+++ b/extra/file-trees/file-trees.factor
@@ -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 ;
\ No newline at end of file
+   [ selected-value>> <switch> ]
+   [ swap >>model ] bi ;
\ No newline at end of file

diff --git a/extra/file-trees/file-trees.factor copy b/extra/file-trees/file-trees.factor copy
new file mode 100644 (file)
index 0000000..e3324d9
--- /dev/null
+++ b/extra/file-trees/file-trees.factor copy
@@ -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 ;
\ No newline at end of file