Browser cleanups, moving assoc word from lists to sequences

library/bootstrap/boot-stage1.factor

@@ -166,12 +166,12 @@ vectors words ;
         "/library/ui/gadgets.factor"
         "/library/ui/layouts.factor"
         "/library/ui/hierarchy.factor"
+        "/library/ui/frames.factor"
         "/library/ui/world.factor"
         "/library/ui/paint.factor"
         "/library/ui/theme.factor"
         "/library/ui/labels.factor"
         "/library/ui/gestures.factor"
-        "/library/ui/frames.factor"
         "/library/ui/borders.factor"
         "/library/ui/buttons.factor"
         "/library/ui/line-editor.factor"
@@ -183,6 +183,7 @@ vectors words ;
         "/library/ui/paragraphs.factor"
         "/library/ui/panes.factor"
         "/library/ui/outliner.factor"
+        "/library/ui/environment.factor"
         "/library/ui/listener.factor"
         "/library/ui/browser.factor"
         "/library/ui/launchpad.factor"

library/collections/lists.factor

@@ -79,8 +79,6 @@ M: cons = ( obj cons -- ? )
 
 : curry ( obj quot -- quot ) >r literalize r> cons ;
 
-: assoc ( key alist -- value ) [ car = ] find-with nip cdr ;
-
 : (>list) ( n i seq -- list )
     pick pick <= [
         3drop [ ]

library/collections/sequences-epilogue.factor

@@ -106,6 +106,9 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
     pick over bounds-check 2drop 2dup bounds-check 2drop
     exchange-unsafe ;
 
+: assoc ( key assoc -- value ) 
+    [ first = ] find-with nip second ;
+
 IN: kernel
 
 M: object <=>

library/inference/words.factor

@@ -37,7 +37,7 @@ TUPLE: rstate label base-case? ;
     r> current-node set ;
 
 : with-recursive-state ( word label base-case quot -- )
-    >r <rstate> cons recursive-state [ cons ] change r>
+    >r <rstate> 2array recursive-state [ cons ] change r>
     nest-node 2slip unnest-node ; inline
 
 : inline-block ( word base-case -- node-block variables )

library/tools/components.factor

@@ -1,24 +1,21 @@
 IN: components
-USING: help inspector kernel namespaces sequences words ;
+USING: hashtables help inspector kernel namespaces sequences
-
+words ;
-! Component document framework, like OpenDoc.
-
-TUPLE: component name predicate builder ;
 
 SYMBOL: components
 
-V{ } clone components set-global
+H{ } clone components set-global
 
-: get-components ( obj -- seq )
+: get-components ( class -- assoc )
-    components get-global
+    components get-global hash [ { } ] unless*
-    [ component-predicate call ] subset-with ;
+    { "Slots" [ describe ] } append ;
 
-: define-component ( name predicate builder -- )
+{
-    <component> components get-global push ;
+    { "Definition" [ help ] }
+    { "Calls in" [ usage. ] }
+    { "Calls out" [ uses. ] }
+} word components get-global set-hash
 
-"Slots" [ drop t ] [ describe ] define-component
+{
-"Documentation" [ word? ] [ help ] define-component
+    { "Documentation" [ help ] }
-"Calls in" [ word? ] [ usage. ] define-component
+} link components get-global set-hash
-"Calls out" [ word? ] [ uses. ] define-component
-"Definition" [ term? ] [ help ] define-component
-"Documentation" [ link? ] [ help ] define-component

library/ui/browser.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-browser
-USING: components gadgets gadgets-buttons gadgets-labels
+USING: arrays components gadgets gadgets-buttons gadgets-labels
 gadgets-layouts gadgets-panes gadgets-scrolling gadgets-theme
 hashtables help inspector kernel lists math namespaces
 prettyprint sequences words ;
@@ -10,39 +10,32 @@ TUPLE: book page pages ;
 
 : show-page ( key book -- )
     dup book-page unparent
-    [ book-pages hash ] keep
+    [ book-pages assoc ] keep
     [ set-book-page ] 2keep
     add-gadget ;
 
-C: book ( page pages -- book )
+C: book ( pages -- book )
     dup delegate>gadget
-    [ set-book-pages ] keep
+    [ set-book-pages ] 2keep
+    [ >r first r> show-page ] keep
     [ show-page ] keep ;
 
 M: book pref-dim* ( book -- dim )
-    { 0 0 0 } swap book-pages [ nip pref-dim vmax ] hash-each ;
+    book-pages { 0 0 0 } [ second pref-dim vmax ] reduce ;
 
 M: book layout* ( book -- )
     dup rect-dim swap book-page set-gadget-dim ;
 
-: component-page ( obj component -- gadget )
+: component-pages ( obj -- assoc )
-    component-builder make-pane <scroller> ;
+    dup get-components
-
+    [ first2 swapd make-pane <scroller> 2array ] map-with ;
-: component-pages ( obj -- hash )
-    dup get-components [
-        [ component-name over ] keep component-page
-    ] map>hash nip ;
-
-: component-book ( hash -- book )
-    dup hash-keys natural-sort first swap <book> ;
 
 : <tab> ( name book -- button )
     dupd [ show-page ] curry curry
     >r <label> r> <bevel-button> ;
 
-: tabs ( hash book gadget -- )
+: tabs ( assoc book gadget -- )
-    >r swap hash-keys natural-sort
+    >r swap [ first swap <tab> ] map-with r> add-gadgets ;
-    [ swap <tab> ] map-with r> add-gadgets ;
 
 TUPLE: browser object history tabs ;
 
@@ -52,7 +45,7 @@ TUPLE: browser object history tabs ;
 : browse ( obj browser -- )
     [ set-browser-object ] 2keep
     dup browser-tabs clear-gadget
-    >r component-pages dup component-book r>
+    >r component-pages dup <book> r>
     [ @center frame-add ] 2keep browser-tabs tabs ;
 
 : find-browser [ browser? ] find-parent ;