Merge git://factorcode.org/git/factor

core/bootstrap/stage2.factor

@@ -85,4 +85,6 @@ IN: bootstrap.stage2
 
         "output-image" get resource-path save-image-and-exit
     ] if
-] [ error-hook get call "listener" run ] recover
+] [
+    error-hook get call "listener" vocab-main execute
+] recover

extra/color-picker/color-picker.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.functions math.parser models sequences
-ui ui.gadgets ui.gadgets.controls ui.gadgets.frames
+ui ui.gadgets ui.gadgets.frames
 ui.gadgets.labels ui.gadgets.packs ui.gadgets.sliders ui.render
 ;
 IN: color-picker
@@ -11,9 +11,14 @@ IN: color-picker
 : <color-slider> ( model -- gadget )
     <x-slider> 1 over set-slider-line ;
 
+TUPLE: color-preview ;
+
 : <color-preview> ( model -- gadget )
-    <gadget> { 100 100 } over set-rect-dim
+    <gadget> color-preview construct-control
-    [ set-gadget-interior ] <control> ;
+    { 100 100 } over set-rect-dim ;
+
+M: color-preview model-changed
+    dup control-value over set-gadget-interior relayout-1 ;
 
 : <color-model> ( model -- model )
     [ [ 256 /f ] map 1 add <solid> ] <filter> ;

extra/destructors/destructors-docs.factor

@@ -23,7 +23,7 @@ HELP: close-later
 
 HELP: with-destructors
 { $values { "quot" "a quotation" } }
-{ $description "Calls a quotation within a new dynamic scope.  This quotation may register destructors, on any object, by wrapping the object in a destructor and implementing " { $link (destruct) } " on that object type.  After the quotation finishes, if an error was thrown, all destructors are called and the error is then rethrown.  However, if the quotation was successful, only those destructors created with an 'always cleanup' flag will be destroyed." }
+{ $description "Calls a quotation within a new dynamic scope.  This quotation may register destructors, on any object, by wrapping the object in a destructor and implementing " { $link destruct } " on that object type.  After the quotation finishes, if an error was thrown, all destructors are called and the error is then rethrown.  However, if the quotation was successful, only those destructors created with an 'always cleanup' flag will be destroyed." }
 { $notes "Destructors are not allowed to throw exceptions.  No exceptions." }
 { $examples
     { $code "[ 10 malloc free-always ] with-destructors" }

extra/io/windows/nt/backend/backend.factor

@@ -2,7 +2,8 @@ USING: alien alien.c-types arrays assocs combinators
 continuations destructors io io.backend io.nonblocking
 io.windows libc kernel math namespaces sequences threads
 tuples.lib windows windows.errors windows.kernel32 strings
-splitting io.files windows.winsock ;
+splitting io.files qualified ;
+QUALIFIED: windows.winsock
 IN: io.windows.nt.backend
 
 : unicode-prefix ( -- seq )
@@ -62,14 +63,16 @@ C: <io-callback> io-callback
 : set-port-overlapped ( overlapped port -- )
     port-handle set-win32-file-overlapped ;
 
-: completion-port ( handle existing -- handle )
+: <completion-port> ( handle existing -- handle )
      f 1 CreateIoCompletionPort dup win32-error=0/f ;
 
-: master-completion-port ( -- handle )
+SYMBOL: master-completion-port
-    INVALID_HANDLE_VALUE f completion-port ;
+
+: <master-completion-port> ( -- handle )
+    INVALID_HANDLE_VALUE f <completion-port> ;
 
 M: windows-nt-io add-completion ( handle -- )
-    \ master-completion-port get-global completion-port drop ;
+    master-completion-port get-global <completion-port> drop ;
 
 TUPLE: GetOverlappedResult-args hFile* lpOverlapped* lpNumberOfBytesTransferred* bWait* port ;
 
@@ -98,8 +101,8 @@ TUPLE: GetQueuedCompletionStatusParams hCompletionPort* lpNumberOfBytes* lpCompl
 C: <GetQueuedCompletionStatusParams> GetQueuedCompletionStatusParams
 
 : wait-for-overlapped ( ms -- GetQueuedCompletionStatus-Params ret )
-    >r \ master-completion-port get-global 0 <int>
+    >r master-completion-port get-global 0 <int> 0 <int> 0 <int>
-    0 <int> 0 <int> r> <GetQueuedCompletionStatusParams> [
+    r> <GetQueuedCompletionStatusParams> [
         GetQueuedCompletionStatusParams >tuple*<
         GetQueuedCompletionStatus
     ] keep swap ;
@@ -146,7 +149,7 @@ M: windows-nt-io init-io ( -- )
     #! Should only be called on startup. Calling this at any
     #! other time can have unintended consequences.
     global [
-        master-completion-port \ master-completion-port set
+        <master-completion-port> master-completion-port set
         H{ } clone io-hash set
-        init-winsock
+        windows.winsock:init-winsock
     ] bind ;

extra/models/models-docs.factor

@@ -106,7 +106,7 @@ $nl
         ": <funny-slider> <x-slider> 100 over set-slider-max ;"
         "<funny-slider> <funny-slider> 2array"
         "dup make-pile gadget."
-        "dup [ control-model ] map <compose> [ unparse ] <filter>"
+        "dup [ gadget-model ] map <compose> [ unparse ] <filter>"
         "<label-control> gadget."
     }
 } ;
@@ -146,7 +146,7 @@ HELP: delay
         ": <funny-slider>"
         "    0 0 0 100 <range> <x-slider> 500 over set-slider-max ;"
         "<funny-slider> dup gadget."
-        "control-model 500 <delay> [ number>string ] <filter>"
+        "gadget-model 500 <delay> [ number>string ] <filter>"
         "<label-control> gadget."
     }
 } ;

extra/slides/slides.factor

@@ -1,6 +1,6 @@
 USING: arrays hashtables help.markup help.stylesheet io
 io.styles kernel math models namespaces sequences ui ui.gadgets
-ui.gadgets.books ui.gadgets.controls ui.gadgets.panes
+ui.gadgets.books ui.gadgets.panes
 ui.gestures ui.render ;
 IN: slides
 
@@ -75,7 +75,7 @@ TUPLE: slides ;
 
 : change-page ( book n -- )
     over control-value + over gadget-children length rem
-    swap control-model set-model ;
+    swap gadget-model set-model ;
 
 : next-page ( book -- ) 1 change-page ;
 

