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=da60d66afff72794d83ee90b6919bf2b23fc036a;hb=4843bd64ead67e74c22eb715eac3ca814304250a;hpb=a3c168cb5ebb0b351ccdacba168072ae2092b164 diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index da60d66aff..f846d6cbdb 100644 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -1,21 +1,36 @@ -! Copyright (C) 2006, 2009 Slava Pestov +! Copyright (C) 2006, 2011 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alarms arrays assocs calendar colors.constants -combinators combinators.short-circuit documents -documents.elements fry grouping kernel locals make math -math.functions math.order math.ranges math.rectangles -math.vectors models models.arrow namespaces opengl sequences -sorting splitting ui.baseline-alignment ui.clipboards +USING: accessors arrays assocs calendar colors combinators +combinators.short-circuit documents documents.elements fonts fry +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 -ui.gestures ui.pens.solid ui.render ui.text unicode.categories ; -EXCLUDE: fonts => selection ; +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-color -caret mark -focused? blink blink-alarm ; + caret mark + caret-shape + focused? blink blink-timer + default-text + preedit-start + preedit-end + preedit-selected-start + preedit-selected-end + preedit-selection-mode? + preedit-underlines ; + +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 ; >>caret + >>caret-shape >>mark ; inline : editor-theme ( editor -- editor ) - COLOR: red >>caret-color monospace-font >>font ; inline PRIVATE> @@ -60,14 +75,11 @@ SYMBOL: blink-interval 750 milliseconds blink-interval set-global : stop-blinking ( editor -- ) - [ [ cancel-alarm ] when* f ] change-blink-alarm drop ; + blink-timer>> [ stop-timer ] when* ; : start-blinking ( editor -- ) - [ stop-blinking ] [ - t >>blink - dup '[ _ blink-caret ] blink-interval get every - >>blink-alarm drop - ] bi ; + t >>blink + blink-timer>> [ restart-timer ] when* ; : restart-blinking ( editor -- ) dup focused?>> [ @@ -80,10 +92,15 @@ PRIVATE> M: editor graft* [ dup caret>> activate-editor-model ] - [ dup mark>> activate-editor-model ] bi ; + [ dup mark>> activate-editor-model ] + [ + [ + '[ _ blink-caret ] blink-interval get dup + ] keep blink-timer<< + ] tri ; M: editor ungraft* - [ stop-blinking ] + [ [ stop-blinking ] [ f >>blink-timer drop ] bi ] [ dup caret>> deactivate-editor-model ] [ dup mark>> deactivate-editor-model ] tri ; @@ -94,14 +111,17 @@ M: editor ungraft* : set-caret ( loc editor -- ) [ model>> validate-loc ] [ caret>> ] bi set-model ; -: change-caret ( editor quot -- ) +: set-mark ( loc editor -- ) + [ model>> validate-loc ] [ mark>> ] bi set-model ; + +: change-caret ( editor quot: ( loc document -- newloc ) -- ) [ [ [ editor-caret ] [ model>> ] bi ] dip call ] [ drop ] 2bi set-caret ; inline : mark>caret ( editor -- ) [ editor-caret ] [ mark>> ] bi set-model ; -: change-caret&mark ( editor quot -- ) +: change-caret&mark ( editor quot: ( loc document -- newloc ) -- ) [ change-caret ] [ drop mark>caret ] 2bi ; inline : editor-line ( n editor -- str ) control-value nth ; @@ -132,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 ; @@ -153,17 +173,56 @@ M: editor ungraft* > ] [ blink>> ] } 1&& ; + { [ 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? [ - [ caret-color>> gl-color ] - [ - [ caret-loc ] [ caret-dim ] bi - over v+ gl-line - ] bi + [ editor-caret-color gl-color ] dip + draw-caret-shape ] [ drop ] if ; +:: draw-preedit-underlines ( editor -- ) + editor [ preedit? ] [ preedit-underlines>> ] bi and [ + editor [ caret-loc second ] [ caret-dim second ] bi + 2.0 - :> y + editor editor-caret first :> row + editor font>> foreground>> gl-color + editor preedit-underlines>> [ + GL_LINE_BIT [ + dup second glLineWidth + 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* + gl-line + ] do-attribs + ] each + ] when ; + : selection-start/end ( editor -- start end ) [ editor-mark ] [ editor-caret ] bi sort-pair ; @@ -173,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 -- ) @@ -199,20 +258,34 @@ TUPLE: selected-line start end first? last? ; ] 3bi ] if ; +: draw-default-text? ( editor -- ? ) + { [ default-text>> ] [ model>> doc-string empty? ] } 1&& ; + +: draw-default-text ( editor -- ) + [ font>> clone line-color >>foreground ] + [ default-text>> ] bi draw-text ; + 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 ; M: editor draw-gadget* - dup compute-selection selected-lines [ - [ draw-lines ] [ draw-caret ] bi - ] with-variable ; + dup draw-default-text? [ + [ draw-default-text ] [ draw-caret ] [ draw-preedit-underlines ] tri + ] [ + dup compute-selection selected-lines [ + [ draw-lines ] [ draw-caret ] [ draw-preedit-underlines ] tri + ] with-variable + ] 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>> ] [ control-value ] bi text-dim { 1 0 } v+ ; + [ font>> ] keep dup draw-default-text? + [ default-text>> ] [ control-value ] if + text-dim { 1 0 } v+ vmax ; M: editor baseline font>> font-metrics ascent>> ; @@ -249,6 +322,9 @@ M: editor gadget-selection M: editor user-input* [ selection-start/end ] [ model>> ] bi set-doc-range t ; +M: editor temp-im-input + [ selection-start/end ] [ model>> ] bi set-doc-range* t ; + : editor-string ( editor -- string ) model>> doc-string ; @@ -262,6 +338,21 @@ M: editor gadget-text* editor-string % ; [ restart-blinking ] [ dup caret>> click-loc ] tri ; +: remove-preedit-text ( editor -- ) + { [ preedit-start>> ] [ set-caret ] + [ preedit-end>> ] [ set-mark ] + [ remove-selection ] + } cleave ; + +: remove-preedit-info ( editor -- ) + f >>preedit-start + f >>preedit-end + f >>preedit-selected-start + f >>preedit-selected-end + f >>preedit-selection-mode? + f >>preedit-underlines + drop ; + : mouse-elt ( -- element ) hand-click# get { { 1 one-char-elt } @@ -339,23 +430,29 @@ M: editor gadget-text* editor-string % ; [ drop dup extend-selection dup mark>> click-loc ] [ select-elt ] if ; -: delete-next-character ( editor -- ) +: delete-previous-character ( editor -- ) + char-elt editor-backspace ; + +: delete-next-character ( editor -- ) char-elt editor-delete ; -: delete-previous-character ( editor -- ) - char-elt editor-backspace ; +: delete-previous-word ( editor -- ) + word-elt editor-backspace ; -: delete-previous-word ( editor -- ) +: delete-next-word ( editor -- ) word-elt editor-delete ; -: delete-next-word ( editor -- ) - word-elt editor-backspace ; +: delete-to-start-of-line ( editor -- ) + one-line-elt editor-backspace ; -: delete-to-start-of-line ( editor -- ) +: delete-to-end-of-line ( editor -- ) one-line-elt editor-delete ; -: delete-to-end-of-line ( editor -- ) - one-line-elt editor-backspace ; +: delete-to-start-of-document ( editor -- ) + doc-elt editor-delete ; + +: delete-to-end-of-document ( editor -- ) + doc-elt editor-delete ; : com-undo ( editor -- ) model>> undo ; @@ -366,16 +463,20 @@ 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-previous-word } - { T{ key-down f { C+ } "BACKSPACE" } delete-next-word } - { T{ key-down f { A+ } "DELETE" } delete-to-start-of-line } - { T{ key-down f { A+ } "BACKSPACE" } delete-to-end-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 ; -: paste-selection ( editor -- ) selection get paste-clipboard ; +: paste-selection ( editor -- ) ui.clipboards:selection get paste-clipboard ; : com-cut ( editor -- ) clipboard get editor-cut ; @@ -411,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 ; @@ -437,34 +551,40 @@ editor "caret-motion" f { [ dup select-word ] unless gadget-selection ; -: select-previous-character ( editor -- ) +: select-previous-character ( editor -- ) char-elt editor-select-prev ; -: select-next-character ( editor -- ) +: select-next-character ( editor -- ) char-elt editor-select-next ; -: select-previous-word ( editor -- ) +: select-previous-word ( editor -- ) word-elt editor-select-prev ; -: select-next-word ( editor -- ) +: select-next-word ( editor -- ) word-elt editor-select-next ; -: select-start-of-line ( editor -- ) +: select-start-of-line ( editor -- ) one-line-elt editor-select-prev ; -: select-end-of-line ( editor -- ) +: select-end-of-line ( editor -- ) one-line-elt editor-select-next ; -: select-start-of-document ( editor -- ) +: 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 ; -: select-end-of-document ( editor -- ) +: select-end-of-document ( editor -- ) doc-elt editor-select-next ; editor "selection" f { { T{ button-down f { S+ } 1 } extend-selection } { T{ button-up f { S+ } 1 } com-copy-selection } - { T{ drag } drag-selection } + { T{ drag { # 1 } } drag-selection } { gain-focus focus-editor } { lose-focus unfocus-editor } { delete-action remove-selection } @@ -472,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 -- ) { @@ -491,6 +620,7 @@ editor "selection" f { } show-commands-menu ; editor "misc" f { + ! { T{ button-down f f 2 } paste-selection } { T{ button-down f f 3 } editor-menu } } define-command-map @@ -506,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 ; @@ -531,30 +668,24 @@ PRIVATE> >size { 1 0 } >>fill - COLOR: gray >>boundary ; inline + field-border-color >>boundary ; inline : ( gadget -- border ) - { 2 2 } - { 1 0 } >>fill - field-theme ; + border new-border field-theme ; PRIVATE> @@ -628,6 +758,10 @@ M: field pref-dim* [ [ line-gadget-width ] [ drop second ] 2bi 2array ] tri border-pref-dim ; +M: field default-text>> editor>> default-text>> ; + +M: field default-text<< editor>> default-text<< ; + TUPLE: model-field < field field-model ; : ( model -- gadget ) @@ -647,8 +781,10 @@ M: model-field model-changed TUPLE: action-field < field quot ; -: ( quot -- gadget ) - action-field new-field +: ( quot: ( string -- ) -- gadget ) + action-field [ ] dip new-border + dup gadget-child >>editor + field-theme swap >>quot ; : invoke-action-field ( field -- ) @@ -660,3 +796,19 @@ TUPLE: action-field < field quot ; action-field H{ { T{ key-down f f "RET" } [ invoke-action-field ] } } set-gestures + +: readline-bindings ( editor-class -- ) + "readline" f { + { T{ key-down f { C+ } "p" } previous-line } + { T{ key-down f { C+ } "n" } next-line } + { T{ key-down f { C+ } "b" } previous-character } + { T{ key-down f { C+ } "f" } next-character } + { T{ key-down f { C+ } "a" } start-of-line } + { T{ key-down f { C+ } "e" } end-of-line } + ! { T{ key-down f { C+ } "t" } transpose-character } + { T{ key-down f { C+ } "d" } delete-next-character } + { T{ key-down f { C+ } "h" } delete-previous-character } + { T{ key-down f { C+ } "u" } delete-to-start-of-line } + { T{ key-down f { C+ } "k" } delete-to-end-of-line } + { T{ key-down f { C+ } "w" } delete-previous-word } + } define-command-map ;