Merge branch 'master' of git://factorcode.org/git/factor

basis/ui/freetype/freetype.factor

@@ -203,7 +203,7 @@ M: freetype-renderer string-height ( open-font string -- h )
     ] do-enabled ;
 
 : font-sprites ( font world -- open-font sprites )
-    world-fonts [ open-font H{ } clone 2array ] cache first2 ;
+    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) ;

basis/ui/gadgets/incremental/incremental-docs.factor

@@ -8,7 +8,7 @@ $nl
 $nl
 "Children are managed with the " { $link add-incremental } " and " { $link clear-incremental } " words."
 $nl
-"Not every " { $link pack } " can use incremental layout, since incremental layout does not support non-default values for " { $link pack-align } ", " { $link pack-fill } ", and " { $link pack-gap } "." } ;
+"Not every " { $link pack } " can use incremental layout, since incremental layout does not support non-default values for " { $snippet "align" } ", " { $snippet "fill" } ", and " { $snippet "gap" } "." } ;
 
 HELP: <incremental>
 { $values { "incremental" "a new instance of " { $link incremental } } }

basis/ui/gadgets/labelled/labelled.factor

@@ -22,7 +22,7 @@ M: labelled-gadget focusable-child* content>> ;
     >r <scroller> r> <labelled-gadget> ;
 
 : <labelled-pane> ( model quot scrolls? title -- gadget )
-    >r >r <pane-control> r> over set-pane-scrolls? r>
+    >r >r <pane-control> r> over (>>scrolls?) r>
     <labelled-scroller> ;
 
 : <close-box> ( quot -- button/f )

basis/ui/gadgets/menus/menus.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays ui.commands ui.gadgets ui.gadgets.buttons
+USING: accessors arrays ui.commands ui.gadgets ui.gadgets.buttons
 ui.gadgets.worlds ui.gestures generic hashtables kernel math
 models namespaces opengl sequences math.vectors
 ui.gadgets.theme ui.gadgets.packs ui.gadgets.borders colors
@@ -20,14 +20,14 @@ TUPLE: menu-glass < gadget ;
 M: menu-glass layout* gadget-child prefer ;
 
 : hide-glass ( world -- )
-    dup world-glass [ unparent ] when*
+    dup glass>> [ unparent ] when*
-    f swap set-world-glass ;
+    f swap (>>glass) ;
 
 : show-glass ( gadget world -- )
     over hand-clicked set-global
     [ hide-glass ] keep
     [ swap add-gadget drop ] 2keep
-    set-world-glass ;
+    (>>glass) ;
 
 : show-menu ( gadget owner -- )
     find-world [ <menu-glass> ] keep show-glass ;

basis/ui/gadgets/packs/packs-docs.factor

@@ -23,9 +23,9 @@ HELP: pack
 }
 "Packs have the following slots:"
 { $list
-    { { $link pack-align } " a rational number between 0 and 1, the alignment of gadgets along the axis perpendicular to the pack's orientation" }
+    { { $snippet "align" } " a rational number between 0 and 1, the alignment of gadgets along the axis perpendicular to the pack's orientation" }
-    { { $link pack-fill } " a rational number between 0 and 1, where 0 gives each gadget its preferred size and 1 fills the dimension perpendicular to the pack's orientation" }
+    { { $snippet "fill" } " a rational number between 0 and 1, where 0 gives each gadget its preferred size and 1 fills the dimension perpendicular to the pack's orientation" }
-    { { $link pack-gap } " a pair of integers, the horizontal and vertical gap between children" }
+    { { $snippet "gap" } " a pair of integers, the horizontal and vertical gap between children" }
 }
 "Custom gadgets can inherit from the " { $link pack } " class and implement their own " { $link pref-dim* } " and " { $link layout* } " methods, reusing pack layout logic by calling " { $link pack-pref-dim } " and " { $link pack-layout } "." } ;
 

basis/ui/gadgets/packs/packs.factor

