Refactoring usages of >r/r> to dip in UI

basis/ui/clipboards/clipboards.factor

@@ -33,7 +33,7 @@ SYMBOL: selection
 
 : gadget-copy ( gadget clipboard -- )
     over gadget-selection?
-        [ >r [ gadget-selection ] keep r> copy-clipboard ]
+        [ [ [ gadget-selection ] keep ] dip copy-clipboard ]
         [ 2drop ]
     if ;
 

basis/ui/cocoa/cocoa.factor

@@ -5,7 +5,7 @@ command-line kernel memory namespaces cocoa.messages
 cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
 cocoa.windows cocoa.classes cocoa.application sequences system
 ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
-ui.cocoa.views core-foundation threads math.geometry.rect ;
+ui.cocoa.views core-foundation threads math.geometry.rect fry ;
 IN: ui.cocoa
 
 TUPLE: handle view window ;
@@ -15,7 +15,7 @@ C: <handle> handle
 SINGLETON: cocoa-ui-backend
 
 M: cocoa-ui-backend do-events ( -- )
-    [ NSApp [ do-event ] curry loop ui-wait ] with-autorelease-pool ;
+    [ NSApp '[ _ do-event ] loop ui-wait ] with-autorelease-pool ;
 
 TUPLE: pasteboard handle ;
 

basis/ui/cocoa/tools/tools.factor

@@ -25,7 +25,7 @@ CLASS: {
 }
 
 { "application:openFiles:" "void" { "id" "SEL" "id" "id" }
-    [ >r 3drop r> finder-run-files ]
+    [ [ 3drop ] dip finder-run-files ]
 }
 
 { "newFactorWorkspace:" "id" { "id" "SEL" "id" }

basis/ui/cocoa/views/views.factor

@@ -8,7 +8,7 @@ core-foundation threads combinators math.geometry.rect ;
 IN: ui.cocoa.views
 
 : send-mouse-moved ( view event -- )
-    over >r mouse-location r> window move-hand fire-motion ;
+    [ mouse-location ] [ drop window ] 2bi move-hand fire-motion ;
 
 : button ( event -- n )
     #! Cocoa -> Factor UI button mapping
@@ -85,18 +85,19 @@ IN: ui.cocoa.views
     mouse-location rot window send-button-up ;
 
 : send-wheel$ ( view event -- )
-    over >r
+    [
         dup -> deltaX sgn neg over -> deltaY sgn neg 2array -rot
         mouse-location
-    r> window send-wheel ;
+    ] [ drop window ] 2bi send-wheel ;
 
 : send-action$ ( view event gesture -- junk )
-    >r drop window r> send-action f ;
+    [ drop window ] dip send-action f ;
 
 : add-resize-observer ( observer object -- )
-    >r "updateFactorGadgetSize:"
+    [
+        "updateFactorGadgetSize:"
         "NSViewFrameDidChangeNotification" <NSString>
-    r> add-observer ;
+    ] dip add-observer ;
 
 : string-or-nil? ( NSString -- ? )
     [ CF>string NSStringPboardType = ] [ t ] if* ;
@@ -109,7 +110,7 @@ IN: ui.cocoa.views
     ] if ;
 
 : NSRect>rect ( NSRect world -- rect )
-    >r dup NSRect-x over NSRect-y r>
+    [ dup NSRect-x over NSRect-y ] dip
     rect-dim second swap - 2array
     over NSRect-w rot NSRect-h 2array
     <rect> ;
@@ -256,7 +257,7 @@ CLASS: {
 { "validRequestorForSendType:returnType:" "id" { "id" "SEL" "id" "id" }
     [
         ! We return either self or nil
-        >r >r over window-focus r> r>
+        [ over window-focus ] 2dip
         valid-service? [ drop ] [ 2drop f ] if
     ]
 }
@@ -278,7 +279,7 @@ CLASS: {
 { "readSelectionFromPasteboard:" "char" { "id" "SEL" "id" }
     [
         pasteboard-string dup [
-            >r drop window-focus r> swap user-input 1
+            [ drop window-focus ] dip swap user-input 1
         ] [
             3drop 0
         ] if

basis/ui/commands/commands.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays definitions kernel sequences strings
 math assocs words generic namespaces make assocs quotations
-splitting ui.gestures unicode.case unicode.categories tr ;
+splitting ui.gestures unicode.case unicode.categories tr fry ;
 IN: ui.commands
 
 SYMBOL: +nullary+
@@ -37,7 +37,7 @@ GENERIC: command-word ( command -- word )
         [
             commands>>
             [ drop ] assoc-filter
-            [ [ invoke-command ] curry swap set ] assoc-each
+            [ '[ _ invoke-command ] swap set ] assoc-each
         ] each
     ] H{ } make-assoc ;
 

basis/ui/freetype/freetype.factor

@@ -111,7 +111,7 @@ M: freetype-renderer open-font ( font -- open-font )
     freetype drop open-fonts get [ <font> ] cache ;
 
 : load-glyph ( font char -- glyph )
-    >r handle>> dup r> 0 FT_Load_Char
+    [ handle>> dup ] dip 0 FT_Load_Char
     freetype-error face-glyph ;
 
 : char-width ( open-font char -- w )
@@ -174,7 +174,7 @@ M: freetype-renderer string-height ( open-font string -- h )
     bi 2array ;
 
 : <char-sprite> ( open-font char -- sprite )
-    over >r render-glyph dup r> glyph-texture-loc
+    over [ render-glyph dup ] dip glyph-texture-loc
     over glyph-size pick glyph-texture-size <sprite>
     [ bitmap>texture ] keep [ init-sprite ] keep ;
 
@@ -206,7 +206,7 @@ M: freetype-renderer string-height ( open-font string -- h )
     fonts>> [ open-font H{ } clone 2array ] cache first2 ;
 
 M: freetype-renderer draw-string ( font string loc -- )
-    >r >r world get font-sprites r> r> (draw-string) ;
+    [ world get font-sprites ] 2dip (draw-string) ;
 
 : run-char-widths ( open-font string -- widths )
     char-widths [ scan-sums ] [ 2 v/n ] bi v+ ;

basis/ui/gadgets/books/books.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sequences models ui.gadgets math.geometry.rect ;
+USING: accessors kernel sequences models ui.gadgets
+math.geometry.rect fry ;
 IN: ui.gadgets.books
 
 TUPLE: book < gadget ;
@@ -25,6 +26,6 @@ M: book model-changed ( model book -- )
 M: book pref-dim* ( book -- dim ) children>> pref-dims max-dim ;
 
 M: book layout* ( book -- )
-    [ children>> ] [ dim>> ] bi [ >>dim drop ] curry each ;
+    [ children>> ] [ dim>> ] bi '[ _ >>dim drop ] each ;
 
 M: book focusable-child* ( book -- child/t ) current-page ;

basis/ui/gadgets/gadgets.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays hashtables kernel models math namespaces
 make sequences quotations math.vectors combinators sorting
 binary-search vectors dlists deques models threads
-concurrency.flags math.order math.geometry.rect ;
+concurrency.flags math.order math.geometry.rect fry ;
 IN: ui.gadgets
 
 SYMBOL: ui-notify-flag
@@ -56,9 +56,7 @@ M: gadget model-changed 2drop ;
     2dup eq? [
         2drop { 0 0 }
     ] [
-        over rect-loc >r
+        over rect-loc [ [ parent>> ] dip relative-loc ] dip v+
-        >r parent>> r> relative-loc
-        r> v+
     ] if ;
 
 GENERIC: user-input* ( str gadget -- ? )
@@ -73,7 +71,7 @@ M: gadget children-on nip children>> ;
     [ swap loc>> v- ] dip v. 0 <=> ;
 
 : (fast-children-on) ( dim axis children -- i )
-    -rot [ ((fast-children-on)) ] 2curry search drop ;
+    -rot '[ _ _ ((fast-children-on)) ] search drop ;
 
 : fast-children-on ( rect axis children -- from to )
     [ [ rect-loc ] 2dip (fast-children-on) 0 or ]
@@ -95,10 +93,10 @@ M: gadget children-on nip children>> ;
 : dim-sum ( seq -- dim ) { 0 0 } [ v+ ] reduce ;
 
 : orient ( gadget seq1 seq2 -- seq )
-    >r >r orientation>> r> r> [ pick set-axis ] 2map nip ;
+    rot orientation>> '[ [ _ ] 2dip set-axis ] 2map ;
 
 : each-child ( gadget quot -- )
-    >r children>> r> each ; inline
+    [ children>> ] dip each ; inline
 
 ! Selection protocol
 GENERIC: gadget-selection? ( gadget -- ? )
@@ -310,18 +308,18 @@ SYMBOL: in-layout?
     [ parent>> ] follow ;
 
 : each-parent ( gadget quot -- ? )
-    >r parents r> all? ; inline
+    [ parents ] dip all? ; inline
 
 : find-parent ( gadget quot -- parent )
-    >r parents r> find nip ; inline
+    [ parents ] dip find nip ; inline
 
 : screen-loc ( gadget -- loc )
     parents { 0 0 } [ rect-loc v+ ] reduce ;
 
 : (screen-rect) ( gadget -- loc ext )
     dup parent>> [
-        >r rect-extent r> (screen-rect)
+        [ rect-extent ] dip (screen-rect)
-        >r tuck v+ r> vmin >r v+ r>
+        [ tuck v+ ] dip vmin [ v+ ] dip
     ] [
         rect-extent
     ] if* ;

basis/ui/gadgets/grid-lines/grid-lines.factor

@@ -1,7 +1,8 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors math namespaces opengl opengl.gl sequences
+USING: kernel accessors math namespaces opengl opengl.gl
-math.vectors ui.gadgets ui.gadgets.grids ui.render math.geometry.rect ;
+sequences math.vectors ui.gadgets ui.gadgets.grids ui.render
+math.geometry.rect fry ;
 IN: ui.gadgets.grid-lines
 
 TUPLE: grid-lines color ;
@@ -19,8 +20,8 @@ SYMBOL: grid-dim
 
 : draw-grid-lines ( gaps orientation -- )
     [ grid get swap grid-positions grid get rect-dim suffix ] dip
-    [ [ v- ] curry map ] keep
+    [ '[ _ v- ] map ] keep
-    [ swap grid-line-from/to gl-line ] curry each ;
+    '[ _ swap grid-line-from/to gl-line ] each ;
 
 M: grid-lines draw-boundary
     color>> gl-color [

basis/ui/gadgets/grids/grids.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel math namespaces make sequences words io
 io.streams.string math.vectors ui.gadgets columns accessors
-math.geometry.rect locals ;
+math.geometry.rect locals fry ;
 IN: ui.gadgets.grids
 
 TUPLE: grid < gadget
@@ -48,21 +48,18 @@ grid
     dupd add-gaps dim-sum v+ ;
 
 M: grid pref-dim*
-    dup gap>> swap compute-grid >r over r>
+    dup gap>> swap compute-grid [ over ] dip
-    gap-sum >r gap-sum r> (pair-up) ;
+    [ gap-sum ] 2bi@ (pair-up) ;
 
 : do-grid ( dims grid quot -- )
-    -rot grid>>
+    [ grid>> ] dip '[ _ 2each ] 2each ; inline
-    [ [ pick call ] 2each ] 2each
-    drop ; inline
 
 : grid-positions ( grid dims -- locs )
-    >r gap>> dup r> add-gaps swap [ v+ ] accumulate nip ;
+    [ gap>> dup ] dip add-gaps swap [ v+ ] accumulate nip ;
 
 : position-grid ( grid horiz vert -- )
-    pick >r
+    pick [ [ over ] dip [ grid-positions ] 2bi@ pair-up ] dip
-    >r over r> grid-positions >r grid-positions r>
+    [ (>>loc) ] do-grid ;
-    pair-up r> [ (>>loc) ] do-grid ;
 
 : resize-grid ( grid horiz vert -- )
     pick fill?>> [

basis/ui/gadgets/labelled/labelled.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays ui.gadgets.buttons ui.gadgets.borders
 ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers
@@ -19,10 +19,10 @@ TUPLE: labelled-gadget < track content ;
 M: labelled-gadget focusable-child* content>> ;
 
 : <labelled-scroller> ( gadget title -- gadget )
-    >r <scroller> r> <labelled-gadget> ;
+    [ <scroller> ] dip <labelled-gadget> ;
 
 : <labelled-pane> ( model quot scrolls? title -- gadget )
-    >r >r <pane-control> r> >>scrolls? r>
+    [ [ <pane-control> ] dip >>scrolls? ] dip
     <labelled-scroller> ;
 
 : <close-box> ( quot -- button/f )

basis/ui/gadgets/labels/labels.factor

@@ -13,7 +13,7 @@ TUPLE: label < gadget text font color ;
 
 : set-label-string ( string label -- )
     CHAR: \n pick memq? [
-        >r string-lines r> (>>text)
+        [ string-lines ] dip (>>text)
     ] [
         (>>text)
     ] if ; inline

basis/ui/gadgets/lists/lists.factor

@@ -33,7 +33,7 @@ TUPLE: list < pack index presenter color hook ;
     hook>> [ [ list? ] find-parent ] prepend ;
 
 : <list-presentation> ( hook elt presenter -- gadget )
-    keep >r >label text-theme r>
+    keep [ >label text-theme ] dip
     <presentation>
     swap >>hook ; inline
 
@@ -42,7 +42,7 @@ TUPLE: list < pack index presenter color hook ;
     [ presenter>> ]
     [ control-value ]
     tri [
-        >r 2dup r> swap <list-presentation>
+        [ 2dup ] dip swap <list-presentation>
     ] map 2nip ;
 
 M: list model-changed
@@ -113,8 +113,8 @@ M: list focusable-child* drop t ;
     select-gadget ;
 
 : list-page ( list vec -- )
-    >r dup selected-rect rect-bounds 2 v/n v+
+    [ dup selected-rect rect-bounds 2 v/n v+ over visible-dim ] dip
-    over visible-dim r> v* v+ swap select-at ;
+    v* v+ swap select-at ;
 
 : list-page-up ( list -- ) { 0 -1 } list-page ;
 

basis/ui/gadgets/menus/menus.factor

@@ -8,13 +8,13 @@ math.geometry.rect ;
 IN: ui.gadgets.menus
 
 : menu-loc ( world menu -- loc )
-    >r rect-dim r> pref-dim [v-] hand-loc get-global vmin ;
+    [ rect-dim ] [ pref-dim ] bi* [v-] hand-loc get-global vmin ;
 
 TUPLE: menu-glass < gadget ;
 
 : <menu-glass> ( menu world -- glass )
     menu-glass new-gadget
-    >r over menu-loc >>loc r>
+    [ over menu-loc >>loc ] dip
     swap add-gadget ;
 
 M: menu-glass layout* gadget-child prefer ;

basis/ui/gadgets/packs/packs.factor

@@ -19,10 +19,10 @@ TUPLE: pack < gadget
     { 0 0 } [ v+ over v+ ] accumulate 2nip ;
 
 : aligned-locs ( gadget sizes -- seq )
-    [ >r dup align>> swap rect-dim r> v- n*v ] with map ;
+    [ [ dup align>> swap rect-dim ] dip v- n*v ] with map ;
 
 : packed-locs ( gadget sizes -- seq )
-    over gap>> over gap-locs >r dupd aligned-locs r> orient ;
+    over gap>> over gap-locs [ dupd aligned-locs ] dip orient ;
 
 : round-dims ( seq -- newseq )
     { 0 0 } swap
@@ -31,8 +31,9 @@ TUPLE: pack < gadget
 
 : pack-layout ( pack sizes -- )
     round-dims over children>>
-    >r dupd packed-dims r> 2dup [ (>>dim) ] 2each
+    [ dupd packed-dims ] dip
-    >r packed-locs r> [ (>>loc) ] 2each ;
+    [ [ (>>dim) ] 2each ]
+    [ [ packed-locs ] dip [ (>>loc) ] 2each ] 2bi ;
 
 : <pack> ( orientation -- pack )
     pack new-gadget
@@ -48,7 +49,7 @@ TUPLE: pack < gadget
     [ dim-sum ] keep length 1 [-] rot n*v v+ ;
 
 : pack-pref-dim ( gadget sizes -- dim )
-    over gap>> over gap-dims >r max-dim r>
+    over gap>> over gap-dims [ max-dim ] dip
     rot orientation>> set-axis ;
 
 M: pack pref-dim*

basis/ui/gadgets/panes/panes.factor

@@ -9,7 +9,7 @@ opengl combinators math.vectors sorting splitting
 io.streams.nested assocs ui.gadgets.presentations
 ui.gadgets.slots ui.gadgets.grids ui.gadgets.grid-lines
 classes.tuple models continuations destructors accessors
-math.geometry.rect ;
+math.geometry.rect fry ;
 IN: ui.gadgets.panes
 
 TUPLE: pane < pack
@@ -59,7 +59,7 @@ M: pane gadget-selection ( pane -- string/f )
 GENERIC: draw-selection ( loc obj -- )
 
 : if-fits ( rect quot -- )
-    >r clip get over intersects? r> [ drop ] if ; inline
+    [ clip get over intersects? ] dip [ drop ] if ; inline
 
 M: gadget draw-selection ( loc gadget -- )
     swap offset-rect [
@@ -135,8 +135,8 @@ M: style-stream write-gadget
 
 : with-pane ( pane quot -- )
     over scroll>top
-    over pane-clear >r <pane-stream> r>
+    over pane-clear [ <pane-stream> ] dip
-    over >r with-output-stream* r> ?nl ; inline
+    over [ with-output-stream* ] dip ?nl ; inline
 
 : make-pane ( quot -- gadget )
     <pane> [ swap with-pane ] keep smash-pane ; inline
@@ -154,7 +154,7 @@ M: pane-control model-changed ( model pane-control -- )
         swap >>model ;
 
 : do-pane-stream ( pane-stream quot -- )
-    >r pane>> r> keep scroll-pane ; inline
+    [ pane>> ] dip keep scroll-pane ; inline
 
 M: pane-stream stream-nl
     [ pane-nl drop ] do-pane-stream ;
@@ -178,7 +178,7 @@ M: pane-stream make-span-stream
 ! Character styles
 
 : apply-style ( style gadget key quot -- style gadget )
-    >r pick at r> when* ; inline
+    [ pick at ] dip when* ; inline
 
 : apply-foreground-style ( style gadget -- style gadget )
     foreground [ >>color ] apply-style ;
@@ -228,7 +228,7 @@ M: pane-stream make-span-stream
     border-width [ <border> ] apply-style ;
 
 : apply-printer-style ( style gadget -- style gadget )
-    presented-printer [ [ make-pane ] curry >>printer ] apply-style ;
+    presented-printer [ '[ _ make-pane ] >>printer ] apply-style ;
 
 : style-pane ( style pane -- pane )
     apply-border-width-style
@@ -284,10 +284,10 @@ M: pane-stream make-cell-stream
     pane-cell-stream new-nested-pane-stream ;
 
 M: pane-stream stream-write-table
-    >r
+    [
         swap [ [ pane>> smash-pane ] map ] map
         styled-grid
-    r> print-gadget ;
+    ] dip print-gadget ;
 
 ! Stream utilities
 M: pack dispose drop ;
@@ -309,7 +309,7 @@ M: paragraph stream-write
     drop ;
 
 : gadget-write1 ( char gadget -- )
-    >r 1string r> stream-write ;
+    [ 1string ] dip stream-write ;
 
 M: pack stream-write1 gadget-write1 ;
 

basis/ui/gadgets/presentations/presentations.factor

@@ -12,7 +12,7 @@ TUPLE: presentation < button object hook ;
 
 : invoke-presentation ( presentation command -- )
     over dup hook>> call
-    >r object>> r> invoke-command ;
+    [ object>> ] dip invoke-command ;
 
 : invoke-primary ( presentation -- )
     dup object>> primary-operation

basis/ui/gadgets/sliders/sliders.factor

@@ -4,7 +4,7 @@ USING: accessors arrays ui.gestures ui.gadgets ui.gadgets.buttons
 ui.gadgets.frames ui.gadgets.grids math.order
 ui.gadgets.theme ui.render kernel math namespaces sequences
 vectors models models.range math.vectors math.functions
-quotations colors math.geometry.rect ;
+quotations colors math.geometry.rect fry ;
 IN: ui.gadgets.sliders
 
 TUPLE: elevator < gadget direction ;
@@ -104,13 +104,14 @@ elevator H{
 
 : layout-thumb-loc ( slider -- )
     dup thumb-loc (layout-thumb)
-    >r [ floor ] map r> (>>loc) ;
+    [ [ floor ] map ] dip (>>loc) ;
 
 : layout-thumb-dim ( slider -- )
-    dup dup thumb-dim (layout-thumb) >r
+    dup dup thumb-dim (layout-thumb)
-    >r dup rect-dim r>
+    [
+        [ dup rect-dim ] dip
         rot orientation>> set-axis [ ceiling ] map
-    r> (>>dim) ;
+    ] dip (>>dim) ;
 
 : layout-thumb ( slider -- )
     dup layout-thumb-loc layout-thumb-dim ;
@@ -121,8 +122,8 @@ M: elevator layout*
 : slide-by-line ( amount slider -- ) [ line>> * ] keep slide-by ;
 
 : <slide-button> ( vector polygon amount -- button )
-    >r gray swap <polygon-gadget> r>
+    [ gray swap <polygon-gadget> ] dip
-    [ swap find-slider slide-by-line ] curry <repeat-button>
+    '[ _ swap find-slider slide-by-line ] <repeat-button>
     swap >>orientation ;
 
 : elevator, ( gadget orientation -- gadget )

basis/ui/gadgets/status-bar/status-bar.factor

@@ -16,4 +16,4 @@ IN: ui.gadgets.status-bar
     open-world-window ;
 
 : show-summary ( object gadget -- )
-    >r [ summary ] [ "" ] if* r> show-status ;
+    [ [ summary ] [ "" ] if* ] dip show-status ;

basis/ui/gadgets/worlds/worlds.factor

@@ -52,7 +52,7 @@ M: world request-focus-on ( child gadget -- )
 M: world layout*
     dup call-next-method
     dup glass>> [
-        >r dup rect-dim r> (>>dim)
+        [ dup rect-dim ] dip (>>dim)
     ] when* drop ;
 
 M: world focusable-child* gadget-child ;

basis/ui/operations/operations.factor

@@ -38,7 +38,7 @@ SYMBOL: operations
     operations get [ predicate>> call ] with filter ;
 
 : find-operation ( obj quot -- command )
-    >r object-operations r> find-last nip ; inline
+    [ object-operations ] dip find-last nip ; inline
 
 : primary-operation ( obj -- operation )
     [ command>> +primary+ word-prop ] find-operation ;

basis/ui/render/render.factor

@@ -12,7 +12,7 @@ SYMBOL: viewport-translation
 
 : flip-rect ( rect -- loc dim )
     rect-bounds [
-        >r { 1 -1 } v* r> { 0 -1 } v* v+
+        [ { 1 -1 } v* ] dip { 0 -1 } v* v+
         viewport-translation get v+
     ] keep ;
 
@@ -79,9 +79,7 @@ DEFER: draw-gadget
     >absolute clip [ rect-intersect ] change ;
 
 : with-clipping ( gadget quot -- )
-    clip get >r
+    clip get [ over change-clip do-clip call ] dip clip set do-clip ; inline
-    over change-clip do-clip call
-    r> clip set do-clip ; inline
 
 : draw-gadget ( gadget -- )
     {
@@ -200,7 +198,7 @@ M: polygon draw-interior
 
 : <polygon-gadget> ( color points -- gadget )
     dup max-dim
-    >r <polygon> <gadget> r> >>dim
+    [ <polygon> <gadget> ] dip >>dim
     swap >>interior ;
 
 ! Font rendering
@@ -242,7 +240,7 @@ HOOK: free-fonts font-renderer ( world -- )
         [
             [
                 2dup { 0 0 } draw-string
-                >r open-font r> string-height
+                [ open-font ] dip string-height
                 0.0 swap 0.0 glTranslated
             ] with each
         ] with-translation

basis/ui/tools/deploy/deploy.factor

@@ -1,12 +1,11 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: ui.gadgets colors kernel ui.render namespaces
+USING: ui.gadgets colors kernel ui.render namespaces models
-       models models.mapping sequences ui.gadgets.buttons
+models.mapping sequences ui.gadgets.buttons ui.gadgets.packs
-       ui.gadgets.packs ui.gadgets.labels tools.deploy.config
+ui.gadgets.labels tools.deploy.config namespaces
-       namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
+ui.gadgets.editors ui.gadgets.borders ui.gestures ui.commands
-       ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
+assocs ui.gadgets.tracks ui ui.tools.listener tools.deploy
-       tools.deploy vocabs ui.tools.workspace system accessors ;
+vocabs ui.tools.workspace system accessors fry ;
-
 IN: ui.tools.deploy
 
 TUPLE: deploy-gadget < pack vocab settings ;
@@ -83,7 +82,7 @@ TUPLE: deploy-gadget < pack vocab settings ;
 
 : com-deploy ( gadget -- )
     dup com-save
-    dup find-deploy-vocab [ deploy ] curry call-listener
+    dup find-deploy-vocab '[ _ deploy ] call-listener
     close-window ;
 
 : com-help ( -- )

basis/ui/tools/interactor/interactor.factor

@@ -7,7 +7,7 @@ quotations sequences strings threads listener classes.tuple
 ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.status-bar
 ui.gadgets.presentations ui.gadgets.worlds ui.gestures
 definitions calendar concurrency.flags concurrency.mailboxes
-ui.tools.workspace accessors sets destructors ;
+ui.tools.workspace accessors sets destructors fry ;
 IN: ui.tools.interactor
 
 ! If waiting is t, we're waiting for user input, and invoking
@@ -88,7 +88,7 @@ M: interactor model-changed
     [ editor-string ] keep
     [ interactor-input. ] 2keep
     [ add-interactor-history ] keep
-    [ clear-input ] curry "Clearing input" spawn drop ;
+    '[ _ clear-input ] "Clearing input" spawn drop ;
 
 : interactor-eof ( interactor -- )
     dup interactor-busy? [
@@ -126,7 +126,7 @@ M: interactor stream-read
     swap dup zero? [
         2drop ""
     ] [
-        >r interactor-read dup [ "\n" join ] when r> short head
+        [ interactor-read dup [ "\n" join ] when ] dip short head
     ] if ;
 
 M: interactor stream-read-partial

basis/ui/tools/listener/listener.factor

@@ -28,7 +28,7 @@ M: listener-gadget focusable-child*
     input>> ;
 
 M: listener-gadget call-tool* ( input listener -- )
-    >r string>> r> input>> set-editor-string ;
+    [ string>> ] dip input>> set-editor-string ;
 
 M: listener-gadget tool-scroller
     output>> find-scroller ;
@@ -95,13 +95,13 @@ M: engine-word word-completion-string
 : use-if-necessary ( word seq -- )
     over vocabulary>> over and [
         2dup [ assoc-stack ] keep = [ 2drop ] [
-            >r vocabulary>> vocab-words r> push
+            [ vocabulary>> vocab-words ] dip push
         ] if
     ] [ 2drop ] if ;
 
 : insert-word ( word -- )
     get-workspace listener>> input>>
-    [ >r word-completion-string r> user-input* drop ]
+    [ [ word-completion-string ] dip user-input* drop ]
     [ interactor-use use-if-necessary ]
     2bi ;
 

basis/ui/tools/profiler/profiler.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: ui.tools.workspace kernel quotations tools.profiler
 ui.commands ui.gadgets ui.gadgets.panes ui.gadgets.scrollers
-ui.gadgets.tracks ui.gestures ui.gadgets.buttons accessors ;
+ui.gadgets.tracks ui.gestures ui.gadgets.buttons accessors fry ;
 IN: ui.tools.profiler
 
 TUPLE: profiler-gadget < track pane ;
@@ -14,7 +14,7 @@ TUPLE: profiler-gadget < track pane ;
         dup pane>> <scroller> 1 track-add ;
 
 : with-profiler-pane ( gadget quot -- )
-    >r pane>> r> with-pane ;
+    [ pane>> ] dip with-pane ;
 
 : com-full-profile ( gadget -- )
     [ profile. ] with-profiler-pane ;
@@ -39,10 +39,10 @@ profiler-gadget "toolbar" f {
 GENERIC: profiler-presentation ( obj -- quot )
 
 M: usage-profile profiler-presentation
-    word>> [ usage-profile. ] curry ;
+    word>> '[ _ usage-profile. ] ;
 
 M: vocab-profile profiler-presentation
-    vocab>> [ vocab-profile. ] curry ;
+    vocab>> '[ _ vocab-profile. ] ;
 
 M: f profiler-presentation
     drop [ vocabs-profile. ] ;

basis/ui/tools/search/search-tests.factor

@@ -19,7 +19,7 @@ IN: ui.tools.search.tests
     ] with-grafted-gadget ;
 
 : test-live-search ( gadget quot -- ? )
-    >r update-live-search dup assert-non-empty r> all? ;
+    [ update-live-search dup assert-non-empty ] dip all? ;
 
 [ t ] [
     "swp" all-words f <definition-search>

basis/ui/tools/tools.factor

@@ -9,7 +9,7 @@ ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
 ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
 ui.gadgets.presentations ui.gestures words vocabs.loader
 tools.test tools.vocabs ui.gadgets.buttons ui.gadgets.status-bar
-mirrors ;
+mirrors fry ;
 IN: ui.tools
 
 : <workspace-tabs> ( workspace -- tabs )
@@ -93,7 +93,7 @@ workspace "workflow" f {
 ] workspace-window-hook set-global
 
 : inspect-continuation ( traceback -- )
-    control-value [ inspect ] curry call-listener ;
+    control-value '[ _ inspect ] call-listener ;
 
 traceback-gadget "toolbar" f {
     { T{ key-down f f "v" } variables }

basis/ui/tools/walker/walker.factor

@@ -5,7 +5,7 @@ ui.tools.listener ui.tools.traceback ui.gadgets.buttons
 ui.gadgets.status-bar ui.gadgets.tracks ui.commands ui.gadgets
 models models.filter ui.tools.workspace ui.gestures
 ui.gadgets.labels ui threads namespaces make tools.walker assocs
-combinators ;
+combinators fry ;
 IN: ui.tools.walker
 
 TUPLE: walker-gadget < track
@@ -53,7 +53,7 @@ M: walker-gadget focusable-child*
     ] "" make ;
 
 : <thread-status> ( model thread -- gadget )
-    [ walker-state-string ] curry <filter> <label-control> ;
+    '[ _ walker-state-string ] <filter> <label-control> ;
 
 : <walker-gadget> ( status continuation thread -- gadget )
     { 0 1 } walker-gadget new-track
@@ -89,7 +89,7 @@ walker-gadget "toolbar" f {
     } cond ;
 
 : find-walker-window ( thread -- world/f )
-    [ swap walker-for-thread? ] curry find-window ;
+    '[ _ swap walker-for-thread? ] find-window ;
 
 : walker-window ( status continuation thread -- )
     [ <walker-gadget> ] [ name>> ] bi open-status-window ;

basis/ui/tools/workspace/workspace.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes continuations help help.topics kernel models
-sequences assocs arrays namespaces accessors math.vectors ui
+sequences assocs arrays namespaces accessors math.vectors fry 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
@@ -33,7 +33,7 @@ M: gadget tool-scroller drop f ;
     set-model ;
 
 : get-workspace* ( quot -- workspace )
-    [ >r dup workspace? r> [ drop f ] if ] curry find-window
+    '[ dup workspace? _ [ drop f ] if ] find-window
     [ dup raise-window gadget-child ]
     [ workspace-window* ] if* ; inline
 

basis/ui/windows/windows.factor

@@ -288,7 +288,7 @@ SYMBOL: nc-buttons
 : mouse-wheel ( lParam -- array ) >lo-hi [ sgn neg ] map ;
 
 : mouse-absolute>relative ( lparam handle -- array )
-    >r >lo-hi r>
+    [ >lo-hi ] dip
     "RECT" <c-object> [ GetWindowRect win32-error=0/f ] keep
     get-RECT-top-left 2array v- ;
 
@@ -297,7 +297,7 @@ SYMBOL: nc-buttons
     [ <button-down> ] [ <button-up> ] if ;
 
 : prepare-mouse ( hWnd uMsg wParam lParam -- button coordinate world )
-    nip >r mouse-event>gesture r> >lo-hi rot window ;
+    [ drop mouse-event>gesture ] dip >lo-hi rot window ;
 
 : set-capture ( hwnd -- )
     mouse-captured get [
@@ -312,10 +312,10 @@ SYMBOL: nc-buttons
     mouse-captured off ;
 
 : handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
-    >r >r
+    [
         over set-capture
         dup message>button drop nc-buttons get delete
-    r> r> prepare-mouse send-button-down ;
+    ] 2dip prepare-mouse send-button-down ;
 
 : handle-wm-buttonup ( hWnd uMsg wParam lParam -- )
     mouse-captured get [ release-capture ] when
@@ -337,9 +337,10 @@ SYMBOL: nc-buttons
     TrackMouseEvent drop
     >lo-hi swap window move-hand fire-motion ;
 
-: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
+:: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
-    >r nip r>
+    lParam mouse-wheel
-    pick mouse-absolute>relative >r mouse-wheel r> rot window send-wheel ;
+    hWnd mouse-absolute>relative
+    hWnd window send-wheel ;
 
 : handle-wm-cancelmode ( hWnd uMsg wParam lParam -- )
     #! message sent if windows needs application to stop dragging
@@ -456,10 +457,11 @@ M: windows-ui-backend do-events
 
 : create-window ( rect -- hwnd )
     make-adjusted-RECT
-    >r class-name-ptr get-global f r>
+    [ class-name-ptr get-global f ] dip
-    >r >r >r ex-style r> r>
+    [
+        [ ex-style ] 2dip
         { WS_CLIPSIBLINGS WS_CLIPCHILDREN style } flags
-    r> get-RECT-dimensions
+    ] dip get-RECT-dimensions
     f f f GetModuleHandle f CreateWindowEx dup win32-error=0/f ;
 
 : show-window ( hWnd -- )
@@ -515,7 +517,7 @@ M: windows-ui-backend raise-window* ( world -- )
 M: windows-ui-backend set-title ( string world -- )
     handle>>
     dup title>> [ free ] when*
-    >r utf16n malloc-string r>
+    [ utf16n malloc-string ] dip
     2dup (>>title)
     hWnd>> WM_SETTEXT 0 roll alien-address SendMessage drop ;
 

basis/ui/x11/x11.factor

@@ -79,7 +79,7 @@ M: world configure-event
 : key-down-event>gesture ( event world -- string gesture )
     dupd
     handle>> xic>> lookup-string
-    >r swap event-modifiers r> key-code <key-down> ;
+    [ swap event-modifiers ] dip key-code <key-down> ;
 
 M: world key-down-event
     [ key-down-event>gesture ] keep
@@ -92,18 +92,18 @@ M: world key-down-event
     dup event-modifiers swap 0 XLookupKeysym key-code <key-up> ;
 
 M: world key-up-event
-    >r key-up-event>gesture r> world-focus propagate-gesture ;
+    [ key-up-event>gesture ] dip world-focus propagate-gesture ;
 
 : mouse-event>gesture ( event -- modifiers button loc )
     dup event-modifiers over XButtonEvent-button
     rot mouse-event-loc ;
 
 M: world button-down-event
-    >r mouse-event>gesture >r <button-down> r> r>
+    [ mouse-event>gesture [ <button-down> ] dip ] dip
     send-button-down ;
 
 M: world button-up-event
-    >r mouse-event>gesture >r <button-up> r> r>
+    [ mouse-event>gesture [ <button-up> ] dip ] dip
     send-button-up ;
 
 : mouse-event>scroll-direction ( event -- pair )
@@ -115,7 +115,7 @@ M: world button-up-event
     } at ;
 
 M: world wheel-event
-    >r dup mouse-event>scroll-direction swap mouse-event-loc r>
+    [ dup mouse-event>scroll-direction swap mouse-event-loc ] dip
     send-wheel ;
 
 M: world enter-event motion-event ;
@@ -123,7 +123,7 @@ M: world enter-event motion-event ;
 M: world leave-event 2drop forget-rollover ;
 
 M: world motion-event
-    >r dup XMotionEvent-x swap XMotionEvent-y 2array r>
+    [ dup XMotionEvent-x swap XMotionEvent-y 2array ] dip
     move-hand fire-motion ;
 
 M: world focus-in-event
@@ -158,7 +158,7 @@ M: world selection-notify-event
     [ XSelectionRequestEvent-requestor ] keep
     [ XSelectionRequestEvent-property ] keep
     [ XSelectionRequestEvent-target ] keep
-    >r 8 PropModeReplace r>
+    [ 8 PropModeReplace ] dip
     [
         XSelectionRequestEvent-selection
         clipboard-for-atom contents>>
@@ -208,8 +208,7 @@ M: x-clipboard copy-clipboard
     (>>contents) ;
 
 M: x-clipboard paste-clipboard
-    >r find-world handle>> window>>
+    [ find-world handle>> window>> ] dip atom>> convert-selection ;
-    r> atom>> convert-selection ;
 
 : init-clipboard ( -- )
     XA_PRIMARY <x-clipboard> selection set-global
@@ -219,9 +218,8 @@ M: x-clipboard paste-clipboard
     dup [ 127 <= ] all? [ XStoreName drop ] [ 3drop ] if ;
 
 : set-title-new ( dpy window string -- )
-    >r
+    [ XA_NET_WM_NAME XA_UTF8_STRING 8 PropModeReplace ] dip
-    XA_NET_WM_NAME XA_UTF8_STRING 8 PropModeReplace
+    utf8 encode dup length XChangeProperty drop ;
-    r> utf8 encode dup length XChangeProperty drop ;
 
 M: x11-ui-backend set-title ( string world -- )
     handle>> window>> swap dpy get -rot
@@ -237,8 +235,7 @@ M: x11-ui-backend set-fullscreen* ( ? world -- )
     "_NET_WM_STATE" x-atom over set-XClientMessageEvent-message_type
     32 over set-XClientMessageEvent-format
     "_NET_WM_STATE_FULLSCREEN" x-atom over set-XClientMessageEvent-data1
-    >r dpy get root get 0 SubstructureNotifyMask r> XSendEvent drop ;
+    [ dpy get root get 0 SubstructureNotifyMask ] dip XSendEvent drop ;
-
 
 M: x11-ui-backend (open-window) ( world -- )
     dup gadget-window