UI cleanup: make some ui.gadgets words private, give labels a virtual slot instead of label-string/set-label-string words

basis/tools/test/ui/ui.factor

@@ -1,5 +1,5 @@
-USING: dlists ui.gadgets kernel ui namespaces io.streams.string
+USING: dlists ui.gadgets ui.gadgets.private
-io ;
+kernel ui namespaces io.streams.string io ;
 IN: tools.test.ui
 
 ! We can't print to output-stream here because that might be a pane

basis/ui/backend/cocoa/views/views.factor

@@ -3,7 +3,7 @@
 USING: accessors alien alien.c-types arrays assocs cocoa kernel
 math cocoa.messages cocoa.subclassing cocoa.classes cocoa.views
 cocoa.application cocoa.pasteboard cocoa.types cocoa.windows
-sequences ui ui.gadgets ui.gadgets.worlds ui.gestures
+sequences ui ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures
 core-foundation.strings core-graphics core-graphics.types
 threads combinators math.geometry.rect ;
 IN: ui.backend.cocoa.views
@@ -117,8 +117,8 @@ CONSTANT: key-codes
     2bi <rect> ;
 
 : rect>NSRect ( rect world -- NSRect )
-    [ [ rect-loc first2 ] [ dim>> second ] bi* swap - ]
+    [ [ loc>> first2 ] [ dim>> second ] bi* swap - ]
-    [ drop rect-dim first2 ]
+    [ drop dim>> first2 ]
     2bi <CGRect> ;
 
 CLASS: {
@@ -366,7 +366,7 @@ CLASS: {
     CGLSetParameter drop ;
 
 : <FactorView> ( world -- view )
-    FactorView over rect-dim <GLView>
+    FactorView over dim>> <GLView>
     [ sync-refresh-to-screen ] keep
     [ register-window ] keep ;
 

basis/ui/gadgets/buttons/buttons-tests.factor

@@ -17,7 +17,7 @@ TUPLE: foo-gadget ;
 T{ foo-gadget } <toolbar> "t" set
 
 [ 2 ] [ "t" get children>> length ] unit-test
-[ "Foo A" ] [ "t" get gadget-child gadget-child label-string ] unit-test
+[ "Foo A" ] [ "t" get gadget-child gadget-child string>> ] unit-test
 
 [ ] [
     2 <model> {

basis/ui/gadgets/editors/editors.factor

@@ -176,7 +176,7 @@ M: editor ungraft*
 
 : first-visible-line ( editor -- n )
     [
-        [ clip get rect-loc second origin get second - ] dip
+        [ clip get loc>> second origin get second - ] dip
         y>line
     ] keep model>> validate-line ;
 

basis/ui/gadgets/gadgets-docs.factor

@@ -1,5 +1,6 @@
 USING: help.markup help.syntax opengl kernel strings
-       classes.tuple classes quotations models math.geometry.rect ;
+classes.tuple classes quotations models math.geometry.rect
+ui.gadgets.private ;
 IN: ui.gadgets
 
 HELP: gadget-child

basis/ui/gadgets/gadgets-tests.factor

@@ -1,7 +1,7 @@
-USING: accessors ui.gadgets ui.gadgets.packs ui.gadgets.worlds
+USING: accessors ui.gadgets ui.gadgets.private ui.gadgets.packs
-tools.test namespaces models kernel dlists deques math sets
+ui.gadgets.worlds tools.test namespaces models kernel dlists deques
-math.parser ui sequences hashtables assocs io arrays prettyprint
+math sets math.parser ui sequences hashtables assocs io arrays
-io.streams.string math.geometry.rect ;
+prettyprint io.streams.string math.geometry.rect ;
 IN: ui.gadgets.tests
 
 [ { 300 300 } ]

basis/ui/gadgets/gadgets.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays hashtables kernel models math namespaces
 make sequences quotations math.vectors combinators sorting
@@ -6,10 +6,6 @@ binary-search vectors dlists deques models threads
 concurrency.flags math.order math.geometry.rect fry ;
 IN: ui.gadgets
 
-SYMBOL: ui-notify-flag
-
-: notify-ui-thread ( -- ) ui-notify-flag get-global raise-flag ;
-
 TUPLE: gadget < rect pref-dim parent children orientation focus
 visible? root? clipped? layout-state graft-state graft-node
 interior boundary model ;
@@ -35,17 +31,6 @@ M: gadget model-changed 2drop ;
 : <gadget> ( -- gadget )
     gadget new-gadget ;
 
-: activate-control ( gadget -- )
-    dup model>> dup [
-        2dup add-connection
-        swap model-changed
-    ] [
-        2drop
-    ] if ;
-
-: deactivate-control ( gadget -- )
-    dup model>> dup [ 2dup remove-connection ] when 2drop ;
-
 : control-value ( control -- value )
     model>> value>> ;
 
@@ -56,7 +41,7 @@ M: gadget model-changed 2drop ;
     2dup eq? [
         2drop { 0 0 }
     ] [
-        over rect-loc [ [ parent>> ] dip relative-loc ] dip v+
+        [ [ parent>> ] dip relative-loc ] [ drop loc>> ] 2bi v+
     ] if ;
 
 GENERIC: user-input* ( str gadget -- ? )
@@ -67,23 +52,31 @@ GENERIC: children-on ( rect/point gadget -- seq )
 
 M: gadget children-on nip children>> ;
 
+<PRIVATE
+
 : ((fast-children-on)) ( gadget dim axis -- <=> )
     [ swap loc>> v- ] dip v. 0 <=> ;
 
 : (fast-children-on) ( dim axis children -- i )
     -rot '[ _ _ ((fast-children-on)) ] search drop ;
 
+PRIVATE>
+
 : fast-children-on ( rect axis children -- from to )
     [ [ rect-loc ] 2dip (fast-children-on) 0 or ]
     [ [ rect-bounds v+ ] 2dip (fast-children-on) ?1+ ]
     3bi ;
 
+<PRIVATE
+
 : inside? ( bounds gadget -- ? )
     dup visible?>> [ intersects? ] [ 2drop f ] if ;
 
 : (pick-up) ( point gadget -- gadget )
     dupd children-on [ inside? ] with find-last nip ;
 
+PRIVATE>
+
 : pick-up ( point gadget -- child/f )
     2dup (pick-up) dup
     [ nip [ rect-loc v- ] keep pick-up ] [ drop nip ] if ;
@@ -124,6 +117,14 @@ M: array gadget-text*
 
 : gadget-text ( gadget -- string ) [ gadget-text* ] "" make ;
 
+DEFER: relayout
+
+<PRIVATE
+
+SYMBOL: ui-notify-flag
+
+: notify-ui-thread ( -- ) ui-notify-flag get-global raise-flag ;
+
 : invalidate ( gadget -- )
     \ invalidate >>layout-state drop ;
 
@@ -137,14 +138,14 @@ M: array gadget-text*
     #! invalidation requests.
     layout-queue [ push-front notify-ui-thread ] [ drop ] if* ;
 
-DEFER: relayout
-
 : invalidate* ( gadget -- )
     \ invalidate* >>layout-state
     dup forget-pref-dim
     dup root?>>
     [ layout-later ] [ parent>> [ relayout ] when* ] if ;
 
+PRIVATE>
+
 : relayout ( gadget -- )
     dup layout-state>> \ invalidate* eq?
     [ drop ] [ invalidate* ] if ;
@@ -157,13 +158,17 @@ DEFER: relayout
                               
 : hide-gadget ( gadget -- ) f >>visible? drop ;
 
-DEFER: in-layout?
+<PRIVATE
+
+SYMBOL: in-layout?
 
 GENERIC: dim-changed ( gadget -- )
 
 M: gadget dim-changed
     in-layout? get [ invalidate ] [ invalidate* ] if ;
 
+PRIVATE>
+
 M: gadget (>>dim) ( dim gadget -- )
     2dup dim>> =
     [ 2drop ]
@@ -171,18 +176,19 @@ M: gadget (>>dim) ( dim gadget -- )
 
 GENERIC: pref-dim* ( gadget -- dim )
 
-: ?set-gadget-pref-dim ( dim gadget -- )
-    dup layout-state>>
-    [ 2drop ] [ (>>pref-dim) ] if ;
-
 : pref-dim ( gadget -- dim )
     dup pref-dim>> [ ] [
-        [ pref-dim* dup ] keep ?set-gadget-pref-dim
+        [ pref-dim* ] keep dup layout-state>>
+        [ drop ] [ dupd (>>pref-dim) ] if
     ] ?if ;
 
 : pref-dims ( gadgets -- seq ) [ pref-dim ] map ;
 
-M: gadget pref-dim* rect-dim ;
+M: gadget pref-dim* dim>> ;
+
+GENERIC: baseline ( gadget -- y )
+
+M: gadget baseline pref-dim second ;
 
 GENERIC: layout* ( gadget -- )
 
@@ -190,15 +196,23 @@ M: gadget layout* drop ;
 
 : prefer ( gadget -- ) dup pref-dim >>dim drop ;
 
-: validate ( gadget -- ) f >>layout-state drop ;
-
 : layout ( gadget -- )
     dup layout-state>> [
-        dup validate
+        f >>layout-state
         dup layout*
         dup [ layout ] each-child
     ] when drop ;
 
+GENERIC: graft* ( gadget -- )
+
+M: gadget graft* drop ;
+
+GENERIC: ungraft* ( gadget -- )
+
+M: gadget ungraft* drop ;
+
+<PRIVATE
+
 : graft-queue ( -- dlist ) \ graft-queue get ;
 
 : unqueue-graft ( gadget -- )
@@ -224,6 +238,9 @@ M: gadget layout* drop ;
         { { f f } [ queue-graft ] }
     } case ;
 
+: graft ( gadget -- )
+    dup graft-later [ graft ] each-child ;
+
 : ungraft-later ( gadget -- )
     dup graft-state>> {
         { { f f } [ drop ] }
@@ -232,29 +249,44 @@ M: gadget layout* drop ;
         { { t t } [ queue-ungraft ] }
     } case ;
 
-GENERIC: graft* ( gadget -- )
-
-M: gadget graft* drop ;
-
-: graft ( gadget -- )
-    dup graft-later [ graft ] each-child ;
-
-GENERIC: ungraft* ( gadget -- )
-
-M: gadget ungraft* drop ;
-
 : ungraft ( gadget -- )
     dup [ ungraft ] each-child ungraft-later ;
 
+: activate-control ( gadget -- )
+    dup model>> dup [
+        2dup add-connection
+        swap model-changed
+    ] [
+        2drop
+    ] if ;
+
+: deactivate-control ( gadget -- )
+    dup model>> dup [ 2dup remove-connection ] when 2drop ;
+
+: notify ( gadget -- )
+    dup graft-state>>
+    [ first { f f } { t t } ? >>graft-state ] keep
+    {
+        { { f t } [ dup activate-control graft* ] }
+        { { t f } [ dup deactivate-control ungraft* ] }
+    } case ;
+
+: notify-queued ( -- )
+    graft-queue [ notify ] slurp-deque ;
+
 : (unparent) ( gadget -- )
     dup ungraft
     dup forget-pref-dim
     f >>parent drop ;
 
+: (clear-gadget) ( gadget -- )
+    dup [ (unparent) ] each-child
+    f >>focus f >>children drop ;
+
 : unfocus-gadget ( child gadget -- )
     [ nip ] [ focus>> eq? ] 2bi [ f >>focus ] when drop ;
 
-SYMBOL: in-layout?
+PRIVATE>
 
 : not-in-layout ( -- )
     in-layout? get
@@ -273,14 +305,12 @@ SYMBOL: in-layout?
         ] if
     ] when* ;
 
-: (clear-gadget) ( gadget -- )
-    dup [ (unparent) ] each-child
-    f >>focus f >>children drop ;
-
 : clear-gadget ( gadget -- )
     not-in-layout
     dup (clear-gadget) relayout ;
 
+<PRIVATE
+
 : ((add-gadget)) ( parent child -- parent )
     over children>> ?push >>children ;
 
@@ -290,6 +320,8 @@ SYMBOL: in-layout?
     tuck ((add-gadget))
     tuck graft-state>> second [ graft ] [ drop ] if ;
 
+PRIVATE>
+
 : add-gadget ( parent child -- parent )
     not-in-layout
     (add-gadget)
@@ -310,7 +342,9 @@ SYMBOL: in-layout?
     [ parents ] dip find nip ; inline
 
 : screen-loc ( gadget -- loc )
-    parents { 0 0 } [ rect-loc v+ ] reduce ;
+    parents { 0 0 } [ loc>> v+ ] reduce ;
+
+<PRIVATE
 
 : (screen-rect) ( gadget -- loc ext )
     dup parent>> [
@@ -320,6 +354,8 @@ SYMBOL: in-layout?
         rect-extent
     ] if* ;
 
+PRIVATE>
+
 : screen-rect ( gadget -- rect )
     (screen-rect) <extent-rect> ;
 
@@ -347,5 +383,5 @@ M: f request-focus-on 2drop ;
 : request-focus ( gadget -- )
     [ focusable-child ] keep request-focus-on ;
 
-: focus-path ( world -- seq )
+: focus-path ( gadget -- seq )
     [ focus>> ] follow ;

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

@@ -19,14 +19,14 @@ SYMBOL: grid-dim
     [ [ grid-dim get ] 2dip set-axis ] 2bi ;
 
 : draw-grid-lines ( gaps orientation -- )
-    [ grid get swap grid-positions grid get rect-dim suffix ] dip
+    [ grid get swap grid-positions grid get dim>> suffix ] dip
     [ '[ _ v- ] map ] keep
     '[ _ swap grid-line-from/to gl-line ] each ;
 
 M: grid-lines draw-boundary
     color>> gl-color [
         [ grid set ]
-        [ rect-dim half-gap v- grid-dim set ]
+        [ dim>> half-gap v- grid-dim set ]
         [ compute-grid ] tri
         [ { 1 0 } draw-grid-lines ]
         [ { 0 1 } draw-grid-lines ]

basis/ui/gadgets/incremental/incremental.factor

@@ -1,7 +1,8 @@
 ! 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 combinators ;
+ui.gadgets.private ui.gadgets.packs accessors
+math.geometry.rect combinators ;
 IN: ui.gadgets.incremental
 
 TUPLE: incremental < pack cursor ;
@@ -18,7 +19,7 @@ M: incremental pref-dim*
 
 : next-cursor ( gadget incremental -- cursor )
     [
-        [ rect-dim ] [ cursor>> ] bi*
+        [ dim>> ] [ cursor>> ] bi*
         [ vmax ] [ v+ ] 2bi
     ] keep orientation>> set-axis ;
 

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

@@ -8,28 +8,19 @@ HELP: <label>
 { $values { "string" string } { "label" "a new " { $link label } } }
 { $description "Creates a new " { $link label } " gadget. The string is permitted to contain line breaks." } ;
 
-HELP: label-string
-{ $values { "label" label } { "string" string } }
-{ $description "Outputs the string currently displayed by the label." } ;
-
-HELP: set-label-string
-{ $values { "label" label } { "string" string } }
-{ $description "Sets the string currently displayed by the label. The string is permitted to contain line breaks. After calling this word, you must also call " { $link relayout } " on the label." } ;
-
 HELP: <label-control>
 { $values { "model" model } { "gadget" "a new " { $link gadget } } }
 { $description "Creates a control which displays the value of " { $snippet "model" } ", which is required to be a string. The label control is automatically updated when the model value changes." } ;
 
-{ label-string set-label-string } related-words
 { <label> <label-control> } related-words
 
 ARTICLE: "ui.gadgets.labels" "Label gadgets"
-"The " { $vocab-link "ui.gadgets.labels" } " vocabulary implements labels. A label displays a piece of text, either a single line string or an array of line strings."
+"The " { $vocab-link "ui.gadgets.labels" } " vocabulary implements labels. A label displays a piece of text, which is either a single line string or an array of line strings."
 { $subsection label }
 { $subsection <label> }
 { $subsection <label-control> }
-{ $subsection label-string }
+"Labels have a virtual slot named " { $slot "string" } " which contains the displayed text. The " { $slot "text" } " slot should not be set directly."
-{ $subsection set-label-string }
+$nl
 "Label specifiers are used by buttons, checkboxes and radio buttons:"
 { $subsection >label } ;
 

basis/ui/gadgets/labels/labels.factor

@@ -9,10 +9,12 @@ IN: ui.gadgets.labels
 ! A label gadget draws a string.
 TUPLE: label < gadget text font ;
 
-: label-string ( label -- string )
+SLOT: string
+
+M: label string>> ( label -- string )
     text>> dup string? [ "\n" join ] unless ; inline
 
-: set-label-string ( string label -- )
+M: label (>>string) ( string label -- )
     [ CHAR: \n over memq? [ string-lines ] when ] dip (>>text) ; inline
 
 : label-theme ( gadget -- gadget )
@@ -20,24 +22,30 @@ TUPLE: label < gadget text font ;
 
 : new-label ( string class -- label )
     new-gadget
-    [ set-label-string ] keep
+    swap >>string
     label-theme ; inline
 
 : <label> ( string -- label )
     label new-label ;
 
+: >label< ( label -- font text )
+    [ font>> ] [ text>> ] bi ;
+
 M: label pref-dim*
-    [ font>> ] [ text>> ] bi text-dim ;
+    >label< text-dim ;
+
+M: label baseline
+    >label< line-metrics ascent>> ;
 
 M: label draw-gadget*
-    [ font>> ] [ text>> ] bi origin get draw-text ;
+    >label< origin get draw-text ;
 
-M: label gadget-text* label-string % ;
+M: label gadget-text* string>> % ;
 
 TUPLE: label-control < label ;
 
 M: label-control model-changed
-    swap value>> over set-label-string relayout ;
+    swap value>> >>string relayout ;
 
 : <label-control> ( model -- gadget )
     "" label-control new-label
@@ -47,7 +55,8 @@ M: label-control model-changed
     monospace-font >>font ;
 
 : reverse-video-theme ( label -- label )
-    sans-serif-font reverse-video-font >>font ;
+    sans-serif-font reverse-video-font >>font
+    black <solid> >>interior ;
 
 GENERIC: >label ( obj -- gadget )
 M: string >label <label> ;

basis/ui/gadgets/panes/panes.factor

@@ -4,7 +4,7 @@ USING: arrays hashtables io kernel namespaces sequences
 io.styles strings quotations math opengl combinators memoize
 math.vectors sorting splitting assocs classes.tuple models
 continuations destructors accessors math.geometry.rect fry
-fonts ui.gadgets ui.gadgets.borders ui.gadgets.buttons
+fonts ui.gadgets ui.gadgets.private ui.gadgets.borders ui.gadgets.buttons
 ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.paragraphs
 ui.gadgets.incremental ui.gadgets.packs ui.gadgets.theme
 ui.gadgets.menus ui.clipboards ui.gestures ui.traverse ui.render
@@ -71,7 +71,7 @@ M: gadget draw-selection ( loc gadget -- )
 M: node draw-selection ( loc node -- )
     2dup value>> swap offset-rect [
         drop 2dup
-        [ value>> rect-loc v+ ] keep
+        [ value>> loc>> v+ ] keep
         children>> [ draw-selection ] with each
     ] if-fits 2drop ;
 
@@ -350,7 +350,7 @@ M: f sloppy-pick-up*
     2drop f ;
 
 : wet-and-sloppy ( loc gadget n -- newloc newgadget )
-    swap nth-gadget [ rect-loc v- ] keep ;
+    swap nth-gadget [ loc>> v- ] keep ;
 
 : sloppy-pick-up ( loc gadget -- path )
     2dup sloppy-pick-up* dup

basis/ui/gadgets/scrollers/scrollers-tests.factor

@@ -75,7 +75,7 @@ dup layout
         "g2" get scroll>gadget
         "s" get layout
         "s" get scroller-value
-    ] map [ { 2 0 } = ] all?
+    ] map [ { 3 0 } = ] all?
 ] unit-test
 
 [ ] [ "Hi" <label> dup "l" set <scroller> "s" set ] unit-test

