From e703dd2b8d04fa356d22e679f6f6f503109ee238 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 11 Jul 2008 14:43:51 -0500
Subject: [PATCH] Cleaning up some code

---
 extra/ui/gadgets/frames/frames.factor       |  4 ++--
 extra/ui/gadgets/gadgets-docs.factor        |  4 ++--
 extra/ui/gadgets/gadgets.factor             | 12 +++++-------
 extra/ui/gadgets/labelled/labelled.factor   | 16 ++++++----------
 extra/ui/gadgets/packs/packs.factor         |  6 +++---
 extra/ui/gadgets/scrollers/scrollers.factor | 10 ++++------
 extra/ui/gadgets/sliders/sliders.factor     | 12 ++++++------
 extra/ui/gadgets/slots/slots.factor         | 10 ++++------
 extra/ui/gadgets/tracks/tracks.factor       |  4 ++--
 extra/ui/tools/browser/browser.factor       | 10 ++++------
 extra/ui/tools/debugger/debugger.factor     | 10 ++++------
 extra/ui/tools/deploy/deploy.factor         | 10 ++++------
 extra/ui/tools/inspector/inspector.factor   |  8 +++-----
 extra/ui/tools/listener/listener.factor     | 12 +++++-------
 extra/ui/tools/profiler/profiler.factor     | 10 ++++------
 extra/ui/tools/search/search.factor         | 10 ++++------
 extra/ui/tools/tools.factor                 | 16 +++++++---------
 extra/ui/tools/traceback/traceback.factor   | 14 ++++++++------
 extra/ui/tools/walker/walker.factor         | 11 +++++------
 extra/ui/ui-docs.factor                     |  2 +-
 20 files changed, 83 insertions(+), 108 deletions(-)

diff --git a/extra/ui/gadgets/frames/frames.factor b/extra/ui/gadgets/frames/frames.factor
index df1b7aa654..096d916a9b 100644
--- a/extra/ui/gadgets/frames/frames.factor
+++ b/extra/ui/gadgets/frames/frames.factor
@@ -39,7 +39,7 @@ M: frame layout*
     grid-layout ;
 
 : make-frame ( quot -- frame )
-    <frame> make-gadget ; inline
+    <frame> swap make-gadget ; inline
 
 : frame, ( gadget i j -- )
-    \ make-gadget get -rot grid-add ;
+    gadget get -rot grid-add ;
diff --git a/extra/ui/gadgets/gadgets-docs.factor b/extra/ui/gadgets/gadgets-docs.factor
index f05126fec3..8093aa5dc5 100755
--- a/extra/ui/gadgets/gadgets-docs.factor
+++ b/extra/ui/gadgets/gadgets-docs.factor
@@ -235,8 +235,8 @@ HELP: gadget,
 { $description "Adds a new child to the gadget being constructed. This word can only be used from a quotation passed to " { $link make-gadget } "." } ;
 
 HELP: make-gadget
-{ $values { "quot" quotation } { "gadget" gadget } }
-{ $description "Calls the quotation in a new scope with the gadget stored in the " { $link make-gadget } " variable." } ;
+{ $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 } } 
diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor
index 58b58d4fdc..5bfb5a1b05 100755
--- a/extra/ui/gadgets/gadgets.factor
+++ b/extra/ui/gadgets/gadgets.factor
@@ -391,19 +391,17 @@ M: f request-focus-on 2drop ;
 : focus-path ( world -- seq )
     [ gadget-focus ] follow ;
 
-: make-gadget ( quot gadget -- gadget )
-    [ \ make-gadget rot with-variable ] keep ; inline
-
-: gadget, ( gadget -- ) \ make-gadget get add-gadget ;
+: gadget, ( gadget -- ) gadget get add-gadget ;
 
 : g ( -- gadget ) gadget get ;
 
 : g-> ( x -- x x gadget ) dup g ;
 
 : with-gadget ( gadget quot -- )
