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

left and right arrow keys move between graphemes in UI

db4
Daniel Ehrenberg 2009-03-31 21:49:14 -05:00
parent 95d9b3a417
commit 3211270d5b
2 changed files with 60 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
basis/documents/elements/elements-tests.factor
View File

@ -3,68 +3,72 @@
USING: tools.test namespaces documents documents.elements multiline ; USING: tools.test namespaces documents documents.elements multiline ;
IN: document.elements.tests IN: document.elements.tests
<document> "doc" set SYMBOL: doc
"123\nabc" "doc" get set-doc-string <document> doc set
"123\nabcé" doc get set-doc-string
! char-elt ! char-elt
[ { 0 0 } ] [ { 0 0 } "doc" get char-elt prev-elt ] unit-test [ { 0 0 } ] [ { 0 0 } doc get char-elt prev-elt ] unit-test
[ { 0 0 } ] [ { 0 1 } "doc" get char-elt prev-elt ] unit-test [ { 0 0 } ] [ { 0 1 } doc get char-elt prev-elt ] unit-test
[ { 0 3 } ] [ { 1 0 } "doc" get char-elt prev-elt ] unit-test [ { 0 3 } ] [ { 1 0 } doc get char-elt prev-elt ] unit-test
[ { 1 3 } ] [ { 1 5 } doc get char-elt prev-elt ] unit-test
[ { 1 3 } ] [ { 1 3 } "doc" get char-elt next-elt ] unit-test [ { 1 5 } ] [ { 1 5 } doc get char-elt next-elt ] unit-test
[ { 0 2 } ] [ { 0 1 } "doc" get char-elt next-elt ] unit-test [ { 0 2 } ] [ { 0 1 } doc get char-elt next-elt ] unit-test
[ { 1 0 } ] [ { 0 3 } "doc" get char-elt next-elt ] unit-test [ { 1 0 } ] [ { 0 3 } doc get char-elt next-elt ] unit-test
[ { 1 5 } ] [ { 1 3 } doc get char-elt next-elt ] unit-test
! word-elt ! word-elt
<document> "doc" set <document> doc set
"Hello world\nanother line" "doc" get set-doc-string "Hello world\nanother line" doc get set-doc-string
[ { 0 0 } ] [ { 0 0 } "doc" get word-elt prev-elt ] unit-test [ { 0 0 } ] [ { 0 0 } doc get word-elt prev-elt ] unit-test
[ { 0 0 } ] [ { 0 2 } "doc" get word-elt prev-elt ] unit-test [ { 0 0 } ] [ { 0 2 } doc get word-elt prev-elt ] unit-test
[ { 0 0 } ] [ { 0 5 } "doc" get word-elt prev-elt ] unit-test [ { 0 0 } ] [ { 0 5 } doc get word-elt prev-elt ] unit-test
[ { 0 5 } ] [ { 0 6 } "doc" get word-elt prev-elt ] unit-test [ { 0 5 } ] [ { 0 6 } doc get word-elt prev-elt ] unit-test
[ { 0 6 } ] [ { 0 8 } "doc" get word-elt prev-elt ] unit-test [ { 0 6 } ] [ { 0 8 } doc get word-elt prev-elt ] unit-test
[ { 0 11 } ] [ { 1 0 } "doc" get word-elt prev-elt ] unit-test [ { 0 11 } ] [ { 1 0 } doc get word-elt prev-elt ] unit-test
[ { 0 5 } ] [ { 0 0 } doc get word-elt next-elt ] unit-test
[ { 0 6 } ] [ { 0 5 } doc get word-elt next-elt ] unit-test
[ { 0 11 } ] [ { 0 6 } doc get word-elt next-elt ] unit-test
[ { 1 0 } ] [ { 0 11 } doc get word-elt next-elt ] unit-test
[ { 0 5 } ] [ { 0 0 } "doc" get word-elt next-elt ] unit-test
[ { 0 6 } ] [ { 0 5 } "doc" get word-elt next-elt ] unit-test
[ { 0 11 } ] [ { 0 6 } "doc" get word-elt next-elt ] unit-test
[ { 1 0 } ] [ { 0 11 } "doc" get word-elt next-elt ] unit-test
! one-word-elt ! one-word-elt
[ { 0 0 } ] [ { 0 0 } "doc" get one-word-elt prev-elt ] unit-test [ { 0 0 } ] [ { 0 0 } doc get one-word-elt prev-elt ] unit-test
[ { 0 0 } ] [ { 0 2 } "doc" get one-word-elt prev-elt ] unit-test [ { 0 0 } ] [ { 0 2 } doc get one-word-elt prev-elt ] unit-test
[ { 0 0 } ] [ { 0 5 } "doc" get one-word-elt prev-elt ] unit-test [ { 0 0 } ] [ { 0 5 } doc get one-word-elt prev-elt ] unit-test
[ { 0 5 } ] [ { 0 2 } "doc" get one-word-elt next-elt ] unit-test [ { 0 5 } ] [ { 0 2 } doc get one-word-elt next-elt ] unit-test
[ { 0 5 } ] [ { 0 5 } "doc" get one-word-elt next-elt ] unit-test [ { 0 5 } ] [ { 0 5 } doc get one-word-elt next-elt ] unit-test
! line-elt ! line-elt
<document> "doc" set <document> doc set
"Hello\nworld, how are\nyou?" "doc" get set-doc-string "Hello\nworld, how are\nyou?" doc get set-doc-string
[ { 0 0 } ] [ { 0 3 } "doc" get line-elt prev-elt ] unit-test [ { 0 0 } ] [ { 0 3 } doc get line-elt prev-elt ] unit-test
[ { 0 3 } ] [ { 1 3 } "doc" get line-elt prev-elt ] unit-test [ { 0 3 } ] [ { 1 3 } doc get line-elt prev-elt ] unit-test
[ { 2 4 } ] [ { 2 1 } "doc" get line-elt next-elt ] unit-test [ { 2 4 } ] [ { 2 1 } doc get line-elt next-elt ] unit-test
! one-line-elt ! one-line-elt
[ { 1 0 } ] [ { 1 3 } "doc" get one-line-elt prev-elt ] unit-test [ { 1 0 } ] [ { 1 3 } doc get one-line-elt prev-elt ] unit-test
[ { 1 14 } ] [ { 1 3 } "doc" get one-line-elt next-elt ] unit-test [ { 1 14 } ] [ { 1 3 } doc get one-line-elt next-elt ] unit-test
! page-elt ! page-elt
<document> "doc" set <document> doc set
<" First line <" First line
Second line Second line
Third line Third line
Fourth line Fourth line
Fifth line Fifth line
Sixth line"> "doc" get set-doc-string Sixth line"> doc get set-doc-string
[ { 0 0 } ] [ { 3 3 } "doc" get 4 <page-elt> prev-elt ] unit-test [ { 0 0 } ] [ { 3 3 } doc get 4 <page-elt> prev-elt ] unit-test
[ { 1 2 } ] [ { 5 2 } "doc" get 4 <page-elt> prev-elt ] unit-test [ { 1 2 } ] [ { 5 2 } doc get 4 <page-elt> prev-elt ] unit-test
[ { 4 3 } ] [ { 0 3 } "doc" get 4 <page-elt> next-elt ] unit-test [ { 4 3 } ] [ { 0 3 } doc get 4 <page-elt> next-elt ] unit-test
[ { 5 10 } ] [ { 4 2 } "doc" get 4 <page-elt> next-elt ] unit-test [ { 5 10 } ] [ { 4 2 } doc get 4 <page-elt> next-elt ] unit-test
! doc-elt ! doc-elt
[ { 0 0 } ] [ { 3 4 } "doc" get doc-elt prev-elt ] unit-test [ { 0 0 } ] [ { 3 4 } doc get doc-elt prev-elt ] unit-test
[ { 5 10 } ] [ { 3 4 } "doc" get doc-elt next-elt ] unit-test [ { 5 10 } ] [ { 3 4 } doc get doc-elt next-elt ] unit-test

