Multi-line text editor gadget
slava
parent
8f42c4b655
commit
9a7b1402b2
|
|
@ -200,6 +200,8 @@ sequences vectors words ;
|
||||||
"/library/ui/gadgets/panes.factor"
|
"/library/ui/gadgets/panes.factor"
|
||||||
"/library/ui/gadgets/books.factor"
|
"/library/ui/gadgets/books.factor"
|
||||||
"/library/ui/gadgets/outliner.factor"
|
"/library/ui/gadgets/outliner.factor"
|
||||||
|
"/library/ui/text/document.factor"
|
||||||
|
"/library/ui/text/editor.factor"
|
||||||
"/library/ui/ui.factor"
|
"/library/ui/ui.factor"
|
||||||
"/library/ui/gadgets/presentations.factor"
|
"/library/ui/gadgets/presentations.factor"
|
||||||
"/library/ui/tools/listener.factor"
|
"/library/ui/tools/listener.factor"
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,60 @@
|
||||||
|
IN: temporary
|
||||||
|
USING: gadgets-text namespaces test ;
|
||||||
|
|
||||||
|
! Tests
|
||||||
|
|
||||||
|
[ { 10 4 } ] [ { "a" } { 10 3 } text+loc ] unit-test
|
||||||
|
[ { 10 4 } ] [ { "a" } { 10 3 } text+loc ] unit-test
|
||||||
|
|
||||||
|
[ { 2 0 } ] [
|
||||||
|
<document> "doc" set
|
||||||
|
"Hello world,\nhow are you?\nMore text"
|
||||||
|
"doc" get set-doc-text
|
||||||
|
{ 10 0 } "doc" get validate-loc
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ { 1 12 } ] [
|
||||||
|
<document> "doc" set
|
||||||
|
"Hello world,\nhow are you?\nMore text"
|
||||||
|
"doc" get set-doc-text
|
||||||
|
{ 1 20 } "doc" get validate-loc
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ " world,\nhow are you?\nMore" ] [
|
||||||
|
<document> "doc" set
|
||||||
|
"Hello world,\nhow are you?\nMore text"
|
||||||
|
"doc" get set-doc-text
|
||||||
|
{ 0 5 } { 2 4 } "doc" get doc-range
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ "Hello world,\nhow you?\nMore text" ] [
|
||||||
|
<document> "doc" set
|
||||||
|
"Hello world,\nhow are you?\nMore text"
|
||||||
|
"doc" get set-doc-text
|
||||||
|
{ 1 3 } { 1 7 } "doc" get remove-doc-range
|
||||||
|
"doc" get doc-text
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ "Hello world,\nhow text" ] [
|
||||||
|
<document> "doc" set
|
||||||
|
"Hello world,\nhow are you?\nMore text"
|
||||||
|
"doc" get set-doc-text
|
||||||
|
{ 1 3 } { 2 4 } "doc" get remove-doc-range
|
||||||
|
"doc" get doc-text
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ "Hello world,\nhow you?\nMore text" ] [
|
||||||
|
<document> "doc" set
|
||||||
|
"Hello world,\nhow are you?\nMore text"
|
||||||
|
"doc" get set-doc-text
|
||||||
|
"" { 1 3 } { 1 7 } "doc" get set-doc-range
|
||||||
|
"doc" get doc-text
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ "Hello world,\nhow text" ] [
|
||||||
|
<document> "doc" set
|
||||||
|
"Hello world,\nhow are you?\nMore text"
|
||||||
|
"doc" get set-doc-text
|
||||||
|
"" { 1 3 } { 2 4 } "doc" get set-doc-range
|
||||||
|
"doc" get doc-text
|
||||||
|
] unit-test
|
||||||
|
|
@ -0,0 +1,158 @@
|
||||||
|
! Copyright (C) 2006 Slava Pestov
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
IN: gadgets-text
|
||||||
|
USING: arrays generic io kernel math models namespaces sequences
|
||||||
|
test ;
|
||||||
|
|
||||||
|
: +col ( loc n -- loc ) >r first2 r> + 2array ;
|
||||||
|
|
||||||
|
: +line ( loc n -- loc ) >r first2 swap r> + swap 2array ;
|
||||||
|
|
||||||
|
: =col ( n loc -- loc ) first swap 2array ;
|
||||||
|
|
||||||
|
: =line ( n loc -- loc ) second 2array ;
|
||||||
|
|
||||||
|
: lines-equal? ( loc loc -- n ) [ first ] 2apply number= ;
|
||||||
|
|
||||||
|
TUPLE: document locs ;
|
||||||
|
|
||||||
|
C: document ( -- document )
|
||||||
|
{ "" } <model> 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 ;
|
||||||
|
|
||||||
|
: doc-line ( line# document -- str ) model-value nth ;
|
||||||
|
|
||||||
|
: doc-lines ( from# to# document -- slice )
|
||||||
|
>r 1+ r> model-value <slice> ;
|
||||||
|
|
||||||
|
: start-on-line ( document from line# -- n1 )
|
||||||
|
>r dup first r> = [
|
||||||
|
nip second
|
||||||
|
] [
|
||||||
|
2drop 0
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: end-on-line ( document to line# -- n2 )
|
||||||
|
over first over = [
|
||||||
|
drop second nip
|
||||||
|
] [
|
||||||
|
nip swap doc-line length
|
||||||
|
] if ;
|
||||||
|
|
||||||
|
: each-line ( startloc endloc quot -- )
|
||||||
|
pick pick = [
|
||||||
|
3drop
|
||||||
|
] [
|
||||||
|
>r [ first ] 2apply 1+ dup <slice> r> each
|
||||||
|
] if ; inline
|
||||||
|
|
||||||
|
: start/end-on-line ( startloc endloc line# -- n1 n2 )
|
||||||
|
tuck >r >r document get -rot start-on-line r> r>
|
||||||
|
document get -rot end-on-line ;
|
||||||
|
|
||||||
|
: (doc-range) ( startloc endloc line# -- str )
|
||||||
|
[ start/end-on-line ] keep document get doc-line <slice> , ;
|
||||||
|
|
||||||
|
: doc-range ( startloc endloc document -- str )
|
||||||
|
[
|
||||||
|
document set 2dup [
|
||||||
|
>r 2dup r> (doc-range)
|
||||||
|
] each-line 2drop
|
||||||
|
] { } make "\n" join ;
|
||||||
|
|
||||||
|
: replace-columns ( str start# end# line# document -- )
|
||||||
|
[
|
||||||
|
[ swap [ replace-slice ] change-nth ] keep
|
||||||
|
] change-model ;
|
||||||
|
|
||||||
|
: set-on-1 ( lines startloc endloc document -- )
|
||||||
|
>r >r >r first r> second r> first2 swap r> replace-columns ;
|
||||||
|
|
||||||
|
: loc-col/str ( loc lines -- col str )
|
||||||
|
>r first2 swap r> nth ;
|
||||||
|
|
||||||
|
: merge-lines ( lines startloc endloc lines -- str )
|
||||||
|
#! Start line from 0 to start col + end line from end col
|
||||||
|
#! to length
|
||||||
|
tuck loc-col/str tail-slice
|
||||||
|
>r loc-col/str head-slice
|
||||||
|
swap first r> append3 ;
|
||||||
|
|
||||||
|
: set-on>1pre ( str startloc endloc lines -- )
|
||||||
|
[ merge-lines 1array ] 3keep
|
||||||
|
>r [ first ] 2apply 1+ r> replace-slice ;
|
||||||
|
|
||||||
|
: set-on>1 ( str startloc endloc document -- )
|
||||||
|
[ set-on>1pre ] change-model ;
|
||||||
|
|
||||||
|
: text+loc ( lines loc -- loc )
|
||||||
|
over >r over length 1 = [
|
||||||
|
nip first2
|
||||||
|
] [
|
||||||
|
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>
|
||||||
|
pick pick lines-equal? [ set-on-1 ] [ set-on>1 ] if
|
||||||
|
] keep update-locs ;
|
||||||
|
|
||||||
|
: remove-doc-range ( startloc endloc document -- )
|
||||||
|
>r >r >r "" r> r> r> set-doc-range ;
|
||||||
|
|
||||||
|
: validate-line ( line document -- line )
|
||||||
|
model-value length 1- min 0 max ;
|
||||||
|
|
||||||
|
: validate-col ( col line document -- col )
|
||||||
|
doc-line length min 0 max ;
|
||||||
|
|
||||||
|
: validate-loc ( loc document -- loc )
|
||||||
|
>r first2 swap r> [ validate-line ] keep
|
||||||
|
>r tuck r> validate-col 2array ;
|
||||||
|
|
||||||
|
: line-end ( line# document -- loc )
|
||||||
|
dupd doc-line length 2array ;
|
||||||
|
|
||||||
|
: line-end? ( loc document -- ? )
|
||||||
|
>r first2 swap r> doc-line length = ;
|
||||||
|
|
||||||
|
: doc-end ( document -- loc )
|
||||||
|
model-value dup length 1- swap peek length 2array ;
|
||||||
|
|
||||||
|
GENERIC: prev-elt ( loc document elt -- loc )
|
||||||
|
GENERIC: next-elt ( loc document elt -- loc )
|
||||||
|
|
||||||
|
TUPLE: char-elt ;
|
||||||
|
|
||||||
|
M: char-elt prev-elt
|
||||||
|
drop {
|
||||||
|
{ [ over { 0 0 } = ] [ drop ] }
|
||||||
|
{ [ over second zero? ] [ >r first 1- r> line-end ] }
|
||||||
|
{ [ t ] [ drop -1 +col ] }
|
||||||
|
} cond ;
|
||||||
|
|
||||||
|
M: char-elt next-elt
|
||||||
|
drop {
|
||||||
|
{ [ 2dup doc-end = ] [ drop ] }
|
||||||
|
{ [ 2dup line-end? ] [ drop first 1+ 0 2array ] }
|
||||||
|
{ [ t ] [ drop 1 +col ] }
|
||||||
|
} cond ;
|
||||||
|
|
||||||
|
TUPLE: line-elt ;
|
||||||
|
|
||||||
|
M: line-elt prev-elt 2drop -1 +line ;
|
||||||
|
M: line-elt next-elt 2drop 1 +line ;
|
||||||
|
|
@ -0,0 +1,302 @@
|
||||||
|
! Copyright (C) 2006 Slava Pestov
|
||||||
|
! 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 ;
|
||||||
|
|
||||||
|
TUPLE: editor
|
||||||
|
document
|
||||||
|
font color caret-color selection-color
|
||||||
|
caret mark
|
||||||
|
focused? ;
|
||||||
|
|
||||||
|
: editor-theme ( editor -- )
|
||||||
|
{ 0.0 0.0 0.0 1.0 } over set-editor-color
|
||||||
|
{ 1.0 0.0 0.0 1.0 } over set-editor-caret-color
|
||||||
|
{ 0.8 0.8 1.0 1.0 } over set-editor-selection-color
|
||||||
|
{ "monospace" plain 12 } swap set-editor-font ;
|
||||||
|
|
||||||
|
TUPLE: action-relayout-1 editor ;
|
||||||
|
|
||||||
|
M: action-relayout-1 model-changed
|
||||||
|
#! Caret changed
|
||||||
|
action-relayout-1-editor 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
|
||||||
|
<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 ;
|
||||||
|
|
||||||
|
: deactivate-editor-model ( editor model -- )
|
||||||
|
dup deactivate-model swap editor-document remove-loc ;
|
||||||
|
|
||||||
|
M: editor graft* ( editor -- )
|
||||||
|
dup
|
||||||
|
dup editor-caret activate-editor-model
|
||||||
|
dup editor-mark activate-editor-model ;
|
||||||
|
|
||||||
|
M: editor ungraft* ( editor -- )
|
||||||
|
dup
|
||||||
|
dup editor-caret deactivate-editor-model
|
||||||
|
dup editor-mark deactivate-editor-model ;
|
||||||
|
|
||||||
|
M: editor model-changed ( editor -- )
|
||||||
|
#! Document changed
|
||||||
|
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
|
||||||
|
editor-caret set-model ; inline
|
||||||
|
|
||||||
|
: mark>caret ( editor -- )
|
||||||
|
dup editor-caret* swap editor-mark set-model ;
|
||||||
|
|
||||||
|
: change-caret&mark ( editor quot -- )
|
||||||
|
over >r change-caret r> mark>caret ; inline
|
||||||
|
|
||||||
|
: editor-lines ( editor -- seq )
|
||||||
|
editor-document model-value ;
|
||||||
|
|
||||||
|
: editor-line ( n editor -- str ) editor-lines nth ;
|
||||||
|
|
||||||
|
: editor-font* ( editor -- font ) editor-font lookup-font ;
|
||||||
|
|
||||||
|
: line-height ( editor -- n )
|
||||||
|
editor-font* font-height ;
|
||||||
|
|
||||||
|
: run-char-widths ( str editor -- wlist )
|
||||||
|
#! List of x co-ordinates of each character.
|
||||||
|
editor-font* swap >array [ char-width ] map-with
|
||||||
|
dup 0 [ + ] accumulate swap 2 v/n v+ ;
|
||||||
|
|
||||||
|
: x>offset ( x line# editor -- col# )
|
||||||
|
[ editor-line ] keep
|
||||||
|
over >r run-char-widths [ <= ] find-with drop dup -1 =
|
||||||
|
[ drop r> length ] [ r> drop ] if ;
|
||||||
|
|
||||||
|
: y>line ( y editor -- line# )
|
||||||
|
[ line-height / >fixnum ] keep editor-lines length 1- min ;
|
||||||
|
|
||||||
|
: set-caret-y ( y editor -- )
|
||||||
|
[ y>line ] keep [ drop =line ] change-caret&mark ;
|
||||||
|
|
||||||
|
: point>loc ( point editor -- loc )
|
||||||
|
over second over y>line [
|
||||||
|
>r >r first r> r> swap x>offset
|
||||||
|
] keep swap 2array ;
|
||||||
|
|
||||||
|
: click-loc ( editor model -- )
|
||||||
|
>r [ hand-rel ] keep point>loc r> set-model ;
|
||||||
|
|
||||||
|
: focus-editor ( editor -- )
|
||||||
|
t over set-editor-focused? relayout-1 ;
|
||||||
|
|
||||||
|
: unfocus-editor ( editor -- )
|
||||||
|
f over set-editor-focused? relayout-1 ;
|
||||||
|
|
||||||
|
: (offset>x) ( font col# str -- x )
|
||||||
|
head-slice string-width ;
|
||||||
|
|
||||||
|
: offset>x ( col# line# editor -- x )
|
||||||
|
[ editor-line ] keep editor-font* -rot (offset>x) ;
|
||||||
|
|
||||||
|
: loc>x ( loc editor -- x ) >r first2 swap r> offset>x ;
|
||||||
|
|
||||||
|
: (draw-caret) ( loc editor -- )
|
||||||
|
dup editor-caret-color gl-color
|
||||||
|
[ loc>x ] keep line-height dupd 2array >r 0 2array r>
|
||||||
|
gl-line ;
|
||||||
|
|
||||||
|
: draw-caret ( n editor -- )
|
||||||
|
{
|
||||||
|
{ [ dup editor-focused? not ] [ ] }
|
||||||
|
{ [ 2dup editor-caret* first = not ] [ ] }
|
||||||
|
{ [ t ] [ dup editor-caret* over (draw-caret) ] }
|
||||||
|
} cond 2drop ;
|
||||||
|
|
||||||
|
: translate-lines ( n -- )
|
||||||
|
editor get line-height * 0.0 swap 0.0 glTranslated ;
|
||||||
|
|
||||||
|
: draw-line ( str n -- )
|
||||||
|
editor get draw-caret
|
||||||
|
editor get editor-color gl-color
|
||||||
|
>r editor get editor-font r> draw-string ;
|
||||||
|
|
||||||
|
: with-editor ( editor quot -- )
|
||||||
|
[
|
||||||
|
swap dup editor-document document set editor set call
|
||||||
|
] with-scope ; inline
|
||||||
|
|
||||||
|
: draw-lines ( editor -- )
|
||||||
|
GL_MODELVIEW [
|
||||||
|
editor get editor-lines dup length
|
||||||
|
[ draw-line 1 translate-lines ] 2each
|
||||||
|
] do-matrix ;
|
||||||
|
|
||||||
|
: selection-start/end ( editor -- start end )
|
||||||
|
dup editor-mark* swap editor-caret*
|
||||||
|
2dup <=> 0 > [ swap ] when ;
|
||||||
|
|
||||||
|
: (draw-selection) ( x1 x2 -- )
|
||||||
|
2dup = [ 2 + ] when
|
||||||
|
0.0 swap editor get line-height glRectd ;
|
||||||
|
|
||||||
|
: draw-selected-line ( start end n -- )
|
||||||
|
[ start/end-on-line ] keep tuck
|
||||||
|
>r >r editor get offset>x r> r>
|
||||||
|
editor get offset>x
|
||||||
|
(draw-selection) ;
|
||||||
|
|
||||||
|
: translate>selection-start ( start -- )
|
||||||
|
first translate-lines ;
|
||||||
|
|
||||||
|
: draw-selection ( -- )
|
||||||
|
GL_MODELVIEW [
|
||||||
|
editor get
|
||||||
|
dup editor-selection-color gl-color
|
||||||
|
selection-start/end
|
||||||
|
over translate>selection-start
|
||||||
|
2dup [
|
||||||
|
>r 2dup r> draw-selected-line 1 translate-lines
|
||||||
|
] each-line 2drop
|
||||||
|
] do-matrix ;
|
||||||
|
|
||||||
|
M: editor draw-gadget* ( gadget -- )
|
||||||
|
[ draw-selection draw-lines ] with-editor ;
|
||||||
|
|
||||||
|
: line>y ( lines# editor -- y )
|
||||||
|
line-height * ;
|
||||||
|
|
||||||
|
: editor-height ( editor -- n )
|
||||||
|
[ editor-lines length ] keep line>y ;
|
||||||
|
|
||||||
|
: editor-width ( editor -- n )
|
||||||
|
0 swap dup editor-font* swap editor-lines
|
||||||
|
[ string-width max ] each-with ;
|
||||||
|
|
||||||
|
M: editor pref-dim* ( editor -- dim )
|
||||||
|
dup editor-width swap editor-height 2array ;
|
||||||
|
|
||||||
|
: editor-selection? ( editor -- ? )
|
||||||
|
selection-start/end = not ;
|
||||||
|
|
||||||
|
: editor-selection ( editor -- str )
|
||||||
|
[ selection-start/end ] keep editor-document doc-range ;
|
||||||
|
|
||||||
|
: remove-editor-selection ( editor -- )
|
||||||
|
[ 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 ;
|
||||||
Loading…
Reference in New Issue