From 208b548909a10795d4dbd806d79c078d2378edcc Mon Sep 17 00:00:00 2001 From: slava Date: Fri, 21 Jul 2006 22:07:26 +0000 Subject: [PATCH] Since other gadgets delegate to the editor gadget, we need to handle this at the control level --- TODO.FACTOR.txt | 3 ++ library/ui/gadgets/controls.factor | 17 +++++++---- library/ui/text/commands.factor | 11 +++---- library/ui/text/editor.factor | 48 ++++++++++++++---------------- library/ui/text/field.factor | 13 ++++---- library/ui/text/interactor.factor | 7 +++-- 6 files changed, 54 insertions(+), 45 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 0938546941..227d063448 100644 --- a/TODO.FACTOR.txt +++ b/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 diff --git a/library/ui/gadgets/controls.factor b/library/ui/gadgets/controls.factor index 2ee4fd4d06..fd9bd42f58 100644 --- a/library/ui/gadgets/controls.factor +++ b/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 - dup model-changed ; + [ set-control-model ] keep ; 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 -- ) + [ drop ] swap set-gadget-delegate ; diff --git a/library/ui/text/commands.factor b/library/ui/text/commands.factor index 2c32669fc9..74fdf70f80 100644 --- a/library/ui/text/commands.factor +++ b/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 - r> call r> editor-document remove-doc-range ; inline + over >r >r dup editor-caret* swap control-model + 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 ] } diff --git a/library/ui/text/editor.factor b/library/ui/text/editor.factor index 40626bbd2e..5f3a6fe781 100644 --- a/library/ui/text/editor.factor +++ b/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-theme io kernel math models namespaces opengl sequences -strings styles ; +gadgets-buttons gadgets-controls gadgets-frames gadgets-labels +gadgets-scrolling gadgets-theme io kernel math models namespaces +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 over editor-caret add-connection dup swap editor-mark add-connection ; C: editor ( document -- editor ) - dup delegate>gadget - over set-editor-document + dup delegate>control { 0 0 } over set-editor-caret { 0 0 } 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 editor-caret activate-editor-model - dup editor-mark activate-editor-model ; + dup dup editor-caret activate-editor-model + dup dup editor-mark activate-editor-model + dup control-self swap control-model add-connection ; M: editor ungraft* ( editor -- ) - dup - dup editor-caret deactivate-editor-model - dup editor-mark deactivate-editor-model ; + dup dup editor-caret deactivate-editor-model + dup 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> - [ editor-document validate-loc ] keep + over >r >r dup editor-caret* swap control-model r> call r> + [ 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 ; diff --git a/library/ui/text/field.factor b/library/ui/text/field.factor index 482a799b18..2a5c9ff066 100644 --- a/library/ui/text/field.factor +++ b/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 ) 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 diff --git a/library/ui/text/interactor.factor b/library/ui/text/interactor.factor index 285fee4965..0d6f4e77a6 100644 --- a/library/ui/text/interactor.factor +++ b/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 -styles threads ; +USING: gadgets gadgets-controls gadgets-panes io kernel +namespaces prettyprint styles threads ; TUPLE: interactor output continuation ; C: interactor ( output -- gadget ) [ set-interactor-output ] keep - f over set-gadget-delegate ; + f over set-gadget-delegate + dup dup set-control-self ; : interactor-eval ( string gadget -- ) interactor-continuation dup