From 1a8058a8bd2999ffae75cb9b4ee6474cdde7e8d2 Mon Sep 17 00:00:00 2001 From: slava Date: Tue, 25 Jul 2006 04:14:59 +0000 Subject: [PATCH] Improved UI listener and editor --- library/ui/models.factor | 19 +++++++++++++++---- library/ui/text/commands.factor | 4 ++++ library/ui/text/document.factor | 11 +++++++++++ library/ui/text/editor.factor | 26 +++++++++++++++++--------- library/ui/text/field.factor | 5 +++-- library/ui/text/interactor.factor | 13 +++++++------ library/ui/tools/listener.factor | 28 ++++++++++------------------ 7 files changed, 67 insertions(+), 39 deletions(-) diff --git a/library/ui/models.factor b/library/ui/models.factor index 14f9112180..8149bb01c3 100644 --- a/library/ui/models.factor +++ b/library/ui/models.factor @@ -63,8 +63,14 @@ M: model set-model ( value model -- ) : set-model* ( value model -- ) 2dup model-value = [ 2drop ] [ set-model ] if ; +: ((change-model)) ( model quot -- newvalue model ) + over >r >r model-value r> call r> ; inline + : change-model ( model quot -- ) - over >r >r model-value r> call r> set-model ; inline + ((change-model)) set-model ; inline + +: (change-model) ( model quot -- ) + ((change-model)) set-model-value ; inline : delegate>model ( obj -- ) f swap set-delegate ; @@ -127,8 +133,11 @@ C: history ( value -- history ) V{ } clone over set-history-back V{ } clone over set-history-forward ; -: (add-history) ( history vector -- ) - swap model-value dup [ swap push ] [ 2drop ] if ; +G: (add-history) ( history vector -- ) + 1 standard-combination ; + +M: history (add-history) ( history vector -- ) + swap model-value [ 2drop ] [ swap push ] if ; : go-back/forward ( history to from -- ) dup empty? @@ -141,6 +150,8 @@ C: history ( value -- history ) : go-forward ( history -- ) dup history-back over history-forward go-back/forward ; -: add-history ( history -- ) +GENERIC: add-history ( history -- ) + +M: history add-history ( history -- ) 0 over history-forward set-length dup history-back (add-history) ; diff --git a/library/ui/text/commands.factor b/library/ui/text/commands.factor index 4231a2f0c3..efaebcd7d7 100644 --- a/library/ui/text/commands.factor +++ b/library/ui/text/commands.factor @@ -58,7 +58,11 @@ sequences ; 3dup next-elt >r prev-elt r> r> editor-select ; +: select-all ( editor -- ) T{ doc-elt } select-elt ; + editor H{ + { T{ key-down f f "RETURN" } [ "\n" swap user-input ] } + { T{ key-down f { S+ } "RETURN" } [ "\n" swap user-input ] } { T{ button-down } [ editor-mouse-down ] } { T{ drag } [ editor-mouse-drag ] } { T{ gain-focus } [ focus-editor ] } diff --git a/library/ui/text/document.factor b/library/ui/text/document.factor index 138f611baf..98a0bfb6d6 100644 --- a/library/ui/text/document.factor +++ b/library/ui/text/document.factor @@ -127,3 +127,14 @@ C: document ( -- document ) : clear-doc ( document -- ) "" swap set-doc-text ; + +M: document (add-history) ( document vector -- ) + >r model-value dup { "" } sequence= + [ r> 2drop ] [ r> push-new ] if ; + +M: document add-history ( document -- ) + #! Add the new entry at the end of the history, and avoid + #! duplicates. + dup history-back dup + pick history-forward nappend + (add-history) ; diff --git a/library/ui/text/editor.factor b/library/ui/text/editor.factor index 9a70d18782..900b62e0de 100644 --- a/library/ui/text/editor.factor +++ b/library/ui/text/editor.factor @@ -11,16 +11,22 @@ font color caret-color selection-color caret mark focused? ; -: init-editor-models ( editor -- ) - dup control-self over editor-caret add-connection - dup control-self swap editor-mark add-connection ; +TUPLE: loc-monitor editor ; + +M: loc-monitor model-changed ( obj -- ) + loc-monitor-editor control-self relayout-1 ; + +: ( editor -- loc ) + { 0 0 } [ add-connection ] keep ; + +: init-editor-locs ( editor -- ) + dup over set-editor-caret + dup swap set-editor-mark ; C: editor ( document -- editor ) dup delegate>control dup dup set-control-self - { 0 0 } over set-editor-caret - { 0 0 } over set-editor-mark - dup init-editor-models + dup init-editor-locs dup editor-theme ; : activate-editor-model ( editor model -- ) @@ -40,14 +46,16 @@ M: editor ungraft* ( editor -- ) dup control-self swap control-model remove-connection ; M: editor model-changed ( editor -- ) - #! Document changed - control-self relayout ; + control-self dup control-model + over editor-caret [ over validate-loc ] (change-model) + over editor-mark [ over validate-loc ] (change-model) + drop relayout ; : editor-caret* editor-caret model-value ; : editor-mark* editor-mark model-value ; -: change-caret ( editor quot -- ) +: change-caret ( editor quot -- | quot: caret doc -- caret ) over >r >r dup editor-caret* swap control-model r> call r> [ control-model validate-loc ] keep editor-caret set-model ; inline diff --git a/library/ui/text/field.factor b/library/ui/text/field.factor index 8173f08438..cd5c88b9b9 100644 --- a/library/ui/text/field.factor +++ b/library/ui/text/field.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-text -USING: gadgets gadgets-controls generic kernel models ; +USING: gadgets gadgets-controls generic kernel models sequences ; TUPLE: field model quot ; @@ -19,7 +19,8 @@ C: field ( model quot -- field ) [ editor-text ] keep dup field-model [ dupd set-model ] when* dup field-quot [ dupd call ] when* - control-model dup add-history clear-doc ; + dup control-model add-history + select-all ; field H{ { T{ key-down f { C+ } "p" } [ field-prev ] } diff --git a/library/ui/text/interactor.factor b/library/ui/text/interactor.factor index 272d17f60e..63ee1daa84 100644 --- a/library/ui/text/interactor.factor +++ b/library/ui/text/interactor.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-text -USING: gadgets gadgets-controls gadgets-panes io kernel -namespaces prettyprint styles threads ; +USING: gadgets gadgets-controls gadgets-panes hashtables help io +kernel namespaces prettyprint styles threads ; TUPLE: interactor output continuation ; @@ -27,14 +27,15 @@ SYMBOL: structured-input : print-input ( string interactor -- ) interactor-output [ - dup [ - presented set - bold font-style set - ] make-hash format terpri + H{ { font-style bold } } [ + dup presented associate + [ write ] with-nesting terpri + ] with-style ] with-stream* ; : interactor-commit ( gadget -- ) dup field-commit + over control-model clear-doc swap 2dup print-input interactor-eval ; interactor H{ diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor index d5d697bca3..d97dfac2df 100644 --- a/library/ui/tools/listener.factor +++ b/library/ui/tools/listener.factor @@ -31,34 +31,26 @@ TUPLE: listener-gadget input output stack ; >r r> f ; : ( model title -- gadget ) - [ [ 32 margin set stack. ] with-scope ] swap ; + [ stack. ] swap ; -: ( listener -- gadget ) - listener-gadget-input "Input" f ; +: ( -- gadget ) + gadget get listener-gadget-output ; -: ( listener -- gadget ) - listener-gadget-stack "Stack" ; - -: ( listener -- gadget ) - dup { - { [ ] f f 2/3 } - { [ ] f f 1/3 } - } { 1 0 } make-track ; +: ( -- gadget ) + gadget get listener-gadget-stack "Stack" ; : init-listener ( listener -- ) - f over set-listener-gadget-stack - over set-listener-gadget-output - dup listener-gadget-output - swap set-listener-gadget-input ; + f swap set-listener-gadget-stack ; C: listener-gadget ( -- gadget ) dup init-listener { - { [ gadget get listener-gadget-output ] f f 5/6 } - { [ gadget get ] f f 1/6 } + { [ ] set-listener-gadget-output [ ] 4/6 } + { [ ] f f 1/6 } + { [ ] set-listener-gadget-input [ ] 1/6 } } { 0 1 } make-track* dup start-listener ; M: listener-gadget pref-dim* - delegate pref-dim* { 700 500 } vmax ; + delegate pref-dim* { 500 600 } vmax ; M: listener-gadget focusable-child* ( listener -- gadget ) listener-gadget-input ;