basis/ui/gadgets/scrollers/scrollers.factor

@@ -50,7 +50,7 @@ scroller H{
 
 : scroll ( value scroller -- )
     [
-        viewport>> [ rect-dim { 0 0 } ] [ viewport-dim ] bi
+        viewport>> [ dim>> { 0 0 } ] [ viewport-dim ] bi
         4array flip
     ] keep
     2dup control-value = [ 2drop ] [ set-control-value ] if ;

basis/ui/gadgets/sliders/sliders.factor

@@ -111,7 +111,7 @@ elevator H{
 : layout-thumb-dim ( slider -- )
     dup dup thumb-dim (layout-thumb)
     [
-        [ [ rect-dim ] dip ] [ drop orientation>> ] 2bi set-axis
+        [ [ dim>> ] dip ] [ drop orientation>> ] 2bi set-axis
         [ ceiling ] map
     ] dip (>>dim) ;
 

basis/ui/gadgets/viewports/viewports.factor

@@ -55,4 +55,4 @@ M: viewport model-changed
 
 : visible-dim ( gadget -- dim )
     dup parent>> viewport?
-    [ parent>> rect-dim viewport-gap 2 v*n v- ] [ dim>> ] if ;
+    [ parent>> dim>> viewport-gap 2 v*n v- ] [ dim>> ] if ;

basis/ui/gestures/gestures.factor

@@ -4,7 +4,7 @@ USING: accessors arrays assocs kernel math math.order models
 namespaces make sequences words strings system hashtables
 math.parser math.vectors classes.tuple classes boxes calendar
 alarms combinators sets columns fry deques ui.gadgets
-unicode.case combinators.short-circuit ;
+ui.gadgets.private unicode.case combinators.short-circuit ;
 IN: ui.gestures
 
 GENERIC: handle-gesture ( gesture gadget -- ? )

basis/ui/render/render.factor

@@ -56,7 +56,7 @@ SYMBOL: origin
 : visible-children ( gadget -- seq )
     clip get origin get vneg offset-rect swap children-on ;
 
-: translate ( rect/point -- ) rect-loc origin [ v+ ] change ;
+: translate ( rect/point -- ) loc>> origin [ v+ ] change ;
 
 DEFER: draw-gadget
 

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

@@ -110,8 +110,6 @@ IN: ui.tools.listener.tests
 
 [ CHAR: H ] [ "promise" get 2 seconds ?promise-timeout ] unit-test
 
-[ f ] [ "word" source-editor command-map commands>> empty? ] unit-test
-
 [ ] [ <listener-gadget> [ ] with-grafted-gadget ] unit-test
 
 [ ] [ <listener-gadget> "listener" set ] unit-test

basis/ui/ui-docs.factor

@@ -1,7 +1,7 @@
 USING: help.markup help.syntax strings quotations debugger
 namespaces ui.backend ui.gadgets ui.gadgets.worlds
 ui.gadgets.tracks ui.gadgets.packs ui.gadgets.grids
-math.geometry.rect colors ui.text fonts ;
+ui.gadgets.private math.geometry.rect colors ui.text fonts ;
 IN: ui
 
 HELP: windows

basis/ui/ui.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs io kernel math models namespaces make
+USING: arrays assocs io kernel math models namespaces make dlists
-dlists deques sequences threads sequences words continuations
+deques sequences threads sequences words continuations init
-init combinators hashtables concurrency.flags sets accessors
+combinators hashtables concurrency.flags sets accessors calendar fry
-calendar fry ui.gadgets ui.gadgets.worlds ui.gadgets.tracks
+ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gadgets.tracks
 ui.gestures ui.backend ui.render ui.text ui.text.private ;
 IN: ui
 
@@ -112,17 +112,6 @@ M: world ungraft*
 : redraw-worlds ( seq -- )
     [ dup update-hand draw-world ] each ;
 
-: notify ( gadget -- )
-    dup graft-state>>
-    [ first { f f } { t t } ? >>graft-state ] keep
-    {
-        { { f t } [ dup activate-control graft* ] }
-        { { t f } [ dup deactivate-control ungraft* ] }
-    } case ;
-
-: notify-queued ( -- )
-    graft-queue [ notify ] slurp-deque ;
-
 : send-queued-gestures ( -- )
     gesture-queue [ send-queued-gesture notify-queued ] slurp-deque ;
 

extra/boids/boids.factor

@@ -237,7 +237,7 @@ USING: math.parser
     [wlet | update-value-label [ ! ( -- )
               BEHAVIOUR weight>> truncate-number number>string
               VALUE-LABEL
-              set-label-string ] |
+              (>>string) ] |
 
       update-value-label
       
@@ -275,7 +275,7 @@ USING: math.parser
     [wlet | update-value-label [ ( -- )
               BOIDS-GADGET boids>> length number>string
               VALUE-LABEL
-              set-label-string ] |
+              (>>string) ] |
 
       update-value-label
       

extra/lcd/lcd.factor

@@ -25,7 +25,7 @@ IN: lcd
 
 : <time-display> ( timestamp -- gadget )
     [ hh:mm:ss lcd ] <filter> <label-control>
-    "99:99:99" lcd over set-label-string
+    "99:99:99" lcd >>string
     monospace-font >>font ;
 
 : time-window ( -- )

extra/ui/gadgets/lists/lists.factor

@@ -106,7 +106,7 @@ M: list focusable-child* drop t ;
     vmin { 0 0 } vmax ;
 
 : select-at ( point list -- )
-    [ rect-dim clamp-loc ] keep
+    [ dim>> clamp-loc ] keep
     [ pick-up ] keep
     select-gadget ;