From 72efda83e1ec9f5969c8e76769ef5f3676251766 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 14 Jul 2008 18:27:15 -0500
Subject: [PATCH 01/29] Fix doc link

---
 extra/ui/tools/listener/listener.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor
index f6d9f54efd..187a0a56f2 100755
--- a/extra/ui/tools/listener/listener.factor
+++ b/extra/ui/tools/listener/listener.factor
@@ -29,7 +29,7 @@ TUPLE: listener-gadget < track input output stack ;
 
 : welcome. ( -- )
    "If this is your first time with Factor, please read the " print
-   "cookbook" ($link) "." print nl ;
+   "handbook" ($link) "." print nl ;
 
 M: listener-gadget focusable-child*
     input>> ;

From 0b90cda9e2faf12ad10204eb6e9271d7a7f35183 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 18:35:30 -0500
Subject: [PATCH 02/29] ui.gadgets.labelled: refactor

---
 extra/ui/gadgets/labelled/labelled.factor | 22 ++++++++++------------
 1 file changed, 10 insertions(+), 12 deletions(-)

diff --git a/extra/ui/gadgets/labelled/labelled.factor b/extra/ui/gadgets/labelled/labelled.factor
index 2cb69d6061..8f504aea14 100755
--- a/extra/ui/gadgets/labelled/labelled.factor
+++ b/extra/ui/gadgets/labelled/labelled.factor
@@ -5,17 +5,16 @@ ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers
 ui.gadgets.tracks ui.gadgets.theme ui.gadgets.frames
 ui.gadgets.grids io kernel math models namespaces prettyprint
 sequences sequences words classes.tuple ui.gadgets ui.render
-colors ;
+colors accessors ;
 IN: ui.gadgets.labelled
 
 TUPLE: labelled-gadget < track content ;
 
 : <labelled-gadget> ( gadget title -- newgadget )
-    { 0 1 } labelled-gadget new-track
-    [
-        <label> reverse-video-theme f track,
-        g-> set-labelled-gadget-content 1 track,
-    ] make-gadget ;
+  { 0 1 } labelled-gadget new-track
+    swap <label> reverse-video-theme f track-add*
+    swap >>content
+    dup content>> 1 track-add* ;
 
 M: labelled-gadget focusable-child* labelled-gadget-content ;
 
@@ -50,10 +49,9 @@ TUPLE: closable-gadget < frame content ;
     [ [ closable-gadget? ] is? ] find-parent ;
 
 : <closable-gadget> ( gadget title quot -- gadget )
-    closable-gadget new-frame 
-    [
-        <title-bar> @top frame,
-        g-> set-closable-gadget-content @center frame,
-    ] make-gadget ;
-
+  closable-gadget new-frame
+    -rot <title-bar> @top grid-add*
+    swap >>content
+    dup content>> @center grid-add* ;
+    
 M: closable-gadget focusable-child* closable-gadget-content ;

From 96c44d779c369412656f686e2efe353e1b0d54c3 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 18:52:15 -0500
Subject: [PATCH 03/29] ui.gadgets: remove 'g->'

---
 extra/ui/gadgets/gadgets-docs.factor | 6 +-----
 extra/ui/gadgets/gadgets.factor      | 2 --
 extra/ui/ui-docs.factor              | 2 +-
 3 files changed, 2 insertions(+), 8 deletions(-)

diff --git a/extra/ui/gadgets/gadgets-docs.factor b/extra/ui/gadgets/gadgets-docs.factor
index 47ae6b4733..07b02e15e4 100755
--- a/extra/ui/gadgets/gadgets-docs.factor
+++ b/extra/ui/gadgets/gadgets-docs.factor
@@ -186,16 +186,12 @@ HELP: make-gadget
 
 HELP: with-gadget
 { $values { "gadget" gadget } { "quot" quotation } } 
-{ $description "Calls the quotation in a new scope with the " { $link gadget } " and " { $link make-gadget } " variables set to " { $snippet "gadget" } ". The quotation can call " { $link g } " and " { $link g-> } " to access the gadget." } ;
+{ $description "Calls the quotation in a new scope with the " { $link gadget } " and " { $link make-gadget } " variables set to " { $snippet "gadget" } ". The quotation can call " { $link g } " to access the gadget." } ;
 
 HELP: g
 { $values { "gadget" gadget } }
 { $description "Outputs the gadget being built. Can only be used inside a quotation passed to " { $link with-gadget } "." } ;
 
-HELP: g->
-{ $values { "x" object } { "gadget" gadget } }
-{ $description "Duplicates the top of the stack and outputs the gadget being built. Can only be used inside a quotation passed to " { $link with-gadget } "." } ;
-
 { control-value set-control-value gadget-model } related-words
 
 HELP: control-value
diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor
index ce0df019e7..8209307959 100755
--- a/extra/ui/gadgets/gadgets.factor
+++ b/extra/ui/gadgets/gadgets.factor
@@ -359,8 +359,6 @@ M: f request-focus-on 2drop ;
 
 : g ( -- gadget ) gadget get ;
 
-: g-> ( x -- x x gadget ) dup g ;
-
 : with-gadget ( gadget quot -- )
     gadget swap with-variable ; inline
 
diff --git a/extra/ui/ui-docs.factor b/extra/ui/ui-docs.factor
index 172c57061c..771a552259 100755
--- a/extra/ui/ui-docs.factor
+++ b/extra/ui/ui-docs.factor
@@ -241,7 +241,7 @@ $nl
 { $subsection with-gadget }
 "The following words access the " { $link gadget } " variable; they can be used from " { $link with-gadget } " to store child gadgets in tuple slots:"
 { $subsection g }
-{ $subsection g-> } ;
+ ;
 
 ARTICLE: "ui-null-layout" "Manual layouts"
 "When automatic layout is not appropriate, gadgets can be added to a parent with no layout policy, and then positioned and sized manually:"

From 886fbcfe98823939b2f083da03d41b3bea52c6d1 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 19:30:16 -0500
Subject: [PATCH 04/29] ui.gadgets: remove 'g'

---
 extra/ui/gadgets/gadgets-docs.factor | 8 ++------
 extra/ui/gadgets/gadgets.factor      | 2 --
 extra/ui/ui-docs.factor              | 5 +----
 3 files changed, 3 insertions(+), 12 deletions(-)

diff --git a/extra/ui/gadgets/gadgets-docs.factor b/extra/ui/gadgets/gadgets-docs.factor
index 07b02e15e4..3437f1fdb4 100755
--- a/extra/ui/gadgets/gadgets-docs.factor
+++ b/extra/ui/gadgets/gadgets-docs.factor
@@ -185,12 +185,8 @@ HELP: make-gadget
 { $description "Calls the quotation in a new scope with the gadget stored in the " { $link gadget } " variable." } ;
 
 HELP: with-gadget
-{ $values { "gadget" gadget } { "quot" quotation } } 
-{ $description "Calls the quotation in a new scope with the " { $link gadget } " and " { $link make-gadget } " variables set to " { $snippet "gadget" } ". The quotation can call " { $link g } " to access the gadget." } ;
-
-HELP: g
-{ $values { "gadget" gadget } }
-{ $description "Outputs the gadget being built. Can only be used inside a quotation passed to " { $link with-gadget } "." } ;
+{ $values { "gadget" gadget } { "quot" quotation } }
+{ $description "Calls the quotation in a new scope with the " { $link gadget } " and " { $link make-gadget } " variables set to " { $snippet "gadget" } } ;
 
 { control-value set-control-value gadget-model } related-words
 
diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor
index 8209307959..ef0a9e828d 100755
--- a/extra/ui/gadgets/gadgets.factor
+++ b/extra/ui/gadgets/gadgets.factor
@@ -357,8 +357,6 @@ M: f request-focus-on 2drop ;
 : focus-path ( world -- seq )
     [ focus>> ] follow ;
 
-: g ( -- gadget ) gadget get ;
-
 : with-gadget ( gadget quot -- )
     gadget swap with-variable ; inline
 
diff --git a/extra/ui/ui-docs.factor b/extra/ui/ui-docs.factor
index 771a552259..333afd3485 100755
--- a/extra/ui/ui-docs.factor
+++ b/extra/ui/ui-docs.factor
@@ -238,10 +238,7 @@ $nl
 "Words such as " { $link track, } " access the gadget through the " { $link gadget } " variable."
 $nl
 "A combinator which stores a gadget in the " { $link gadget } " variable:"
-{ $subsection with-gadget }
-"The following words access the " { $link gadget } " variable; they can be used from " { $link with-gadget } " to store child gadgets in tuple slots:"
-{ $subsection g }
- ;
+{ $subsection with-gadget } ;
 
 ARTICLE: "ui-null-layout" "Manual layouts"
 "When automatic layout is not appropriate, gadgets can be added to a parent with no layout policy, and then positioned and sized manually:"

From 7df6e58f7e461917d57ebf54b114bb69f6677c08 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 20:03:02 -0500
Subject: [PATCH 05/29] ui.gadgets.packs: remove make-pile

---
 extra/ui/gadgets/packs/packs-docs.factor | 6 ------
 extra/ui/gadgets/packs/packs.factor      | 3 ---
 2 files changed, 9 deletions(-)

diff --git a/extra/ui/gadgets/packs/packs-docs.factor b/extra/ui/gadgets/packs/packs-docs.factor
index 7b87e8c441..b3dcf736e0 100755
--- a/extra/ui/gadgets/packs/packs-docs.factor
+++ b/extra/ui/gadgets/packs/packs-docs.factor
@@ -10,7 +10,6 @@ ARTICLE: "ui-pack-layout" "Pack layouts"
 { $subsection <pile> }
 { $subsection <shelf> }
 "Creating packs using a combinator:"
-{ $subsection make-pile }
 { $subsection make-filled-pile }
 { $subsection make-shelf }
 
@@ -24,7 +23,6 @@ HELP: pack
     { $link <pack> }
     { $link <pile> }
     { $link <shelf> }
-    { $link make-pile }
     { $link make-filled-pile }
     { $link make-shelf }
 }
@@ -64,10 +62,6 @@ HELP: pack-pref-dim
     "This word is useful if you are writing your own layout gadget which inherits from " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
 } ;
 
-HELP: make-pile
-{ $values { "quot" quotation } { "pack" "a new " { $link pack } } }
-{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets vertically. The quotation can add children by calling the gadget, word." } ;
-
 HELP: make-filled-pile
 { $values { "quot" quotation } { "pack" "a new " { $link pack } } }
 { $description "Creates a new " { $link pack } " which lays out a sequence of gadgets vertically, such that all gadgets have the same width. The quotation can add children by calling the gadget, word." } ;
diff --git a/extra/ui/gadgets/packs/packs.factor b/extra/ui/gadgets/packs/packs.factor
index 7ae222c279..bc07deb55d 100755
--- a/extra/ui/gadgets/packs/packs.factor
+++ b/extra/ui/gadgets/packs/packs.factor
@@ -61,9 +61,6 @@ M: pack children-on ( rect gadget -- seq )
     dup gadget-orientation swap gadget-children
     [ fast-children-on ] keep <slice> ;
 
-: make-pile ( quot -- pack )
-    <pile> swap make-gadget ; inline
-
 : make-filled-pile ( quot -- pack )
     <filled-pile> swap make-gadget ; inline
 

From 23ed8de042c402456d9feeae33e794db4fc5702b Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 20:04:53 -0500
Subject: [PATCH 06/29] ui.gadgets.packs: remove make-filled-pile

---
 extra/ui/gadgets/packs/packs-docs.factor | 6 ------
 extra/ui/gadgets/packs/packs.factor      | 3 ---
 2 files changed, 9 deletions(-)

diff --git a/extra/ui/gadgets/packs/packs-docs.factor b/extra/ui/gadgets/packs/packs-docs.factor
index b3dcf736e0..5f7b57d22c 100755
--- a/extra/ui/gadgets/packs/packs-docs.factor
+++ b/extra/ui/gadgets/packs/packs-docs.factor
@@ -10,7 +10,6 @@ ARTICLE: "ui-pack-layout" "Pack layouts"
 { $subsection <pile> }
 { $subsection <shelf> }
 "Creating packs using a combinator:"
-{ $subsection make-filled-pile }
 { $subsection make-shelf }
 
 "For more control, custom layouts can reuse portions of pack layout logic:"
@@ -23,7 +22,6 @@ HELP: pack
     { $link <pack> }
     { $link <pile> }
     { $link <shelf> }
-    { $link make-filled-pile }
     { $link make-shelf }
 }
 "Packs have the following slots:"
@@ -62,10 +60,6 @@ HELP: pack-pref-dim
     "This word is useful if you are writing your own layout gadget which inherits from " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
 } ;
 
-HELP: make-filled-pile
-{ $values { "quot" quotation } { "pack" "a new " { $link pack } } }
-{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets vertically, such that all gadgets have the same width. The quotation can add children by calling the gadget, word." } ;
-
 HELP: make-shelf
 { $values { "quot" quotation } { "pack" "a new " { $link pack } } }
 { $description "Creates a new " { $link pack } " which lays out a sequence of gadgets horizontally. The quotation can add children by calling the gadget, word." } ;
diff --git a/extra/ui/gadgets/packs/packs.factor b/extra/ui/gadgets/packs/packs.factor
index bc07deb55d..86bb5f1883 100755
--- a/extra/ui/gadgets/packs/packs.factor
+++ b/extra/ui/gadgets/packs/packs.factor
@@ -61,8 +61,5 @@ M: pack children-on ( rect gadget -- seq )
     dup gadget-orientation swap gadget-children
     [ fast-children-on ] keep <slice> ;
 
-: make-filled-pile ( quot -- pack )
-    <filled-pile> swap make-gadget ; inline
-
 : make-shelf ( quot -- pack )
     <shelf> swap make-gadget ; inline

From 201a3e711275bc609d53ba74ef11015601f4de9e Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 20:06:59 -0500
Subject: [PATCH 07/29] ui.gadgets.packs: remove make-shelf

---
 extra/ui/gadgets/packs/packs-docs.factor | 7 -------
 extra/ui/gadgets/packs/packs.factor      | 3 ---
 2 files changed, 10 deletions(-)

diff --git a/extra/ui/gadgets/packs/packs-docs.factor b/extra/ui/gadgets/packs/packs-docs.factor
index 5f7b57d22c..7d28e84e88 100755
--- a/extra/ui/gadgets/packs/packs-docs.factor
+++ b/extra/ui/gadgets/packs/packs-docs.factor
@@ -9,8 +9,6 @@ ARTICLE: "ui-pack-layout" "Pack layouts"
 { $subsection <pack> }
 { $subsection <pile> }
 { $subsection <shelf> }
-"Creating packs using a combinator:"
-{ $subsection make-shelf }
 
 "For more control, custom layouts can reuse portions of pack layout logic:"
 { $subsection pack-pref-dim }
@@ -22,7 +20,6 @@ HELP: pack
     { $link <pack> }
     { $link <pile> }
     { $link <shelf> }
-    { $link make-shelf }
 }
 "Packs have the following slots:"
 { $list
@@ -60,8 +57,4 @@ HELP: pack-pref-dim
     "This word is useful if you are writing your own layout gadget which inherits from " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
 } ;
 
