-USING: accessors ui.gadgets.editors tools.test kernel io
-io.streams.plain definitions namespaces ui.gadgets
-ui.gadgets.grids prettyprint documents ui.gestures ui.gadgets.debug
-models documents.elements ui.gadgets.scrollers ui.gadgets.line-support
-sequences ;
+USING: accessors ui.gadgets.editors ui.gadgets.editors.private
+tools.test kernel io io.streams.plain definitions namespaces
+ui.gadgets ui.gadgets.grids prettyprint documents ui.gestures
+ui.gadgets.debug models documents.elements ui.gadgets.scrollers
+ui.gadgets.line-support sequences ;
IN: ui.gadgets.editors.tests
[ "foo bar" ] [
[ ] [ <editor> com-join-lines ] unit-test
[ ] [ <editor> "A" over set-editor-string com-join-lines ] unit-test
[ "A B" ] [ <editor> "A\nB" over set-editor-string [ com-join-lines ] [ editor-string ] bi ] unit-test
+[ "A B\nC\nD" ] [ <editor> "A\nB\nC\nD" over set-editor-string { 0 0 } over set-caret dup mark>caret [ com-join-lines ] [ editor-string ] bi ] unit-test
+[ "A\nB C\nD" ] [ <editor> "A\nB\nC\nD" over set-editor-string { 1 0 } over set-caret dup mark>caret [ com-join-lines ] [ editor-string ] bi ] unit-test
+[ "A\nB\nC D" ] [ <editor> "A\nB\nC\nD" over set-editor-string { 2 0 } over set-caret dup mark>caret [ com-join-lines ] [ editor-string ] bi ] unit-test
[ 2 ] [ <editor> 20 >>min-rows 20 >>min-cols pref-viewport-dim length ] unit-test
caret mark
focused? blink blink-alarm ;
+<PRIVATE
+
: <loc> ( -- loc ) { 0 0 } <model> ;
: init-editor-locs ( editor -- editor )
COLOR: red >>caret-color
monospace-font >>font ; inline
+PRIVATE>
+
: new-editor ( class -- editor )
new-line-gadget
<document> >>model
: <editor> ( -- editor )
editor new-editor ;
+<PRIVATE
+
: activate-editor-model ( editor model -- )
[ add-connection ]
[ nip activate-model ]
bi
] [ drop ] if ;
+PRIVATE>
+
M: editor graft*
[ dup caret>> activate-editor-model ]
[ dup mark>> activate-editor-model ] bi ;
] keep scroll>rect
] [ drop ] if ;
+<PRIVATE
+
: draw-caret? ( editor -- ? )
{ [ focused?>> ] [ blink>> ] } 1&& ;
] 3bi
] if ;
+PRIVATE>
+
M: editor draw-line ( line index editor -- )
[ selected-lines get at ] dip over
[ draw-selected-line ] [ nip draw-unselected-line ] if ;
M: editor cap-height font>> font-metrics cap-height>> ;
+<PRIVATE
+
: contents-changed ( model editor -- )
[ [ nip caret>> ] [ drop ] 2bi '[ _ validate-loc ] (change-model) ]
[ [ nip mark>> ] [ drop ] 2bi '[ _ validate-loc ] (change-model) ]
: caret/mark-changed ( editor -- )
[ restart-blinking ] keep scroll>caret ;
+PRIVATE>
+
M: editor model-changed
{
{ [ 2dup model>> eq? ] [ contents-changed ] }
: change-selection ( editor quot -- )
'[ gadget-selection @ ] [ user-input* drop ] bi ; inline
+<PRIVATE
+
: join-lines ( string -- string' )
"\n" split
[ rest-slice [ [ blank? ] trim-head-slice ] change-each ]
[ " " join ]
tri ;
+: last-line? ( document line -- ? )
+ [ last-line# ] dip = ;
+
+: prev-line-and-this ( document line -- start end )
+ swap
+ [ drop 1 - 0 2array ]
+ [ [ drop ] [ doc-line length ] 2bi 2array ]
+ 2bi ;
+
+: join-with-prev ( document line -- )
+ [ prev-line-and-this ] [ drop ] 2bi
+ [ join-lines ] change-doc-range ;
+
: this-line-and-next ( document line -- start end )
- [ nip 0 swap 2array ]
- [ 1 + [ nip ] [ swap doc-line length ] 2bi 2array ]
+ swap
+ [ drop 0 2array ]
+ [ [ 1 + ] dip [ drop ] [ doc-line length ] 2bi 2array ]
2bi ;
-: last-line? ( document line -- ? )
- [ last-line# ] dip = ;
+: join-with-next ( document line -- )
+ [ this-line-and-next ] [ drop ] 2bi
+ [ join-lines ] change-doc-range ;
+
+PRIVATE>
: com-join-lines ( editor -- )
dup gadget-selection?
[ [ join-lines ] change-selection ] [
- [ model>> ] [ editor-caret first ] bi
- 2dup last-line? [ 2drop ] [
- [ this-line-and-next ] [ drop ] 2bi
- [ join-lines ] change-doc-range
- ] if
+ [ model>> ] [ editor-caret first ] bi {
+ { [ over last-line# 0 = ] [ 2drop ] }
+ { [ 2dup last-line? ] [ join-with-prev ] }
+ [ join-with-next ]
+ } cond
] if ;
multiline-editor "multiline" f {
! Fields wrap an editor
TUPLE: field < border editor min-cols max-cols ;
+<PRIVATE
+
: field-theme ( gadget -- gadget )
{ 2 2 } >>size
{ 1 0 } >>fill
{ 1 0 } >>fill
field-theme ;
+PRIVATE>
+
: new-field ( class -- gadget )
[ <editor> ] dip new-border
dup gadget-child >>editor