Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / documents / elements / elements.factor

diff --git a/basis/documents/elements/elements.factor b/basis/documents/elements/elements.factor
index 977628cdc397d06af7daa1760826d26b88db0362..7ba3cb8a6eddf866f6a61e69d461c911f616958a 100644 (file)
--- a/basis/documents/elements/elements.factor
+++ b/basis/documents/elements/elements.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays combinators documents fry kernel math sequences
-unicode.categories ;
+accessors unicode.categories unicode.breaks combinators.short-circuit ;
 IN: documents.elements
 
 GENERIC: prev-elt ( loc document elt -- newloc )
@@ -20,27 +20,32 @@ SINGLETON: char-elt
 
 <PRIVATE
 
-: (prev-char) ( loc document quot -- loc )
+: prev ( loc document quot: ( loc document -- loc ) -- loc )
     {
         { [ pick { 0 0 } = ] [ 2drop ] }
-        { [ pick second zero? ] [ drop [ first 1- ] dip line-end ] }
+        { [ pick second zero? ] [ drop [ first 1 - ] dip line-end ] }
         [ call ]
     } cond ; inline
 
-: (next-char) ( loc document quot -- loc )
+: next ( loc document quot: ( loc document -- loc ) -- loc )
     {
         { [ 2over doc-end = ] [ 2drop ] }
-        { [ 2over line-end? ] [ 2drop first 1+ 0 2array ] }
+        { [ 2over line-end? ] [ 2drop first 1 + 0 2array ] }
         [ call ]
     } cond ; inline
 
+: modify-col ( loc document quot: ( col str -- col' ) -- loc )
+    pick [
+        [ [ first2 swap ] dip doc-line ] dip call
+    ] dip =col ; inline
+
 PRIVATE>
 
 M: char-elt prev-elt
-    drop [ drop -1 +col ] (prev-char) ;
+    drop [ [ last-grapheme-from ] modify-col ] prev ;
 
 M: char-elt next-elt
-    drop [ drop 1 +col ] (next-char) ;
+    drop [ [ first-grapheme-from ] modify-col ] next ;
 
 SINGLETON: one-char-elt
 
@@ -50,23 +55,17 @@ M: one-char-elt next-elt 2drop ;
 
 <PRIVATE
 
-: (word-elt) ( loc document quot -- loc )
-    pick [
-        [ [ first2 swap ] dip doc-line ] dip call
-    ] dip =col ; inline
-
-: ((word-elt)) ( n seq -- ? n seq )
-    [ ?nth blank? ] 2keep ;
+: blank-at? ( n seq -- n seq ? )
+    2dup ?nth blank? ;
 
 : break-detector ( ? -- quot )
     '[ blank? _ xor ] ; inline
 
-: (prev-word) ( ? col str -- col )
-    rot break-detector find-last-from drop ?1+ ;
+: prev-word ( col str ? -- col )
+    break-detector find-last-from drop ?1+ ;
 
-: (next-word) ( ? col str -- col )
-    [ rot break-detector find-from drop ] keep
-    over not [ nip length ] [ drop ] if ;
+: next-word ( col str ? -- col )
+    [ break-detector find-from drop ] [ drop length ] 2bi or ;
 
 PRIVATE>
 
@@ -74,23 +73,30 @@ SINGLETON: one-word-elt
 
 M: one-word-elt prev-elt
     drop
-    [ [ [ f ] dip 1- ] dip (prev-word) ] (word-elt) ;
+    [ [ 1 - ] dip f prev-word ] modify-col ;
 
 M: one-word-elt next-elt
     drop
-    [ [ f ] 2dip (next-word) ] (word-elt) ;
+    [ f next-word ] modify-col ;
+
+SINGLETON: word-start-elt
+
+M: word-start-elt prev-elt
+    drop one-word-elt prev-elt ;
+
+M: word-start-elt next-elt 2drop ;
 
 SINGLETON: word-elt
 
 M: word-elt prev-elt
     drop
-    [ [ [ 1- ] dip ((word-elt)) (prev-word) ] (word-elt) ]
-    (prev-char) ;
+    [ [ [ 1 - ] dip blank-at? prev-word ] modify-col ]
+    prev ;
 
 M: word-elt next-elt
     drop
-    [ [ ((word-elt)) (next-word) ] (word-elt) ]
-    (next-char) ;
+    [ [ blank-at? next-word ] modify-col ]
+    next ;
 
 SINGLETON: one-line-elt
 
@@ -100,17 +106,23 @@ M: one-line-elt prev-elt
 M: one-line-elt next-elt
     drop [ first dup ] dip doc-line length 2array ;
 
-SINGLETON: line-elt
+TUPLE: page-elt { lines read-only } ;
+
+C: <page-elt> page-elt
+
+M: page-elt prev-elt
+    nip
+    2dup [ first ] [ lines>> ] bi* <
+    [ 2drop { 0 0 } ] [ lines>> neg +line ] if ;
 
-M: line-elt prev-elt
-    2drop dup first zero? [ drop { 0 0 } ] [ -1 +line ] if ;
+M: page-elt next-elt
+    3dup [ first ] [ last-line# ] [ lines>> ] tri* - >
+    [ drop nip doc-end ] [ nip lines>> +line ] if ;
 
-M: line-elt next-elt
-    drop over first over last-line# number=
-    [ nip doc-end ] [ drop 1 +line ] if ;
+CONSTANT: line-elt T{ page-elt f 1 }
 
 SINGLETON: doc-elt
 
 M: doc-elt prev-elt 3drop { 0 0 } ;
 
-M: doc-elt next-elt drop nip doc-end ;
\ No newline at end of file
+M: doc-elt next-elt drop nip doc-end ;