]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/ui/traverse/traverse.factor
Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...
[factor.git] / basis / ui / traverse / traverse.factor
index 7765b73d12184d141bd56eefcbad8427abd0935f..11c2a48a2a5408900b03b538f9390eae9f4a36bb 100644 (file)
@@ -1,7 +1,7 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors namespaces make sequences kernel math arrays io
-ui.gadgets generic combinators ;
+ui.gadgets generic combinators fry sets ;
 IN: ui.traverse
 
 TUPLE: node value children ;
@@ -35,7 +35,7 @@ TUPLE: node value children ;
         ] [
             [
                 [ traverse-step traverse-from-path ]
-                [ tuck children>> swap first 1+ tail-slice % ] 2bi
+                [ tuck children>> swap first 1 + tail-slice % ] 2bi
             ] make-node
         ] if
     ] if ;
@@ -44,7 +44,7 @@ TUPLE: node value children ;
     traverse-step traverse-from-path ;
 
 : (traverse-middle) ( frompath topath gadget -- )
-    [ first 1+ ] [ first ] [ children>> ] tri* <slice> % ;
+    [ first 1 + ] [ first ] [ children>> ] tri* <slice> % ;
 
 : traverse-post ( topath gadget -- )
     traverse-step traverse-to-path ;
@@ -78,10 +78,20 @@ DEFER: (gadget-subtree)
     [ (gadget-subtree) ] { } make ;
 
 M: node gadget-text*
-    dup children>> swap value>> gadget-seq-text ;
+    [ children>> ] [ value>> ] bi gadget-seq-text ;
 
 : gadget-text-range ( frompath topath gadget -- str )
     gadget-subtree gadget-text ;
 
 : gadget-at-path ( parent path -- gadget )
     [ swap nth-gadget ] each ;
+
+GENERIC# leaves* 1 ( tree assoc -- )
+
+M: node leaves* [ children>> ] dip leaves* ;
+
+M: array leaves* '[ _ leaves* ] each ;
+
+M: gadget leaves* conjoin ;
+
+: leaves ( tree -- assoc ) H{ } clone [ leaves* ] keep ;