@@ -5,12 +5,12 @@ math.vectors namespaces math.order accessors math.geometry.rect ;
 IN: ui.gadgets.packs
 
 TUPLE: pack < gadget
-{ align initial: 0 }
+  { align initial: 0       }
-{ fill initial: 0 }
+  { fill  initial: 0       }
-{ gap initial: { 0 0 } } ;
+  { gap   initial: { 0 0 } } ;
 
 : packed-dim-2 ( gadget sizes -- list )
-    [ over rect-dim over v- rot pack-fill v*n v+ ] with map ;
+    [ over rect-dim over v- rot fill>> v*n v+ ] with map ;
 
 : packed-dims ( gadget sizes -- seq )
     2dup packed-dim-2 swap orient ;
@@ -19,10 +19,10 @@ TUPLE: pack < gadget
     { 0 0 } [ v+ over v+ ] accumulate 2nip ;
 
 : aligned-locs ( gadget sizes -- seq )
-    [ >r dup pack-align swap rect-dim r> v- n*v ] with map ;
+    [ >r dup align>> swap rect-dim r> v- n*v ] with map ;
 
 : packed-locs ( gadget sizes -- seq )
-    over pack-gap over gap-locs >r dupd aligned-locs r> orient ;
+    over gap>> over gap-locs >r dupd aligned-locs r> orient ;
 
 : round-dims ( seq -- newseq )
     { 0 0 } swap
@@ -40,7 +40,7 @@ TUPLE: pack < gadget
 
 : <pile> ( -- pack ) { 0 1 } <pack> ;
 
-: <filled-pile> ( -- pack ) <pile> 1 over set-pack-fill ;
+: <filled-pile> ( -- pack ) <pile> 1 over (>>fill) ;
 
 : <shelf> ( -- pack ) { 1 0 } <pack> ;
 
@@ -48,7 +48,7 @@ TUPLE: pack < gadget
     [ dim-sum ] keep length 1 [-] rot n*v v+ ;
 
 : pack-pref-dim ( gadget sizes -- dim )
-    over pack-gap over gap-dims >r max-dim r>
+    over gap>> over gap-dims >r max-dim r>
     rot orientation>> set-axis ;
 
 M: pack pref-dim*

basis/ui/gadgets/panes/panes.factor

@@ -37,8 +37,8 @@ M: pane gadget-selection ( pane -- string/f ) selected-children gadget-text ;
 
 : pane-clear ( pane -- )
   clear-selection
-  [ pane-output clear-incremental ]
+  [ output>> clear-incremental ]
-  [ pane-current clear-gadget ]
+  [ current>> clear-gadget ]
   bi ;
 
 : new-pane ( class -- pane )
@@ -68,7 +68,7 @@ M: node draw-selection ( loc node -- )
 
 M: pane draw-gadget*
     dup gadget-selection? [
-        dup pane-selection-color set-color
+        dup selection-color>> set-color
         origin get over rect-loc v- swap selected-children
         [ draw-selection ] with each
     ] [
@@ -76,7 +76,7 @@ M: pane draw-gadget*
     ] if ;
 
 : scroll-pane ( pane -- )
-    dup pane-scrolls? [ scroll>bottom ] [ drop ] if ;
+    dup scrolls?>> [ scroll>bottom ] [ drop ] if ;
 
 TUPLE: pane-stream pane ;
 
@@ -89,21 +89,21 @@ C: <pane-stream> pane-stream
         [ drop ]
     } cond ;
 
-: smash-pane ( pane -- gadget ) pane-output smash-line ;
+: smash-pane ( pane -- gadget ) output>> smash-line ;
 
 : pane-nl ( pane -- pane )
-    dup pane-current dup unparent smash-line
+    dup current>> dup unparent smash-line
-    over pane-output add-incremental
+    over output>> add-incremental
     prepare-line ;
 
 : pane-write ( pane seq -- )
     [ pane-nl ]