-    [
-        swap dup \ make-gadget set gadget set call
-    ] with-scope ; inline
+    gadget swap with-variable ; inline
+
+: make-gadget ( gadget quot -- gadget )
+    [ with-gadget ] [ drop ] 2bi ; inline
 
 ! Deprecated
 : set-gadget-delegate ( gadget tuple -- )
diff --git a/extra/ui/gadgets/labelled/labelled.factor b/extra/ui/gadgets/labelled/labelled.factor
index ee27620273..2cb69d6061 100755
--- a/extra/ui/gadgets/labelled/labelled.factor
+++ b/extra/ui/gadgets/labelled/labelled.factor
@@ -13,11 +13,9 @@ 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,
-        ] with-gadget
-    ] keep ;
+        <label> reverse-video-theme f track,
+        g-> set-labelled-gadget-content 1 track,
+    ] make-gadget ;
 
 M: labelled-gadget focusable-child* labelled-gadget-content ;
 
@@ -54,10 +52,8 @@ TUPLE: closable-gadget < frame content ;
 : <closable-gadget> ( gadget title quot -- gadget )
     closable-gadget new-frame 
     [
-        [
-            <title-bar> @top frame,
-            g-> set-closable-gadget-content @center frame,
-        ] with-gadget
-    ] keep ;
+        <title-bar> @top frame,
+        g-> set-closable-gadget-content @center frame,
+    ] make-gadget ;
 
 M: closable-gadget focusable-child* closable-gadget-content ;
diff --git a/extra/ui/gadgets/packs/packs.factor b/extra/ui/gadgets/packs/packs.factor
index 3503d8e530..00f27af270 100755
--- a/extra/ui/gadgets/packs/packs.factor
+++ b/extra/ui/gadgets/packs/packs.factor
@@ -62,10 +62,10 @@ M: pack children-on ( rect gadget -- seq )
     [ fast-children-on ] keep <slice> ;
 
 : make-pile ( quot -- pack )
-    <pile> make-gadget ; inline
+    <pile> swap make-gadget ; inline
 
 : make-filled-pile ( quot -- pack )
-    <filled-pile> make-gadget ; inline
+    <filled-pile> swap make-gadget ; inline
 
 : make-shelf ( quot -- pack )
-    <shelf> make-gadget ; inline
+    <shelf> swap make-gadget ; inline
diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor
index 7f8e5044eb..d1ee3da7b3 100755
--- a/extra/ui/gadgets/scrollers/scrollers.factor
+++ b/extra/ui/gadgets/scrollers/scrollers.factor
@@ -46,12 +46,10 @@ scroller H{
         <scroller-model> >>model
          faint-boundary
     [
-        [
-            x-model <x-slider> g-> set-scroller-x @bottom frame,
-            y-model <y-slider> g-> set-scroller-y @right frame,
-            viewport,
-        ] with-gadget
-    ] keep ;
+        x-model <x-slider> g-> set-scroller-x @bottom frame,
+        y-model <y-slider> g-> set-scroller-y @right frame,
+        viewport,
+    ] make-gadget ;
 
 : <scroller> ( gadget -- scroller )
     scroller new-scroller ;
diff --git a/extra/ui/gadgets/sliders/sliders.factor b/extra/ui/gadgets/sliders/sliders.factor
index 56bfb0bc80..da18dea142 100755
--- a/extra/ui/gadgets/sliders/sliders.factor
+++ b/extra/ui/gadgets/sliders/sliders.factor
@@ -149,12 +149,12 @@ M: elevator layout*
 : <right-button> ( -- button )
     { 0 1 } arrow-right 1 <slide-button> ;
 
-: build-x-slider ( slider -- )
+: build-x-slider ( slider -- slider )
     [
         <left-button> @left frame,
         { 0 1 } elevator,
         <right-button> @right frame,
-    ] with-gadget ;
+    ] make-gadget ; inline
 
 : <up-button> ( -- button )
     { 1 0 } arrow-up -1 <slide-button> ;
@@ -162,12 +162,12 @@ M: elevator layout*
 : <down-button> ( -- button )
     { 1 0 } arrow-down 1 <slide-button> ;
 