-HELP: make-shelf
-{ $values { "quot" quotation } { "pack" "a new " { $link pack } } }
-{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets horizontally. The quotation can add children by calling the gadget, word." } ;
-
 ABOUT: "ui-pack-layout"
diff --git a/extra/ui/gadgets/packs/packs.factor b/extra/ui/gadgets/packs/packs.factor
index 86bb5f1883..c33217a494 100755
--- a/extra/ui/gadgets/packs/packs.factor
+++ b/extra/ui/gadgets/packs/packs.factor
@@ -60,6 +60,3 @@ M: pack layout*
 M: pack children-on ( rect gadget -- seq )
     dup gadget-orientation swap gadget-children
     [ fast-children-on ] keep <slice> ;
-
-: make-shelf ( quot -- pack )
-    <shelf> swap make-gadget ; inline

From 8782ef8c5f35e09587733aa39b89b44fe22d5f4e Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 20:13:42 -0500
Subject: [PATCH 08/29] ui.gadgets.labels: rewrite to not use 'make-track'

---
 extra/ui/gadgets/labels/labels.factor | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/extra/ui/gadgets/labels/labels.factor b/extra/ui/gadgets/labels/labels.factor
index 354e87a92d..e965d6b2b8 100755
--- a/extra/ui/gadgets/labels/labels.factor
+++ b/extra/ui/gadgets/labels/labels.factor
@@ -64,7 +64,11 @@ M: object >label ;
 M: f >label drop <gadget> ;
 
 : label-on-left ( gadget label -- button )
-    [ >label f track, 1 track, ] { 1 0 } make-track ;
-
+  { 1 0 } <track>
+    swap >label f track-add*
+    swap        1 track-add* ;
+    
 : label-on-right ( label gadget -- button )
-    [ f track, >label 1 track, ] { 1 0 } make-track ;
+  { 1 0 } <track>
+    swap        f track-add*
+    swap >label 1 track-add* ;

From 7aa66d2f5c34c7cf92b6e44df1147eecf427440e Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 20:19:59 -0500
Subject: [PATCH 09/29] ui.gadgets.tracks: remove 'make-track'

---
 extra/ui/gadgets/tracks/tracks-docs.factor  |  9 +--------
 extra/ui/gadgets/tracks/tracks-tests.factor | 17 +++++++++--------
 extra/ui/gadgets/tracks/tracks.factor       |  3 ---
 3 files changed, 10 insertions(+), 19 deletions(-)

diff --git a/extra/ui/gadgets/tracks/tracks-docs.factor b/extra/ui/gadgets/tracks/tracks-docs.factor
index 8df68718c5..9cbf1e2f1b 100755
--- a/extra/ui/gadgets/tracks/tracks-docs.factor
+++ b/extra/ui/gadgets/tracks/tracks-docs.factor
@@ -10,7 +10,6 @@ ARTICLE: "ui-track-layout" "Track layouts"
 "Adding children:"
 { $subsection track-add }
 "Creating new tracks using a combinator:"
-{ $subsection make-track }
 { $subsection track, } ;
 
 HELP: track
@@ -20,18 +19,12 @@ HELP: <track>
 { $values { "orientation" "an orientation specifier" } { "track" "a new " { $link track } } }
 { $description "Creates a new track which lays out children along the given axis. Children are laid out vertically if the orientation is " { $snippet "{ 0 1 }" } " and horizontally if the orientation is " { $snippet "{ 1 0 }" } "." } ; 
 
-{ <track> make-track } related-words
-
 HELP: track-add
 { $values { "gadget" gadget } { "track" track } { "constraint" "a number between 0 and 1, or " { $link f } } }
 { $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child." } ;
 
 HELP: track,
 { $values { "gadget" gadget } { "constraint" "a number between 0 and 1, or " { $link f } } }
-{ $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child. This word can only be called inside the quotation passed to " { $link make-track } "." } ;
-
-HELP: make-track
-{ $values { "quot" quotation } { "orientation" "an orientation specifier" } { "track" track } }
-{ $description "Creates a new track. The quotation can add children by calling the " { $link track, } " word." } ;
+{ $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child." } ;
 
 ABOUT: "ui-track-layout"
diff --git a/extra/ui/gadgets/tracks/tracks-tests.factor b/extra/ui/gadgets/tracks/tracks-tests.factor
index d3264b2470..210a7c5771 100644
--- a/extra/ui/gadgets/tracks/tracks-tests.factor
+++ b/extra/ui/gadgets/tracks/tracks-tests.factor
@@ -1,15 +1,16 @@
-USING: kernel ui.gadgets ui.gadgets.tracks tools.test math.geometry.rect ;
+USING: kernel ui.gadgets ui.gadgets.tracks tools.test
+       math.geometry.rect accessors ;
 IN: ui.gadgets.tracks.tests
 
 [ { 100 100 } ] [
-    [
-        <gadget> { 100 100 } over set-rect-dim 1 track,
-    ] { 0 1 } make-track pref-dim
+  { 0 1 } <track>
+    <gadget> { 100 100 } >>dim 1 track-add*
+  pref-dim
 ] unit-test
 
 [ { 100 110 } ] [
-    [
-        <gadget> { 10 10 } over set-rect-dim f track,
-        <gadget> { 100 100 } over set-rect-dim 1 track,
-    ] { 0 1 } make-track pref-dim
+  { 0 1 } <track>
+    <gadget> { 10 10 }   >>dim f track-add*
+    <gadget> { 100 100 } >>dim 1 track-add*
+  pref-dim
 ] unit-test
diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index 7a8ee65a8b..7af33e0255 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -56,9 +56,6 @@ M: track pref-dim*
 : track, ( gadget constraint -- )
     gadget get swap track-add ;
 
-: make-track ( quot orientation -- track )
-    <track> swap make-gadget ; inline
-
 : track-remove ( gadget track -- )
     over [
         [ gadget-children index ] 2keep

From c05ebef125404bfa3377dd67464ed6099e7f1a64 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 20:45:06 -0500
Subject: [PATCH 10/29] ui.gadgets.tabs: rewrite add-toggle

---
 extra/ui/gadgets/tabs/tabs.factor | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/extra/ui/gadgets/tabs/tabs.factor b/extra/ui/gadgets/tabs/tabs.factor
index d9e322eed3..5688bb5a2e 100755
--- a/extra/ui/gadgets/tabs/tabs.factor
+++ b/extra/ui/gadgets/tabs/tabs.factor
@@ -4,7 +4,7 @@
 USING: accessors kernel fry math math.vectors sequences arrays vectors assocs
        hashtables models models.range models.compose combinators
        ui ui.gadgets ui.gadgets.buttons ui.gadgets.frames ui.gadgets.packs
-       ui.gadgets.grids ui.gadgets.viewports ui.gadgets.books ;
+       ui.gadgets.grids ui.gadgets.viewports ui.gadgets.books locals ;
 
 IN: ui.gadgets.tabs
 
@@ -12,11 +12,12 @@ TUPLE: tabbed < frame names toggler content ;
 
 DEFER: (del-page)
 
-: add-toggle ( model n name toggler -- )
-    [ [ gadget-parent '[ , , , (del-page) ] "X" swap
-       <bevel-button> @right frame, ] 3keep 
-      [ swapd <toggle-button> @center frame, ] dip ] make-frame
-    add-gadget drop ;
+:: add-toggle ( model n name toggler -- )
+  <frame>
+    n name toggler parent>> '[ , , , (del-page) ] "X" swap <bevel-button>
+      @right grid-add*
+    n model name <toggle-button> @center grid-add*
+  toggler swap add-gadget drop ;
 
 : redo-toggler ( tabbed -- )
      [ names>> ] [ model>> ] [ toggler>> ] tri

From 539e697a08549f99575ee99312e59989b78a5c73 Mon Sep 17 00:00:00 2001
From: Chris Double <chris@bethia.(none)>
Date: Tue, 15 Jul 2008 13:51:30 +1200
Subject: [PATCH 11/29] Correct help-lint issues in pegs

---
 extra/peg/parsers/parsers-docs.factor | 38 +++++++++++++--------------
 extra/peg/peg-docs.factor             | 11 ++++----
 2 files changed, 24 insertions(+), 25 deletions(-)

diff --git a/extra/peg/parsers/parsers-docs.factor b/extra/peg/parsers/parsers-docs.factor
index d71fdaea3b..7ffd458fce 100755
--- a/extra/peg/parsers/parsers-docs.factor
+++ b/extra/peg/parsers/parsers-docs.factor
@@ -11,7 +11,7 @@ HELP: 1token
 } { $description
     "Calls 1string on a character and returns a parser that matches that character."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"a\" CHAR: a 1token parse parse-result-ast ." "\"a\"" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"a\" CHAR: a 1token parse ." "\"a\"" }
 } { $see-also 'string' } ;
 
 HELP: (list-of)
@@ -33,8 +33,8 @@ HELP: list-of
     "Returns a parser that returns a list of items separated by the separator parser.  Hides the separators and matches a list of one or more items."
 } { $notes "Use " { $link list-of-many } " to ensure a list contains two or more items." }
 { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of parse parse-result-ast ." "V{ \"a\" }" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of parse  ." "V{ \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
 } { $see-also list-of-many } ;
     
 HELP: list-of-many
@@ -46,8 +46,8 @@ HELP: list-of-many
     "Returns a parser that returns a list of items separated by the separator parser.  Hides the separators and matches a list of two or more items."
 } { $notes "Use " { $link list-of } " to return a list of only one item."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of-many parse ." "f" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of-many parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $code "USING: peg peg.parsers prettyprint ;" "\"a\" \"a\" token \",\" token list-of-many parse => exception" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"a,a,a,a\" \"a\" token \",\" token list-of-many parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
 } { $see-also list-of } ;
 
 HELP: epsilon
@@ -72,8 +72,8 @@ HELP: exactly-n
 } { $description
     "Returns a parser that matches an exact repetition of the input parser."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 exactly-n parse ." "f" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 exactly-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $code "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 exactly-n parse => exception" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 exactly-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
 } { $see-also at-least-n at-most-n from-m-to-n } ;
 
 HELP: at-least-n
@@ -84,9 +84,9 @@ HELP: at-least-n
 } { $description
     "Returns a parser that matches n or more repetitions of the input parser."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 at-least-n parse ." "f" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-least-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-least-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" \"a\" }" }
+    { $code "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 4 at-least-n parse => exception"}
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-least-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-least-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" \"a\" }" }
 } { $see-also exactly-n at-most-n from-m-to-n } ;
 
 HELP: at-most-n