-    [ over pane-current stream-write ]
+    [ over current>> stream-write ]
     interleave drop ;
 
 : pane-format ( style pane seq -- )
     [ pane-nl ]
-    [ 2over pane-current stream-format ]
+    [ 2over current>> stream-format ]
     interleave 2drop ;
 
 GENERIC: write-gadget ( gadget stream -- )
@@ -121,7 +121,7 @@ M: style-stream write-gadget
     output-stream get print-gadget ;
 
 : ?nl ( stream -- )
-    dup pane-stream-pane pane-current children>> empty?
+    dup pane>> current>> children>> empty?
     [ dup stream-nl ] unless drop ;
 
 : with-pane ( pane quot -- )
@@ -132,8 +132,7 @@ M: style-stream write-gadget
 : make-pane ( quot -- gadget )
     <pane> [ swap with-pane ] keep smash-pane ; inline
 
-: <scrolling-pane> ( -- pane )
+: <scrolling-pane> ( -- pane ) <pane> t over (>>scrolls?) ;
-    <pane> t over set-pane-scrolls? ;
 
 TUPLE: pane-control < pane quot ;
 
@@ -146,13 +145,13 @@ M: pane-control model-changed ( model pane-control -- )
         swap >>model ;
 
 : do-pane-stream ( pane-stream quot -- )
-    >r pane-stream-pane r> keep scroll-pane ; inline
+    >r pane>> r> keep scroll-pane ; inline
 
 M: pane-stream stream-nl
     [ pane-nl drop ] do-pane-stream ;
 
 M: pane-stream stream-write1
-    [ pane-current stream-write1 ] do-pane-stream ;
+    [ current>> stream-write1 ] do-pane-stream ;
 
 M: pane-stream stream-write
     [ swap string-lines pane-write ] do-pane-stream ;
@@ -277,7 +276,7 @@ M: pane-stream make-cell-stream
 
 M: pane-stream stream-write-table
     >r
-    swap [ [ pane-stream-pane smash-pane ] map ] map
+    swap [ [ pane>> smash-pane ] map ] map
     styled-grid
     r> print-gadget ;
 
@@ -353,11 +352,10 @@ M: f sloppy-pick-up*
 : move-caret ( pane -- pane )
   dup hand-rel
   over sloppy-pick-up
-  over set-pane-caret
+  over (>>caret)
   dup relayout-1 ;
 
-: begin-selection ( pane -- )
+: begin-selection ( pane -- ) move-caret f swap (>>mark) ;
-    move-caret f swap set-pane-mark ;
 
 : extend-selection ( pane -- )
     hand-moved? [
@@ -371,7 +369,7 @@ M: f sloppy-pick-up*
                 caret>mark
             ] when
         ] if
-        dup dup pane-caret gadget-at-path scroll>gadget
+        dup dup caret>> gadget-at-path scroll>gadget
     ] when drop ;
 
 : end-selection ( pane -- )
@@ -383,7 +381,7 @@ M: f sloppy-pick-up*
     ] if ;
 
 : select-to-caret ( pane -- )
-    dup pane-mark [ caret>mark ] unless
+    dup mark>> [ caret>mark ] unless
     move-caret
     dup request-focus
     com-copy-selection ;

basis/ui/gadgets/paragraphs/paragraphs.factor

@@ -18,7 +18,7 @@ TUPLE: paragraph < gadget margin ;
 : <paragraph> ( margin -- gadget )
     paragraph new-gadget
     { 1 0 } over (>>orientation)
-    [ set-paragraph-margin ] keep ;
+    [ (>>margin) ] keep ;
 
 SYMBOL: x SYMBOL: max-x
 
@@ -56,7 +56,7 @@ SYMBOL: margin
 : wrap-dim ( -- dim ) max-x get max-y get 2array ;
 
 : init-wrap ( paragraph -- )
-    paragraph-margin margin set
+    margin>> margin set
     { x max-x y max-y line-height } zero-vars ;
 
 : do-wrap ( paragraph quot -- dim )

basis/ui/gadgets/presentations/presentations-docs.factor