-: build-y-slider ( slider -- )
+: build-y-slider ( slider -- slider )
     [
         <up-button> @top frame,
         { 1 0 } elevator,
         <down-button> @bottom frame,
-    ] with-gadget ;
+    ] make-gadget ; inline
 
 : <slider> ( range orientation -- slider )
     slider new-frame
@@ -176,10 +176,10 @@ M: elevator layout*
         32 >>line ;
 
 : <x-slider> ( range -- slider )
-    { 1 0 } <slider> dup build-x-slider ;
+    { 1 0 } <slider> build-x-slider ;
 
 : <y-slider> ( range -- slider )
-    { 0 1 } <slider> dup build-y-slider ;
+    { 0 1 } <slider> build-y-slider ;
 
 M: slider pref-dim*
     dup call-next-method
diff --git a/extra/ui/gadgets/slots/slots.factor b/extra/ui/gadgets/slots/slots.factor
index 1b101e5bf7..2c2831a2ee 100755
--- a/extra/ui/gadgets/slots/slots.factor
+++ b/extra/ui/gadgets/slots/slots.factor
@@ -72,12 +72,10 @@ M: value-ref finish-editing
     { 0 1 } slot-editor new-track
         swap >>ref
     [
-        [
-            toolbar,
-            <source-editor> g-> set-slot-editor-text
-            <scroller> 1 track,
-        ] with-gadget
-    ] keep
+        toolbar,
+        <source-editor> g-> set-slot-editor-text
+        <scroller> 1 track,
+    ] make-gadget
     dup revert ;
 
 M: slot-editor pref-dim* call-next-method { 600 200 } vmin ;
diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index d2d4275750..f9276fd1a1 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -50,10 +50,10 @@ M: track pref-dim*
     over track-sizes push add-gadget ;
 
 : track, ( gadget constraint -- )
-    \ make-gadget get swap track-add ;
+    gadget get swap track-add ;
 
 : make-track ( quot orientation -- track )
-    <track> make-gadget ; inline
+    <track> swap make-gadget ; inline
 
 : track-remove ( gadget track -- )
     over [
diff --git a/extra/ui/tools/browser/browser.factor b/extra/ui/tools/browser/browser.factor
index d8d2ac0104..421ffdbaaf 100755
--- a/extra/ui/tools/browser/browser.factor
+++ b/extra/ui/tools/browser/browser.factor
@@ -23,12 +23,10 @@ TUPLE: browser-gadget < track pane history ;
     { 0 1 } browser-gadget new-track
     dup init-history
     [
-        [
-            toolbar,
-            g <help-pane> g-> set-browser-gadget-pane
-            <scroller> 1 track,
-        ] with-gadget
-    ] keep ;
+        toolbar,
+        g <help-pane> g-> set-browser-gadget-pane
+        <scroller> 1 track,
+    ] make-gadget ;
 
 M: browser-gadget call-tool* show-help ;
 
diff --git a/extra/ui/tools/debugger/debugger.factor b/extra/ui/tools/debugger/debugger.factor
index ddf4b0106f..fbf9b28937 100644
--- a/extra/ui/tools/debugger/debugger.factor
+++ b/extra/ui/tools/debugger/debugger.factor
@@ -23,12 +23,10 @@ TUPLE: debugger < track restarts ;
 : <debugger> ( error restarts restart-hook -- gadget )
     { 0 1 } debugger new-track
     [
-        [
-            toolbar,
-            <restart-list> g-> set-debugger-restarts
-            swap <debugger-display> <scroller> 1 track,
-        ] with-gadget
-    ] keep ;
+        toolbar,
+        <restart-list> g-> set-debugger-restarts
+        swap <debugger-display> <scroller> 1 track,
+    ] make-gadget ;
 
 M: debugger focusable-child* debugger-restarts ;
 
