Eliminate some more usages of tuck

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
+            [ drop prefer-incremental ]
-        2dup incremental-loc
+            [ drop layout-later ]
-        tuck update-cursor
+            [ incremental-loc ]
-        dup prefer-incremental
+            [ update-cursor ]
-        parent>> [ invalidate* ] when*
+            [ nip prefer-incremental ]
+            [ nip parent>> [ invalidate* ] when* ]
+        } 2cleave
     ] with-variable ;
 
 : clear-incremental ( incremental -- )
     not-in-layout
-    dup (clear-gadget)
+    [ (clear-gadget) ]
-    dup forget-pref-dim
+    [ forget-pref-dim ]
-    { 0 0 } >>cursor
+    [ { 0 0 } >>cursor parent>> [ relayout ] when* ]
-    parent>> [ relayout ] when* ;
+    tri ;

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 [

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 ;

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 ]

basis/ui/gestures/gestures.factor

@@ -9,9 +9,9 @@ IN: ui.gestures
 GENERIC: handle-gesture ( gesture gadget -- ? )
 
 M: object handle-gesture
-    tuck class superclasses
+    [ nip ]
-    [ "gestures" word-prop ] map
+    [ class superclasses [ "gestures" word-prop ] map assoc-stack ] 2bi
-    assoc-stack dup [ call f ] [ 2drop t ] if ;
+    dup [ call f ] [ 2drop t ] if ;
 
 : set-gestures ( class hash -- ) "gestures" set-word-prop ;
 

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
+    [ nip ] [ [ [ orientation>> ] [ dim>> ] bi ] [ colors>> ] bi* ] 2bi
-    [ [ orientation>> ] [ dim>> ] bi ] [ colors>> ] bi*
     [ gradient-vertices >>last-vertices ]
-    [ gradient-colors >>last-colors ] bi
+    [ gradient-colors >>last-colors ]
-    drop ;
+    bi drop ;
 
 : draw-gradient ( colors -- )
     GL_COLOR_ARRAY [

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?
+    model>> [ value>> swap showing-definition? ] keep
-    [ notify-connections ] [ drop ] if ;
+    '[ _ notify-connections ] when ;
 
 M: browser-gadget focusable-child* search-field>> ;
 

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 ]

basis/ui/traverse/traverse.factor

@@ -19,8 +19,9 @@ TUPLE: node value children ;
             nip ,
         ] [
             [
-                2dup children>> swap first head-slice %
+                [ children>> swap first head-slice % ]
-                tuck traverse-step traverse-to-path
+                [ 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
+                [ traverse-step traverse-from-path ]
-                tuck children>> swap first 1+ tail-slice %
+                [ tuck children>> swap first 1+ tail-slice % ] 2bi
             ] make-node
         ] if
     ] if ;

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