@@ -10,23 +10,23 @@ $nl
 $nl
 "Presentations have two slots:"
 { $list
-    { { $link presentation-object } " - the object being presented." }
+    { { $snippet "object" } " - the object being presented." }
-    { { $link presentation-hook } " - a quotation with stack effect " { $snippet "( presentation -- )" } ". The default value is " { $snippet "[ drop ]" } "." }
+    { { $snippet "hook" } " - a quotation with stack effect " { $snippet "( presentation -- )" } ". The default value is " { $snippet "[ drop ]" } "." }
 } } ;
 
 HELP: invoke-presentation
 { $values { "presentation" presentation } { "command" "a command" } }
-{ $description "Calls the " { $link presentation-hook } " and then invokes the command on the " { $link presentation-object } "." } ;
+{ $description "Calls the " { $snippet "hook" } " and then invokes the command on the " { $snippet "object" } "." } ;
 
 { invoke-presentation invoke-primary invoke-secondary } related-words
 
 HELP: invoke-primary
 { $values { "presentation" presentation } } 
-{ $description "Invokes the " { $link primary-operation } " associated to the " { $link presentation-object } ". This word is executed when the presentation is clicked with the left mouse button." } ;
+{ $description "Invokes the " { $link primary-operation } " associated to the " { $snippet "object" } ". This word is executed when the presentation is clicked with the left mouse button." } ;
 
 HELP: invoke-secondary
 { $values { "presentation" presentation } } 
-{ $description "Invokes the " { $link secondary-operation } " associated to the " { $link presentation-object } ". This word is executed when a list receives a " { $snippet "RET" } " key press." } ;
+{ $description "Invokes the " { $link secondary-operation } " associated to the " { $snippet "object" } ". This word is executed when a list receives a " { $snippet "RET" } " key press." } ;
 
 HELP: <presentation>
 { $values { "label" "a label" } { "object" object } { "button" "a new " { $link button } } }
@@ -41,7 +41,7 @@ HELP: <presentation>
 
 HELP: show-mouse-help
 { $values { "presentation" presentation } }
-{ $description "Displays a " { $link summary } " of the " { $link presentation-object } "in the status bar of the " { $link world } " containing this presentation. This word is executed when the mouse enters the presentation." } ;
+{ $description "Displays a " { $link summary } " of the " { $snippet "object" } "in the status bar of the " { $link world } " containing this presentation. This word is executed when the mouse enters the presentation." } ;
 
 ARTICLE: "ui.gadgets.presentations" "Presentation gadgets"
 "Outliner gadgets are usually not constructed directly, and instead are written to " { $link "ui.gadgets.panes" } " with formatted stream output words (" { $link "presentations" } ")."

basis/ui/gadgets/presentations/presentations.factor

@@ -11,19 +11,19 @@ IN: ui.gadgets.presentations
 TUPLE: presentation < button object hook ;
 
 : invoke-presentation ( presentation command -- )
-    over dup presentation-hook call
+    over dup hook>> call
-    >r presentation-object r> invoke-command ;
+    >r object>> r> invoke-command ;
 
 : invoke-primary ( presentation -- )
-    dup presentation-object primary-operation
+    dup object>> primary-operation
     invoke-presentation ;
 
 : invoke-secondary ( presentation -- )
-    dup presentation-object secondary-operation
+    dup object>> secondary-operation
     invoke-presentation ;
 
 : show-mouse-help ( presentation -- )
-    dup presentation-object over show-summary button-update ;
+    dup object>> over show-summary button-update ;
 
 : <presentation> ( label object -- button )
     swap [ invoke-primary ] presentation new-button
@@ -36,8 +36,8 @@ M: presentation ungraft*
     call-next-method ;
 
 : <operations-menu> ( presentation -- menu )
-    dup dup presentation-hook curry
+    dup dup hook>> curry
-    swap presentation-object
+    swap object>>
     dup object-operations <commands-menu> ;
 
 : operations-menu ( presentation -- )