diff --git a/extra/ui/tools/deploy/deploy.factor b/extra/ui/tools/deploy/deploy.factor
index d6b6683e29..3395c95663 100755
--- a/extra/ui/tools/deploy/deploy.factor
+++ b/extra/ui/tools/deploy/deploy.factor
@@ -109,12 +109,10 @@ deploy-gadget "toolbar" f {
         swap >>vocab
         { 0 1 } >>orientation
     [
-        [
-            g vocab>> <deploy-settings>
-            g-> set-deploy-gadget-settings gadget,
-            buttons,
-        ] with-gadget
-    ] keep
+        g vocab>> <deploy-settings>
+        g-> set-deploy-gadget-settings gadget,
+        buttons,
+    ] make-gadget
     dup deploy-settings-theme
     dup com-revert ;
 
diff --git a/extra/ui/tools/inspector/inspector.factor b/extra/ui/tools/inspector/inspector.factor
index bdb5c4d985..4aaf31881e 100644
--- a/extra/ui/tools/inspector/inspector.factor
+++ b/extra/ui/tools/inspector/inspector.factor
@@ -16,11 +16,9 @@ TUPLE: inspector-gadget < track object pane ;
 : <inspector-gadget> ( -- gadget )
     { 0 1 } inspector-gadget new-track
     [
-        [
-            toolbar,
-            <pane> g-> set-inspector-gadget-pane <scroller> 1 track,
-        ] with-gadget
-    ] keep ;
+        toolbar,
+        <pane> g-> set-inspector-gadget-pane <scroller> 1 track,
+    ] make-gadget ;
 
 : inspect-object ( obj inspector -- )
     [ set-inspector-gadget-object ] keep refresh ;
diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor
index 9b668142e8..3331999cc1 100755
--- a/extra/ui/tools/listener/listener.factor
+++ b/extra/ui/tools/listener/listener.factor
@@ -124,12 +124,10 @@ TUPLE: stack-display < track ;
     g workspace-listener
     { 0 1 } stack-display new-track
     [
-        [
-            dup <toolbar> f track,
-            stack>> [ [ stack. ] curry try ]
-            t "Data stack" <labelled-pane> 1 track,
-        ] with-gadget
-    ] keep ;
+        dup <toolbar> f track,
+        stack>> [ [ stack. ] curry try ]
+        t "Data stack" <labelled-pane> 1 track,
+    ] make-gadget ;
 
 M: stack-display tool-scroller
     find-workspace workspace-listener tool-scroller ;
@@ -174,7 +172,7 @@ M: stack-display tool-scroller
 : <listener-gadget> ( -- gadget )
     { 0 1 } listener-gadget new-track
     dup init-listener
-    [ [ listener-output, listener-input, ] with-gadget ] keep ;
+    [ listener-output, listener-input, ] make-gadget ;
 
 : listener-help ( -- ) "ui-listener" help-window ;
 
diff --git a/extra/ui/tools/profiler/profiler.factor b/extra/ui/tools/profiler/profiler.factor
index c86a0660a5..eca93cd8e1 100755
--- a/extra/ui/tools/profiler/profiler.factor
+++ b/extra/ui/tools/profiler/profiler.factor
@@ -10,12 +10,10 @@ TUPLE: profiler-gadget < track pane ;
 : <profiler-gadget> ( -- gadget )
     { 0 1 } profiler-gadget new-track
     [
-        [
-            toolbar,
-            <pane> g-> set-profiler-gadget-pane
-            <scroller> 1 track,
-        ] with-gadget
-    ] keep ;
+        toolbar,
+        <pane> g-> set-profiler-gadget-pane
+        <scroller> 1 track,
+    ] make-gadget ;
 
 : with-profiler-pane ( gadget quot -- )
     >r profiler-gadget-pane r> with-pane ;