@@ -97,8 +97,8 @@ HELP: at-most-n
 } { $description
     "Returns a parser that matches n or fewer repetitions of the input parser."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-most-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-most-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 4 at-most-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 4 at-most-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
 } { $see-also exactly-n at-least-n from-m-to-n } ;
 
 HELP: from-m-to-n
@@ -110,9 +110,9 @@ HELP: from-m-to-n
 } { $description
     "Returns a parser that matches between and including m to n repetitions of the input parser."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" }" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
-    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 3 4 from-m-to-n parse parse-result-ast ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"aaaaa\" \"a\" token 3 4 from-m-to-n parse ." "V{ \"a\" \"a\" \"a\" \"a\" }" }
 } { $see-also exactly-n at-most-n at-least-n } ;
 
 HELP: pack
@@ -124,7 +124,7 @@ HELP: pack
 } { $description
     "Returns a parser that parses the begin, body, and end parsers in order.  The begin and end parsers are hidden."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse parse-result-ast ." "123" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" \"hi\" token 'integer' \"bye\" token pack parse ." "123" }
 } { $see-also surrounded-by } ;
 
 HELP: surrounded-by
@@ -136,7 +136,7 @@ HELP: surrounded-by
 } { $description
     "Calls token on begin and end to make them into string parsers.  Returns a parser that parses the begin, body, and end parsers in order.  The begin and end parsers are hidden."
 } { $examples
-    { $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse parse-result-ast ." "123" }
+    { $example "USING: peg peg.parsers prettyprint ;" "\"hi123bye\" 'integer' \"hi\" \"bye\" surrounded-by parse ." "123" }
 } { $see-also pack } ;
 
 HELP: 'digit'
@@ -173,7 +173,7 @@ HELP: range-pattern
 "of characters separated with a dash (-) represents the "
 "range of characters from the first to the second, inclusive."
 { $examples
-    { $example "USING: peg peg.parsers prettyprint strings ;" "\"a\" \"_a-zA-Z\" range-pattern parse parse-result-ast 1string ." "\"a\"" } 
-    { $example "USING: peg peg.parsers prettyprint ;\n\"0\" \"^0-9\" range-pattern parse ." "f" } 
+    { $example "USING: peg peg.parsers prettyprint strings ;" "\"a\" \"_a-zA-Z\" range-pattern parse 1string ." "\"a\"" } 
+    { $code "USING: peg peg.parsers prettyprint ;\n\"0\" \"^0-9\" range-pattern parse => exception"} 
 }
 }  ;
diff --git a/extra/peg/peg-docs.factor b/extra/peg/peg-docs.factor
index 10e05a2512..00390c1b1e 100644
--- a/extra/peg/peg-docs.factor
+++ b/extra/peg/peg-docs.factor
@@ -7,11 +7,11 @@ HELP: parse
 { $values 
   { "input" "a string" } 
   { "parser" "a parser" } 
-  { "result" "a parse-result or f" } 
+  { "ast" "an object" } 
 }
 { $description 
-    "Given the input string, parse it using the given parser. The result is a <parse-result> object if "
-    "the parse was successful, otherwise it is f." } 
+    "Given the input string, parse it using the given parser. The result is the abstract "
+    "syntax tree returned by the parser." } 
 { $see-also compile } ;
 
 HELP: compile
@@ -20,7 +20,7 @@ HELP: compile
   { "word" "a word" } 
 }
 { $description 
-    "Compile the parser to a word. The word will have stack effect ( -- result )."
+    "Compile the parser to a word. The word will have stack effect ( -- ast )."
 } 
 { $see-also parse } ;
 
@@ -104,8 +104,7 @@ HELP: semantic
     "Returns a parser that succeeds if the 'p1' parser succeeds and the quotation called with "
     "the AST produced by 'p1' on the stack returns true." }
 { $examples 
-  { $example "USING: kernel math peg prettyprint ;" "\"A\" [ drop t ] satisfy [ 66 > ] semantic parse ." "f" } 
-  { $example "USING: kernel math peg prettyprint ;" "\"C\" [ drop t ] satisfy [ 66 > ] semantic parse parse-result-ast ." "67" } 
+  { $example "USING: kernel math peg prettyprint ;" "\"C\" [ drop t ] satisfy [ 66 > ] semantic parse ." "67" } 
 } ;
 
 HELP: ensure

