Clean up documents.elements a bit, add more tests, add page-elt

diff --git a/basis/documents/documents-tests.factor b/basis/documents/documents-tests.factor
index c4bc1528c3767539be24cb9da61fe742e9775d8f..b0ff3bc8d8876a6e22501045949f0a2184ab535e 100644 (file)
--- a/basis/documents/documents-tests.factor
+++ b/basis/documents/documents-tests.factor
@@ -89,6 +89,11 @@ namespaces tools.test make arrays kernel fry ;
     "doc" get doc-string
 ] 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
 [ ] [ <document> "d" set ] unit-test
 

diff --git a/basis/documents/elements/elements-tests.factor b/basis/documents/elements/elements-tests.factor
index c449393ac4b912eab5aeb4b3355d299af3524af5..a3f05d7a715a86b41d1313064c5e0df28b002739 100644 (file)
--- a/basis/documents/elements/elements-tests.factor
+++ b/basis/documents/elements/elements-tests.factor
@@ -1,21 +1,70 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! 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
 
 <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 2 } "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 5 } "doc" get one-word-elt next-elt ] unit-test
 
+! line-elt
 <document> "doc" set
 "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 3 } ] [ { 1 3 } "doc" get line-elt prev-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
\ No newline at end of file

diff --git a/basis/documents/elements/elements.factor b/basis/documents/elements/elements.factor
index 977628cdc397d06af7daa1760826d26b88db0362..adb498df138d277c11e2aad42e07e5fbd4bfc406 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 ;
+unicode.categories accessors ;
 IN: documents.elements
 
 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
     ] dip =col ; inline
 
-: ((word-elt)) ( n seq -- ? n seq )
-    [ ?nth blank? ] 2keep ;
+: ((word-elt)) ( 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,11 +73,11 @@ SINGLETON: one-word-elt
 
 M: one-word-elt prev-elt
     drop
-    [ [ [ f ] dip 1- ] dip (prev-word) ] (word-elt) ;
+    [ [ 1- ] dip f (prev-word) ] (word-elt) ;
 
 M: one-word-elt next-elt
     drop
-    [ [ f ] 2dip (next-word) ] (word-elt) ;
+    [ f (next-word) ] (word-elt) ;
 
 SINGLETON: word-elt
 
@@ -100,14 +99,20 @@ 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 } ;
 
-M: line-elt prev-elt
-    2drop dup first zero? [ drop { 0 0 } ] [ -1 +line ] if ;
+C: <page-elt> page-elt
 
-M: line-elt next-elt
-    drop over first over last-line# number=
-    [ nip doc-end ] [ drop 1 +line ] if ;
+M: page-elt prev-elt
+    nip
+    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