diff --git a/extra/ui/tools/search/search.factor b/extra/ui/tools/search/search.factor
index 3a48655a78..1d8f16de5a 100755
--- a/extra/ui/tools/search/search.factor
+++ b/extra/ui/tools/search/search.factor
@@ -62,12 +62,10 @@ search-field H{
 : <live-search> ( string seq limited? presenter -- gadget )
     { 0 1 } live-search new-track
     [
-        [
-            <search-field> g-> set-live-search-field f track,
-            <search-list> g-> set-live-search-list
-            <scroller> 1 track,
-        ] with-gadget
-    ] keep
+        <search-field> g-> set-live-search-field f track,
+        <search-list> g-> set-live-search-list
+        <scroller> 1 track,
+    ] make-gadget
     [ live-search-field set-editor-string ] keep
     [ live-search-field end-of-document ] keep ;
 
diff --git a/extra/ui/tools/tools.factor b/extra/ui/tools/tools.factor
index 9107454fa7..9b8affc649 100755
--- a/extra/ui/tools/tools.factor
+++ b/extra/ui/tools/tools.factor
@@ -30,15 +30,13 @@ IN: ui.tools
     { 0 1 } workspace new-track
         0 <model> >>model
     [
-        [
-            <listener-gadget> g set-workspace-listener
-            <workspace-book> g set-workspace-book
-            <workspace-tabs> f track,
-            g workspace-book 1/5 track,
-            g workspace-listener 4/5 track,
-            toolbar,
-        ] with-gadget
-    ] keep ;
+        <listener-gadget> g set-workspace-listener
+        <workspace-book> g set-workspace-book
+        <workspace-tabs> f track,
+        g workspace-book 1/5 track,
+        g workspace-listener 4/5 track,
+        toolbar,
+    ] make-gadget ;
 
 : resize-workspace ( workspace -- )
     dup track-sizes over control-value zero? [
diff --git a/extra/ui/tools/traceback/traceback.factor b/extra/ui/tools/traceback/traceback.factor
index fa24d8c37d..e1743a4bc8 100755
--- a/extra/ui/tools/traceback/traceback.factor
+++ b/extra/ui/tools/traceback/traceback.factor
@@ -27,15 +27,17 @@ M: traceback-gadget pref-dim* drop { 550 600 } ;
     { 0 1 } traceback-gadget new-track
         swap >>model
     [
+        g model>>
         [
             [
-                g gadget-model <datastack-display> 1/2 track,
-                g gadget-model <retainstack-display> 1/2 track,
+                [ <datastack-display> 1/2 track, ]
+                [ <retainstack-display> 1/2 track, ]
+                bi
             ] { 1 0 } make-track 1/3 track,
-            g gadget-model <callstack-display> 2/3 track,
-            toolbar,
-        ] with-gadget
-    ] keep ;
+        ]
+        [ <callstack-display> 2/3 track, ] bi
+        toolbar,
+    ] make-gadget ;
 
 : <namestack-display> ( model -- gadget )
     [ [ continuation-name namestack. ] when* ]
diff --git a/extra/ui/tools/walker/walker.factor b/extra/ui/tools/walker/walker.factor
index 59aa644505..3588b44644 100755
--- a/extra/ui/tools/walker/walker.factor
+++ b/extra/ui/tools/walker/walker.factor
@@ -60,13 +60,12 @@ M: walker-gadget focusable-child*
         swap >>thread
         swap >>continuation
         swap >>status
+        dup continuation>> <traceback-gadget> >>traceback
     [
-        [
-            toolbar,
-            g status>> self <thread-status> f track,
-            g continuation>> <traceback-gadget> 1 track,
-        ] with-gadget
-    ] keep ;
+        toolbar,
+        g status>> self <thread-status> f track,
+        g traceback>> 1 track,
+    ] make-gadget ;
 
 : walker-help ( -- ) "ui-walker" help-window ;
 
diff --git a/extra/ui/ui-docs.factor b/extra/ui/ui-docs.factor
index 3567ff6311..c037f13888 100755
--- a/extra/ui/ui-docs.factor
+++ b/extra/ui/ui-docs.factor
@@ -235,7 +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:"
 { $subsection make-gadget }
-"Words such as " { $link gadget, } " and " { $link track, } " access the gadget through the " { $link make-gadget } " variable."
+"Words such as " { $link gadget, } " and " { $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 }