Clean up documents.elements a bit, add more tests, add page-elt
parent
d26ae3d141
commit
e0b074f3a5
|
@ -89,6 +89,11 @@ namespaces tools.test make arrays kernel fry ;
|
||||||
"doc" get doc-string
|
"doc" get doc-string
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
<document> "doc" set
|
||||||
|
"Hello\nworld, how are\nyou?" "doc" get set-doc-string
|
||||||
|
|
||||||
|
[ { 2 4 } ] [ "doc" get doc-end ] unit-test
|
||||||
|
|
||||||
! Undo/redo
|
! Undo/redo
|
||||||
[ ] [ <document> "d" set ] unit-test
|
[ ] [ <document> "d" set ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -1,21 +1,70 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: tools.test namespaces documents documents.elements ;
|
USING: tools.test namespaces documents documents.elements multiline ;
|
||||||
IN: document.elements.tests
|
IN: document.elements.tests
|
||||||
|
|
||||||
<document> "doc" set
|
<document> "doc" set
|
||||||
"Hello world" "doc" get set-doc-string
|
"123\nabc" "doc" get set-doc-string
|
||||||
|
|
||||||
|
! char-elt
|
||||||
|
[ { 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 3 } ] [ { 1 0 } "doc" get char-elt prev-elt ] unit-test
|
||||||
|
|
||||||
|
[ { 1 3 } ] [ { 1 3 } "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
|
||||||
|
|
||||||
|
! word-elt
|
||||||
|
<document> "doc" set
|
||||||
|
"Hello world\nanother line" "doc" get set-doc-string
|
||||||
|
|
||||||
|
[ { 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 5 } "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 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
|
||||||
|
|
||||||
|
! 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
|
||||||
<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
|
||||||
|
|
||||||
[ { 2 4 } ] [ "doc" get doc-end ] unit-test
|
|
||||||
|
|
||||||
[ { 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
|
||||||
|
[ { 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
|
||||||
|
|
||||||
|
! page-elt
|
||||||
|
<document> "doc" set
|
||||||
|
<" First line
|
||||||
|
Second line
|
||||||
|
Third line
|
||||||
|
Fourth line
|
||||||
|
Fifth line
|
||||||
|
Sixth line"> "doc" get set-doc-string
|
||||||
|
|
||||||
|
[ { 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
|
||||||
|
|
||||||
|
[ { 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
|
||||||
|
|
||||||
|
! doc-elt
|
||||||
|
[ { 0 0 } ] [ { 3 4 } "doc" get doc-elt prev-elt ] unit-test
|
||||||
|
[ { 5 10 } ] [ { 3 4 } "doc" get doc-elt next-elt ] unit-test
|
|
@ -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
|
||||||
unicode.categories ;
|
unicode.categories accessors ;
|
||||||
IN: documents.elements
|
IN: documents.elements
|
||||||
|
|
||||||
GENERIC: prev-elt ( loc document elt -- newloc )
|
GENERIC: prev-elt ( loc document elt -- newloc )
|
||||||
|
@ -55,18 +55,17 @@ M: one-char-elt next-elt 2drop ;
|
||||||
[ [ first2 swap ] dip doc-line ] dip call
|
[ [ first2 swap ] dip doc-line ] dip call
|
||||||
] dip =col ; inline
|
] dip =col ; inline
|
||||||
|
|
||||||
: ((word-elt)) ( n seq -- ? n seq )
|
: ((word-elt)) ( n seq -- n seq ? )
|
||||||
[ ?nth blank? ] 2keep ;
|
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 )
|
||||||
rot break-detector find-last-from drop ?1+ ;
|
break-detector find-last-from drop ?1+ ;
|
||||||
|
|
||||||
: (next-word) ( ? col str -- col )
|
: (next-word) ( col str ? -- col )
|
||||||
[ rot break-detector find-from drop ] keep
|
[ break-detector find-from drop ] [ drop length ] 2bi or ;
|
||||||
over not [ nip length ] [ drop ] if ;
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
@ -74,11 +73,11 @@ SINGLETON: one-word-elt
|
||||||
|
|
||||||
M: one-word-elt prev-elt
|
M: one-word-elt prev-elt
|
||||||
drop
|
drop
|
||||||
[ [ [ f ] dip 1- ] dip (prev-word) ] (word-elt) ;
|
[ [ 1- ] dip f (prev-word) ] (word-elt) ;
|
||||||
|
|
||||||
M: one-word-elt next-elt
|
M: one-word-elt next-elt
|
||||||
drop
|
drop
|
||||||
[ [ f ] 2dip (next-word) ] (word-elt) ;
|
[ f (next-word) ] (word-elt) ;
|
||||||
|
|
||||||
SINGLETON: word-elt
|
SINGLETON: word-elt
|
||||||
|
|
||||||
|
@ -100,14 +99,20 @@ M: one-line-elt prev-elt
|
||||||
M: one-line-elt next-elt
|
M: one-line-elt next-elt
|
||||||
drop [ first dup ] dip doc-line length 2array ;
|
drop [ first dup ] dip doc-line length 2array ;
|
||||||
|
|
||||||
SINGLETON: line-elt
|
TUPLE: page-elt { lines read-only } ;
|
||||||
|
|
||||||
M: line-elt prev-elt
|
C: <page-elt> page-elt
|
||||||
2drop dup first zero? [ drop { 0 0 } ] [ -1 +line ] if ;
|
|
||||||
|
|
||||||
M: line-elt next-elt
|
M: page-elt prev-elt
|
||||||
drop over first over last-line# number=
|
nip
|
||||||
[ nip doc-end ] [ drop 1 +line ] if ;
|
2dup [ first ] [ lines>> ] bi* <
|
||||||
|
[ 2drop { 0 0 } ] [ lines>> neg +line ] if ;
|
||||||
|
|
||||||
|
M: page-elt next-elt
|
||||||
|
3dup [ first ] [ last-line# ] [ lines>> ] tri* - >
|
||||||
|
[ drop nip doc-end ] [ nip lines>> +line ] if ;
|
||||||
|
|
||||||
|
CONSTANT: line-elt T{ page-elt f 1 }
|
||||||
|
|
||||||
SINGLETON: doc-elt
|
SINGLETON: doc-elt
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue