factor/library/ui/editors.factor

161 lines
5.0 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
2005-10-03 19:53:32 -04:00
gadgets-menus gadgets-scrolling gadgets-theme generic kernel
lists 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
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 -- )
2005-10-07 20:26:21 -04:00
dup hand get relative 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 )
2005-10-03 20:54:05 -04:00
dupd [ [ complete ] with-editor drop ] curry curry cons ;
2005-10-03 19:53:32 -04:00
: <completion-menu> ( editor completions -- menu )
[ swap <completion-item> ] map-with <menu> ;
: completion-menu ( editor completions -- )
over >r <completion-menu> r> popup-location show-menu ;
: do-completion-1 ( editor completions -- )
swap [ first complete ] with-editor ;
: do-completion ( editor -- )
dup [ completions ] with-editor @{
@{ [ dup empty? ] [ 2drop ] }@
@{ [ dup length 1 = ] [ do-completion-1 ] }@
@{ [ t ] [ completion-menu ] }@
}@ cond ;
2005-02-27 16:51:12 -05:00
: editor-actions ( editor -- )
2005-10-07 20:26:21 -04:00
{{
2005-02-27 16:00:55 -05:00
[[ [ gain-focus ] [ focus-editor ] ]]
[[ [ lose-focus ] [ unfocus-editor ] ]]
[[ [ button-down 1 ] [ click-editor ] ]]
2005-10-01 01:44:49 -04:00
[[ [ "BACKSPACE" ] [ [ << char-elt >> delete-prev-elt ] with-editor ] ]]
[[ [ "DELETE" ] [ [ << char-elt >> delete-next-elt ] with-editor ] ]]
[[ [ "CTRL" "BACKSPACE" ] [ [ << word-elt >> delete-prev-elt ] with-editor ] ]]
[[ [ "CTRL" "DELETE" ] [ [ << word-elt >> delete-next-elt ] with-editor ] ]]
[[ [ "ALT" "BACKSPACE" ] [ [ << document-elt >> delete-prev-elt ] with-editor ] ]]
[[ [ "ALT" "DELETE" ] [ [ << document-elt >> delete-next-elt ] with-editor ] ]]
[[ [ "LEFT" ] [ [ << char-elt >> prev-elt ] with-editor ] ]]
[[ [ "RIGHT" ] [ [ << char-elt >> next-elt ] with-editor ] ]]
[[ [ "CTRL" "LEFT" ] [ [ << word-elt >> prev-elt ] with-editor ] ]]
[[ [ "CTRL" "RIGHT" ] [ [ << word-elt >> next-elt ] with-editor ] ]]
[[ [ "HOME" ] [ [ << document-elt >> prev-elt ] with-editor ] ]]
[[ [ "END" ] [ [ << document-elt >> next-elt ] with-editor ] ]]
2005-02-27 16:00:55 -05:00
[[ [ "CTRL" "k" ] [ [ line-clear ] with-editor ] ]]
2005-10-03 19:53:32 -04:00
[[ [ "TAB" ] [ do-completion ] ]]
2005-10-07 20:26:21 -04:00
}} 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
2005-04-30 17:17:10 -04:00
M: editor user-input* ( ch editor -- ? )
2005-10-05 02:01:06 -04:00
[ insert-char ] with-editor f ;
2005-02-27 16:00:55 -05:00
2005-06-28 23:50:23 -04:00
M: editor pref-dim ( editor -- dim )
2005-10-14 04:05:02 -04:00
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 ;