From 3e9e5e681ebc2a474f721789e1f8c42a9e506fa6 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 22:14:31 -0500
Subject: [PATCH 12/29] ui.gadgets.frames: refactor to not use 'make-frame'

---
 extra/ui/gadgets/labelled/labelled.factor | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/extra/ui/gadgets/labelled/labelled.factor b/extra/ui/gadgets/labelled/labelled.factor
index 8f504aea14..686e940ae6 100755
--- a/extra/ui/gadgets/labelled/labelled.factor
+++ b/extra/ui/gadgets/labelled/labelled.factor
@@ -38,10 +38,9 @@ M: labelled-gadget focusable-child* labelled-gadget-content ;
 : <title-label> ( text -- label ) <label> dup title-theme ;
 
 : <title-bar> ( title quot -- gadget )
-    [
-        [ <close-box> @left frame, ] when*
-        <title-label> @center frame,
-    ] make-frame ;
+  <frame>
+    swap dup [ <close-box> @left grid-add* ] [ drop ] if
+    swap <title-label> @center grid-add* ;
 
 TUPLE: closable-gadget < frame content ;
 

From 369426bef010c553d2a08cceb96d75af0bfb0c95 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 22:15:01 -0500
Subject: [PATCH 13/29] ui.gadgets.frames: remove 'make-frame'

---
 extra/ui/gadgets/frames/frames-docs.factor | 9 +--------
 extra/ui/gadgets/frames/frames.factor      | 3 ---
 2 files changed, 1 insertion(+), 11 deletions(-)

diff --git a/extra/ui/gadgets/frames/frames-docs.factor b/extra/ui/gadgets/frames/frames-docs.factor
index bb759cf92e..db3ae856b1 100755
--- a/extra/ui/gadgets/frames/frames-docs.factor
+++ b/extra/ui/gadgets/frames/frames-docs.factor
@@ -8,7 +8,6 @@ ARTICLE: "ui-frame-layout" "Frame layouts"
 "Creating empty frames:"
 { $subsection <frame> }
 "Creating new frames using a combinator:"
-{ $subsection make-frame }
 { $subsection frame, }
 "A set of mnemonic words for the positions on a frame's 3x3 grid; these words push values which may be passed to " { $link grid-add } " or " { $link frame, } ":"
 { $subsection @center }
@@ -44,15 +43,9 @@ HELP: <frame>
 { $values { "frame" frame } }
 { $description "Creates a new " { $link frame } " for laying out gadgets in a 3x3 grid." } ;
 
-{ <frame> make-frame } related-words
-
-HELP: make-frame
-{ $values { "quot" quotation } { "frame" frame } }
-{ $description "Creates a new frame. The quotation can add children by calling the " { $link frame, } " word." } ;
-
 HELP: frame,
 { $values { "gadget" gadget } { "i" "non-negative integer" } { "j" "non-negative integer" } }
-{ $description "Adds a child gadget at the specified location. This word can only be called inside the quotation passed to " { $link make-frame } "." } ;
+{ $description "Adds a child gadget at the specified location. This word can only be called inside the quotation passed to make-frame." } ;
 
 { grid frame } related-words
 
diff --git a/extra/ui/gadgets/frames/frames.factor b/extra/ui/gadgets/frames/frames.factor
index 717323c69a..4e0601d4c3 100644
--- a/extra/ui/gadgets/frames/frames.factor
+++ b/extra/ui/gadgets/frames/frames.factor
@@ -39,8 +39,5 @@ M: frame layout*
     [ rot rect-dim fill-center ] 3keep
     grid-layout ;
 
-: make-frame ( quot -- frame )
-    <frame> swap make-gadget ; inline
-
 : frame, ( gadget i j -- )
     gadget get -rot grid-add ;

From 4bce4db2f767ac337ab51114de040985bde0a7a6 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 22:17:49 -0500
Subject: [PATCH 14/29] ui.gadgets: remove 'make-gadget'

---
 extra/ui/gadgets/gadgets-docs.factor | 6 +-----
 extra/ui/gadgets/gadgets.factor      | 3 ---
 extra/ui/ui-docs.factor              | 1 -
 3 files changed, 1 insertion(+), 9 deletions(-)

diff --git a/extra/ui/gadgets/gadgets-docs.factor b/extra/ui/gadgets/gadgets-docs.factor
index 3437f1fdb4..597e811d7f 100755
--- a/extra/ui/gadgets/gadgets-docs.factor
+++ b/extra/ui/gadgets/gadgets-docs.factor
@@ -180,13 +180,9 @@ HELP: focusable-child
 { $values { "gadget" gadget } { "child" gadget } }
 { $description "Outputs the child of the gadget which would prefer to receive keyboard focus." } ;
 
-HELP: make-gadget
-{ $values { "gadget" gadget } { "quot" quotation } }
-{ $description "Calls the quotation in a new scope with the gadget stored in the " { $link gadget } " variable." } ;
-
 HELP: with-gadget
 { $values { "gadget" gadget } { "quot" quotation } }
-{ $description "Calls the quotation in a new scope with the " { $link gadget } " and " { $link make-gadget } " variables set to " { $snippet "gadget" } } ;
+{ $description "Calls the quotation in a new scope with the " { $link gadget } " variable set to " { $snippet "gadget" } } ;
 
 { control-value set-control-value gadget-model } related-words
 
diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor
index ef0a9e828d..10ea9cbb7e 100755
--- a/extra/ui/gadgets/gadgets.factor
+++ b/extra/ui/gadgets/gadgets.factor
@@ -360,9 +360,6 @@ M: f request-focus-on 2drop ;
 : with-gadget ( gadget quot -- )
     gadget swap with-variable ; inline
 
-: make-gadget ( gadget quot -- gadget )
-    [ with-gadget ] [ drop ] 2bi ; inline
-
 ! Deprecated
 : set-gadget-delegate ( gadget tuple -- )
     over [
diff --git a/extra/ui/ui-docs.factor b/extra/ui/ui-docs.factor
index 333afd3485..7b7a6866c7 100755
--- a/extra/ui/ui-docs.factor
+++ b/extra/ui/ui-docs.factor
@@ -234,7 +234,6 @@ $nl
 "Similar tools exist for constructing complex gadget hierarchies. Different words are used for different types of gadgets; see " { $link "ui-pack-layout" } ", " { $link "ui-track-layout" } " and " { $link "ui-frame-layout" } " for specifics. This section documents their common factors."
 $nl
 "Gadget construction combinators whose names are prefixed with " { $snippet "make-" } " construct new gadgets and push them on the stack. The primitive combinator used to define all combinators of this form:"
-{ $subsection make-gadget }
 "Words such as " { $link track, } " access the gadget through the " { $link gadget } " variable."
 $nl
 "A combinator which stores a gadget in the " { $link gadget } " variable:"

From b01bd3a0328665ea1c9049fd145e67f091280119 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 22:26:49 -0500
Subject: [PATCH 15/29] ui.gadgets.slots: rewrite 'display-slot'

---
 extra/ui/gadgets/slots/slots.factor | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/extra/ui/gadgets/slots/slots.factor b/extra/ui/gadgets/slots/slots.factor
index 7d488c727b..cd339d7ff7 100755
--- a/extra/ui/gadgets/slots/slots.factor
+++ b/extra/ui/gadgets/slots/slots.factor
@@ -96,8 +96,10 @@ TUPLE: editable-slot < track printer ref ;
     <roll-button> ;
 
 : display-slot ( gadget editable-slot -- )
-    dup clear-track
-    [ 1 track, <edit-button> f track, ] with-gadget ;
+  dup clear-track
+    swap          1 track-add*
+    <edit-button> f track-add*
+  drop ;
 
 : update-slot ( editable-slot -- )
     [ [ ref>> get-ref ] [ printer>> ] bi call ] keep

From 078079859ccdd1f04a0bedd467ca94d2fc932330 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 22:37:34 -0500
Subject: [PATCH 16/29] ui.gadgets: remove 'with-gadget'

---
 extra/ui/gadgets/gadgets-docs.factor | 4 ----
 extra/ui/gadgets/gadgets.factor      | 3 ---
 extra/ui/ui-docs.factor              | 4 +---
 3 files changed, 1 insertion(+), 10 deletions(-)

diff --git a/extra/ui/gadgets/gadgets-docs.factor b/extra/ui/gadgets/gadgets-docs.factor
index 597e811d7f..ac428799ab 100755
--- a/extra/ui/gadgets/gadgets-docs.factor
+++ b/extra/ui/gadgets/gadgets-docs.factor
@@ -180,10 +180,6 @@ HELP: focusable-child
 { $values { "gadget" gadget } { "child" gadget } }
 { $description "Outputs the child of the gadget which would prefer to receive keyboard focus." } ;
 
-HELP: with-gadget
-{ $values { "gadget" gadget } { "quot" quotation } }
-{ $description "Calls the quotation in a new scope with the " { $link gadget } " variable set to " { $snippet "gadget" } } ;
-
 { control-value set-control-value gadget-model } related-words
 
 HELP: control-value
diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor
index 10ea9cbb7e..19593d2f22 100755
--- a/extra/ui/gadgets/gadgets.factor
+++ b/extra/ui/gadgets/gadgets.factor
@@ -357,9 +357,6 @@ M: f request-focus-on 2drop ;
 : focus-path ( world -- seq )
     [ focus>> ] follow ;
 
-: with-gadget ( gadget quot -- )
-    gadget swap with-variable ; inline
-
 ! Deprecated
 : set-gadget-delegate ( gadget tuple -- )
     over [
diff --git a/extra/ui/ui-docs.factor b/extra/ui/ui-docs.factor
index 7b7a6866c7..fc70b57af5 100755
--- a/extra/ui/ui-docs.factor
+++ b/extra/ui/ui-docs.factor
@@ -235,9 +235,7 @@ $nl
 $nl
 "Gadget construction combinators whose names are prefixed with " { $snippet "make-" } " construct new gadgets and push them on the stack. The primitive combinator used to define all combinators of this form:"
 "Words such as " { $link track, } " access the gadget through the " { $link gadget } " variable."
-$nl
-"A combinator which stores a gadget in the " { $link gadget } " variable:"
-{ $subsection with-gadget } ;
+;
 
 ARTICLE: "ui-null-layout" "Manual layouts"
 "When automatic layout is not appropriate, gadgets can be added to a parent with no layout policy, and then positioned and sized manually:"

From 1f3f062bf69cdf4b7dcd899a9865286b41a9cd67 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Mon, 14 Jul 2008 23:29:14 -0500
Subject: [PATCH 17/29] ui.gadgets.tracks: refactor

---
 extra/ui/gadgets/tracks/tracks-docs.factor | 8 +-------
 extra/ui/gadgets/tracks/tracks.factor      | 3 ---
 extra/ui/ui-docs.factor                    | 3 ---
 3 files changed, 1 insertion(+), 13 deletions(-)

diff --git a/extra/ui/gadgets/tracks/tracks-docs.factor b/extra/ui/gadgets/tracks/tracks-docs.factor
index 9cbf1e2f1b..7fbbd1a330 100755
--- a/extra/ui/gadgets/tracks/tracks-docs.factor
+++ b/extra/ui/gadgets/tracks/tracks-docs.factor
@@ -8,9 +8,7 @@ ARTICLE: "ui-track-layout" "Track layouts"
 "Creating empty tracks:"
 { $subsection <track> }
 "Adding children:"
-{ $subsection track-add }
-"Creating new tracks using a combinator:"
-{ $subsection track, } ;
+{ $subsection track-add } ;
 
 HELP: track
 { $class-description "A track is like a " { $link pack } " except each child is resized to a fixed multiple of the track's dimension in the direction of " { $link gadget-orientation } ". Tracks are created by calling " { $link <track> } "." } ;
@@ -23,8 +21,4 @@ HELP: track-add
 { $values { "gadget" gadget } { "track" track } { "constraint" "a number between 0 and 1, or " { $link f } } }
 { $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child." } ;
 
-HELP: track,
-{ $values { "gadget" gadget } { "constraint" "a number between 0 and 1, or " { $link f } } }
-{ $description "Adds a new child to a track. If the constraint is " { $link f } ", the child always occupies its preferred size. Otherwise, the constrant is a fraction of the total size which is allocated for the child." } ;
-
 ABOUT: "ui-track-layout"
diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index 7af33e0255..af54b3c47c 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -53,9 +53,6 @@ M: track pref-dim*
     pick sizes>> push
     add-gadget ;
 
-: track, ( gadget constraint -- )
-    gadget get swap track-add ;
-
 : track-remove ( gadget track -- )
     over [
         [ gadget-children index ] 2keep
diff --git a/extra/ui/ui-docs.factor b/extra/ui/ui-docs.factor
index fc70b57af5..4181f60d81 100755
--- a/extra/ui/ui-docs.factor
+++ b/extra/ui/ui-docs.factor
@@ -232,9 +232,6 @@ ARTICLE: "ui-layout-combinators" "Creating layouts using combinators"
 "The " { $link make } " combinator provides a convenient way of constructing sequences by keeping the intermediate sequence off the stack until construction is done. The " { $link , } " and " { $link % } " words operate on this implicit sequence, reducing stack noise."
 $nl
 "Similar tools exist for constructing complex gadget hierarchies. Different words are used for different types of gadgets; see " { $link "ui-pack-layout" } ", " { $link "ui-track-layout" } " and " { $link "ui-frame-layout" } " for specifics. This section documents their common factors."
-$nl
-"Gadget construction combinators whose names are prefixed with " { $snippet "make-" } " construct new gadgets and push them on the stack. The primitive combinator used to define all combinators of this form:"
-"Words such as " { $link track, } " access the gadget through the " { $link gadget } " variable."
 ;
 
 ARTICLE: "ui-null-layout" "Manual layouts"

From 653dee57d95c78744465c5b20035a0c2548ce992 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Tue, 15 Jul 2008 01:58:37 -0500
Subject: [PATCH 18/29] color-picker: rewrite <color-picker>

---
 extra/color-picker/color-picker.factor | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/extra/color-picker/color-picker.factor b/extra/color-picker/color-picker.factor
index c786f77e85..15c4e7c733 100755
--- a/extra/color-picker/color-picker.factor
+++ b/extra/color-picker/color-picker.factor
@@ -3,7 +3,8 @@
 USING: kernel math math.functions math.parser models
        models.filter models.range models.compose sequences ui
        ui.gadgets ui.gadgets.frames ui.gadgets.labels ui.gadgets.packs
-       ui.gadgets.sliders ui.render math.geometry.rect accessors ;
+       ui.gadgets.sliders ui.render math.geometry.rect accessors
+       ui.gadgets.grids ;
 IN: color-picker
 
 ! Simple example demonstrating the use of models.
@@ -33,12 +34,16 @@ M: color-preview model-changed
       [ <color-slider> add-gadget ] each ;
 
 : <color-picker> ( -- gadget )
-    [
-        <color-sliders> @top frame,
-        dup <color-model> <color-preview> @center frame,
-        [ [ truncate number>string ] map " " join ] <filter>
-        <label-control> @bottom frame,
-    ] make-frame ;
+  <frame>
+    <color-sliders>
+      swap dup
+      [                               @top    grid-add* ]
+      [ <color-model> <color-preview> @center grid-add* ]
+      [
+        [ [ truncate number>string ] map " " join ] <filter> <label-control>
+        @bottom grid-add*
+      ]
+      tri* ;
 
 : color-picker-window ( -- )
     [ <color-picker> "Color Picker" open-window ] with-ui ;

From a0d978227f5939da7236d66f0d007f10c97b942e Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Tue, 15 Jul 2008 02:00:05 -0500
Subject: [PATCH 19/29] ui.tools-tests: fix using

---
 extra/ui/tools/tools-tests.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/ui/tools/tools-tests.factor b/extra/ui/tools/tools-tests.factor
index 0120ecb92f..e9c907a33f 100755
--- a/extra/ui/tools/tools-tests.factor
+++ b/extra/ui/tools/tools-tests.factor
@@ -2,7 +2,7 @@ USING: ui.tools ui.tools.interactor ui.tools.listener
 ui.tools.search ui.tools.workspace kernel models namespaces
 sequences tools.test ui.gadgets ui.gadgets.buttons
 ui.gadgets.labelled ui.gadgets.presentations
-ui.gadgets.scrollers vocabs tools.test.ui ui ;
+ui.gadgets.scrollers vocabs tools.test.ui ui accessors ;
 IN: ui.tools.tests
 
 [ f ]

From 799d541d92a98085353a4727842fdfc576c179a2 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Tue, 15 Jul 2008 02:04:53 -0500
Subject: [PATCH 20/29] ui.tools.search-tests: add a missing stack effect

---
 extra/ui/tools/search/search-tests.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/ui/tools/search/search-tests.factor b/extra/ui/tools/search/search-tests.factor
index 4a75ebfc96..34e1823a42 100755
--- a/extra/ui/tools/search/search-tests.factor
+++ b/extra/ui/tools/search/search-tests.factor
@@ -10,7 +10,7 @@ IN: ui.tools.search.tests
     T{ key-down f { C+ } "x" } swap search-gesture
 ] unit-test
 
-: assert-non-empty empty? f assert= ;
+: assert-non-empty ( obj -- ) empty? f assert= ;
 
 : update-live-search ( search -- seq )
     dup [

From 1a04f30c7ce8187fadbab0aa71cda400ae2df05a Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Tue, 15 Jul 2008 02:17:13 -0500
Subject: [PATCH 21/29] ui.gadgets.tracks: rewrite available-dim

---
 extra/ui/gadgets/tracks/tracks.factor | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index af54b3c47c..9ab3c5200f 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -23,8 +23,7 @@ TUPLE: track < pack sizes ;
     dup gadget-children swap track-sizes { 0 0 }
     [ [ drop { 0 0 } ] [ pref-dim ] if v+ ] 2reduce ;
 
-: available-dim ( track -- dim )
-    dup rect-dim swap alloted-dim v- ;
+: available-dim ( track -- dim ) [ dim>> ] [ alloted-dim ] bi v- ;
 
 : track-layout ( track -- sizes )
     dup available-dim over gadget-children rot normalized-sizes

From 43b20221767dbbcbd171ec824f23a4d57b0f4a66 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Tue, 15 Jul 2008 02:25:37 -0500
Subject: [PATCH 22/29] ui.gadgets.tracks: rewrite pref-dim* method

---
 extra/ui/gadgets/tracks/tracks.factor | 20 +++++++++-----------
 1 file changed, 9 insertions(+), 11 deletions(-)

diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index 9ab3c5200f..09e3d5307a 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -16,8 +16,7 @@ TUPLE: track < pack sizes ;
         V{ } clone >>sizes
         1 >>fill ; inline
 
-: <track> ( orientation -- track )
-    track new-track ;
+: <track> ( orientation -- track ) track new-track ;
 
 : alloted-dim ( track -- dim )
     dup gadget-children swap track-sizes { 0 0 }
@@ -29,21 +28,20 @@ TUPLE: track < pack sizes ;
     dup available-dim over gadget-children rot normalized-sizes
     [ [ over n*v ] [ pref-dim ] ?if ] 2map nip ;
 
-M: track layout*
-    dup track-layout pack-layout ;
+M: track layout* ( track -- ) dup track-layout pack-layout ;
 
-: track-pref-dims-1 ( track -- dim )
-    gadget-children pref-dims max-dim ;
+: track-pref-dims-1 ( track -- dim ) children>> pref-dims max-dim ;
 
 : track-pref-dims-2 ( track -- dim )
     dup gadget-children pref-dims swap normalized-sizes
     [ [ v/n ] when* ] 2map max-dim [ >fixnum ] map ;
 
-M: track pref-dim*
-    dup track-pref-dims-1
-    over alloted-dim
-    pick track-pref-dims-2 v+
-    rot gadget-orientation set-axis ;
+M: track pref-dim* ( gadget -- dim )
+   [ track-pref-dims-1                           ]
+   [ [ alloted-dim ] [ track-pref-dims-1 ] bi v+ ]
+   [ orientation>>                               ]
+   tri
+   set-axis ;
 
 : track-add ( gadget track constraint -- )
     over track-sizes push swap add-gadget drop ;

From 27c83d4884b7e2d3470577badc89676773f55924 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Tue, 15 Jul 2008 02:31:04 -0500
Subject: [PATCH 23/29] ui.gadgets.tracks: rewrite alloted-dim

---
 extra/ui/gadgets/tracks/tracks.factor | 15 +++++++--------
 1 file changed, 7 insertions(+), 8 deletions(-)

diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index 09e3d5307a..755dc341d3 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -11,16 +11,16 @@ TUPLE: track < pack sizes ;
     [ sift sum ] keep [ dup [ over / ] when ] map nip ;
 
 : new-track ( orientation class -- track )
-    new-gadget
-        swap >>orientation
-        V{ } clone >>sizes
-        1 >>fill ; inline
+  new-gadget
+    swap       >>orientation
+    V{ } clone >>sizes
+    1          >>fill ; inline
 
 : <track> ( orientation -- track ) track new-track ;
 
 : alloted-dim ( track -- dim )
-    dup gadget-children swap track-sizes { 0 0 }
-    [ [ drop { 0 0 } ] [ pref-dim ] if v+ ] 2reduce ;
+  [ children>> ] [ sizes>> ] bi { 0 0 }
+  [ [ drop { 0 0 } ] [ pref-dim ] if v+ ] 2reduce ;
 
 : available-dim ( track -- dim ) [ dim>> ] [ alloted-dim ] bi v- ;
 
@@ -47,8 +47,7 @@ M: track pref-dim* ( gadget -- dim )
     over track-sizes push swap add-gadget drop ;
 
 : track-add* ( track gadget constraint -- track )
-    pick sizes>> push
-    add-gadget ;
+  pick sizes>> push add-gadget ;
 
 : track-remove ( gadget track -- )
     over [

From 39ec81361eca214d7673cc77bd4d53c09731cdae Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Tue, 15 Jul 2008 02:33:44 -0500
Subject: [PATCH 24/29] ui.gadgets.tracks: rewrite track-layout

---
 extra/ui/gadgets/tracks/tracks.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index 755dc341d3..296385bfb8 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -25,7 +25,7 @@ TUPLE: track < pack sizes ;
 : available-dim ( track -- dim ) [ dim>> ] [ alloted-dim ] bi v- ;
 
 : track-layout ( track -- sizes )
-    dup available-dim over gadget-children rot normalized-sizes
+    [ available-dim ] [ children>> ] [ normalized-sizes ] tri
     [ [ over n*v ] [ pref-dim ] ?if ] 2map nip ;
 
 M: track layout* ( track -- ) dup track-layout pack-layout ;

From 1f422a14127126781fc70ee596f20a1591fdaad1 Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Tue, 15 Jul 2008 02:38:04 -0500
Subject: [PATCH 25/29] ui.gadgets.tracks: rewrite track-pref-dims-2

---
 extra/ui/gadgets/tracks/tracks.factor | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index 296385bfb8..7f0e38bff7 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -33,8 +33,10 @@ M: track layout* ( track -- ) dup track-layout pack-layout ;
 : track-pref-dims-1 ( track -- dim ) children>> pref-dims max-dim ;
 
 : track-pref-dims-2 ( track -- dim )
-    dup gadget-children pref-dims swap normalized-sizes
-    [ [ v/n ] when* ] 2map max-dim [ >fixnum ] map ;
+  [ children>> pref-dims ] [ normalized-sizes ] bi
+  [ [ v/n ] when* ] 2map
+  max-dim
+  [ >fixnum ] map ;
 
 M: track pref-dim* ( gadget -- dim )
    [ track-pref-dims-1                           ]

From 57dfbf6d10e7021848952a34d2415e8cdb45455a Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Tue, 15 Jul 2008 02:45:15 -0500
Subject: [PATCH 26/29] ui.gadgets.tracks: rewrite normalized-sizes

---
 extra/ui/gadgets/tracks/tracks.factor | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index 7f0e38bff7..36df45a3b6 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -1,14 +1,15 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors io kernel math namespaces
-sequences words math.vectors ui.gadgets ui.gadgets.packs math.geometry.rect ;
+       sequences words math.vectors ui.gadgets ui.gadgets.packs
+       math.geometry.rect fry ;
+
 IN: ui.gadgets.tracks
 
 TUPLE: track < pack sizes ;
 
 : normalized-sizes ( track -- seq )
-    track-sizes
-    [ sift sum ] keep [ dup [ over / ] when ] map nip ;
+  sizes>> dup sift sum '[ dup [ , / ] when ] map ;
 
 : new-track ( orientation class -- track )
   new-gadget
@@ -59,5 +60,4 @@ M: track pref-dim* ( gadget -- dim )
         2drop
     ] if ;
 
-: clear-track ( track -- )
-    V{ } clone over set-track-sizes clear-gadget ;
+: clear-track ( track -- ) V{ } clone >>sizes clear-gadget ;

From fd7f3423edbe286dc9ce99b77c6231cb282bc67a Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Tue, 15 Jul 2008 03:48:48 -0500
Subject: [PATCH 27/29] ui.gadgets.tracks: rewrite track-remove

---
 extra/ui/gadgets/tracks/tracks.factor     | 16 +++++++++-------
 extra/ui/tools/workspace/workspace.factor |  6 +++---
 2 files changed, 12 insertions(+), 10 deletions(-)

diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index 36df45a3b6..bf6b02463e 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -52,12 +52,14 @@ M: track pref-dim* ( gadget -- dim )
 : track-add* ( track gadget constraint -- track )
   pick sizes>> push add-gadget ;
 
-: track-remove ( gadget track -- )
-    over [
-        [ gadget-children index ] 2keep
-        swap unparent track-sizes delete-nth
-    ] [
-        2drop
-    ] if ;
+: track-remove ( track gadget -- track )
+  dupd dup
+    [
+      [ swap children>> index ]
+      [ unparent sizes>>      ] 2bi
+      delete-nth 
+    ]
+    [ 2drop ]
+  if ;
 
 : clear-track ( track -- ) V{ } clone >>sizes clear-gadget ;
diff --git a/extra/ui/tools/workspace/workspace.factor b/extra/ui/tools/workspace/workspace.factor
index c7a13938b1..ee3f24c2cd 100755
--- a/extra/ui/tools/workspace/workspace.factor
+++ b/extra/ui/tools/workspace/workspace.factor
@@ -57,9 +57,9 @@ M: gadget tool-scroller drop f ;
     article-title open-window ;
 
 : hide-popup ( workspace -- )
-    dup workspace-popup over track-remove
-    f over set-workspace-popup
-    request-focus ;
+  dup popup>> track-remove
+  f >>popup
+  request-focus ;
 
 : show-popup ( gadget workspace -- )
     dup hide-popup

From 7c0fe0cf05d998ed02abbed38d9de882a167009a Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Tue, 15 Jul 2008 03:54:05 -0500
Subject: [PATCH 28/29] ui.tools.workspace: update find-tool

---
 extra/ui/tools/workspace/workspace.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/extra/ui/tools/workspace/workspace.factor b/extra/ui/tools/workspace/workspace.factor
index ee3f24c2cd..2d759ca1d2 100755
--- a/extra/ui/tools/workspace/workspace.factor
+++ b/extra/ui/tools/workspace/workspace.factor
@@ -28,7 +28,7 @@ GENERIC: tool-scroller ( tool -- scroller )
 M: gadget tool-scroller drop f ;
 
 : find-tool ( class workspace -- index tool )
-    workspace-book gadget-children [ class eq? ] with find ;
+  book>> children>> [ class eq? ] with find ;
 
 : show-tool ( class workspace -- tool )
     [ find-tool swap ] keep workspace-book gadget-model

From 2abc7c329b84e867d30de098c9dcc15ba1d7c5fd Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Tue, 15 Jul 2008 03:58:01 -0500
Subject: [PATCH 29/29] ui.tools.workspace: minor changes

---
 extra/ui/tools/workspace/workspace.factor | 20 +++++++++-----------
 1 file changed, 9 insertions(+), 11 deletions(-)

diff --git a/extra/ui/tools/workspace/workspace.factor b/extra/ui/tools/workspace/workspace.factor
index 2d759ca1d2..45dfd32609 100755
--- a/extra/ui/tools/workspace/workspace.factor
+++ b/extra/ui/tools/workspace/workspace.factor
@@ -1,25 +1,23 @@
 ! Copyright (C) 2006, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes continuations help help.topics kernel models
-sequences ui ui.backend ui.tools.debugger ui.gadgets
-ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
-ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
-ui.gadgets.worlds ui.gadgets.presentations ui.gadgets.status-bar
-ui.commands ui.gestures assocs arrays namespaces accessors ;
+       sequences ui ui.backend ui.tools.debugger ui.gadgets
+       ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
+       ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
+       ui.gadgets.worlds ui.gadgets.presentations ui.gadgets.status-bar
+       ui.commands ui.gestures assocs arrays namespaces accessors ;
+
 IN: ui.tools.workspace
 
 TUPLE: workspace < track book listener popup ;
 
-: find-workspace ( gadget -- workspace )
-    [ workspace? ] find-parent ;
+: find-workspace ( gadget -- workspace ) [ workspace? ] find-parent ;
 
 SYMBOL: workspace-window-hook
 
-: workspace-window* ( -- workspace )
-    workspace-window-hook get call ;
+: workspace-window* ( -- workspace ) workspace-window-hook get call ;
 
-: workspace-window ( -- )
-    workspace-window* drop ;
+: workspace-window ( -- ) workspace-window* drop ;
 
 GENERIC: call-tool* ( arg tool -- )