X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=basis%2Fui%2Fgadgets%2Feditors%2Feditors.factor;h=f846d6cbdb881cefa69dbfb7104f58cc124b6edb;hp=772e7891937c699dc1873bebcc051ceb3ab1f386;hb=4843bd64ead67e74c22eb715eac3ca814304250a;hpb=bada736a3ffb9e71d15f30ea2157d252cdd743c6 diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 772e789193..f846d6cbdb 100644 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -1,17 +1,20 @@ ! Copyright (C) 2006, 2011 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs calendar colors.constants combinators +USING: accessors arrays assocs calendar colors combinators combinators.short-circuit documents documents.elements fonts fry -grouping kernel locals make math math.functions math.order math.ranges -math.rectangles math.vectors models models.arrow namespaces opengl -sequences sorting splitting timers ui.baseline-alignment ui.clipboards -ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.line-support -ui.gadgets.menus ui.gadgets.scrollers ui.gestures ui.pens.solid -ui.render ui.text ui.theme unicode opengl.gl ; +grouping kernel literals locals make math math.functions +math.order ranges math.rectangles math.vectors models +models.arrow namespaces opengl opengl.gl sequences sorting +splitting system timers ui.baseline-alignment ui.clipboards +ui.commands ui.gadgets ui.gadgets.borders +ui.gadgets.line-support ui.gadgets.menus ui.gadgets.scrollers +prettyprint math.parser +ui.gestures ui.pens.solid ui.render ui.text ui.theme unicode variables ; IN: ui.gadgets.editors TUPLE: editor < line-gadget caret mark + caret-shape focused? blink blink-timer default-text preedit-start @@ -21,14 +24,21 @@ TUPLE: editor < line-gadget preedit-selection-mode? preedit-underlines ; -M: editor preedit? preedit-start>> [ t ] [ f ] if ; - +M: editor preedit? preedit-start>> ; + +SYMBOLS: +line+ +box+ +filled+ ; +GLOBAL: caret-is-shape ++line+ caret-is-shape set-global + +: ( -- shape ) caret-is-shape get-global ; + ( -- loc ) { 0 0 } ; : init-editor-locs ( editor -- editor ) >>caret + >>caret-shape >>mark ; inline : editor-theme ( editor -- editor ) @@ -142,10 +152,10 @@ M: editor ungraft* [ stop-blinking ] [ f >>focused? relayout-1 ] bi ; : loc>x ( loc editor -- x ) - [ first2 swap ] dip [ editor-line ] [ font>> ] bi swap offset>x round ; + [ first2 swap ] dip [ editor-line ] [ font>> ] bi swap offset>x gl-round ; : loc>point ( loc editor -- loc ) - [ loc>x ] [ [ first ] dip line>y ceiling ] 2bi 2array ; + [ loc>x ] [ [ first ] dip line>y gl-ceiling ] 2bi 2array ; : caret-loc ( editor -- loc ) [ editor-caret ] keep loc>point ; @@ -166,11 +176,34 @@ M: editor ungraft* { [ focused?>> ] [ blink>> ] [ [ preedit? not ] [ preedit-selection-mode?>> not ] bi or ] } 1&& ; +: (caret-location) ( editor -- loc dim ) + [ caret-loc ] [ caret-dim ] bi ; + +: (caret-rect) ( dim -- newdim ) + second [ 2 / ] keep 2array ; + +: draw-caret-line ( editor -- ) + (caret-location) over v+ gl-line ; + +: draw-caret-rect ( editor -- ) + (caret-location) (caret-rect) gl-rect ; + +: draw-caret-rect-filled ( editor -- ) + (caret-location) (caret-rect) gl-fill-rect ; + +: draw-caret-shape ( editor -- ) + dup caret-shape>> value>> + { + { +box+ [ draw-caret-rect ] } + { +filled+ [ draw-caret-rect-filled ] } + [ drop draw-caret-line ] + } case ; + + : draw-caret ( editor -- ) dup draw-caret? [ [ editor-caret-color gl-color ] dip - [ caret-loc ] [ caret-dim ] bi - over v+ gl-line + draw-caret-shape ] [ drop ] if ; :: draw-preedit-underlines ( editor -- ) @@ -178,10 +211,10 @@ M: editor ungraft* editor [ caret-loc second ] [ caret-dim second ] bi + 2.0 - :> y editor editor-caret first :> row editor font>> foreground>> gl-color - editor preedit-underlines>> [ + editor preedit-underlines>> [ GL_LINE_BIT [ dup second glLineWidth - first editor preedit-start>> second dup 2array v+ first2 + first editor preedit-start>> second dup 2array v+ first2 [ row swap 2array editor loc>x 1.0 + y 2array ] [ row swap 2array editor loc>x 1.0 - y 2array ] bi* @@ -199,16 +232,16 @@ TUPLE: selected-line start end first? last? ; : compute-selection ( editor -- assoc ) dup gadget-selection? [ - [ selection-start/end [ [ first ] bi@ [a,b] ] [ ] 2bi ] + [ selection-start/end [ [ first ] bi@ [a..b] ] [ ] 2bi ] [ model>> ] bi '[ [ _ _ ] [ _ start/end-on-line ] bi 2array ] H{ } map>assoc ] [ drop f ] if ; :: draw-selection ( line pair editor -- ) - pair [ editor font>> line offset>x ] map :> pair + pair [ editor font>> line offset>x gl-round ] map :> pair editor selection-color>> gl-color pair first 0 2array - pair second pair first - round 1 max editor line-height 2array + pair second pair first - 1 max editor line-height 2array gl-fill-rect ; : draw-unselected-line ( line editor -- ) @@ -234,7 +267,7 @@ TUPLE: selected-line start end first? last? ; PRIVATE> -M: editor draw-line ( line index editor -- ) +M: editor draw-line [ selected-lines get at ] dip over [ draw-selected-line ] [ nip draw-unselected-line ] if ; @@ -248,10 +281,11 @@ M: editor draw-gadget* ] if ; M: editor pref-dim* + [ call-next-method ] keep ! at least as big as our min-rows/min-cols ! Add some space for the caret. [ font>> ] keep dup draw-default-text? [ default-text>> ] [ control-value ] if - text-dim { 1 0 } v+ ; + text-dim { 1 0 } v+ vmax ; M: editor baseline font>> font-metrics ascent>> ; @@ -429,12 +463,16 @@ editor "editing" f { { redo-action com-redo } { T{ key-down f f "DELETE" } delete-next-character } { T{ key-down f f "BACKSPACE" } delete-previous-character } + { T{ key-down f { S+ } "DELETE" } delete-next-character } { T{ key-down f { S+ } "BACKSPACE" } delete-previous-character } - { T{ key-down f { C+ } "DELETE" } delete-next-word } - { T{ key-down f { C+ } "BACKSPACE" } delete-previous-word } - { T{ key-down f { A+ } "DELETE" } delete-to-end-of-line } - { T{ key-down f { A+ } "BACKSPACE" } delete-to-start-of-line } -} define-command-map + { T{ key-down f ${ os macosx? A+ C+ ? } "DELETE" } delete-next-word } + { T{ key-down f ${ os macosx? A+ C+ ? } "BACKSPACE" } delete-previous-word } + { T{ key-down f ${ os macosx? M+ A+ ? } "DELETE" } delete-to-end-of-line } + { T{ key-down f ${ os macosx? M+ A+ ? } "BACKSPACE" } delete-to-start-of-line } +} os macosx? [ { + { T{ key-down f { C+ } "DELETE" } delete-next-character } + { T{ key-down f { C+ } "BACKSPACE" } delete-previous-character } +} append ] when define-command-map : com-paste ( editor -- ) clipboard get paste-clipboard ; @@ -474,17 +512,30 @@ editor "clipboard" f { : end-of-line ( editor -- ) one-line-elt editor-next ; +: start-of-paragraph ( editor -- ) paragraph-elt editor-prev ; + +: end-of-paragraph ( editor -- ) paragraph-elt editor-next ; + editor "caret-motion" f { { T{ button-down } position-caret } { T{ key-down f f "LEFT" } previous-character } { T{ key-down f f "RIGHT" } next-character } - { T{ key-down f { C+ } "LEFT" } previous-word } - { T{ key-down f { C+ } "RIGHT" } next-word } + { T{ key-down f ${ os macosx? A+ C+ ? } "LEFT" } previous-word } + { T{ key-down f ${ os macosx? A+ C+ ? } "RIGHT" } next-word } { T{ key-down f f "HOME" } start-of-line } { T{ key-down f f "END" } end-of-line } - { T{ key-down f { C+ } "HOME" } start-of-document } - { T{ key-down f { C+ } "END" } end-of-document } -} define-command-map + { T{ key-down f ${ os macosx? A+ C+ ? } "UP" } start-of-paragraph } + { T{ key-down f ${ os macosx? A+ C+ ? } "DOWN" } end-of-paragraph } + { T{ key-down f ${ os macosx? A+ C+ ? } "HOME" } start-of-document } + { T{ key-down f ${ os macosx? A+ C+ ? } "END" } end-of-document } +} os macosx? [ { + { T{ key-down f { M+ } "LEFT" } start-of-line } + { T{ key-down f { M+ } "RIGHT" } end-of-line } + { T{ key-down f { M+ } "UP" } start-of-paragraph } + { T{ key-down f { M+ } "DOWN" } end-of-paragraph } + { T{ key-down f { M+ } "HOME" } start-of-document } + { T{ key-down f { M+ } "END" } end-of-document } +} append ] when define-command-map : clear-editor ( editor -- ) model>> clear-doc ; @@ -518,6 +569,12 @@ editor "caret-motion" f { : select-end-of-line ( editor -- ) one-line-elt editor-select-next ; +: select-start-of-paragraph ( editor -- ) + paragraph-elt editor-select-prev ; + +: select-end-of-paragraph ( editor -- ) + paragraph-elt editor-select-next ; + : select-start-of-document ( editor -- ) doc-elt editor-select-prev ; @@ -535,13 +592,22 @@ editor "selection" f { { T{ key-down f { C+ } "l" } select-line } { T{ key-down f { S+ } "LEFT" } select-previous-character } { T{ key-down f { S+ } "RIGHT" } select-next-character } - { T{ key-down f { S+ C+ } "LEFT" } select-previous-word } - { T{ key-down f { S+ C+ } "RIGHT" } select-next-word } + { T{ key-down f ${ S+ os macosx? A+ C+ ? } "LEFT" } select-previous-word } + { T{ key-down f ${ S+ os macosx? A+ C+ ? } "RIGHT" } select-next-word } { T{ key-down f { S+ } "HOME" } select-start-of-line } { T{ key-down f { S+ } "END" } select-end-of-line } - { T{ key-down f { S+ C+ } "HOME" } select-start-of-document } - { T{ key-down f { S+ C+ } "END" } select-end-of-document } -} define-command-map + { T{ key-down f ${ S+ os macosx? A+ C+ ? } "UP" } select-start-of-paragraph } + { T{ key-down f ${ S+ os macosx? A+ C+ ? } "DOWN" } select-end-of-paragraph } + { T{ key-down f ${ S+ os macosx? A+ C+ ? } "HOME" } select-start-of-document } + { T{ key-down f ${ S+ os macosx? A+ C+ ? } "END" } select-end-of-document } +} os macosx? [ { + { T{ key-down f { S+ M+ } "LEFT" } select-start-of-line } + { T{ key-down f { S+ M+ } "RIGHT" } select-end-of-line } + { T{ key-down f { S+ M+ } "UP" } select-start-of-paragraph } + { T{ key-down f { S+ M+ } "DOWN" } select-end-of-paragraph } + { T{ key-down f { S+ M+ } "HOME" } select-start-of-document } + { T{ key-down f { S+ M+ } "END" } select-end-of-document } +} append ] when define-command-map : editor-menu ( editor -- ) { @@ -570,21 +636,28 @@ TUPLE: multiline-editor < editor ; ; +: page-elt ( editor n -- editor element ) + over visible-lines 1 - min 1 max ; + +: prev-page-elt ( editor -- editor element ) + dup editor-caret first page-elt ; + +: next-page-elt ( editor -- editor element ) + dup [ control-value length 1 - ] [ editor-caret first ] bi - page-elt ; PRIVATE> -: previous-page ( editor -- ) page-elt editor-prev ; +: previous-page ( editor -- ) prev-page-elt editor-prev ; -: next-page ( editor -- ) page-elt editor-next ; +: next-page ( editor -- ) next-page-elt editor-next ; : select-previous-line ( editor -- ) line-elt editor-select-prev ; : select-next-line ( editor -- ) line-elt editor-select-next ; -: select-previous-page ( editor -- ) page-elt editor-select-prev ; +: select-previous-page ( editor -- ) prev-page-elt editor-select-prev ; -: select-next-page ( editor -- ) page-elt editor-select-next ; +: select-next-page ( editor -- ) next-page-elt editor-select-next ; : insert-newline ( editor -- ) "\n" swap user-input* drop ; @@ -595,10 +668,10 @@ PRIVATE>