diff --git a/basis/ui/gadgets/editors/editors-tests.factor b/basis/ui/gadgets/editors/editors-tests.factor index 3ba32dc3c2..3fbdf12cbe 100644 --- a/basis/ui/gadgets/editors/editors-tests.factor +++ b/basis/ui/gadgets/editors/editors-tests.factor @@ -1,8 +1,8 @@ -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" ] [ @@ -55,6 +55,9 @@ IN: ui.gadgets.editors.tests [ ] [ com-join-lines ] unit-test [ ] [ "A" over set-editor-string com-join-lines ] unit-test [ "A B" ] [ "A\nB" over set-editor-string [ com-join-lines ] [ editor-string ] bi ] unit-test +[ "A B\nC\nD" ] [ "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" ] [ "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" ] [ "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 ] [ 20 >>min-rows 20 >>min-cols pref-viewport-dim length ] unit-test diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index f83c5d710a..071ac1cffe 100755 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -17,6 +17,8 @@ caret-color caret mark focused? blink blink-alarm ; + ( -- loc ) { 0 0 } ; : init-editor-locs ( editor -- editor ) @@ -27,6 +29,8 @@ focused? blink blink-alarm ; COLOR: red >>caret-color monospace-font >>font ; inline +PRIVATE> + : new-editor ( class -- editor ) new-line-gadget >>model @@ -36,6 +40,8 @@ focused? blink blink-alarm ; : ( -- editor ) editor new-editor ; + + M: editor graft* [ dup caret>> activate-editor-model ] [ dup mark>> activate-editor-model ] bi ; @@ -142,6 +150,8 @@ M: editor ungraft* ] keep scroll>rect ] [ drop ] if ; +> ] [ blink>> ] } 1&& ; @@ -189,6 +199,8 @@ TUPLE: selected-line start end first? last? ; ] 3bi ] if ; +PRIVATE> + M: editor draw-line ( line index editor -- ) [ selected-lines get at ] dip over [ draw-selected-line ] [ nip draw-unselected-line ] if ; @@ -206,6 +218,8 @@ M: editor baseline font>> font-metrics ascent>> ; M: editor cap-height font>> font-metrics cap-height>> ; +> ] [ drop ] 2bi '[ _ validate-loc ] (change-model) ] [ [ nip mark>> ] [ drop ] 2bi '[ _ validate-loc ] (change-model) ] @@ -214,6 +228,8 @@ M: editor cap-height font>> font-metrics cap-height>> ; : caret/mark-changed ( editor -- ) [ restart-blinking ] keep scroll>caret ; +PRIVATE> + M: editor model-changed { { [ 2dup model>> eq? ] [ contents-changed ] } @@ -513,6 +529,8 @@ PRIVATE> : change-selection ( editor quot -- ) '[ gadget-selection @ ] [ user-input* drop ] bi ; inline + [ " " join ] tri ; -: this-line-and-next ( document line -- start end ) - [ nip 0 swap 2array ] - [ 1 + [ nip ] [ swap doc-line length ] 2bi 2array ] - 2bi ; - : 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 ) + swap + [ drop 0 2array ] + [ [ 1 + ] dip [ drop ] [ doc-line length ] 2bi 2array ] + 2bi ; + +: 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 { @@ -566,6 +601,8 @@ TUPLE: source-editor < multiline-editor ; ! Fields wrap an editor TUPLE: field < border editor min-cols max-cols ; +>size { 1 0 } >>fill @@ -576,6 +613,8 @@ TUPLE: field < border editor min-cols max-cols ; { 1 0 } >>fill field-theme ; +PRIVATE> + : new-field ( class -- gadget ) [ ] dip new-border dup gadget-child >>editor