From d590e87e2688fe8901906c06f9efcba398fbc0f4 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Wed, 6 May 2009 21:36:06 -0500
Subject: [PATCH] file-trees: backwords browsing, path in selection

---
 extra/file-trees/file-trees.factor | 34 +++++++++++++++++++++---------
 1 file changed, 24 insertions(+), 10 deletions(-)

diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
index eadfccdc4c..ccd2338061 100644
--- a/extra/file-trees/file-trees.factor
+++ b/extra/file-trees/file-trees.factor
@@ -1,17 +1,25 @@
 USING: accessors arrays delegate delegate.protocols
-io.pathnames kernel locals namespaces prettyprint sequences
-ui.frp vectors ;
+io.pathnames kernel locals models.arrow namespaces prettyprint sequences
+ui.frp vectors tools.continuations make ;
 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>> ;
 
-: <tree> ( start -- tree ) V{ } clone
-   [ tree boa dup children>> ] [ ".." swap tree boa ] bi swap push ;
+: <dir-tree> ( {start,comment} -- tree ) first2 walkable-vector new vector new >>vector
+   [ tree boa dup children>> ] [ ".." -rot tree boa ] 2bi swap (>>father) ;
+
+! If this was added to all grandchildren
 
 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-children [ node>> path-head node>> = ] find nip
    [ path-rest swap tree-insert ]
@@ -19,10 +27,16 @@ DEFER: (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 <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 )
    <frp-list*> [ node>> 1array ] >>quot
-   [ selected-value>> <switch> ]
-   [ swap >>model ] bi ;
\ No newline at end of file
+   [ selected-value>> [ dup [ first ] when ] <arrow> <switch> ]
+   [ swap >>model ] bi
+   [ dup comment>> 2array ] >>val-quot ;
\ No newline at end of file