UI cleanup: make some ui.gadgets words private, give labels a virtual slot instead...

diff --git a/basis/tools/test/ui/ui.factor b/basis/tools/test/ui/ui.factor
index 666a7d24d9cf51ba60806d06b9c873a644fbc539..c37e7799cb73865d66ff985d9508091474512d77 100644 (file)
--- a/basis/tools/test/ui/ui.factor
+++ b/basis/tools/test/ui/ui.factor
@@ -1,5 +1,5 @@
-USING: dlists ui.gadgets kernel ui namespaces io.streams.string
-io ;
+USING: dlists ui.gadgets ui.gadgets.private
+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

diff --git a/basis/ui/backend/cocoa/views/views.factor b/basis/ui/backend/cocoa/views/views.factor
index e70172bed762000e3f034965a340248727409c39..27c2e07d99695ae1ebc5b8cccbb17807bbc21562 100644 (file)
--- a/basis/ui/backend/cocoa/views/views.factor
+++ b/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 - ]
-    [ drop rect-dim first2 ]
+    [ [ loc>> first2 ] [ dim>> second ] bi* swap - ]
+    [ 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 ;
 

diff --git a/basis/ui/gadgets/buttons/buttons-tests.factor b/basis/ui/gadgets/buttons/buttons-tests.factor
index bdd9ebaf13c630e6476ea3d6dcdec5d9b40788c3..37af24ae25759f00e0d004626f5f0bf45715df2e 100644 (file)
--- a/basis/ui/gadgets/buttons/buttons-tests.factor
+++ b/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> {

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 32e124afd7fdcdb24c176c2e218ea36343de5379..25a92a685217a051b5a297450515130b26011cfb 100755 (executable)
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/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 ;
 

diff --git a/basis/ui/gadgets/gadgets-docs.factor b/basis/ui/gadgets/gadgets-docs.factor
index 169f97f0b95e51cbaea4c47f8f9c0e6000824a89..0312921344015b49e3a344379fdde79816004191 100644 (file)
--- a/basis/ui/gadgets/gadgets-docs.factor
+++ b/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

diff --git a/basis/ui/gadgets/gadgets-tests.factor b/basis/ui/gadgets/gadgets-tests.factor
index 01d695c28194fd88855959a6cd380f575b880dea..cf76fb52d22d6092e24943acb1a8cb285e29baa5 100644 (file)
--- a/basis/ui/gadgets/gadgets-tests.factor
+++ b/basis/ui/gadgets/gadgets-tests.factor
@@ -1,7 +1,7 @@
-USING: accessors ui.gadgets ui.gadgets.packs ui.gadgets.worlds
-tools.test namespaces models kernel dlists deques math sets
-math.parser ui sequences hashtables assocs io arrays prettyprint
-io.streams.string math.geometry.rect ;
+USING: accessors ui.gadgets ui.gadgets.private ui.gadgets.packs
+ui.gadgets.worlds tools.test namespaces models kernel dlists deques
+math sets math.parser ui sequences hashtables assocs io arrays
+prettyprint io.streams.string math.geometry.rect ;
 IN: ui.gadgets.tests
 
 [ { 300 300 } ]

diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor
index 0a439a1a1a1730dd89cf1bcb0c1033bf2efd095b..f9cad9525124f13c6895ea3494771e76ec99aa8b 100644 (file)
--- a/basis/ui/gadgets/gadgets.factor
+++ b/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 ;
+: ungraft ( gadget -- )
+    dup [ ungraft ] each-child ungraft-later ;
 
-: graft ( gadget -- )
-    dup graft-later [ graft ] each-child ;
+: activate-control ( gadget -- )
+    dup model>> dup [
+        2dup add-connection
+        swap model-changed
+    ] [
+        2drop
+    ] if ;
 
-GENERIC: ungraft* ( gadget -- )
+: deactivate-control ( gadget -- )
+    dup model>> dup [ 2dup remove-connection ] when 2drop ;
 
-M: gadget ungraft* drop ;
+: 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 ;
 
-: ungraft ( gadget -- )
-    dup [ ungraft ] each-child ungraft-later ;
+: 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 ;

diff --git a/basis/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor
index 4552fcdd5dd11e2b2b113dc1e7a455b314e73b76..a28f21c3ad52dc11b2af9f86ae6b1dfb231515bb 100755 (executable)
--- a/basis/ui/gadgets/grid-lines/grid-lines.factor
+++ b/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 ]

diff --git a/basis/ui/gadgets/incremental/incremental.factor b/basis/ui/gadgets/incremental/incremental.factor
index e7a651604cb0f0573c2eb93e92767a4def5d6676..81c980afbc486ac3079a24184a879a2871ef6fa9 100644 (file)
--- a/basis/ui/gadgets/incremental/incremental.factor
+++ b/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 ;
 

diff --git a/basis/ui/gadgets/labels/labels-docs.factor b/basis/ui/gadgets/labels/labels-docs.factor
index ed4278e2cd765b9e6277f0d55432aec886442a43..066a79b90009220075e65dc33be61e2c52513db5 100644 (file)
--- a/basis/ui/gadgets/labels/labels-docs.factor
+++ b/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 }
-{ $subsection set-label-string }
+"Labels have a virtual slot named " { $slot "string" } " which contains the displayed text. The " { $slot "text" } " slot should not be set directly."
+$nl
 "Label specifiers are used by buttons, checkboxes and radio buttons:"
 { $subsection >label } ;
 

diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor
index 5f7ceecfb52f77af7f36561c04b6360170a0deea..3739a9044c5c637f9d10b1cabfbb33f4357f8692 100644 (file)
--- a/basis/ui/gadgets/labels/labels.factor
+++ b/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> ;

diff --git a/basis/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor
index b0f2a9f86a4299fd7887b950984efe29f80265b7..0c3d739b98ebe59acf0326718bf65d5735ade823 100644 (file)
--- a/basis/ui/gadgets/panes/panes.factor
+++ b/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

diff --git a/basis/ui/gadgets/scrollers/scrollers-tests.factor b/basis/ui/gadgets/scrollers/scrollers-tests.factor
index 25977cd9063615c2cdb1f6ea7fe4d481286b9951..cd024285dc8ce4cd32c36b15bb4e87766c0c589f 100644 (file)
--- a/basis/ui/gadgets/scrollers/scrollers-tests.factor
+++ b/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

diff --git a/basis/ui/gadgets/scrollers/scrollers.factor b/basis/ui/gadgets/scrollers/scrollers.factor
index f345e96bba7089dcff67b2d8b0c91911e68dd8c9..5ea99ec5a0059a9c01cd67bb398b12b337baac8c 100644 (file)
--- a/basis/ui/gadgets/scrollers/scrollers.factor
+++ b/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 ;

diff --git a/basis/ui/gadgets/sliders/sliders.factor b/basis/ui/gadgets/sliders/sliders.factor
index 1c2055156ea346020159fb51e1d0ea1ab21aa0f5..349bc38675740eaf490414c4041ecba3f9e35c90 100644 (file)
--- a/basis/ui/gadgets/sliders/sliders.factor
+++ b/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) ;
 

diff --git a/basis/ui/gadgets/viewports/viewports.factor b/basis/ui/gadgets/viewports/viewports.factor
index 73782a1e3d804951e15254f5b6797aeeaebd4eae..163a48b1a9314e50ef8c19e79547888f4f91b78f 100644 (file)
--- a/basis/ui/gadgets/viewports/viewports.factor
+++ b/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 ;

diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor
index 6ebe77623bddb9c3e81d9ec0f6ddbe26cc939fd2..1eda216e8aaaf4790d03ada74934a0cc15e43ee1 100644 (file)
--- a/basis/ui/gestures/gestures.factor
+++ b/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 -- ? )

diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor
index e755f9782b35ca0eb99cbd8302fe414f3f393792..3d0fe4ef0605de31bef13a61d1f80dce43c24f76 100755 (executable)
--- a/basis/ui/render/render.factor
+++ b/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
 

diff --git a/basis/ui/tools/listener/listener-tests.factor b/basis/ui/tools/listener/listener-tests.factor
index c8b60ead48bd444965e7d901c7d9c1115436de58..f7a94dea4980ad60779a7af2c89f5bcf2f96d236 100644 (file)
--- a/basis/ui/tools/listener/listener-tests.factor
+++ b/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

diff --git a/basis/ui/ui-docs.factor b/basis/ui/ui-docs.factor
index ae50ee2c6e792662020b97def8d071ca9916be8e..fd3bf668905c8f5581e04ce389b1f1c05f0c78fa 100644 (file)
--- a/basis/ui/ui-docs.factor
+++ b/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

diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor
index b0ce6d82bcc06669b4f5f4315127fab4cdc2a871..8c84dd691c8dbd40f526a3963f508c5d91edf87d 100644 (file)
--- a/basis/ui/ui.factor
+++ b/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
-dlists deques sequences threads sequences words continuations
-init combinators hashtables concurrency.flags sets accessors
-calendar fry ui.gadgets ui.gadgets.worlds ui.gadgets.tracks
+USING: arrays assocs io kernel math models namespaces make dlists
+deques sequences threads sequences words continuations init
+combinators hashtables concurrency.flags sets accessors calendar fry
+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 ;
 

diff --git a/extra/boids/boids.factor b/extra/boids/boids.factor
index 8319a2d8d9d824a7b54a98415fe4c065ec264ded..83d83221fdb2b7414f22a7cd340e55327bb64c48 100644 (file)
--- a/extra/boids/boids.factor
+++ b/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
       

diff --git a/extra/lcd/lcd.factor b/extra/lcd/lcd.factor
index 8123576f5e9524d0031b21b59b30cccaae47f64e..9f86d23eea3b6f166fe6c6667924aeadb02dbc3b 100755 (executable)
--- a/extra/lcd/lcd.factor
+++ b/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 ( -- )

diff --git a/extra/ui/gadgets/lists/lists.factor b/extra/ui/gadgets/lists/lists.factor
index fbd91379e64c9625721e7ffd7ff7d404009d0546..78cc177a1f53b8191e03f5f019a1b732bdbe5c4e 100644 (file)
--- a/extra/ui/gadgets/lists/lists.factor
+++ b/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 ;