steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clicking past the end of a document moves caret to the end

db4
Slava Pestov 2008-11-25 23:04:57 -06:00
parent f8d4935e0d
commit f3cdd650e7
1 changed files with 37 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
basis/ui/gadgets/editors/editors.factor
View File

@ -1,12 +1,12 @@
! Copyright (C) 2006, 2008 Slava Pestov ! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays documents io kernel math models USING: accessors arrays documents io kernel math models
namespaces make opengl opengl.gl sequences strings io.styles namespaces locals fry make opengl opengl.gl sequences strings
math.vectors sorting colors combinators assocs math.order fry io.styles math.vectors sorting colors combinators assocs
calendar alarms ui.clipboards ui.commands ui.gadgets math.order fry calendar alarms ui.clipboards ui.commands
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels ui.gadgets ui.gadgets.borders ui.gadgets.buttons
ui.gadgets.scrollers ui.gadgets.theme ui.gadgets.wrappers ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.theme
ui.render ui.gestures math.geometry.rect ; ui.gadgets.wrappers ui.render ui.gestures math.geometry.rect ;
IN: ui.gadgets.editors IN: ui.gadgets.editors
TUPLE: editor < gadget TUPLE: editor < gadget
@ -104,14 +104,20 @@ M: editor ungraft*
editor-font* "" string-height ; editor-font* "" string-height ;
: y>line ( y editor -- line# ) : y>line ( y editor -- line# )
[ line-height / >fixnum ] keep model>> validate-line ; line-height / >fixnum ;
: point>loc ( point editor -- loc ) :: point>loc ( point editor -- loc )
[ point second editor y>line {
[ first2 ] dip tuck y>line dup , { [ dup 0 < ] [ drop { 0 0 } ] }
[ dup editor-font* ] dip { [ dup editor model>> last-line# > ] [ drop editor model>> doc-end ] }
rot editor-line x>offset , [| n |
] { } make ; n
point first
editor editor-font*
n editor editor-line
x>offset 2array
]
} cond ;
: clicked-loc ( editor -- loc ) : clicked-loc ( editor -- loc )
[ hand-rel ] keep point>loc ; [ hand-rel ] keep point>loc ;
@ -141,8 +147,8 @@ M: editor ungraft*
line-height * ; line-height * ;
: caret-loc ( editor -- loc ) : caret-loc ( editor -- loc )
[ editor-caret* ] keep 2dup loc>x [ editor-caret* ] keep
rot first rot line>y 2array ; [ loc>x ] [ [ first ] dip line>y ] 2bi 2array ;
: caret-dim ( editor -- dim ) : caret-dim ( editor -- dim )
line-height 0 swap 2array ; line-height 0 swap 2array ;
@ -175,12 +181,16 @@ M: editor ungraft*
[ font>> ] dip { 0 0 } draw-string ; [ font>> ] dip { 0 0 } draw-string ;
: first-visible-line ( editor -- n ) : first-visible-line ( editor -- n )
clip get rect-loc second origin get second - [
swap y>line ; [ clip get rect-loc second origin get second - ] dip
y>line
] keep model>> validate-line ;
: last-visible-line ( editor -- n ) : last-visible-line ( editor -- n )
clip get rect-extent nip second origin get second - [
swap y>line 1+ ; [ clip get rect-extent nip second origin get second - ] dip
y>line
] keep model>> validate-line 1+ ;
: with-editor ( editor quot -- ) : with-editor ( editor quot -- )
[ [
@ -193,9 +203,8 @@ M: editor ungraft*
] with-scope ; inline ] with-scope ; inline
: visible-lines ( editor -- seq ) : visible-lines ( editor -- seq )
\ first-visible-line get [ \ first-visible-line get \ last-visible-line get ] dip
\ last-visible-line get control-value <slice> ;
rot control-value <slice> ;
: with-editor-translation ( n quot -- ) : with-editor-translation ( n quot -- )
[ line-translation origin get v+ ] dip with-translation ; [ line-translation origin get v+ ] dip with-translation ;
@ -313,9 +322,9 @@ M: editor gadget-text* editor-string % ;
: editor-cut ( editor clipboard -- ) : editor-cut ( editor clipboard -- )
dupd gadget-copy remove-selection ; dupd gadget-copy remove-selection ;
: delete/backspace ( elt editor quot -- ) : delete/backspace ( editor quot -- )
over gadget-selection? [ over gadget-selection? [
drop nip remove-selection drop remove-selection
] [ ] [
[ [ [ editor-caret* ] [ model>> ] bi ] dip call ] [ [ [ editor-caret* ] [ model>> ] bi ] dip call ]
[ drop model>> ] [ drop model>> ]
@ -323,19 +332,19 @@ M: editor gadget-text* editor-string % ;
] if ; inline ] if ; inline
: editor-delete ( editor elt -- ) : editor-delete ( editor elt -- )
swap [ over [ rot next-elt ] dip swap ] delete/backspace ; '[ dupd _ next-elt ] delete/backspace ;
: editor-backspace ( editor elt -- ) : editor-backspace ( editor elt -- )
swap [ over [ rot prev-elt ] dip ] delete/backspace ; '[ over [ _ prev-elt ] dip ] delete/backspace ;
: editor-select-prev ( editor elt -- ) : editor-select-prev ( editor elt -- )
swap [ rot prev-elt ] change-caret ; '[ _ prev-elt ] change-caret ;
: editor-prev ( editor elt -- ) : editor-prev ( editor elt -- )
dupd editor-select-prev mark>caret ; dupd editor-select-prev mark>caret ;
: editor-select-next ( editor elt -- ) : editor-select-next ( editor elt -- )
swap [ rot next-elt ] change-caret ; '[ _ next-elt ] change-caret ;
: editor-next ( editor elt -- ) : editor-next ( editor elt -- )
dupd editor-select-next mark>caret ; dupd editor-select-next mark>caret ;