basis/ui/gadgets/scrollers/scrollers.factor

@@ -22,8 +22,8 @@ TUPLE: scroller < frame viewport x y follows ;
 
 : do-mouse-scroll ( scroller -- )
     scroll-direction get-global first2
-    pick scroller-y slide-by-line
+    pick y>> slide-by-line
-    swap scroller-x slide-by-line ;
+    swap x>> slide-by-line ;
 
 scroller H{
     { T{ mouse-scroll } [ do-mouse-scroll ] }
@@ -48,8 +48,8 @@ scroller H{
 
 : scroll ( value scroller -- )
     [
-        dup scroller-viewport rect-dim { 0 0 }
+        dup viewport>> rect-dim { 0 0 }
-        rot scroller-viewport viewport-dim 4array flip
+        rot viewport>> viewport-dim 4array flip
     ] keep
     2dup control-value = [ 2drop ] [ set-control-value ] if ;
 
@@ -61,9 +61,9 @@ scroller H{
         scroller-value vneg offset-rect
         viewport-gap offset-rect
     ] keep
-    [ scroller-viewport rect-min ] keep
+    [ viewport>> rect-min ] keep
     [
-        scroller-viewport 2rect-extent
+        viewport>> 2rect-extent
         >r >r v- { 0 0 } vmin r> r> v- { 0 0 } vmax v+
     ] keep dup scroller-value rot v+ swap scroll ;
 
@@ -72,7 +72,7 @@ scroller H{
 
 : find-scroller* ( gadget -- scroller )
     dup find-scroller dup [
-        2dup scroller-viewport gadget-child
+        2dup viewport>> gadget-child
         swap child? [ nip ] [ 2drop f ] if
     ] [
         2drop f
@@ -81,7 +81,7 @@ scroller H{
 : scroll>rect ( rect gadget -- )
     dup find-scroller* dup [
         [ relative-scroll-rect ] keep
-        [ set-scroller-follows ] keep
+        [ (>>follows) ] keep
         relayout
     ] [
         3drop
@@ -94,18 +94,18 @@ scroller H{
 
 : scroll>gadget ( gadget -- )
     dup find-scroller* dup [
-        [ set-scroller-follows ] keep
+        [ (>>follows) ] keep
         relayout
     ] [
         2drop
     ] if ;
 
 : (scroll>bottom) ( scroller -- )
-    dup scroller-viewport viewport-dim { 0 1 } v* swap scroll ;
+    dup viewport>> viewport-dim { 0 1 } v* swap scroll ;
 
 : scroll>bottom ( gadget -- )
     find-scroller [
-        t over set-scroller-follows relayout-1
+        t over (>>follows) relayout-1
     ] when* ;
 
 : scroll>top ( gadget -- )
@@ -123,15 +123,15 @@ M: f update-scroller drop dup scroller-value swap scroll ;
 
 M: scroller layout*
     dup call-next-method
-    dup scroller-follows
+    dup follows>>
     [ update-scroller ] 2keep
-    swap set-scroller-follows ;
+    swap (>>follows) ;
 
 M: scroller focusable-child*
-    scroller-viewport ;
+    viewport>> ;
 
 M: scroller model-changed
-    nip f swap set-scroller-follows ;
+    nip f swap (>>follows) ;
 
 TUPLE: limited-scroller < scroller fixed-dim ;
 

basis/ui/gadgets/sliders/sliders-docs.factor

@@ -30,7 +30,7 @@ HELP: slide-by-page
 
 HELP: slide-by-line
 { $values { "amount" "an integer" } { "slider" slider } }
-{ $description "Adds the amount multiplied by " { $link slider-line } " to the slider's current position." } ;
+{ $description "Adds the amount multiplied by the " { $snippet "line" } " slot to the slider's current position." } ;
 
 HELP: <slider>
 { $values { "range" range } { "orientation" "an orientation specifier" } { "slider" "a new " { $link slider } } }

basis/ui/gadgets/sliders/sliders.factor

@@ -28,7 +28,7 @@ TUPLE: slider < frame elevator thumb saved line ;
 : thumb-dim ( slider -- h )
     dup slider-page over slider-max 1 max / 1 min
     over elevator-length * min-thumb-dim max
-    over slider-elevator rect-dim
+    over elevator>> rect-dim
     rot orientation>> v. min ;
 
 : slider-scale ( slider -- n )
@@ -41,16 +41,16 @@ TUPLE: slider < frame elevator thumb saved line ;
 : slider>screen ( m scale -- n ) slider-scale * ;
 : screen>slider ( m scale -- n ) slider-scale / ;
 
-M: slider model-changed nip slider-elevator relayout-1 ;
+M: slider model-changed nip elevator>> relayout-1 ;
 
 TUPLE: thumb < gadget ;
 
 : begin-drag ( thumb -- )
-    find-slider dup slider-value swap set-slider-saved ;
+    find-slider dup slider-value swap (>>saved) ;
 
 : do-drag ( thumb -- )
     find-slider drag-loc over orientation>> v.
-    over screen>slider swap [ slider-saved + ] keep
+    over screen>slider swap [ saved>> + ] keep
     model>> set-range-value ;
 
 thumb H{
@@ -80,10 +80,10 @@ thumb H{
     swap slider-value - sgn ;
 
 : elevator-hold ( elevator -- )
-    dup elevator-direction swap find-slider slide-by-page ;
+    dup direction>> swap find-slider slide-by-page ;
 
 : elevator-click ( elevator -- )
-    dup compute-direction over set-elevator-direction
+    dup compute-direction over (>>direction)
     elevator-hold ;
 
 elevator H{
@@ -97,7 +97,7 @@ elevator H{
     lowered-gradient >>interior ;
 
 : (layout-thumb) ( slider n -- n thumb )
-    over orientation>> n*v swap slider-thumb ;
+    over orientation>> n*v swap thumb>> ;
 
 : thumb-loc ( slider -- loc )
     dup slider-value swap slider>screen ;
@@ -118,8 +118,7 @@ elevator H{
 M: elevator layout*
     find-slider layout-thumb ;
 
-: slide-by-line ( amount slider -- )
+: slide-by-line ( amount slider -- ) [ line>> * ] keep slide-by ;
-    [ slider-line * ] keep slide-by ;
 
 : <slide-button> ( vector polygon amount -- button )
     >r gray swap <polygon-gadget> r>

basis/ui/gadgets/slots/slots.factor

@@ -16,8 +16,8 @@ TUPLE: edit-slot ;
 TUPLE: slot-editor < track ref text ;
 
 : revert ( slot-editor -- )
-    dup slot-editor-ref get-ref unparse-use
+    dup ref>> get-ref unparse-use
-    swap slot-editor-text set-editor-string ;
+    swap text>> set-editor-string ;
 
 \ revert H{
     { +description+ "Revert any uncomitted changes." }
@@ -32,21 +32,21 @@ M: value-ref finish-editing
     drop T{ update-slot } swap send-gesture drop ;
 
 : slot-editor-value ( slot-editor -- object )
-    slot-editor-text control-value parse-fresh ;
+    text>> control-value parse-fresh ;
 
 : commit ( slot-editor -- )
-    dup slot-editor-text control-value parse-fresh first
+    dup text>> control-value parse-fresh first
-    over slot-editor-ref set-ref
+    over ref>> set-ref
-    dup slot-editor-ref finish-editing ;
+    dup ref>> finish-editing ;
 
 \ commit H{
     { +description+ "Parse the object being edited, and store the result back into the edited slot." }
 } define-command
 
 : com-eval ( slot-editor -- )
-    [ slot-editor-text editor-string eval ] keep
+    [ text>> editor-string eval ] keep
-    [ slot-editor-ref set-ref ] keep
+    [ ref>> set-ref ] keep
-    dup slot-editor-ref finish-editing ;
+    dup ref>> finish-editing ;
 
 \ com-eval H{
     { +listener+ t }
@@ -54,7 +54,7 @@ M: value-ref finish-editing
 } define-command
 
 : delete ( slot-editor -- )
-    dup slot-editor-ref delete-ref
+    dup ref>> delete-ref
     T{ update-object } swap send-gesture drop ;
 
 \ delete H{

basis/ui/gadgets/worlds/worlds-docs.factor

@@ -11,7 +11,7 @@ HELP: hand-world
 HELP: set-title
 { $values { "string" string } { "world" world } }
 { $description "Sets the title bar of the native window containing the world." }
-{ $notes "This word should not be called directly by user code. Instead, change the " { $link world-title } " model; see " { $link "models" } "." } ;
+{ $notes "This word should not be called directly by user code. Instead, change the " { $snippet "title" } " slot model; see " { $link "models" } "." } ;
 
 HELP: select-gl-context
 { $values { "handle" "a backend-specific handle" } }

basis/ui/gadgets/worlds/worlds.factor

@@ -30,7 +30,7 @@ M: f world-status ;
 
 M: world request-focus-on ( child gadget -- )
     2dup eq?
-    [ 2drop ] [ dup world-focused? (request-focus) ] if ;
+    [ 2drop ] [ dup focused?>> (request-focus) ] if ;
 
 : <world> ( gadget title status -- world )
     { 0 1 } world new-track
@@ -45,7 +45,7 @@ M: world request-focus-on ( child gadget -- )
 
 M: world layout*
     dup call-next-method
-    dup world-glass [
+    dup glass>> [
         >r dup rect-dim r> (>>dim)
     ] when* drop ;
 
@@ -54,15 +54,15 @@ M: world focusable-child* gadget-child ;
 M: world children-on nip children>> ;
 
 : (draw-world) ( world -- )
-    dup world-handle [
+    dup handle>> [
         [ dup init-gl ] keep draw-gadget
     ] with-gl-context ;
 
 : draw-world? ( world -- ? )
     #! We don't draw deactivated worlds, or those with 0 size.
     #! On Windows, the latter case results in GL errors.
-    dup world-active?
+    dup active?>>
-    over world-handle
+    over handle>>
     rot rect-dim [ 0 > ] all? and and ;
 
 TUPLE: world-error error world ;
@@ -83,7 +83,7 @@ SYMBOL: ui-error-hook
                 (draw-world)
             ] [
                 over <world-error> ui-error
-                f swap set-world-active?
+                f swap (>>active?)
             ] recover
         ] with-variable
     ] [

basis/ui/tools/tools.factor

@@ -44,7 +44,7 @@ IN: ui.tools
     dup <toolbar>        f   track-add ;
 
 : resize-workspace ( workspace -- )
-    dup track-sizes over control-value zero? [
+    dup sizes>> over control-value zero? [
         1/5 1 pick set-nth
         4/5 2 rot set-nth
     ] [

basis/ui/ui-docs.factor

@@ -172,7 +172,7 @@ $nl
 ARTICLE: "ui-backend-windows" "UI backend window management"
 "The high-level " { $link open-window } " word eventually calls a low-level word which you must implement:"
 { $subsection open-world-window }
-"This word should create a native window, store some kind of handle in the " { $link world-handle } " slot, then call two words:"
+"This word should create a native window, store some kind of handle in the " { $snippet "handle" } " slot, then call two words:"
 { $subsection register-window }
 "The following words must also be implemented:"
 { $subsection set-title }

basis/ui/ui.factor

@@ -51,31 +51,31 @@ SYMBOL: stop-after-last-window?
     T{ gain-focus } swap each-gesture ;
 
 : focus-world ( world -- )
-    t over set-world-focused?
+    t over (>>focused?)
     dup raised-window
     focus-path f focus-gestures ;
 
 : unfocus-world ( world -- )
-    f over set-world-focused?
+    f over (>>focused?)
     focus-path f swap focus-gestures ;
 
 M: world graft*
     dup (open-window)
-    dup world-title over set-title
+    dup title>> over set-title
     request-focus ;
 
 : reset-world ( world -- )
     #! This is used when a window is being closed, but also
     #! when restoring saved worlds on image startup.
-    dup world-fonts clear-assoc
+    dup fonts>> clear-assoc
     dup unfocus-world
-    f swap set-world-handle ;
+    f swap (>>handle) ;
 
 M: world ungraft*
     dup free-fonts
     dup hand-clicked close-global
     dup hand-gadget close-global
-    dup world-handle (close-window)
+    dup handle>> (close-window)
     reset-world ;
 
 : find-window ( quot -- world )

basis/ui/x11/x11.factor

@@ -69,7 +69,7 @@ M: world configure-event
 
 : key-down-event>gesture ( event world -- string gesture )
     dupd
-    world-handle x11-handle-xic lookup-string
+    handle>> x11-handle-xic lookup-string
     >r swap event-modifiers r> key-code <key-down> ;
 
 M: world key-down-event
@@ -116,14 +116,14 @@ M: world motion-event
 
 M: world focus-in-event
     nip
-    dup world-handle x11-handle-xic XSetICFocus focus-world ;
+    dup handle>> x11-handle-xic XSetICFocus focus-world ;
 
 M: world focus-out-event
     nip
-    dup world-handle x11-handle-xic XUnsetICFocus unfocus-world ;
+    dup handle>> x11-handle-xic XUnsetICFocus unfocus-world ;
 
 M: world selection-notify-event
-    [ world-handle x11-handle-window selection-from-event ] keep
+    [ handle>> x11-handle-window selection-from-event ] keep
     world-focus user-input ;
 
 : supported-type? ( atom -- ? )
@@ -173,7 +173,7 @@ M: world client-event
     dup window-loc>> over rect-dim glx-window
     over "Factor" create-xic <x11-handle>
     2dup x11-handle-window register-window
-    swap set-world-handle ;
+    swap (>>handle) ;
 
 : wait-event ( -- event )
     QueuedAfterFlush events-queued 0 > [
@@ -189,14 +189,14 @@ M: x11-ui-backend do-events
 
 : x-clipboard@ ( gadget clipboard -- prop win )
     x-clipboard-atom swap
-    find-world world-handle x11-handle-window ;
+    find-world handle>> x11-handle-window ;
 
 M: x-clipboard copy-clipboard
     [ x-clipboard@ own-selection ] keep
     set-x-clipboard-contents ;
 
 M: x-clipboard paste-clipboard
-    >r find-world world-handle x11-handle-window
+    >r find-world handle>> x11-handle-window
     r> x-clipboard-atom convert-selection ;
 
 : init-clipboard ( -- )
@@ -212,11 +212,11 @@ M: x-clipboard paste-clipboard
     r> utf8 encode dup length XChangeProperty drop ;
 
 M: x11-ui-backend set-title ( string world -- )
-    world-handle x11-handle-window swap dpy get -rot
+    handle>> x11-handle-window swap dpy get -rot
     3dup set-title-old set-title-new ;
     
 M: x11-ui-backend set-fullscreen* ( ? world -- )
-    world-handle x11-handle-window "XClientMessageEvent" <c-object>
+    handle>> x11-handle-window "XClientMessageEvent" <c-object>
     tuck set-XClientMessageEvent-window
     swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
     over set-XClientMessageEvent-data0
@@ -230,10 +230,10 @@ M: x11-ui-backend set-fullscreen* ( ? world -- )
 
 M: x11-ui-backend (open-window) ( world -- )
     dup gadget-window
-    world-handle x11-handle-window dup set-closable map-window ;
+    handle>> x11-handle-window dup set-closable map-window ;
 
 M: x11-ui-backend raise-window* ( world -- )
-    world-handle [
+    handle>> [
         dpy get swap x11-handle-window XRaiseWindow drop
     ] when* ;