Since other gadgets delegate to the editor gadget, we need to handle this at the control level

TODO.FACTOR.txt

@@ -10,6 +10,8 @@
   - bug after removing all lines
   - word-at-a-time commands
   - deleting words, lines
+  - better listener multi-line expression handling
+  - stack display: trim at 32 columns
 - shift modifier not delivered
 - x11 copy to clipboard
   
@@ -43,6 +45,7 @@
 - add some handy services:
   - base conversion
   - search help for selection
+- make factor a services client
 - services do not launch if factor not running
 - grid slows down with 2000 lines
 - integrated error documentation

library/ui/gadgets/controls.factor

@@ -3,20 +3,25 @@
 IN: gadgets-controls
 USING: gadgets kernel models ;
 
-TUPLE: control model quot ;
+TUPLE: control self model quot ;
 
 C: control ( model gadget quot -- gadget )
+    dup dup set-control-self
     [ set-control-quot ] keep
     [ set-gadget-delegate ] keep
-    [ set-control-model ] keep
+    [ set-control-model ] keep ;
-    dup model-changed ;
 
 M: control graft*
-    dup control-model add-connection ;
+    dup control-self over control-model add-connection
+    model-changed ;
 
 M: control ungraft*
-    dup control-model remove-connection ;
+    dup control-self swap control-model remove-connection ;
 
 M: control model-changed ( gadget -- )
     [ control-model model-value ] keep
-    [ dup control-quot call ] keep relayout ;
+    [ dup control-self swap control-quot call ] keep
+    control-self relayout ;
+
+: delegate>control ( gadget model -- )
+    <gadget> [ drop ] <control> swap set-gadget-delegate ;

library/ui/text/commands.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-text
-USING: gadgets kernel models namespaces sequences ;
+USING: gadgets gadgets-controls kernel models namespaces
+sequences ;
 
 : editor-mouse-down ( editor -- )
     dup request-focus
@@ -23,8 +24,8 @@ USING: gadgets kernel models namespaces sequences ;
     dupd editor-copy remove-editor-selection ;
 
 : remove-at-caret ( editor quot -- | quot: caret editor -- from to )
