1 ! Copyright (C) 2006, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays combinators documents fry kernel math sequences
4 unicode.categories accessors ;
7 GENERIC: prev-elt ( loc document elt -- newloc )
8 GENERIC: next-elt ( loc document elt -- newloc )
10 : prev/next-elt ( loc document elt -- start end )
11 [ prev-elt ] [ next-elt ] 3bi ;
13 : elt-string ( loc document elt -- string )
14 [ prev/next-elt ] [ drop ] 2bi doc-range ;
16 : set-elt-string ( string loc document elt -- )
17 [ prev/next-elt ] [ drop ] 2bi set-doc-range ;
23 : (prev-char) ( loc document quot -- loc )
25 { [ pick { 0 0 } = ] [ 2drop ] }
26 { [ pick second zero? ] [ drop [ first 1- ] dip line-end ] }
30 : (next-char) ( loc document quot -- loc )
32 { [ 2over doc-end = ] [ 2drop ] }
33 { [ 2over line-end? ] [ 2drop first 1+ 0 2array ] }
40 drop [ drop -1 +col ] (prev-char) ;
43 drop [ drop 1 +col ] (next-char) ;
45 SINGLETON: one-char-elt
47 M: one-char-elt prev-elt 2drop ;
49 M: one-char-elt next-elt 2drop ;
53 : (word-elt) ( loc document quot -- loc )
55 [ [ first2 swap ] dip doc-line ] dip call
58 : ((word-elt)) ( n seq -- n seq ? )
61 : break-detector ( ? -- quot )
62 '[ blank? _ xor ] ; inline
64 : (prev-word) ( col str ? -- col )
65 break-detector find-last-from drop ?1+ ;
67 : (next-word) ( col str ? -- col )
68 [ break-detector find-from drop ] [ drop length ] 2bi or ;
72 SINGLETON: one-word-elt
74 M: one-word-elt prev-elt
76 [ [ 1- ] dip f (prev-word) ] (word-elt) ;
78 M: one-word-elt next-elt
80 [ f (next-word) ] (word-elt) ;
86 [ [ [ 1- ] dip ((word-elt)) (prev-word) ] (word-elt) ]
91 [ [ ((word-elt)) (next-word) ] (word-elt) ]
94 SINGLETON: one-line-elt
96 M: one-line-elt prev-elt
97 2drop first 0 2array ;
99 M: one-line-elt next-elt
100 drop [ first dup ] dip doc-line length 2array ;
102 TUPLE: page-elt { lines read-only } ;
104 C: <page-elt> page-elt
108 2dup [ first ] [ lines>> ] bi* <
109 [ 2drop { 0 0 } ] [ lines>> neg +line ] if ;
112 3dup [ first ] [ last-line# ] [ lines>> ] tri* - >
113 [ drop nip doc-end ] [ nip lines>> +line ] if ;
115 CONSTANT: line-elt T{ page-elt f 1 }
119 M: doc-elt prev-elt 3drop { 0 0 } ;
121 M: doc-elt next-elt drop nip doc-end ;