factor/library/ui/editors.factor

167 lines
5.3 KiB
Factor
Raw Normal View History

2005-02-11 19:09:48 -05:00
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: gadgets-editors
2005-10-14 04:05:02 -04:00
USING: arrays freetype gadgets gadgets-labels gadgets-layouts
2006-05-15 01:01:47 -04:00
gadgets-scrolling gadgets-theme generic kernel math namespaces
sequences strings styles threads ;
2005-08-23 18:16:42 -04:00
! A blinking caret
TUPLE: caret ;
C: caret ( -- caret )
2005-10-09 21:27:14 -04:00
dup delegate>gadget dup caret-theme ;
2005-08-23 18:16:42 -04:00
2005-08-24 00:30:07 -04:00
M: caret tick ( ms caret -- ) nip toggle-visible ;
2005-08-23 18:16:42 -04:00
: caret-blink 500 ;
2005-08-23 18:16:42 -04:00
2005-08-23 20:27:42 -04:00
: add-caret ( caret parent -- )
dupd add-gadget caret-blink add-timer ;
2005-08-23 20:27:42 -04:00
: unparent-caret ( caret -- )
dup remove-timer unparent ;
: reset-caret ( caret -- )
2005-09-28 23:29:00 -04:00
dup restart-timer show-gadget ;
2005-08-23 18:16:42 -04:00
USE: line-editor
2005-02-11 19:09:48 -05:00
2005-02-27 16:00:55 -05:00
! An editor gadget wraps a line editor object and passes
! gestures to the line editor.
2005-10-27 16:17:50 -04:00
TUPLE: editor line caret font color ;
2005-02-11 19:09:48 -05:00
2005-10-10 21:12:53 -04:00
: scroll>caret ( editor -- ) editor-caret scroll-to ;
2005-07-09 18:32:31 -04:00
: with-editor ( editor quot -- )
#! Execute a quotation in the line editor scope, then
#! update the display.
swap [ editor-line swap bind ] keep
2005-08-23 20:27:42 -04:00
dup editor-caret reset-caret
2005-10-10 21:12:53 -04:00
dup relayout scroll>caret ; inline
2005-07-09 18:32:31 -04:00
2005-02-11 19:09:48 -05:00
: editor-text ( editor -- text )
editor-line [ line-text get ] bind ;
2005-02-11 19:11:31 -05:00
: set-editor-text ( text editor -- )
2005-07-09 18:32:31 -04:00
[ set-line-text ] with-editor ;
2005-02-11 19:11:31 -05:00
2006-05-18 22:01:38 -04:00
: commit-editor-text ( editor -- line )
#! Add current line to the history, and clear the editor.
[ commit-history line-text get line-clear ] with-editor ;
2005-02-12 21:15:30 -05:00
: focus-editor ( editor -- )
2005-08-23 18:16:42 -04:00
dup editor-caret swap add-caret ;
2005-02-12 21:15:30 -05:00
: unfocus-editor ( editor -- )
2005-08-23 18:16:42 -04:00
editor-caret unparent-caret ;
2005-02-12 21:15:30 -05:00
: run-char-widths ( font str -- wlist )
2005-02-19 17:54:04 -05:00
#! List of x co-ordinates of each character.
2005-10-20 04:33:22 -04:00
>array [ char-width ] map-with
dup 0 [ + ] accumulate swap 2 v/n v+ ;
2005-02-19 17:54:04 -05:00
: x>offset ( x font str -- offset )
2005-07-24 23:35:34 -04:00
dup >r run-char-widths [ <= ] find-with drop dup -1 =
2005-09-24 15:21:17 -04:00
[ drop r> length ] [ r> drop ] if ;
2005-02-12 21:15:30 -05:00
2005-02-27 16:00:55 -05:00
: set-caret-x ( x editor -- )
#! Move the caret to a clicked location.
dup [
2005-10-27 16:17:50 -04:00
label-font* line-text get x>offset set-caret-pos
] with-editor ;
2005-02-27 16:00:55 -05:00
: click-editor ( editor -- )
2006-03-19 02:43:06 -05:00
dup hand-click-rel first over set-caret-x request-focus ;
2005-02-27 16:00:55 -05:00
2005-10-03 19:53:32 -04:00
: popup-location ( editor -- loc )
dup screen-loc swap editor-caret rect-extent nip v+ ;
: <completion-item> ( completion editor -- menu-item )
dupd [ [ complete ] with-editor drop ] curry curry 2array ;
2005-10-03 19:53:32 -04:00
2006-03-24 03:28:46 -05:00
! : <completion-menu> ( editor completions -- menu )
! [ swap <completion-item> ] map-with <menu> ;
2005-10-03 19:53:32 -04:00
: completion-menu ( editor completions -- )
2006-03-24 03:28:46 -05:00
2drop ;
! over popup-location -rot
! over >r <completion-menu> r> show-menu ;
2005-10-03 19:53:32 -04:00
: do-completion-1 ( editor completions -- )
swap [ first complete ] with-editor ;
: do-completion ( editor -- )
dup [ line-completions ] with-editor {
{ [ dup empty? ] [ 2drop ] }
{ [ dup length 1 = ] [ do-completion-1 ] }
{ [ t ] [ completion-menu ] }
} cond ;
2005-10-03 19:53:32 -04:00
2005-02-27 16:51:12 -05:00
: editor-actions ( editor -- )
H{
2006-05-18 22:01:38 -04:00
{ T{ gain-focus } [ focus-editor ] }
{ T{ lose-focus } [ unfocus-editor ] }
{ T{ button-down } [ click-editor ] }
{ T{ key-down f f "BACKSPACE" } [ [ T{ char-elt } delete-prev-elt ] with-editor ] }
{ T{ key-down f f "DELETE" } [ [ T{ char-elt } delete-next-elt ] with-editor ] }
{ T{ key-down f { C+ } "BACKSPACE" } [ [ T{ word-elt } delete-prev-elt ] with-editor ] }
{ T{ key-down f { C+ } "DELETE" } [ [ T{ word-elt } delete-next-elt ] with-editor ] }
{ T{ key-down f { A+ } "BACKSPACE" } [ [ T{ document-elt } delete-prev-elt ] with-editor ] }
{ T{ key-down f { A+ } "DELETE" } [ [ T{ document-elt } delete-next-elt ] with-editor ] }
{ T{ key-down f f "LEFT" } [ [ T{ char-elt } prev-elt ] with-editor ] }
{ T{ key-down f f "RIGHT" } [ [ T{ char-elt } next-elt ] with-editor ] }
{ T{ key-down f { C+ } "LEFT" } [ [ T{ word-elt } prev-elt ] with-editor ] }
{ T{ key-down f { C+ } "RIGHT" } [ [ T{ word-elt } next-elt ] with-editor ] }
{ T{ key-down f f "HOME" } [ [ T{ document-elt } prev-elt ] with-editor ] }
{ T{ key-down f f "END" } [ [ T{ document-elt } next-elt ] with-editor ] }
{ T{ key-down f { C+ } "k" } [ [ line-clear ] with-editor ] }
{ T{ key-down f f "TAB" } [ do-completion ] }
} add-actions ;
2005-02-27 16:00:55 -05:00
C: editor ( text -- )
2005-10-09 21:27:14 -04:00
dup delegate>gadget
2005-09-28 23:29:00 -04:00
dup editor-theme
2005-08-26 21:42:43 -04:00
<line-editor> over set-editor-line
<caret> over set-editor-caret
2005-02-27 16:00:55 -05:00
[ set-editor-text ] keep
2005-02-27 16:51:12 -05:00
dup editor-actions ;
2005-02-27 16:00:55 -05:00
2005-06-27 03:47:22 -04:00
: offset>x ( gadget offset str -- x )
2005-10-27 16:17:50 -04:00
head-slice >r label-font* r> string-width ;
2005-02-27 16:00:55 -05:00
2005-07-08 01:32:29 -04:00
: caret-loc ( editor -- x y )
2005-10-01 01:44:49 -04:00
dup editor-line [ caret-pos line-text get ] bind offset>x
0 0 3array ;
2005-02-12 21:15:30 -05:00
2005-07-08 01:32:29 -04:00
: caret-dim ( editor -- w h )
rect-dim { 0 1 1 } v* { 1 0 0 } v+ ;
2005-02-12 21:15:30 -05:00
2006-03-14 21:09:25 -05:00
M: editor user-input* ( str editor -- ? )
[ insert-string ] with-editor f ;
2005-02-27 16:00:55 -05:00
M: editor pref-dim* ( editor -- dim )
label-size { 1 0 0 } v+ ;
2005-04-30 17:17:10 -04:00
M: editor layout* ( editor -- )
2005-07-08 01:32:29 -04:00
dup editor-caret over caret-dim swap set-gadget-dim
dup editor-caret swap caret-loc swap set-rect-loc ;
2005-02-11 19:09:48 -05:00
2005-10-27 16:17:50 -04:00
M: editor label-text editor-text ;
M: editor label-color editor-color ;
M: editor label-font editor-font ;
M: editor set-label-text set-editor-text ;
M: editor set-label-color set-editor-color ;
M: editor set-label-font set-editor-font ;
2005-10-14 04:05:02 -04:00
2005-10-25 21:52:26 -04:00
M: editor draw-gadget* ( editor -- ) draw-label ;
2005-10-03 19:53:32 -04:00
: set-possibilities ( possibilities editor -- )
#! Set completion possibilities.
[ possibilities set ] with-editor ;