Field gadget adds history to multi-line editor, better handling of gestures
slava
parent
059e207cf1
commit
9e1d22c150
|
|
@ -202,6 +202,8 @@ sequences vectors words ;
|
|||
"/library/ui/gadgets/outliner.factor"
|
||||
"/library/ui/text/document.factor"
|
||||
"/library/ui/text/editor.factor"
|
||||
"/library/ui/text/commands.factor"
|
||||
"/library/ui/text/field.factor"
|
||||
"/library/ui/ui.factor"
|
||||
"/library/ui/gadgets/presentations.factor"
|
||||
"/library/ui/tools/listener.factor"
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
IN: gadgets-buttons
|
||||
USING: gadgets gadgets-borders gadgets-controls gadgets-labels
|
||||
gadgets-theme generic io kernel math models namespaces sequences
|
||||
strings styles threads ;
|
||||
strings styles threads words ;
|
||||
|
||||
TUPLE: button rollover? pressed? selected? quot ;
|
||||
|
||||
|
|
@ -28,13 +28,12 @@ TUPLE: button rollover? pressed? selected? quot ;
|
|||
: button-clicked ( button -- )
|
||||
dup button-quot if-clicked ;
|
||||
|
||||
M: button gadget-gestures
|
||||
drop H{
|
||||
{ T{ button-up } [ button-clicked ] }
|
||||
{ T{ button-down } [ button-update ] }
|
||||
{ T{ mouse-leave } [ button-update ] }
|
||||
{ T{ mouse-enter } [ button-update ] }
|
||||
} ;
|
||||
button H{
|
||||
{ T{ button-up } [ button-clicked ] }
|
||||
{ T{ button-down } [ button-update ] }
|
||||
{ T{ mouse-leave } [ button-update ] }
|
||||
{ T{ mouse-enter } [ button-update ] }
|
||||
} set-gestures
|
||||
|
||||
GENERIC: >label ( obj -- gadget )
|
||||
M: string >label <label> ;
|
||||
|
|
@ -61,13 +60,10 @@ C: button ( gadget quot -- button )
|
|||
|
||||
TUPLE: repeat-button ;
|
||||
|
||||
M: repeat-button gadget-gestures
|
||||
drop H{
|
||||
{ T{ button-down } [ repeat-button-down ] }
|
||||
{ T{ button-up } [ repeat-button-up ] }
|
||||
{ T{ mouse-leave } [ button-update ] }
|
||||
{ T{ mouse-enter } [ button-update ] }
|
||||
} ;
|
||||
repeat-button H{
|
||||
{ T{ button-down } [ repeat-button-down ] }
|
||||
{ T{ button-up } [ repeat-button-up ] }
|
||||
} set-gestures
|
||||
|
||||
C: repeat-button ( gadget quot -- button )
|
||||
#! Button that calls the quotation every 100ms as long as
|
||||
|
|
|
|||
|
|
@ -55,27 +55,26 @@ TUPLE: editor line caret font color ;
|
|||
: click-editor ( editor -- )
|
||||
dup hand-click-rel first over set-caret-x request-focus ;
|
||||
|
||||
M: editor gadget-gestures
|
||||
drop H{
|
||||
{ T{ button-down } [ click-editor ] }
|
||||
{ T{ gain-focus } [ editor-caret show-gadget ] }
|
||||
{ T{ lose-focus } [ editor-caret hide-gadget ] }
|
||||
{ T{ key-down f f "BACKSPACE" } [ [ T{ char-elt } delete-prev-elt ] with-editor ] }
|
||||
{ T{ key-down f f "DELETE" } [ [ T{ char-elt } delete-next-elt ] with-editor ] }
|
||||
{ T{ key-down f { C+ } "BACKSPACE" } [ [ T{ word-elt } delete-prev-elt ] with-editor ] }
|
||||
{ T{ key-down f { C+ } "DELETE" } [ [ T{ word-elt } delete-next-elt ] with-editor ] }
|
||||
{ T{ key-down f { A+ } "BACKSPACE" } [ [ T{ document-elt } delete-prev-elt ] with-editor ] }
|
||||
{ T{ key-down f { A+ } "DELETE" } [ [ T{ document-elt } delete-next-elt ] with-editor ] }
|
||||
{ T{ key-down f f "LEFT" } [ [ T{ char-elt } prev-elt ] with-editor ] }
|
||||
{ T{ key-down f f "RIGHT" } [ [ T{ char-elt } next-elt ] with-editor ] }
|
||||
{ T{ key-down f { C+ } "LEFT" } [ [ T{ word-elt } prev-elt ] with-editor ] }
|
||||
{ T{ key-down f { C+ } "RIGHT" } [ [ T{ word-elt } next-elt ] with-editor ] }
|
||||
{ T{ key-down f f "HOME" } [ [ T{ document-elt } prev-elt ] with-editor ] }
|
||||
{ T{ key-down f f "END" } [ [ T{ document-elt } next-elt ] with-editor ] }
|
||||
{ T{ key-down f { C+ } "k" } [ [ line-clear ] with-editor ] }
|
||||
{ T{ button-up f 2 } [ dup click-editor selection get paste-clipboard ] }
|
||||
{ T{ paste-action } [ clipboard get paste-clipboard ] }
|
||||
} ;
|
||||
editor H{
|
||||
{ T{ button-down } [ click-editor ] }
|
||||
{ T{ gain-focus } [ editor-caret show-gadget ] }
|
||||
{ T{ lose-focus } [ editor-caret hide-gadget ] }
|
||||
{ T{ key-down f f "BACKSPACE" } [ [ T{ char-elt } delete-prev-elt ] with-editor ] }
|
||||
{ T{ key-down f f "DELETE" } [ [ T{ char-elt } delete-next-elt ] with-editor ] }
|
||||
{ T{ key-down f { C+ } "BACKSPACE" } [ [ T{ word-elt } delete-prev-elt ] with-editor ] }
|
||||
{ T{ key-down f { C+ } "DELETE" } [ [ T{ word-elt } delete-next-elt ] with-editor ] }
|
||||
{ T{ key-down f { A+ } "BACKSPACE" } [ [ T{ document-elt } delete-prev-elt ] with-editor ] }
|
||||
{ T{ key-down f { A+ } "DELETE" } [ [ T{ document-elt } delete-next-elt ] with-editor ] }
|
||||
{ T{ key-down f f "LEFT" } [ [ T{ char-elt } prev-elt ] with-editor ] }
|
||||
{ T{ key-down f f "RIGHT" } [ [ T{ char-elt } next-elt ] with-editor ] }
|
||||
{ T{ key-down f { C+ } "LEFT" } [ [ T{ word-elt } prev-elt ] with-editor ] }
|
||||
{ T{ key-down f { C+ } "RIGHT" } [ [ T{ word-elt } next-elt ] with-editor ] }
|
||||
{ T{ key-down f f "HOME" } [ [ T{ document-elt } prev-elt ] with-editor ] }
|
||||
{ T{ key-down f f "END" } [ [ T{ document-elt } next-elt ] with-editor ] }
|
||||
{ T{ key-down f { C+ } "k" } [ [ line-clear ] with-editor ] }
|
||||
{ T{ button-up f 2 } [ dup click-editor selection get paste-clipboard ] }
|
||||
{ T{ paste-action } [ clipboard get paste-clipboard ] }
|
||||
} set-gestures
|
||||
|
||||
: add-editor-caret 2dup set-editor-caret add-gadget ;
|
||||
|
||||
|
|
|
|||
|
|
@ -61,17 +61,13 @@ C: pane ( -- pane )
|
|||
<pile> <incremental> over add-output
|
||||
dup prepare-line ;
|
||||
|
||||
M: pane gadget-gestures
|
||||
pane-input
|
||||
H{
|
||||
{ T{ button-down } [ pane-input click-editor ] }
|
||||
{ T{ key-down f f "RETURN" } [ pane-commit ] }
|
||||
{ T{ key-down f f "UP" } [ pane-input [ history-prev ] with-editor ] }
|
||||
{ T{ key-down f f "DOWN" } [ pane-input [ history-next ] with-editor ] }
|
||||
{ T{ key-down f { C+ } "l" } [ pane-clear ] }
|
||||
}
|
||||
H{ }
|
||||
? ;
|
||||
pane H{
|
||||
{ T{ button-down } [ pane-input click-editor ] }
|
||||
{ T{ key-down f f "RETURN" } [ pane-commit ] }
|
||||
{ T{ key-down f f "UP" } [ pane-input [ history-prev ] with-editor ] }
|
||||
{ T{ key-down f f "DOWN" } [ pane-input [ history-next ] with-editor ] }
|
||||
{ T{ key-down f { C+ } "l" } [ pane-clear ] }
|
||||
} set-gestures
|
||||
|
||||
: <input-pane> ( -- pane )
|
||||
<pane> "" <editor> over set-pane-input ;
|
||||
|
|
|
|||
|
|
@ -25,12 +25,11 @@ TUPLE: scroller viewport x y follows ;
|
|||
|
||||
: scroll-down-line scroller-y 1 swap slide-by-line ;
|
||||
|
||||
M: scroller gadget-gestures
|
||||
drop H{
|
||||
{ T{ wheel-up } [ scroll-up-line ] }
|
||||
{ T{ wheel-down } [ scroll-down-line ] }
|
||||
{ T{ slider-changed } [ relayout-1 ] }
|
||||
} ;
|
||||
scroller H{
|
||||
{ T{ wheel-up } [ scroll-up-line ] }
|
||||
{ T{ wheel-down } [ scroll-down-line ] }
|
||||
{ T{ slider-changed } [ relayout-1 ] }
|
||||
} set-gestures
|
||||
|
||||
C: scroller ( gadget -- scroller )
|
||||
#! Wrap a scrolling pane around the gadget.
|
||||
|
|
|
|||
|
|
@ -62,12 +62,11 @@ TUPLE: thumb ;
|
|||
over screen>slider swap [ slider-saved + ] keep
|
||||
set-slider-value* ;
|
||||
|
||||
M: thumb gadget-gestures
|
||||
drop H{
|
||||
{ T{ button-down } [ begin-drag ] }
|
||||
{ T{ button-up } [ drop ] }
|
||||
{ T{ drag } [ do-drag ] }
|
||||
} ;
|
||||
thumb H{
|
||||
{ T{ button-down } [ begin-drag ] }
|
||||
{ T{ button-up } [ drop ] }
|
||||
{ T{ drag } [ do-drag ] }
|
||||
} set-gestures
|
||||
|
||||
C: thumb ( vector -- thumb )
|
||||
dup delegate>gadget
|
||||
|
|
@ -88,8 +87,8 @@ C: thumb ( vector -- thumb )
|
|||
over screen>slider over slider-value - sgn
|
||||
swap slide-by-page ;
|
||||
|
||||
M: elevator gadget-gestures
|
||||
drop H{ { T{ button-down } [ elevator-click ] } } ;
|
||||
elevator H{ { T{ button-down } [ elevator-click ] } }
|
||||
set-gestures
|
||||
|
||||
C: elevator ( vector -- elevator )
|
||||
dup delegate>gadget
|
||||
|
|
|
|||
|
|
@ -93,12 +93,11 @@ M: track pref-dim* ( track -- dim )
|
|||
dup gadget-parent divider-delta
|
||||
over divider-# rot gadget-parent change-divider ;
|
||||
|
||||
M: divider gadget-gestures
|
||||
drop H{
|
||||
{ T{ button-down } [ gadget-parent save-sizes ] }
|
||||
{ T{ button-up } [ drop ] }
|
||||
{ T{ drag } [ divider-motion ] }
|
||||
} ;
|
||||
divider H{
|
||||
{ T{ button-down } [ gadget-parent save-sizes ] }
|
||||
{ T{ button-up } [ drop ] }
|
||||
{ T{ drag } [ divider-motion ] }
|
||||
} set-gestures
|
||||
|
||||
C: divider ( -- divider )
|
||||
dup delegate>gadget dup reverse-video-theme ;
|
||||
|
|
|
|||
|
|
@ -1,15 +1,20 @@
|
|||
! Copyright (C) 2005, 2006 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: gadgets
|
||||
USING: hashtables kernel math models namespaces queues sequences
|
||||
words ;
|
||||
USING: generic hashtables kernel math models namespaces queues
|
||||
sequences words ;
|
||||
|
||||
GENERIC: gadget-gestures ( gadget -- hash )
|
||||
: (gestures) ( gadget -- )
|
||||
[
|
||||
dup "gestures" word-prop [ , ] when* delegate (gestures)
|
||||
] when* ;
|
||||
|
||||
M: gadget gadget-gestures drop H{ } ;
|
||||
: gestures ( gadget -- seq ) [ (gestures) ] { } make ;
|
||||
|
||||
: set-gestures ( class hash -- ) "gestures" set-word-prop ;
|
||||
|
||||
: handle-gesture* ( gesture gadget -- )
|
||||
tuck gadget-gestures hash [ call f ] [ drop t ] if* ;
|
||||
tuck gestures hash-stack [ call f ] [ drop t ] if* ;
|
||||
|
||||
: handle-gesture ( gesture gadget -- ? )
|
||||
#! If a gadget's handle-gesture* generic returns t, the
|
||||
|
|
@ -185,10 +190,9 @@ V{ } clone hand-buttons set-global
|
|||
: send-action ( world gesture -- ? )
|
||||
swap world-focus handle-gesture ;
|
||||
|
||||
M: world gadget-gestures
|
||||
drop H{
|
||||
{ T{ key-down f { C+ } "x" } [ T{ cut-action } send-action ] }
|
||||
{ T{ key-down f { C+ } "c" } [ T{ copy-action } send-action ] }
|
||||
{ T{ key-down f { C+ } "v" } [ T{ paste-action } send-action ] }
|
||||
{ T{ key-down f { C+ } "a" } [ T{ select-all-action } send-action ] }
|
||||
} ;
|
||||
world H{
|
||||
{ T{ key-down f { C+ } "x" } [ T{ cut-action } send-action ] }
|
||||
{ T{ key-down f { C+ } "c" } [ T{ copy-action } send-action ] }
|
||||
{ T{ key-down f { C+ } "v" } [ T{ paste-action } send-action ] }
|
||||
{ T{ key-down f { C+ } "a" } [ T{ select-all-action } send-action ] }
|
||||
} set-gestures
|
||||
|
|
|
|||
|
|
@ -119,8 +119,8 @@ M: compose set-model ( value compose -- )
|
|||
|
||||
TUPLE: history back forward ;
|
||||
|
||||
C: history ( -- history )
|
||||
dup delegate>model
|
||||
C: history ( value -- history )
|
||||
[ >r <model> r> set-delegate ] keep
|
||||
V{ } clone over set-history-back
|
||||
V{ } clone over set-history-forward ;
|
||||
|
||||
|
|
|
|||
|
|
@ -17,18 +17,15 @@ test ;
|
|||
TUPLE: document locs ;
|
||||
|
||||
C: document ( -- document )
|
||||
{ "" } <model> over set-delegate
|
||||
{ "" } <history> over set-delegate
|
||||
V{ } clone over set-document-locs ;
|
||||
|
||||
: add-loc document-locs push ;
|
||||
|
||||
: remove-loc document-locs delete ;
|
||||
|
||||
: doc-text ( document -- str )
|
||||
model-value "\n" join ;
|
||||
|
||||
: set-doc-text ( string document -- )
|
||||
>r <string-reader> lines r> set-model ;
|
||||
: update-locs ( loc document -- )
|
||||
document-locs [ set-model ] each-with ;
|
||||
|
||||
: doc-line ( line# document -- str ) model-value nth ;
|
||||
|
||||
|
|
@ -36,11 +33,7 @@ C: document ( -- document )
|
|||
>r 1+ r> model-value <slice> ;
|
||||
|
||||
: start-on-line ( document from line# -- n1 )
|
||||
>r dup first r> = [
|
||||
nip second
|
||||
] [
|
||||
2drop 0
|
||||
] if ;
|
||||
>r dup first r> = [ nip second ] [ 2drop 0 ] if ;
|
||||
|
||||
: end-on-line ( document to line# -- n2 )
|
||||
over first over = [
|
||||
|
|
@ -102,9 +95,6 @@ C: document ( -- document )
|
|||
first swap length 1- + 0
|
||||
] if r> peek length + 2array ;
|
||||
|
||||
: update-locs ( loc document -- )
|
||||
document-locs [ set-model ] each-with ;
|
||||
|
||||
: set-doc-range ( str startloc endloc document -- )
|
||||
[
|
||||
>r >r >r "\n" split r> [ text+loc ] 2keep r> r>
|
||||
|
|
@ -156,3 +146,13 @@ TUPLE: line-elt ;
|
|||
|
||||
M: line-elt prev-elt 2drop -1 +line ;
|
||||
M: line-elt next-elt 2drop 1 +line ;
|
||||
|
||||
: doc-text ( document -- str )
|
||||
model-value "\n" join ;
|
||||
|
||||
: set-doc-text ( string document -- )
|
||||
[ >r "\n" split r> set-model ] keep
|
||||
dup doc-end swap update-locs ;
|
||||
|
||||
: clear-doc ( document -- )
|
||||
"" swap set-doc-text ;
|
||||
|
|
|
|||
|
|
@ -204,99 +204,11 @@ M: editor pref-dim* ( editor -- dim )
|
|||
[ selection-start/end ] keep editor-document
|
||||
remove-doc-range ;
|
||||
|
||||
: editor-mouse-down ( editor -- )
|
||||
dup request-focus
|
||||
dup
|
||||
dup editor-caret click-loc
|
||||
dup editor-mark click-loc ;
|
||||
|
||||
: editor-mouse-drag ( editor -- )
|
||||
dup editor-caret click-loc ;
|
||||
|
||||
: editor-copy ( editor clipboard -- )
|
||||
over editor-selection? [
|
||||
>r editor-selection r> set-clipboard-contents
|
||||
] [
|
||||
2drop
|
||||
] if ;
|
||||
|
||||
: 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 editor-document
|
||||
r> call r> editor-document remove-doc-range ; inline
|
||||
|
||||
: editor-delete ( editor -- )
|
||||
dup editor-selection? [
|
||||
remove-editor-selection
|
||||
] [
|
||||
[ dupd T{ char-elt } next-elt ] remove-at-caret
|
||||
] if ;
|
||||
|
||||
: editor-backspace ( editor -- )
|
||||
dup editor-selection? [
|
||||
remove-editor-selection
|
||||
] [
|
||||
[ dupd T{ char-elt } prev-elt swap ] remove-at-caret
|
||||
] if ;
|
||||
|
||||
: editor-select-prev ( editor elt -- )
|
||||
swap [ rot prev-elt ] change-caret ;
|
||||
|
||||
: editor-prev ( editor elt -- )
|
||||
dupd editor-select-prev mark>caret ;
|
||||
|
||||
: editor-select-next ( editor elt -- )
|
||||
swap [ rot next-elt ] change-caret ;
|
||||
|
||||
: editor-next ( editor elt -- )
|
||||
dupd editor-select-next mark>caret ;
|
||||
|
||||
: editor-select-home ( editor -- )
|
||||
[ drop 0 swap =col ] change-caret ;
|
||||
|
||||
: editor-home ( editor -- )
|
||||
dup editor-select-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-all ( editor -- )
|
||||
{ 0 0 } over editor-caret set-model
|
||||
dup editor-document doc-end swap editor-mark set-model ;
|
||||
|
||||
M: editor gadget-gestures
|
||||
drop H{
|
||||
{ T{ button-down } [ editor-mouse-down ] }
|
||||
{ T{ drag } [ editor-mouse-drag ] }
|
||||
{ T{ gain-focus } [ focus-editor ] }
|
||||
{ T{ lose-focus } [ unfocus-editor ] }
|
||||
{ T{ paste-action } [ clipboard get paste-clipboard ] }
|
||||
{ T{ button-up f 2 } [ selection get paste-clipboard ] }
|
||||
{ T{ copy-action } [ clipboard get editor-copy ] }
|
||||
{ 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{ 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 ] }
|
||||
{ T{ key-down f f "DOWN" } [ T{ line-elt } editor-next ] }
|
||||
{ T{ key-down f { S+ } "LEFT" } [ T{ char-elt } editor-select-prev ] }
|
||||
{ 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 f "DELETE" } [ editor-delete ] }
|
||||
{ T{ key-down f f "BACKSPACE" } [ editor-backspace ] }
|
||||
} ;
|
||||
|
||||
M: editor user-input* ( str editor -- ? )
|
||||
[ selection-start/end ] keep editor-document set-doc-range t ;
|
||||
|
||||
: editor-text ( editor -- str )
|
||||
editor-document doc-text ;
|
||||
|
||||
: set-editor-text ( str editor -- )
|
||||
editor-document set-doc-text ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,24 @@
|
|||
! Copyright (C) 2006 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
IN: gadgets-text
|
||||
USING: gadgets generic kernel models ;
|
||||
|
||||
TUPLE: field model ;
|
||||
|
||||
C: field ( model -- field )
|
||||
<editor> over set-delegate
|
||||
[ set-field-model ] keep ;
|
||||
|
||||
: field-prev editor-document go-back ;
|
||||
|
||||
: field-next editor-document go-forward ;
|
||||
|
||||
: field-commit ( field -- )
|
||||
dup field-model [ >r editor-text r> set-model ] when*
|
||||
editor-document 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 f "ENTER" } [ field-commit ] }
|
||||
} set-gestures
|
||||
|
|
@ -30,7 +30,7 @@ TUPLE: help-gadget history ;
|
|||
gadget get help-gadget-history [ help ] <pane-control> ;
|
||||
|
||||
C: help-gadget ( -- gadget )
|
||||
<history> over set-help-gadget-history {
|
||||
f <history> over set-help-gadget-history {
|
||||
{ [ <help-toolbar> ] f f @top }
|
||||
{ [ <help-pane> <scroller> ] f f @center }
|
||||
} make-frame* ;
|
||||
|
|
|
|||
|
|
@ -15,10 +15,8 @@ TUPLE: search-gadget pane input quot ;
|
|||
rot search-gadget-quot with-pane
|
||||
] if ;
|
||||
|
||||
M: search-gadget gadget-gestures
|
||||
drop H{
|
||||
{ T{ key-down f f "RETURN" } [ do-search ] }
|
||||
} ;
|
||||
search-gadget H{ { T{ key-down f f "RETURN" } [ do-search ] } }
|
||||
set-gestures
|
||||
|
||||
C: search-gadget ( quot -- )
|
||||
[ set-search-gadget-quot ] keep {
|
||||
|
|
|
|||
Loading…
Reference in New Issue