From 660bb25d45cf4da5645244d50360f77664a5416f Mon Sep 17 00:00:00 2001 From: slava Date: Sat, 22 Jul 2006 09:11:19 +0000 Subject: [PATCH] Various UI changes --- TODO.FACTOR.txt | 6 +- library/kernel.factor | 1 + library/ui/gadgets/controls.factor | 2 +- library/ui/gadgets/panes.factor | 7 ++- library/ui/text/commands.factor | 93 +++++++++++++----------------- library/ui/text/document.factor | 66 +++++++++++++++++---- library/ui/text/editor.factor | 11 +--- library/ui/text/interactor.factor | 2 +- library/ui/tools/launchpad.factor | 2 - library/ui/tools/listener.factor | 8 +-- 10 files changed, 112 insertions(+), 86 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index c85b9cb8f7..53887d62eb 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -7,13 +7,11 @@ - scroll to caret - only redraw visible lines - clicking input doesn't resize editor gadget - - 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 - +- one-column table doesn't need borders...? + - httpd search tools - remaining HTML issues need fixing diff --git a/library/kernel.factor b/library/kernel.factor index 9593774ce2..6c2f266177 100644 --- a/library/kernel.factor +++ b/library/kernel.factor @@ -25,6 +25,7 @@ M: object clone ; : >boolean t f ? ; inline : and ( a b -- a&b ) f ? ; inline : or ( a b -- a|b ) t swap ? ; inline +: xor ( a b -- a^b ) [ not ] when ; inline : cpu ( -- arch ) 7 getenv ; foldable : os ( -- os ) 11 getenv ; foldable diff --git a/library/ui/gadgets/controls.factor b/library/ui/gadgets/controls.factor index fd9bd42f58..07062918f1 100644 --- a/library/ui/gadgets/controls.factor +++ b/library/ui/gadgets/controls.factor @@ -24,4 +24,4 @@ M: control model-changed ( gadget -- ) control-self relayout ; : delegate>control ( gadget model -- ) - [ drop ] swap set-gadget-delegate ; + [ 2drop ] swap set-gadget-delegate ; diff --git a/library/ui/gadgets/panes.factor b/library/ui/gadgets/panes.factor index 3f03a8bf6e..4f6b8ea93e 100644 --- a/library/ui/gadgets/panes.factor +++ b/library/ui/gadgets/panes.factor @@ -41,10 +41,15 @@ C: pane ( -- pane ) [ pick pick pane-current stream-format ] [ dup stream-terpri ] interleave 2drop ; -: write-gadget ( gadget pane -- ) +GENERIC: write-gadget ( gadget stream -- ) + +M: pane write-gadget ( gadget pane -- ) #! Print a gadget to the given pane. pane-current add-gadget ; +M: duplex-stream write-gadget ( gadget stream -- ) + duplex-stream-out write-gadget ; + : print-gadget ( gadget pane -- ) tuck write-gadget stream-terpri ; diff --git a/library/ui/text/commands.factor b/library/ui/text/commands.factor index 74fdf70f80..87b939901c 100644 --- a/library/ui/text/commands.factor +++ b/library/ui/text/commands.factor @@ -23,23 +23,19 @@ sequences ; : editor-cut ( editor clipboard -- ) dupd editor-copy remove-editor-selection ; -: remove-at-caret ( editor quot -- | quot: caret editor -- from to ) - over >r >r dup editor-caret* swap control-model - r> call r> control-model remove-doc-range ; inline - -: editor-delete ( editor -- ) - dup editor-selection? [ - remove-editor-selection +: delete/backspace ( elt editor quot -- | quot: caret editor -- from to ) + over editor-selection? [ + drop nip remove-editor-selection ] [ - [ dupd T{ char-elt } next-elt ] remove-at-caret - ] if ; + over >r >r dup editor-caret* swap control-model + r> call r> control-model remove-doc-range + ] if ; inline -: editor-backspace ( editor -- ) - dup editor-selection? [ - remove-editor-selection - ] [ - [ dupd T{ char-elt } prev-elt swap ] remove-at-caret - ] if ; +: editor-delete ( editor elt -- ) + swap [ over >r rot next-elt r> swap ] delete/backspace ; + +: editor-backspace ( editor elt -- ) + swap [ over >r rot prev-elt r> ] delete/backspace ; : editor-select-prev ( editor elt -- ) swap [ rot prev-elt ] change-caret ; @@ -53,33 +49,14 @@ sequences ; : editor-next ( editor elt -- ) dupd editor-select-next mark>caret ; -: editor-select-home ( editor -- ) - [ drop 0 swap =col ] change-caret ; +: editor-select ( from to editor -- ) + tuck editor-caret set-model editor-mark set-model ; -: editor-home ( editor -- ) - dup editor-select-home mark>caret ; - -: editor-select-doc-home ( editor -- ) - { 0 0 } swap editor-caret set-model ; - -: editor-doc-home ( editor -- ) - editor-select-doc-home mark>caret ; - -: editor-select-end ( editor -- ) - [ >r first r> line-end ] change-caret ; - -: editor-end ( editor -- ) - dup editor-select-end mark>caret ; - -: editor-select-doc-end ( editor -- ) - 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 control-model doc-end swap editor-mark set-model ; +: select-elt ( editor elt -- ) + over >r + >r dup editor-caret* swap control-model r> + 3dup next-elt >r prev-elt r> + r> editor-select ; editor H{ { T{ button-down } [ editor-mouse-down ] } @@ -92,7 +69,9 @@ editor H{ { T{ button-up } [ selection get editor-copy ] } { T{ cut-action } [ clipboard get editor-cut ] } { T{ delete-action } [ remove-editor-selection ] } - { T{ select-all-action } [ editor-select-all ] } + { T{ select-all-action } [ T{ doc-elt } select-elt ] } + { T{ key-down f { C+ } "l" } [ T{ one-line-elt } select-elt ] } + { T{ key-down f { C+ } "w" } [ T{ word-elt } select-elt ] } { T{ key-down f f "LEFT" } [ T{ char-elt } editor-prev ] } { T{ key-down f f "RIGHT" } [ T{ char-elt } editor-next ] } { T{ key-down f f "UP" } [ T{ line-elt } editor-prev ] } @@ -101,16 +80,22 @@ editor H{ { T{ key-down f { S+ } "RIGHT" } [ T{ char-elt } editor-select-next ] } { T{ key-down f { S+ } "UP" } [ T{ line-elt } editor-select-prev ] } { T{ key-down f { S+ } "DOWN" } [ T{ line-elt } editor-select-next ] } - { T{ key-down f f "HOME" } [ editor-home ] } - { T{ key-down f f "END" } [ editor-end ] } - { T{ key-down f { S+ } "HOME" } [ editor-select-home ] } - { T{ key-down f { S+ } "END" } [ editor-select-end ] } - { T{ key-down f { S+ } "HOME" } [ editor-select-home ] } - { T{ key-down f { S+ } "END" } [ editor-select-end ] } - { T{ key-down f { C+ } "HOME" } [ editor-doc-home ] } - { T{ key-down f { C+ } "END" } [ editor-doc-end ] } - { T{ key-down f { C+ S+ } "HOME" } [ editor-select-doc-home ] } - { T{ key-down f { C+ S+ } "END" } [ editor-select-doc-end ] } - { T{ key-down f f "DELETE" } [ editor-delete ] } - { T{ key-down f f "BACKSPACE" } [ editor-backspace ] } + { T{ key-down f { C+ } "LEFT" } [ T{ word-elt } editor-prev ] } + { T{ key-down f { C+ } "RIGHT" } [ T{ word-elt } editor-next ] } + { T{ key-down f { S+ C+ } "LEFT" } [ T{ word-elt } editor-select-prev ] } + { T{ key-down f { S+ C+ } "RIGHT" } [ T{ word-elt } editor-select-next ] } + { T{ key-down f f "HOME" } [ T{ one-line-elt } editor-prev ] } + { T{ key-down f f "END" } [ T{ one-line-elt } editor-next ] } + { T{ key-down f { S+ } "HOME" } [ T{ one-line-elt } editor-select-prev ] } + { T{ key-down f { S+ } "END" } [ T{ one-line-elt } editor-select-next ] } + { T{ key-down f { C+ } "HOME" } [ T{ doc-elt } editor-prev ] } + { T{ key-down f { C+ } "END" } [ T{ doc-elt } editor-next ] } + { T{ key-down f { C+ S+ } "HOME" } [ T{ doc-elt } editor-select-prev ] } + { T{ key-down f { C+ S+ } "END" } [ T{ doc-elt } editor-select-next ] } + { T{ key-down f f "DELETE" } [ T{ char-elt } editor-delete ] } + { T{ key-down f f "BACKSPACE" } [ T{ char-elt } editor-backspace ] } + { T{ key-down f { C+ } "DELETE" } [ T{ word-elt } editor-delete ] } + { T{ key-down f { C+ } "BACKSPACE" } [ T{ word-elt } editor-backspace ] } + { T{ key-down f { A+ } "DELETE" } [ T{ one-line-elt } editor-delete ] } + { T{ key-down f { A+ } "BACKSPACE" } [ T{ one-line-elt } editor-backspace ] } } set-gestures diff --git a/library/ui/text/document.factor b/library/ui/text/document.factor index b50d08040f..d41c741eb1 100644 --- a/library/ui/text/document.factor +++ b/library/ui/text/document.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-text USING: arrays generic io kernel math models namespaces sequences -test ; +strings test ; : +col ( loc n -- loc ) >r first2 r> + 2array ; @@ -128,31 +128,75 @@ GENERIC: next-elt ( loc document elt -- loc ) TUPLE: char-elt ; -M: char-elt prev-elt - drop { +: (prev-char) ( loc document quot -- loc ) + -rot { { [ over { 0 0 } = ] [ drop ] } { [ over second zero? ] [ >r first 1- r> line-end ] } - { [ t ] [ drop -1 +col ] } - } cond ; + { [ t ] [ pick call ] } + } cond nip ; inline -M: char-elt next-elt - drop { +: (next-char) ( loc document quot -- loc ) + -rot { { [ 2dup doc-end = ] [ drop ] } { [ 2dup line-end? ] [ drop first 1+ 0 2array ] } - { [ t ] [ drop 1 +col ] } - } cond ; + { [ t ] [ pick call ] } + } cond nip ; inline + +M: char-elt prev-elt + drop [ drop -1 +col ] (prev-char) ; + +M: char-elt next-elt + drop [ drop 1 +col ] (next-char) ; + +TUPLE: word-elt ; + +: (word-elt) ( loc document quot -- loc ) + pick >r + >r >r first2 swap r> doc-line r> call + r> =col ; inline + +: ((word-elt)) [ ?nth blank? ] 2keep ; + +: (prev-word) ( col str -- col ) + >r 1- r> ((word-elt)) + [ blank? xor ] find-last-with* drop 1+ ; + +M: word-elt prev-elt + drop [ [ (prev-word) ] (word-elt) ] (prev-char) ; + +: (next-word) ( col str -- col ) + ((word-elt)) + [ [ blank? xor ] find-with* drop ] keep + over -1 = [ nip length ] [ drop ] if ; + +M: word-elt next-elt + drop [ [ (next-word) ] (word-elt) ] (next-char) ; + +TUPLE: one-line-elt ; + +M: one-line-elt prev-elt + 2drop first 0 2array ; +M: one-line-elt next-elt + drop >r first dup r> doc-line length 2array ; TUPLE: line-elt ; M: line-elt prev-elt 2drop -1 +line ; M: line-elt next-elt 2drop 1 +line ; +TUPLE: doc-elt ; + +M: doc-elt prev-elt 3drop { 0 0 } ; +M: doc-elt next-elt drop nip doc-end ; + : doc-text ( document -- str ) model-value "\n" join ; +: set-doc-lines ( seq document -- ) + [ set-model ] keep dup doc-end swap update-locs ; + : set-doc-text ( string document -- ) - [ >r "\n" split r> set-model ] keep - dup doc-end swap update-locs ; + >r "\n" split r> set-doc-lines ; : clear-doc ( document -- ) "" swap set-doc-text ; diff --git a/library/ui/text/editor.factor b/library/ui/text/editor.factor index 5f3a6fe781..ad4a1d8a52 100644 --- a/library/ui/text/editor.factor +++ b/library/ui/text/editor.factor @@ -11,18 +11,13 @@ font color caret-color selection-color caret mark focused? ; -TUPLE: action-relayout-1 editor ; - -M: action-relayout-1 model-changed - #! Caret changed - action-relayout-1-editor control-self relayout-1 ; - : init-editor-models ( editor -- ) - dup over editor-caret add-connection - dup swap editor-mark add-connection ; + dup control-self over editor-caret add-connection + dup control-self swap editor-mark add-connection ; 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 diff --git a/library/ui/text/interactor.factor b/library/ui/text/interactor.factor index 0d6f4e77a6..057ac869c3 100644 --- a/library/ui/text/interactor.factor +++ b/library/ui/text/interactor.factor @@ -39,7 +39,7 @@ SYMBOL: structured-input interactor H{ { T{ key-down f f "RETURN" } [ interactor-commit ] } - { T{ key-down f { C+ } "l" } [ interactor-output pane-clear ] } + { T{ key-down f { C+ } "b" } [ interactor-output pane-clear ] } { T{ key-down f { C+ } "d" } [ f swap interactor-eval ] } } set-gestures diff --git a/library/ui/tools/launchpad.factor b/library/ui/tools/launchpad.factor index 8e15ed5d83..08ad05e175 100644 --- a/library/ui/tools/launchpad.factor +++ b/library/ui/tools/launchpad.factor @@ -29,9 +29,7 @@ prettyprint sequences words ; { { "Listener" [ listener-window ] } { "Browser" [ browser-window ] } - { "Apropos" [ apropos-window ] } { "Documentation" [ handbook-window ] } - { "Search help" [ search-help-window ] } { "Globals" [ globals-window ] } { "Memory" [ memory-window ] } { "Save image" [ save ] } diff --git a/library/ui/tools/listener.factor b/library/ui/tools/listener.factor index 42eb8c4e09..d5d697bca3 100644 --- a/library/ui/tools/listener.factor +++ b/library/ui/tools/listener.factor @@ -31,7 +31,7 @@ TUPLE: listener-gadget input output stack ; >r r> f ; : ( model title -- gadget ) - [ stack. ] swap ; + [ [ 32 margin set stack. ] with-scope ] swap ; : ( listener -- gadget ) listener-gadget-input "Input" f ; @@ -41,8 +41,8 @@ TUPLE: listener-gadget input output stack ; : ( listener -- gadget ) dup { - { [ ] f f 1/2 } - { [ ] f f 1/2 } + { [ ] f f 2/3 } + { [ ] f f 1/3 } } { 1 0 } make-track ; : init-listener ( listener -- ) @@ -58,7 +58,7 @@ C: listener-gadget ( -- gadget ) } { 0 1 } make-track* dup start-listener ; M: listener-gadget pref-dim* - delegate pref-dim* { 600 600 } vmax ; + delegate pref-dim* { 700 500 } vmax ; M: listener-gadget focusable-child* ( listener -- gadget ) listener-gadget-input ;