extra/ui/gadgets/books/books-docs.factor

@@ -1,11 +1,11 @@
-USING: ui.gadgets.books ui.gadgets.controls help.markup
+USING: ui.gadgets.books help.markup
 help.syntax ui.gadgets models ;
 
 HELP: book
-{ $class-description "A book is a " { $link control } " containing one or more children. The " { $link control-value } " is the index of exactly one child to be visible at any one time, the rest being hidden by having their " { $link gadget-visible? } " slots set to " { $link f } ". The sole visible child assumes the dimensions of the book gadget."
+{ $class-description "A book is a control containing one or more children. The " { $link control-value } " is the index of exactly one child to be visible at any one time, the rest being hidden by having their " { $link gadget-visible? } " slots set to " { $link f } ". The sole visible child assumes the dimensions of the book gadget."
 $nl
 "Books are created by calling " { $link <book> } "." } ;
 
 HELP: <book>
 { $values { "pages" "a sequence of gadgets" } { "model" model } { "book" book } }
-{ $description "Creates a " { $link book } { $link control } ", which contains the gadgets in " { $snippet "pages" } ". A book shows one child at a time, determined by the value of the model, which must be an integer " } ;
+{ $description "Creates a " { $link book } " control, which contains the gadgets in " { $snippet "pages" } ". A book shows one child at a time, determined by the value of the model, which must be an integer " } ;

extra/ui/gadgets/books/books.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sequences models ui.gadgets ui.gadgets.controls ;
+USING: kernel sequences models ui.gadgets ;
 IN: ui.gadgets.books
 
 TUPLE: book ;

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

@@ -1,6 +1,6 @@
 IN: temporary
 USING: ui.commands ui.gadgets.buttons ui.gadgets.labels
-ui.gadgets tools.test namespaces sequences kernel ;
+ui.gadgets tools.test namespaces sequences kernel models ;
 
 TUPLE: foo-gadget ;
 
@@ -17,3 +17,20 @@ T{ foo-gadget } <toolbar> "t" set
 
 [ 2 ] [ "t" get gadget-children length ] unit-test
 [ "Foo a" ] [ "t" get gadget-child gadget-child label-string ] unit-test
+
+[ ] [
+    2 <model> {
+        { 0 "atheist" }
+        { 1 "christian" }
+        { 2 "muslim" }
+        { 3 "jewish" }
+    } <radio-buttons> "religion" set
+] unit-test
+
+[ 0 ] [
+    "religion" get gadget-child radio-control-value
+] unit-test
+
+[ 2 ] [
+    "religion" get gadget-child control-value
+] unit-test

extra/ui/gadgets/buttons/buttons.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays ui.commands ui.gadgets ui.gadgets.borders
-ui.gadgets.controls ui.gadgets.labels ui.gadgets.theme
+ui.gadgets.labels ui.gadgets.theme
 ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
 ui.render kernel math models namespaces sequences strings
 quotations assocs combinators classes colors tuples opengl
@@ -131,13 +131,18 @@ M: checkmark-paint draw-interior
     { 5 5 } over set-pack-gap
     1/2 swap set-pack-align ;
 
+TUPLE: checkbox ;
+
 : <checkbox> ( model label -- checkbox )
     <checkmark>
     label-on-right
     over [ toggle-model drop ] curry <button>
-    [ set-button-selected? ] <control>
+    checkbox construct-control
     dup checkbox-theme ;
 
+M: checkbox model-changed
+    dup control-value over set-button-selected? relayout-1 ;
+
 TUPLE: radio-paint color ;
 
 C: <radio-paint> radio-paint
@@ -165,17 +170,27 @@ M: radio-paint draw-boundary
     dup radio-knob-theme
     { 16 16 } over set-gadget-dim ;
 
-: <radio-control> ( model value gadget quot -- control )
+TUPLE: radio-control value ;
-    >r dupd [ set-control-value ] curry* r> call
-    [ >r = r> set-button-selected? ] curry* <control> ; inline
 
-: <radio-controls> ( model assoc quot -- gadget )
+: <radio-control> ( value model gadget quot -- control )
-    swapd [ >r -rot r> call gadget, ] 2curry assoc-each ; inline
+    >r pick [ swap set-control-value ] curry r> call
+    radio-control construct-control
+    tuck set-radio-control-value ; inline
+
+M: radio-control model-changed
+    dup control-value
+    over radio-control-value =
+    over set-button-selected?
+    relayout-1 ;
+
+: <radio-controls> ( model assoc quot -- )
+    #! quot has stack effect ( value model label -- )
+    swapd [ swapd call gadget, ] 2curry assoc-each ; inline
 
 : radio-button-theme
     { 5 5 } over set-pack-gap 1/2 swap set-pack-align ;
 
-: <radio-button> ( model value label -- gadget )
+: <radio-button> ( value model label -- gadget )
     <radio-knob> label-on-right
     [ <button> ] <radio-control>
     dup radio-button-theme ;
@@ -187,7 +202,7 @@ M: radio-paint draw-boundary
     [ [ <radio-button> ] <radio-controls> ] make-filled-pile
     dup radio-buttons-theme ;
 
-: <toggle-button> ( model value label -- gadget )
+: <toggle-button> ( value model label -- gadget )
     [ <bevel-button> ] <radio-control> ;
 
 : <toggle-buttons> ( model assoc -- gadget )

extra/ui/gadgets/controls/authors.txt

@@ -1 +0,0 @@
-Slava Pestov

extra/ui/gadgets/controls/controls-docs.factor

@@ -1,51 +0,0 @@
-USING: ui.gadgets help.markup help.syntax models kernel classes
-tuples ;
-IN: ui.gadgets.controls
-
-HELP: control
-{ $class-description "A control is a " { $link gadget } " linked to a " { $link model } " stored in the " { $link control-model } " slot. Changes to the model are reflected in the appearance and behavior of the control, and the control may in turn change the value of the model in response to user input."
-$nl
-"Controls are created by calling " { $link <control> } " and " { $link construct-control } "."
-$nl
-"Objects may delegate to " { $link control } " instances, in which case the " { $link control-self } " slot must be set to the frontmost object in the delegation chain. This ensures that the correct object receives notification of model changes." } ;
-
-HELP: <control>
-{ $values { "model" model } { "gadget" gadget } { "quot" "a quotation with stack effect " { $snippet "( value control -- )" } } }
-{ $description "Creates a new control linked to the given model. The gadget parameter becomes the control's delegate. The quotation is called when the model value changes," }
-{ $examples
-    "The following example creates a gadget whose fill color is determined by the value of a model:"
-    { $code
-        "USING: ui.gadgets ui.gadgets.panes models ;"
-        ": set-fill-color >r <solid> r> set-gadget-interior ;"
-        "{ 1.0 0.0 0.5 1.0 } <model>"
-        "<gadget> [ set-fill-color ] <control>"
-        "{ 100 100 } over set-rect-dim"
-        "gadget."
-    }
-    "The " { $vocab-link "color-picker" } " module extends this example into an elaborate color choose."
-} ;
-
-{ <control> construct-control control-value set-control-value } related-words
-
-HELP: control-value
-{ $values { "control" control } { "value" object } }
-{ $description "Outputs the value of the control's model." } ;
-
-HELP: set-control-value
-{ $values { "value" object } { "control" control } }
-{ $description "Sets the value of the control's model." } ;
-
-ARTICLE: "ui-control-impl" "Implementing controls"
-"A control is a gadget which is linked to an underlying " { $link model } "."
-{ $subsection control }
-"There are two ways to implement a new control. First, an existing gadget can be wrapped in a control:"
-{ $subsection <control> }
-"Second, a new tuple class can be defined, whose instances delegate to controls:"
-{ $subsection construct-control }
-"Some utility words useful in control implementations:"
-{ $subsection control-model }
-{ $subsection control-value }
-{ $subsection set-control-value }
-{ $see-also "models" } ;
-
-ABOUT: "ui-control-impl"

extra/ui/gadgets/controls/controls.factor

@@ -1,37 +0,0 @@
-! Copyright (C) 2006 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: kernel models ui.gadgets ;
-IN: ui.gadgets.controls
-
-TUPLE: control self model quot ;
-
-: (construct-control)
-    construct dup dup set-control-self ; inline
-
-: <control> ( model gadget quot -- gadget )
-    {
-        set-control-model set-gadget-delegate set-control-quot
-    } control (construct-control) ;
-
-: control-value ( control -- value )
-    control-model model-value ;
-
-: set-control-value ( value control -- )
-    control-model set-model ;
-
-M: control graft*
-    control-self dup dup control-model add-connection
-    model-changed ;
-
-M: control ungraft*
-    control-self dup control-model remove-connection ;
-
-M: control model-changed
-    control-self
-    [ control-value ] keep
-    [ dup control-quot call ] keep
-    relayout ;
-
-: construct-control ( model underlying class -- tuple )
-    >r [ 2drop ] <control> { set-gadget-delegate } r>
-    (construct-control) ; inline

extra/ui/gadgets/controls/summary.txt

@@ -1 +0,0 @@
-Controls display a view of an underlying model

extra/ui/gadgets/editors/editors-docs.factor

@@ -1,10 +1,9 @@
 USING: documents help.markup help.syntax ui.gadgets
-ui.gadgets.scrollers ui.gadgets.controls
+ui.gadgets.scrollers models strings ui.commands ;
-models strings ui.commands ;
 IN: ui.gadgets.editors
 
 HELP: editor
-{ $class-description "An editor is a " { $link control } " for editing a multi-line passage of text stored in a " { $link document } " model. Editors are crated by calling " { $link <editor> } "."
+{ $class-description "An editor is a control for editing a multi-line passage of text stored in a " { $link document } " model. Editors are crated by calling " { $link <editor> } "."
 $nl
 "Editors have the following slots:"
 { $list

extra/ui/gadgets/editors/editors.factor

@@ -2,13 +2,14 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays documents ui.clipboards ui.commands ui.gadgets
 ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels
-ui.gadgets.scrollers ui.gadgets.theme ui.gadgets.controls
+ui.gadgets.scrollers ui.gadgets.theme
 ui.render ui.gestures io kernel math models namespaces opengl
 opengl.gl sequences strings io.styles math.vectors sorting
 colors combinators ;
 IN: ui.gadgets.editors
 
 TUPLE: editor
+self
 font color caret-color selection-color
 caret mark
 focused? ;
@@ -31,6 +32,7 @@ TUPLE: loc-monitor editor ;
 
 : <editor> ( -- editor )
     <document> <gadget> editor construct-control
+    dup dup set-editor-self
     dup init-editor-locs
     dup editor-theme ;
 
@@ -38,42 +40,42 @@ TUPLE: loc-monitor editor ;
     gray <solid> swap set-gadget-boundary ;
 
 : construct-editor ( class -- tuple )
-    >r <editor> { set-gadget-delegate } r>
+    >r <editor> { set-gadget-delegate } r> construct
-    (construct-control) ; inline
+    dup dup set-editor-self ; inline
 
 TUPLE: source-editor ;
 
 : <source-editor> source-editor construct-editor ;
 
 : activate-editor-model ( editor model -- )
-    dup activate-model swap control-model add-loc ;
+    dup activate-model swap gadget-model add-loc ;
 
 : deactivate-editor-model ( editor model -- )
-    dup deactivate-model swap control-model remove-loc ;
+    dup deactivate-model swap gadget-model remove-loc ;
 
 M: editor graft*
-    dup dup editor-caret activate-editor-model
+    dup
-    dup dup editor-mark activate-editor-model
+    dup editor-caret activate-editor-model
-    dup control-self swap control-model add-connection ;
+    dup editor-mark activate-editor-model ;
 
 M: editor ungraft*
-    dup dup editor-caret deactivate-editor-model
+    dup
-    dup dup editor-mark deactivate-editor-model
+    dup editor-caret deactivate-editor-model
-    dup control-self swap control-model remove-connection ;
+    dup editor-mark deactivate-editor-model ;
 
 M: editor model-changed
-    control-self dup control-model
+    dup gadget-model
     over editor-caret [ over validate-loc ] (change-model)
     over editor-mark [ over validate-loc ] (change-model)
-    drop relayout ;
+    drop editor-self relayout ;
 
 : editor-caret* ( editor -- loc ) editor-caret model-value ;
 
 : editor-mark* ( editor -- loc ) editor-mark model-value ;
 
 : change-caret ( editor quot -- )
-    over >r >r dup editor-caret* swap control-model r> call r>
+    over >r >r dup editor-caret* swap gadget-model r> call r>
-    [ control-model validate-loc ] keep
+    [ gadget-model validate-loc ] keep
     editor-caret set-model ; inline
 
 : mark>caret ( editor -- )
@@ -90,7 +92,7 @@ M: editor model-changed
     editor-font* "" string-height ;
 
 : y>line ( y editor -- line# )
-    [ line-height / >fixnum ] keep control-model validate-line ;
+    [ line-height / >fixnum ] keep gadget-model validate-line ;
 
 : point>loc ( point editor -- loc )
     [
@@ -133,7 +135,7 @@ M: editor model-changed
     ] when drop ;
 
 M: loc-monitor model-changed
-    loc-monitor-editor control-self
+    loc-monitor-editor editor-self
     dup relayout-1 scroll>caret ;
 
 : draw-caret ( -- )
@@ -167,7 +169,7 @@ M: loc-monitor model-changed
         swap
         dup first-visible-line \ first-visible-line set
         dup last-visible-line \ last-visible-line set
-        dup control-model document set
+        dup gadget-model document set
         editor set
         call
     ] with-scope ; inline
@@ -221,19 +223,19 @@ M: editor gadget-selection?
     selection-start/end = not ;
 
 M: editor gadget-selection
-    [ selection-start/end ] keep control-model doc-range ;
+    [ selection-start/end ] keep gadget-model doc-range ;
 
 : remove-selection ( editor -- )
-    [ selection-start/end ] keep control-model remove-doc-range ;
+    [ selection-start/end ] keep gadget-model remove-doc-range ;
 
 M: editor user-input*
-    [ selection-start/end ] keep control-model set-doc-range t ;
+    [ selection-start/end ] keep gadget-model set-doc-range t ;
 
 : editor-string ( editor -- string )
-    control-model doc-string ;
+    gadget-model doc-string ;
 
 : set-editor-string ( string editor -- )
-    control-model set-doc-string ;
+    gadget-model set-doc-string ;
 
 M: editor gadget-text* editor-string % ;
 
@@ -250,8 +252,8 @@ M: editor gadget-text* editor-string % ;
     over gadget-selection? [
         drop nip remove-selection
     ] [
-        over >r >r dup editor-caret* swap control-model
+        over >r >r dup editor-caret* swap gadget-model
-        r> call r> control-model remove-doc-range
+        r> call r> gadget-model remove-doc-range
     ] if ; inline
 
 : editor-delete ( editor elt -- )
@@ -277,7 +279,7 @@ M: editor gadget-text* editor-string % ;
 
 : select-elt ( editor elt -- )
     over >r
-    >r dup editor-caret* swap control-model r> prev/next-elt
+    >r dup editor-caret* swap gadget-model r> prev/next-elt
     r> editor-select ;
 
 : start-of-document ( editor -- ) T{ doc-elt } editor-prev ;
@@ -423,7 +425,7 @@ editor "selection" f {
 M: editor stream-write1 >r 1string r> stream-write ;
 
 M: editor stream-write
-    control-self dup end-of-document user-input ;
+    editor-self dup end-of-document user-input ;
 
 M: editor stream-close drop ;
 
@@ -445,10 +447,10 @@ TUPLE: field model editor ;
 M: field graft*
     dup field-model model-value
     over field-editor set-editor-string
-    dup field-editor control-model add-connection ;
+    dup field-editor gadget-model add-connection ;
 
 M: field ungraft*
-    dup field-editor control-model remove-connection ;
+    dup field-editor gadget-model remove-connection ;
 
 M: field model-changed
     dup field-editor editor-string

extra/ui/gadgets/gadgets.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays hashtables kernel models math namespaces sequences
 timers quotations math.vectors combinators sorting vectors
-dlists ;
+dlists models ;
 IN: ui.gadgets
 
 TUPLE: rect loc dim ;
@@ -43,12 +43,15 @@ M: array rect-dim drop { 0 0 } ;
 TUPLE: gadget
 pref-dim parent children orientation state focus
 visible? root? clipped? grafted?
-interior boundary ;
+interior boundary
+model ;
 
 M: gadget equal? 2drop f ;
 
 M: gadget hashcode* drop gadget hashcode* ;
 
+M: gadget model-changed drop ;
+
 : gadget-child ( gadget -- child ) gadget-children first ;
 
 : nth-gadget ( n gadget -- child ) gadget-children nth ;
@@ -63,7 +66,20 @@ M: gadget hashcode* drop gadget hashcode* ;
     } gadget construct ;
 
 : construct-gadget ( class -- tuple )
-    >r <gadget> { set-delegate } r> construct ; inline
+    >r <gadget> r> construct-delegate ; inline
+
+: activate-control ( gadget -- )
+    dup gadget-model dup [ 2dup add-connection ] when drop
+    model-changed ;
+
+: deactivate-control ( gadget -- )
+    dup gadget-model dup [ 2dup remove-connection ] when 2drop ;
+
+: control-value ( control -- value )
+    gadget-model model-value ;
+
+: set-control-value ( value control -- )
+    gadget-model set-model ;
 
 : relative-loc ( fromgadget togadget -- loc )
     2dup eq? [
@@ -119,6 +135,10 @@ M: gadget children-on nip gadget-children ;
         dup pick [ set-gadget-parent ] curry* each-child
     ] when set-delegate ;
 
+: construct-control ( model gadget class -- control )
+    >r tuck set-gadget-model
+    { set-gadget-delegate } r> construct ; inline
+
 ! Selection protocol
 GENERIC: gadget-selection? ( gadget -- ? )
 
@@ -228,6 +248,7 @@ M: gadget graft* drop ;
 : graft ( gadget -- )
     t over set-gadget-grafted?
     dup graft*
+    dup activate-control
     [ graft ] each-child ;
 
 GENERIC: ungraft* ( gadget -- )
@@ -237,6 +258,7 @@ M: gadget ungraft* drop ;
 : ungraft ( gadget -- )
     dup gadget-grafted? [
         dup [ ungraft ] each-child
+        dup deactivate-control
         dup ungraft*
         f over set-gadget-grafted?
     ] when drop ;

extra/ui/gadgets/labelled/labelled-docs.factor

@@ -1,5 +1,5 @@
 USING: ui.gadgets help.markup help.syntax strings models
-ui.gadgets.panes ui.gadgets.controls ;
+ui.gadgets.panes ;
 IN: ui.gadgets.labelled
 
 HELP: labelled-gadget
@@ -19,7 +19,7 @@ HELP: <closable-gadget>
 
 HELP: <labelled-pane>
 { $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( value -- )" } } { "title" string } { "gadget" "a new " { $link gadget } } }
-{ $description "Creates a new " { $link control } " delegating to a " { $link pane } ", and wraps it in a " { $link labelled-gadget } ". When the value of the model changes, the value is pushed on the stack and the quotation is called using " { $link with-pane } "." } ;
+{ $description "Creates a new control delegating to a " { $link pane } ", and wraps it in a " { $link labelled-gadget } ". When the value of the model changes, the value is pushed on the stack and the quotation is called using " { $link with-pane } "." } ;
 
 { <labelled-pane> <pane-control> } related-words
 

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

@@ -1,5 +1,4 @@
-USING: ui.gadgets.controls help.markup
+USING: help.markup help.syntax strings ui.gadgets models ;
-help.syntax strings ui.gadgets models ;
 IN: ui.gadgets.labels
 
 HELP: label
@@ -19,7 +18,7 @@ HELP: set-label-string
 
 HELP: <label-control>
 { $values { "model" model } { "gadget" "a new " { $link gadget } } }
-{ $description "Creates a " { $link 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." } ;
+{ $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

extra/ui/gadgets/labels/labels.factor

@@ -2,8 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays hashtables io kernel math namespaces
 opengl sequences io.streams.lines strings splitting
-ui.gadgets ui.gadgets.controls ui.gadgets.tracks
+ui.gadgets ui.gadgets.tracks ui.gadgets.theme ui.render colors
-ui.gadgets.theme ui.render colors ;
+models ;
 IN: ui.gadgets.labels
 
 ! A label gadget draws a string.
@@ -37,8 +37,13 @@ M: label draw-gadget*
 
 M: label gadget-text* label-string % ;
 
+TUPLE: label-control ;
+
+M: label-control model-changed
+    dup control-value over set-label-text relayout ;
+
 : <label-control> ( model -- gadget )
-    "" <label> [ set-label-string ] <control> ;
+    "" <label> label-control construct-control ;
 
 : text-theme ( gadget -- )
     black over set-label-color

extra/ui/gadgets/lists/lists-docs.factor

@@ -1,6 +1,5 @@
-USING: ui.commands help.markup help.syntax
+USING: ui.commands help.markup help.syntax ui.gadgets
-ui.gadgets ui.gadgets.presentations ui.gadgets.controls
+ui.gadgets.presentations ui.operations kernel models classes ;
-ui.operations kernel models classes ;
 IN: ui.gadgets.lists
 
 HELP: +secondary+
@@ -8,7 +7,7 @@ HELP: +secondary+
 
 HELP: list
 { $class-description
-    "A list " { $link control } " is backed by a " { $link model } " holding a sequence of objects, and displays as a list of " { $link presentation } " instances of these objects."
+    "A list control is backed by a " { $link model } " holding a sequence of objects, and displays as a list of " { $link presentation } " instances of these objects."
     $nl
     "Lists are created by calling " { $link <list> } "."
     { $command-map list "keyboard-navigation" }

extra/ui/gadgets/lists/lists.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: ui.commands ui.gestures ui.render ui.gadgets
-ui.gadgets.controls ui.gadgets.labels ui.gadgets.scrollers
+ui.gadgets.labels ui.gadgets.scrollers
 kernel sequences models opengl math namespaces
 ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.packs
 math.vectors tuples ;

extra/ui/gadgets/panes/panes-docs.factor

@@ -1,5 +1,5 @@
-USING: ui.gadgets.controls ui.gadgets models
+USING: ui.gadgets models help.markup help.syntax io kernel
-help.markup help.syntax io kernel quotations ;
+quotations ;
 IN: ui.gadgets.panes
 
 HELP: pane
@@ -44,7 +44,7 @@ HELP: <scrolling-pane>
 
 HELP: <pane-control>
 { $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( value -- )" } } { "pane" "a new " { $link pane } } }
-{ $description "Creates a new " { $link control } " delegating to a " { $link pane } ". When the value of the model changes, the value is pushed on the stack and the quotation is called using " { $link with-pane } "." } ;
+{ $description "Creates a new control delegating to a " { $link pane } ". When the value of the model changes, the value is pushed on the stack and the quotation is called using " { $link with-pane } "." } ;
 
 HELP: pane-stream
 { $class-description "Pane streams implement the portion of the " { $link "stream-protocol" } " responsible for output of text, including full support for " { $link "styles" } ". Pane streams also support direct output of gadgets via " { $link write-gadget } " and " { $link print-gadget } ". Pane streams are created by calling " { $link <pane-stream> } "." } ;

extra/ui/gadgets/panes/panes.factor

@@ -1,14 +1,14 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays ui.gadgets ui.gadgets.borders ui.gadgets.buttons
-ui.gadgets.labels ui.gadgets.controls ui.gadgets.scrollers
+ui.gadgets.labels ui.gadgets.scrollers
 ui.gadgets.paragraphs ui.gadgets.incremental ui.gadgets.packs
 ui.gadgets.theme ui.clipboards ui.gestures ui.traverse ui.render
 hashtables io kernel namespaces sequences io.styles strings
 quotations math opengl combinators math.vectors
 io.streams.duplex sorting splitting io.streams.nested assocs
 ui.gadgets.presentations ui.gadgets.slots ui.gadgets.grids
-ui.gadgets.grid-lines tuples ;
+ui.gadgets.grid-lines tuples models ;
 IN: ui.gadgets.panes
 
 TUPLE: pane output current prototype scrolls?
@@ -137,8 +137,14 @@ M: duplex-stream write-gadget
 : <scrolling-pane> ( -- pane )
     <pane> t over set-pane-scrolls? ;
 
+TUPLE: pane-control quot ;
+
+M: pane-control model-changed
+    dup control-value swap dup pane-control-quot with-pane ;
+
 : <pane-control> ( model quot -- pane )
-    [ with-pane ] curry <pane> swap <control> ;
+    >r <pane> pane-control construct-control r>
+    over set-pane-control-quot ;
 
 : do-pane-stream ( pane-stream quot -- )
     >r pane-stream-pane r> keep scroll-pane ; inline

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

@@ -1,7 +1,8 @@
 IN: temporary
-USING: ui.gadgets ui.gadgets.scrollers ui.gadgets.controls
+USING: ui.gadgets ui.gadgets.scrollers
-namespaces tools.test kernel models ui.gadgets.viewports math
+namespaces tools.test kernel models ui.gadgets.viewports
-math.vectors arrays sequences ;
+ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames
+ui.gadgets.sliders math math.vectors arrays sequences ;
 
 [ ] [
     <gadget> "g" set
@@ -22,7 +23,7 @@ math.vectors arrays sequences ;
     <viewport> "v" set 
 ] unit-test
 
-[ { 10 20 } ] [ "v" get control-model range-value ] unit-test
+[ { 10 20 } ] [ "v" get gadget-model range-value ] unit-test
 
 [ { 10 20 } ] [ "g" get rect-loc vneg { 3 3 } v+ ] unit-test
 
@@ -43,15 +44,15 @@ math.vectors arrays sequences ;
 
 [ ] [ { 0 0 } "s" get scroll ] unit-test
 
-[ { 0 0 } ] [ "s" get control-model range-min-value ] unit-test
+[ { 0 0 } ] [ "s" get gadget-model range-min-value ] unit-test
 
-[ { 106 106 } ] [ "s" get control-model range-max-value ] unit-test
+[ { 106 106 } ] [ "s" get gadget-model range-max-value ] unit-test
 
 [ ] [ { 10 20 } "s" get scroll ] unit-test
 
-[ { 10 20 } ] [ "s" get control-model range-value ] unit-test
+[ { 10 20 } ] [ "s" get gadget-model range-value ] unit-test
 
-[ { 10 20 } ] [ "s" get scroller-viewport control-model range-value ] unit-test
+[ { 10 20 } ] [ "s" get scroller-viewport gadget-model range-value ] unit-test
 
 [ { 10 20 } ] [ "g" get rect-loc vneg { 3 3 } v+ ] unit-test
 
@@ -74,3 +75,12 @@ dup layout
         "s" get scroller-value
     ] map [ { 3 0 } = ] all?
 ] unit-test
+
+[ ] [ "Hi" <label> dup "l" set <scroller> "s" set ] unit-test
+
+[ t ] [ "l" get find-scroller "s" get eq? ] unit-test
+[ t ] [ "l" get dup find-scroller scroller-viewport swap child? ] unit-test
+[ t ] [ "l" get find-scroller* "s" get eq? ] unit-test
+[ f ] [ "s" get scroller-viewport find-scroller* ] unit-test
+[ t ] [ "s" get @right grid-child slider? ] unit-test
+[ f ] [ "s" get @right grid-child find-scroller* ] unit-test

extra/ui/gadgets/scrollers/scrollers.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays ui.gadgets ui.gadgets.controls
+USING: arrays ui.gadgets
 ui.gadgets.viewports ui.gadgets.frames ui.gadgets.grids
 ui.gadgets.theme ui.gadgets.sliders ui.gestures kernel math
 namespaces sequences models combinators math.vectors ;
@@ -29,15 +29,15 @@ scroller H{
 } set-gestures
 
 : viewport, ( -- )
-    g control-model <viewport>
+    g gadget-model <viewport>
     g-> set-scroller-viewport @center frame, ;
 
 : <scroller-model> ( -- model )
     0 0 0 0 <range> 0 0 0 0 <range> 2array <compose> ;
 
-: x-model g control-model model-dependencies first ;
+: x-model g gadget-model model-dependencies first ;
 
-: y-model g control-model model-dependencies second ;
+: y-model g gadget-model model-dependencies second ;
 
 : <scroller> ( gadget -- scroller )
     <scroller-model> <frame> scroller construct-control [
@@ -70,11 +70,18 @@ scroller H{
     ] keep dup scroller-value rot v+ swap scroll ;
 
 : relative-scroll-rect ( rect gadget scroller -- newrect )
-    scroller-viewport gadget-child 2dup swap child?
+    scroller-viewport gadget-child relative-loc offset-rect ;
-    [ relative-loc offset-rect ] [ 3drop f ] if ;
+
+: find-scroller* ( gadget -- scroller )
+    dup find-scroller dup [
+        2dup scroller-viewport gadget-child
+        swap child? [ nip ] [ 2drop f ] if
+    ] [
+        2drop f
+    ] if ;
 
 : scroll>rect ( rect gadget -- )
-    dup find-scroller dup [
+    dup find-scroller* dup [
         [ relative-scroll-rect ] keep
         [ set-scroller-follows ] keep
         relayout
@@ -88,7 +95,7 @@ scroller H{
     (scroll>rect) ;
 
 : scroll>gadget ( gadget -- )
-    dup find-scroller dup [
+    dup find-scroller* dup [
         [ set-scroller-follows ] keep
         relayout
     ] [
@@ -99,7 +106,7 @@ scroller H{
     dup scroller-viewport viewport-dim { 0 1 } v* swap scroll ;
 
 : scroll>bottom ( gadget -- )
-    find-scroller [
+    find-scroller* [
         t over set-scroller-follows relayout-1
     ] when* ;
 
@@ -108,10 +115,10 @@ scroller H{
 
 : update-scroller ( scroller follows -- )
     {
-        { [ dup t eq? ] [ drop (scroll>bottom) ] }
+        { [ dup t eq? ] [ drop (scroll>bottom) "A" drop ] }
-        { [ dup rect? ] [ swap (scroll>rect) ] }
+        { [ dup rect? ] [ swap (scroll>rect) "B" drop ] }
-        { [ dup ] [ swap (scroll>gadget) ] }
+        { [ dup ] [ swap (scroll>gadget)  "C" drop ] }
-        { [ t ] [ drop dup scroller-value swap scroll ] }
+        { [ t ] [ drop dup scroller-value swap scroll "D" drop ] }
     } cond ;
 
 M: scroller layout*

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

@@ -1,5 +1,4 @@
-USING: ui.gadgets.controls help.markup help.syntax ui.gadgets
+USING: help.markup help.syntax ui.gadgets models ;
-models ;
 IN: ui.gadgets.sliders
 
 HELP: elevator
@@ -10,7 +9,7 @@ HELP: find-elevator
 { $description "Finds the first parent of " { $snippet "gadget" } " which is an " { $link elevator } ". Outputs " { $link f } " if the gadget is not contained in an " { $link elevator } "." } ;
 
 HELP: slider
-{ $class-description "A slider is a " { $link control } " for graphically manipulating a " { $link "models-range" } "."
+{ $class-description "A slider is a control for graphically manipulating a " { $link "models-range" } "."
 $nl
 "Sliders are created by calling " { $link <x-slider> } " or " { $link <y-slider> } "." } ;
 
@@ -57,6 +56,6 @@ ARTICLE: "ui.gadgets.sliders" "Slider gadgets"
 { $subsection slide-by }
 { $subsection slide-by-line }
 { $subsection slide-by-page }
-"Since sliders are controls the value can be get and set by calling " { $link control-model } "." ;
+"Since sliders are controls the value can be get and set by calling " { $link gadget-model } "." ;
 
 ABOUT: "ui.gadgets.sliders"

extra/ui/gadgets/sliders/sliders.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays ui.gestures ui.gadgets ui.gadgets.buttons
-ui.gadgets.controls ui.gadgets.frames ui.gadgets.grids
+ui.gadgets.frames ui.gadgets.grids
 ui.gadgets.theme ui.render kernel math namespaces sequences
 vectors models math.vectors math.functions quotations colors ;
 IN: ui.gadgets.sliders
@@ -22,13 +22,13 @@ TUPLE: slider elevator thumb saved line ;
 
 : min-thumb-dim 15 ;
 
-: slider-value control-model range-value >fixnum ;
+: slider-value gadget-model range-value >fixnum ;
 
-: slider-page control-model range-page-value ;
+: slider-page gadget-model range-page-value ;
 
-: slider-max control-model range-max-value ;
+: slider-max gadget-model range-max-value ;
 
-: slider-max* control-model range-max-value* ;
+: slider-max* gadget-model range-max-value* ;
 
 : thumb-dim ( slider -- h )
     dup slider-page over slider-max 1 max / 1 min
@@ -57,7 +57,7 @@ TUPLE: thumb ;
 : do-drag ( thumb -- )
     find-slider drag-loc over gadget-orientation v.
     over screen>slider swap [ slider-saved + ] keep
-    control-model set-range-value ;
+    gadget-model set-range-value ;
 
 thumb H{
     { T{ button-down } [ begin-drag ] }
@@ -75,10 +75,10 @@ thumb H{
     [ set-gadget-orientation ] keep ;
 
 : slide-by ( amount slider -- )
-    control-model move-by ;
+    gadget-model move-by ;
 
 : slide-by-page ( amount slider -- )
-    control-model move-by-page ;
+    gadget-model move-by-page ;
 
 : compute-direction ( elevator -- -1/1 )
     dup find-slider swap hand-click-rel

extra/ui/gadgets/slots/slots.factor

@@ -3,7 +3,7 @@
 USING: namespaces ui.gadgets ui.gestures ui.commands kernel
 ui.gadgets.scrollers parser prettyprint ui.gadgets.buttons
 sequences arrays ui.gadgets.borders ui.gadgets.tracks
-ui.gadgets.editors ui.gadgets.controls io math
+ui.gadgets.editors io math
 definitions math.vectors assocs refs ;
 IN: ui.gadgets.slots
 

extra/ui/gadgets/viewports/viewports-docs.factor

@@ -1,8 +1,8 @@
-USING: ui.gadgets.viewports ui.gadgets.controls help.markup
+USING: ui.gadgets.viewports help.markup
 help.syntax ui.gadgets models ;
 
 HELP: viewport
-{ $class-description "A viewport is a " { $link control } " which positions a child gadget translated by the " { $link control-value } " vector. Viewports can be created directly by calling " { $link <viewport> } "." } ;
+{ $class-description "A viewport is a control which positions a child gadget translated by the " { $link control-value } " vector. Viewports can be created directly by calling " { $link <viewport> } "." } ;
 
 HELP: <viewport>
 { $values { "content" gadget } { "model" model } { "viewport" "a new " { $link viewport } } }

extra/ui/gadgets/viewports/viewports.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: ui.gadgets.viewports
-USING: arrays ui.gadgets ui.gadgets.borders ui.gadgets.controls
+USING: arrays ui.gadgets ui.gadgets.borders
 kernel math namespaces sequences models math.vectors ;
 
 : viewport-gap { 3 3 } ; inline
@@ -30,7 +30,7 @@ M: viewport focusable-child*
 M: viewport pref-dim* viewport-dim ;
 
 : scroller-value ( scroller -- loc )
-    control-model range-value [ >fixnum ] map ;
+    gadget-model range-value [ >fixnum ] map ;
 
 M: viewport model-changed
     dup relayout-1

extra/ui/tools/deploy/deploy.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: ui.gadgets colors kernel ui.render namespaces
-ui.gadgets.controls models sequences ui.gadgets.buttons
+models sequences ui.gadgets.buttons
 ui.gadgets.packs ui.gadgets.labels tools.deploy.config
 namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
 ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
@@ -52,7 +52,7 @@ TUPLE: deploy-gadget vocab settings ;
             reflection-settings
             advanced-settings
         ] make-pile dup deploy-settings-theme
-        namespace <mapping> swap [ 2drop ] <control>
+        namespace <mapping> over set-gadget-model
     ] bind ;
 
 : find-deploy-gadget

extra/ui/tools/interactor/interactor.factor

@@ -4,7 +4,7 @@ USING: arrays assocs combinators continuations documents
 ui.tools.workspace hashtables io io.styles kernel math
 math.vectors models namespaces parser prettyprint quotations
 sequences strings threads listener tuples ui.commands
-ui.gadgets ui.gadgets.controls ui.gadgets.editors
+ui.gadgets ui.gadgets.editors
 ui.gadgets.presentations ui.gadgets.worlds ui.gestures ;
 IN: ui.tools.interactor
 
@@ -19,7 +19,7 @@ help ;
 
 : word-at-loc ( loc interactor -- word )
     over [
-        [ control-model T{ one-word-elt } elt-string ] keep
+        [ gadget-model T{ one-word-elt } elt-string ] keep
         interactor-use assoc-stack
     ] [
         2drop f
@@ -46,7 +46,7 @@ M: caret-help model-changed
     <source-editor>
     { set-interactor-output set-gadget-delegate }
     interactor construct
-    dup dup set-control-self
+    dup dup set-editor-self
     dup init-interactor-history
     dup init-caret-help ;
 
@@ -79,7 +79,7 @@ M: interactor ungraft*
     [ editor-string ] keep
     [ interactor-input. ] 2keep
     [ add-interactor-history ] keep
-    dup control-model clear-doc
+    dup gadget-model clear-doc
     interactor-continue ;
 
 : interactor-eval ( interactor -- )
@@ -123,7 +123,7 @@ M: interactor stream-read-partial
 
 : go-to-error ( interactor error -- )
     dup parse-error-line 1- swap parse-error-col 2array
-    over [ control-model validate-loc ] keep
+    over [ gadget-model validate-loc ] keep
     editor-caret set-model
     mark>caret ;
 
@@ -156,7 +156,7 @@ M: interactor parse-interactive
 M: interactor pref-dim*
     0 over line-height 4 * 2array swap delegate pref-dim* vmax ;
 
-: clear-input control-model clear-doc ;
+: clear-input gadget-model clear-doc ;
 
 interactor "interactor" f {
     { T{ key-down f f "RET" } evaluate-input }

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

@@ -1,7 +1,7 @@
 USING: continuations documents ui.tools.interactor
 ui.tools.listener hashtables kernel namespaces parser sequences
-timers tools.test ui.commands ui.gadgets.controls
+timers tools.test ui.commands ui.gadgets ui.gadgets.editors
-ui.gadgets.editors ui.gadgets.panes vocabs words ;
+ui.gadgets.panes vocabs words ;
 IN: temporary
 
 timers [ init-timers ] unless
@@ -30,6 +30,6 @@ H{ } "i" get set-interactor-vars
 ] unit-test
 
 [ t ] [
-    "i" get control-model doc-end
+    "i" get gadget-model doc-end
     "i" get editor-caret* =
 ] unit-test

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

@@ -1,6 +1,6 @@
 USING: assocs ui.tools.search help.topics io.files io.styles
 kernel namespaces sequences source-files threads timers
-tools.test ui.gadgets ui.gadgets.controls ui.gestures vocabs
+tools.test ui.gadgets ui.gestures vocabs
 vocabs.loader words ;
 IN: temporary
 

extra/ui/tools/search/search.factor

@@ -4,7 +4,7 @@ USING: assocs ui.tools.interactor ui.tools.listener
 ui.tools.workspace help help.topics io.files io.styles kernel
 models namespaces prettyprint quotations sequences sorting
 source-files strings tools.completion tools.crossref tuples
-ui.commands ui.gadgets ui.gadgets.controls ui.gadgets.editors
+ui.commands ui.gadgets ui.gadgets.editors
 ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks
 ui.gestures ui.operations vocabs words vocabs.loader
 tools.browser ;
@@ -44,7 +44,7 @@ search-field H{
 } set-gestures
 
 : <search-model> ( producer -- model )
-    >r g live-search-field control-model 200 <delay>
+    >r g live-search-field gadget-model 200 <delay>
     [ "\n" join ] r> append <filter> ;
 
 : <search-list> ( seq limited? presenter -- gadget )

extra/ui/tools/tools-tests.factor

@@ -1,13 +1,13 @@
 USING: ui.tools ui.tools.interactor ui.tools.listener
 ui.tools.search ui.tools.workspace kernel models namespaces
 sequences timers tools.test ui.gadgets ui.gadgets.buttons
-ui.gadgets.controls ui.gadgets.labelled ui.gadgets.presentations
+ui.gadgets.labelled ui.gadgets.presentations
 ui.gadgets.scrollers vocabs ;
 IN: temporary
 
 [
     [ f ] [
-        0 <model> <gadget> [ 2drop ] <control> gadget set
+        0 <model> <gadget> [ set-gadget-model ] keep gadget set
         <workspace-tabs> gadget-children empty?
     ] unit-test 
 ] with-scope

extra/ui/tools/tools.factor

@@ -5,7 +5,7 @@ ui.tools.operations ui.tools.browser ui.tools.inspector
 ui.tools.listener ui.tools.profiler ui.tools.walker
 ui.tools.operations inspector io kernel math models namespaces
 prettyprint quotations sequences ui ui.commands ui.gadgets
-ui.gadgets.books ui.gadgets.buttons ui.gadgets.controls
+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 ui.gadgets.buttons
@@ -22,13 +22,13 @@ IN: ui.tools
     } ;
 
 : <workspace-tabs> ( -- tabs )
-    g control-model
+    g gadget-model
     "tool-switching" workspace command-map
     [ command-string ] { } assoc>map <enum> >alist
     <toggle-buttons> ;
 
 : <workspace-book> ( -- gadget )
-    workspace-tabs [ execute ] map g control-model <book> ;
+    workspace-tabs [ execute ] map g gadget-model <book> ;
 
 : <workspace> ( -- workspace )
     0 <model> { 0 1 } <track> workspace construct-control [

extra/ui/tools/traceback/traceback.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: continuations kernel models namespaces prettyprint ui
-ui.commands ui.gadgets ui.gadgets.controls ui.gadgets.labelled
+ui.commands ui.gadgets ui.gadgets.labelled
 ui.gadgets.tracks ui.gestures ;
 IN: ui.tools.traceback
 
@@ -25,10 +25,10 @@ M: traceback-gadget pref-dim* drop { 300 400 } ;
     { 0 1 } <track> traceback-gadget construct-control [
         [
             [
-                g control-model <datastack-display> 1/2 track,
+                g gadget-model <datastack-display> 1/2 track,
-                g control-model <retainstack-display> 1/2 track,
+                g gadget-model <retainstack-display> 1/2 track,
             ] { 1 0 } make-track 1/3 track,
-            g control-model <callstack-display> 2/3 track,
+            g gadget-model <callstack-display> 2/3 track,
         ] with-gadget
     ] keep ;
 

extra/ui/tools/workspace/workspace.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes continuations help help.topics kernel models
 sequences ui ui.backend ui.tools.debugger ui.gadgets
-ui.gadgets.books ui.gadgets.buttons ui.gadgets.controls
+ui.gadgets.books ui.gadgets.buttons
 ui.gadgets.labelled ui.gadgets.panes ui.gadgets.scrollers
 ui.gadgets.tracks ui.gadgets.worlds ui.gadgets.presentations
 ui.gadgets.status-bar ui.commands ui.gestures assocs arrays
@@ -28,7 +28,7 @@ M: gadget tool-scroller drop f ;
     workspace-book gadget-children [ class eq? ] curry* find ;
 
 : show-tool ( class workspace -- tool )
-    [ find-tool swap ] keep workspace-book control-model
+    [ find-tool swap ] keep workspace-book gadget-model
     set-model ;
 
 : select-tool ( workspace class -- ) swap show-tool drop ;