Eliminate some more usages of tuck

diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor
index 2af0f6e6a2584694b9d1b537e24f9c2bc8c04815..0a439a1a1a1730dd89cf1bcb0c1033bf2efd095b 100644 (file)
--- a/basis/ui/gadgets/gadgets.factor
+++ b/basis/ui/gadgets/gadgets.factor
@@ -288,7 +288,7 @@ SYMBOL: in-layout?
     dup unparent
     over >>parent
     tuck ((add-gadget))
-    tuck graft-state>> second [ graft ] [ drop  ] if ;
+    tuck graft-state>> second [ graft ] [ drop ] if ;
 
 : add-gadget ( parent child -- parent )
     not-in-layout

diff --git a/basis/ui/gadgets/incremental/incremental.factor b/basis/ui/gadgets/incremental/incremental.factor
index 2b33d2bfe10fd38a7adec7a2d6ba811b310cb3c6..e7a651604cb0f0573c2eb93e92767a4def5d6676 100644 (file)
--- a/basis/ui/gadgets/incremental/incremental.factor
+++ b/basis/ui/gadgets/incremental/incremental.factor
@@ -1,7 +1,7 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io kernel math namespaces math.vectors ui.gadgets
-ui.gadgets.packs accessors math.geometry.rect ;
+ui.gadgets.packs accessors math.geometry.rect combinators ;
 IN: ui.gadgets.incremental
 
 TUPLE: incremental < pack cursor ;
@@ -29,7 +29,7 @@ M: incremental pref-dim*
     [ cursor>> ] [ orientation>> ] bi v*
     >>loc drop ;
 
-: prefer-incremental ( gadget -- ) USE: slots.private
+: prefer-incremental ( gadget -- )
     dup forget-pref-dim dup pref-dim >>dim drop ;
 
 M: incremental dim-changed drop ;
@@ -38,17 +38,19 @@ M: incremental dim-changed drop ;
     not-in-layout
     2dup swap (add-gadget) drop
     t in-layout? [
-        over prefer-incremental
-        over layout-later
-        2dup incremental-loc
-        tuck update-cursor
-        dup prefer-incremental
-        parent>> [ invalidate* ] when*
+        {
+            [ drop prefer-incremental ]
+            [ drop layout-later ]
+            [ incremental-loc ]
+            [ update-cursor ]
+            [ nip prefer-incremental ]
+            [ nip parent>> [ invalidate* ] when* ]
+        } 2cleave
     ] with-variable ;
 
 : clear-incremental ( incremental -- )
     not-in-layout
-    dup (clear-gadget)
-    dup forget-pref-dim
-    { 0 0 } >>cursor
-    parent>> [ relayout ] when* ;
+    [ (clear-gadget) ]
+    [ forget-pref-dim ]
+    [ { 0 0 } >>cursor parent>> [ relayout ] when* ]
+    tri ;

diff --git a/basis/ui/gadgets/menus/menus.factor b/basis/ui/gadgets/menus/menus.factor
index fd561f4583cb350c61c557c70e672eb73ad027ad..e29d495c05637c3b63381763a0fab1269551b79f 100644 (file)
--- a/basis/ui/gadgets/menus/menus.factor
+++ b/basis/ui/gadgets/menus/menus.factor
@@ -10,7 +10,7 @@ IN: ui.gadgets.menus
     [ dim>> ] [ pref-dim ] bi* [v-] hand-loc get-global vmin ;
 
 : show-menu ( owner menu -- )
-    [ find-world dup ] dip tuck menu-loc show-glass ;
+    [ find-world ] dip 2dup menu-loc show-glass ;
 
 :: <menu-item> ( target hook command -- button )
     command command-name [

diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor
index ffd30ae2fa1d017c1c660567a27a828910746db6..377e883b468f28ba605dc4ae28b5fbfd36b4425f 100644 (file)
--- a/basis/ui/gadgets/panes/panes.factor
+++ b/basis/ui/gadgets/panes/panes.factor
@@ -124,7 +124,7 @@ M: style-stream write-gadget
     stream>> write-gadget ;
 
 : print-gadget ( gadget stream -- )
-    tuck write-gadget stream-nl ;
+    [ write-gadget ] [ nip stream-nl ] 2bi ;
 
 : gadget. ( gadget -- )
     output-stream get print-gadget ;

diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor
index c5b969eb1bda9ce4fdb81e8164eabb0d8bad292e..d879edc476afaef3bb322adc9f355dae68fdea4b 100644 (file)
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -51,7 +51,7 @@ CONSTANT: table-gap 6
 
 : (compute-column-widths) ( font rows -- total widths )
     [ drop 0 { } ] [
-        tuck [ first length 0 <repetition> ] 2dip
+        [ nip first length 0 <repetition> ] 2keep
         [ [ text-width ] with map vmax ] with each
         [ [ sum ] [ length 1 [-] table-gap * ] bi + ] keep
     ] if-empty ;
@@ -217,7 +217,7 @@ PRIVATE>
     if ;
 
 M: table model-changed
-    tuck initial-selected-index {
+    [ nip ] [ initial-selected-index ] 2bi {
         [ >>selected-index drop ]
         [ show-row-summary ]
         [ drop update-selected-value ]

diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor
index 19f813736a7e73b0c07fcdec737368b1182e582e..eea2320b1bfc32c763453b14afeff320de08b522 100644 (file)
--- a/basis/ui/gestures/gestures.factor
+++ b/basis/ui/gestures/gestures.factor
@@ -9,9 +9,9 @@ IN: ui.gestures
 GENERIC: handle-gesture ( gesture gadget -- ? )
 
 M: object handle-gesture
-    tuck class superclasses
-    [ "gestures" word-prop ] map
-    assoc-stack dup [ call f ] [ 2drop t ] if ;
+    [ nip ]
+    [ class superclasses [ "gestures" word-prop ] map assoc-stack ] 2bi
+    dup [ call f ] [ 2drop t ] if ;
 
 : set-gestures ( class hash -- ) "gestures" set-word-prop ;
 

diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor
index deed0b5f04d4bbba7a4848e87718e5a6e6bf0526..37a384d55930e3dcf5ce4b600315a87edc6da88e 100755 (executable)
--- a/basis/ui/render/render.factor
+++ b/basis/ui/render/render.factor
@@ -145,11 +145,10 @@ TUPLE: gradient < caching-pen colors last-vertices last-colors ;
     >float-array ;
 
 M: gradient recompute-pen ( gadget gradient -- )
-    tuck
-    [ [ orientation>> ] [ dim>> ] bi ] [ colors>> ] bi*
+    [ nip ] [ [ [ orientation>> ] [ dim>> ] bi ] [ colors>> ] bi* ] 2bi
     [ gradient-vertices >>last-vertices ]
-    [ gradient-colors >>last-colors ] bi
-    drop ;
+    [ gradient-colors >>last-colors ]
+    bi drop ;
 
 : draw-gradient ( colors -- )
     GL_COLOR_ARRAY [

diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor
index 82aef92158c164c6e571340d0d2292904ee872da..a74ac9c1ade97d96c8ccdc913ce0ee67612dfaa2 100644 (file)
--- a/basis/ui/tools/browser/browser.factor
+++ b/basis/ui/tools/browser/browser.factor
@@ -58,8 +58,8 @@ M: browser-gadget ungraft*
     } 2|| ;
 
 M: browser-gadget definitions-changed ( assoc browser -- )
-    model>> tuck value>> swap showing-definition?
-    [ notify-connections ] [ drop ] if ;
+    model>> [ value>> swap showing-definition? ] keep
+    '[ _ notify-connections ] when ;
 
 M: browser-gadget focusable-child* search-field>> ;
 

diff --git a/basis/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor
index 24b6dea8034a893411088652062d78dcf6ce41ac..145c8cec6e38c7e8c0ba964de859851133696415 100644 (file)
--- a/basis/ui/tools/listener/listener.factor
+++ b/basis/ui/tools/listener/listener.factor
@@ -304,7 +304,7 @@ M: object accept-completion-hook 2drop ;
     ] recover ;
 
 : handle-interactive ( lines interactor -- quot/f ? )
-    tuck try-parse {
+    [ nip ] [ try-parse ] 2bi {
         { [ dup quotation? ] [ nip t ] }
         { [ dup not ] [ drop "\n" swap user-input* drop f f ] }
         [ handle-parse-error f f ]

diff --git a/basis/ui/traverse/traverse.factor b/basis/ui/traverse/traverse.factor
index 7a012aa3e001891530b7022b5ad4263443533c9f..7765b73d12184d141bd56eefcbad8427abd0935f 100644 (file)
--- a/basis/ui/traverse/traverse.factor
+++ b/basis/ui/traverse/traverse.factor
@@ -19,8 +19,9 @@ TUPLE: node value children ;
             nip ,
         ] [
             [
-                2dup children>> swap first head-slice %
-                tuck traverse-step traverse-to-path
+                [ children>> swap first head-slice % ]
+                [ tuck traverse-step traverse-to-path ]
+                2bi
             ] make-node
         ] if
     ] if ;
@@ -33,8 +34,8 @@ TUPLE: node value children ;
             nip ,
         ] [
             [
-                2dup traverse-step traverse-from-path
-                tuck children>> swap first 1+ tail-slice %
+                [ traverse-step traverse-from-path ]
+                [ tuck children>> swap first 1+ tail-slice % ] 2bi
             ] make-node
         ] if
     ] if ;

diff --git a/basis/ui/x11/x11.factor b/basis/ui/x11/x11.factor
index 8667a9f16e1bf8211df5704981fbbec525dd5b01..a14775eb77b75b035381b4413a03b821b19347e1 100755 (executable)
--- a/basis/ui/x11/x11.factor
+++ b/basis/ui/x11/x11.factor
@@ -231,7 +231,7 @@ M: x11-ui-backend set-title ( string world -- )
 
 M: x11-ui-backend set-fullscreen* ( ? world -- )
     handle>> window>> "XClientMessageEvent" <c-object>
-    tuck set-XClientMessageEvent-window
+    [ set-XClientMessageEvent-window ] keep
     swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
     over set-XClientMessageEvent-data0
     ClientMessage over set-XClientMessageEvent-type