32
basis/documents/elements/elements.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2009 Slava Pestov. ! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays combinators documents fry kernel math sequences USING: arrays combinators documents fry kernel math sequences
accessors unicode.categories combinators.short-circuit ; accessors unicode.categories unicode.breaks combinators.short-circuit ;
IN: documents.elements IN: documents.elements
GENERIC: prev-elt ( loc document elt -- newloc ) GENERIC: prev-elt ( loc document elt -- newloc )
@ -27,20 +27,25 @@ SINGLETON: char-elt
[ call ] [ call ]
} cond ; inline } cond ; inline
: next ( loc document quot: ( loc document -- loc ) : next ( loc document quot: ( loc document -- loc ) -- loc )
{ {
{ [ 2over doc-end = ] [ 2drop ] } { [ 2over doc-end = ] [ 2drop ] }
{ [ 2over line-end? ] [ 2drop first 1+ 0 2array ] } { [ 2over line-end? ] [ 2drop first 1+ 0 2array ] }
[ call ] [ call ]
} cond ; inline } cond ; inline
: modify-col ( loc document quot: ( col str -- col' ) -- loc )
pick [
[ [ first2 swap ] dip doc-line ] dip call
] dip =col ; inline
PRIVATE> PRIVATE>
M: char-elt prev-elt M: char-elt prev-elt
drop [ drop -1 +col ] prev ; drop [ [ last-grapheme-from ] modify-col ] prev ;
M: char-elt next-elt M: char-elt next-elt
drop [ drop 1 +col ] next ; drop [ [ first-grapheme-from ] modify-col ] next ;
SINGLETON: one-char-elt SINGLETON: one-char-elt
@ -50,22 +55,17 @@ M: one-char-elt next-elt 2drop ;
<PRIVATE <PRIVATE
: (word-elt) ( loc document quot -- loc )
pick [
[ [ first2 swap ] dip doc-line ] dip call
] dip =col ; inline
: blank-at? ( n seq -- n seq ? ) : blank-at? ( n seq -- n seq ? )
2dup ?nth blank? ; 2dup ?nth blank? ;
: break-detector ( ? -- quot ) : break-detector ( ? -- quot )
'[ blank? _ xor ] ; inline '[ blank? _ xor ] ; inline
: (prev-word) ( col str ? -- col ) : prev-word ( col str ? -- col )
break-detector find-last-from drop ?1+ ; break-detector find-last-from drop ?1+ ;
: (next-word) ( col str ? -- col ) : next-word ( col str ? -- col )
{ [ break-detector find-from drop ] [ drop length ] } 2|| ; [ break-detector find-from drop ] [ drop length ] 2bi or ;
PRIVATE> PRIVATE>
@ -73,22 +73,22 @@ SINGLETON: one-word-elt
M: one-word-elt prev-elt M: one-word-elt prev-elt
drop drop
[ [ 1- ] dip f (prev-word) ] (word-elt) ; [ [ 1- ] dip f prev-word ] modify-col ;
M: one-word-elt next-elt M: one-word-elt next-elt
drop drop
[ f (next-word) ] (word-elt) ; [ f next-word ] modify-col ;
SINGLETON: word-elt SINGLETON: word-elt
M: word-elt prev-elt M: word-elt prev-elt
drop drop
[ [ [ 1- ] dip blank-at? (prev-word) ] (word-elt) ] [ [ [ 1- ] dip blank-at? prev-word ] modify-col ]
prev ; prev ;
M: word-elt next-elt M: word-elt next-elt
drop drop
[ [ blank-at? (next-word) ] (word-elt) ] [ [ blank-at? next-word ] modify-col ]
next ; next ;
SINGLETON: one-line-elt SINGLETON: one-line-elt