-    over >r >r dup editor-caret* swap editor-document
+    over >r >r dup editor-caret* swap control-model
-    r> call r> editor-document remove-doc-range ; inline
+    r> call r> control-model remove-doc-range ; inline
 
 : editor-delete ( editor -- )
     dup editor-selection? [
@@ -71,14 +72,14 @@ USING: gadgets kernel models namespaces sequences ;
     dup editor-select-end mark>caret ;
 
 : editor-select-doc-end ( editor -- )
-    dup editor-document doc-end swap editor-caret set-model ;
+    dup control-model doc-end swap editor-caret set-model ;
 
 : editor-doc-end ( editor -- )
     editor-select-doc-end mark>caret ;
 
 : editor-select-all ( editor -- )
     { 0 0 } over editor-caret set-model
-    dup editor-document doc-end swap editor-mark set-model ;
+    dup control-model doc-end swap editor-mark set-model ;
 
 editor H{
     { T{ button-down } [ editor-mouse-down ] }

library/ui/text/editor.factor

@@ -2,12 +2,11 @@
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-text
 USING: arrays errors freetype gadgets gadgets-borders
-gadgets-buttons gadgets-frames gadgets-labels gadgets-scrolling
+gadgets-buttons gadgets-controls gadgets-frames gadgets-labels
-gadgets-theme io kernel math models namespaces opengl sequences
+gadgets-scrolling gadgets-theme io kernel math models namespaces
-strings styles ;
+opengl sequences strings styles ;
 
 TUPLE: editor
-document
 font color caret-color selection-color
 caret mark
 focused? ;
@@ -16,47 +15,46 @@ TUPLE: action-relayout-1 editor ;
 
 M: action-relayout-1 model-changed
     #! Caret changed
-    action-relayout-1-editor relayout-1 ;
+    action-relayout-1-editor control-self relayout-1 ;
 
 : init-editor-models ( editor -- )
     dup <action-relayout-1> over editor-caret add-connection
     dup <action-relayout-1> swap editor-mark add-connection ;
 
 C: editor ( document -- editor )
-    dup delegate>gadget
+    dup <document> delegate>control
-    <document> over set-editor-document
     { 0 0 } <model> over set-editor-caret
     { 0 0 } <model> over set-editor-mark
     dup init-editor-models
     dup editor-theme ;
 
 : activate-editor-model ( editor model -- )
-    dup activate-model swap editor-document add-loc ;
+    dup activate-model swap control-model add-loc ;
 
 : deactivate-editor-model ( editor model -- )
-    dup deactivate-model swap editor-document remove-loc ;
+    dup deactivate-model swap control-model remove-loc ;
 
 M: editor graft* ( editor -- )
-    dup
+    dup dup editor-caret activate-editor-model
-    dup editor-caret activate-editor-model
+    dup dup editor-mark activate-editor-model
-    dup editor-mark activate-editor-model ;
+    dup control-self swap control-model add-connection ;
 
 M: editor ungraft* ( editor -- )
-    dup
+    dup dup editor-caret deactivate-editor-model
-    dup editor-caret deactivate-editor-model
+    dup dup editor-mark deactivate-editor-model
-    dup editor-mark deactivate-editor-model ;
+    dup control-self swap control-model remove-connection ;
 
 M: editor model-changed ( editor -- )
     #! Document changed
-    relayout ;
+    control-self relayout ;
 
 : editor-caret* editor-caret model-value ;
 
 : editor-mark* editor-mark model-value ;
 
 : change-caret ( editor quot -- )
-    over >r >r dup editor-caret* swap editor-document r> call r>
+    over >r >r dup editor-caret* swap control-model r> call r>
-    [ editor-document validate-loc ] keep
+    [ control-model validate-loc ] keep
     editor-caret set-model ; inline
 
 : mark>caret ( editor -- )
@@ -66,7 +64,7 @@ M: editor model-changed ( editor -- )
     over >r change-caret r> mark>caret ; inline
 
 : editor-lines ( editor -- seq )
-    editor-document model-value ;
+    control-model model-value ;
 
 : editor-line ( n editor -- str ) editor-lines nth ;
 
@@ -132,7 +130,7 @@ M: editor model-changed ( editor -- )
 
 : with-editor ( editor quot -- )
     [
-        swap dup editor-document document set editor set call
+        swap dup control-model document set editor set call
     ] with-scope ; inline
 
 : draw-lines ( editor -- )
@@ -189,17 +187,17 @@ M: editor pref-dim* ( editor -- dim )
     selection-start/end = not ;
 
 : editor-selection ( editor -- str )
-    [ selection-start/end ] keep editor-document doc-range ;
+    [ selection-start/end ] keep control-model doc-range ;
 
 : remove-editor-selection ( editor -- )
-    [ selection-start/end ] keep editor-document
+    [ selection-start/end ] keep control-model
     remove-doc-range ;
 
 M: editor user-input* ( str editor -- ? )
-    [ selection-start/end ] keep editor-document set-doc-range t ;
+    [ selection-start/end ] keep control-model set-doc-range t ;
 
 : editor-text ( editor -- str )
-    editor-document doc-text ;
+    control-model doc-text ;
 
 : set-editor-text ( str editor -- )
-    editor-document set-doc-text ;
+    control-model set-doc-text ;

library/ui/text/field.factor

@@ -1,26 +1,27 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-text
-USING: gadgets generic kernel models ;
+USING: gadgets gadgets-controls generic kernel models ;
 
 TUPLE: field model ;
 
 C: field ( model -- field )
     <editor> over set-delegate
-    [ set-field-model ] keep ;
+    [ set-field-model ] keep
+    dup dup set-control-self ;
 
-: field-prev editor-document go-back ;
+: field-prev control-model go-back ;
 
-: field-next editor-document go-forward ;
+: field-next control-model go-forward ;
 
 : field-commit ( field -- string )
     [ editor-text ] keep
     dup field-model [ dupd set-model ] when*
-    editor-document dup add-history clear-doc ;
+    control-model dup add-history clear-doc ;
 
 field H{
     { T{ key-down f { C+ } "p" } [ field-prev ] }
     { T{ key-down f { C+ } "n" } [ field-next ] }
-    { T{ key-down f { C+ } "k" } [ editor-document clear-doc ] }
+    { T{ key-down f { C+ } "k" } [ control-model clear-doc ] }
     { T{ key-down f f "RETURN" } [ field-commit drop ] }
 } set-gestures

library/ui/text/interactor.factor

@@ -1,14 +1,15 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-text
-USING: gadgets gadgets-panes io kernel namespaces prettyprint
+USING: gadgets gadgets-controls gadgets-panes io kernel
-styles threads ;
+namespaces prettyprint styles threads ;
 
 TUPLE: interactor output continuation ;
 
 C: interactor ( output -- gadget )
     [ set-interactor-output ] keep
-    f <field> over set-gadget-delegate ;
+    f <field> over set-gadget-delegate
+    dup dup set-control-self ;
 
 : interactor-eval ( string gadget -- )
     interactor-continuation dup