diff --git a/basis/documents/documents-tests.factor b/basis/documents/documents-tests.factor index c4bc1528c3..b0ff3bc8d8 100644 --- 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 + "doc" set +"Hello\nworld, how are\nyou?" "doc" get set-doc-string + +[ { 2 4 } ] [ "doc" get doc-end ] unit-test + ! Undo/redo [ ] [ "d" set ] unit-test diff --git a/basis/documents/elements/elements-tests.factor b/basis/documents/elements/elements-tests.factor index c449393ac4..a3f05d7a71 100644 --- 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 "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 + "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 "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 + "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 prev-elt ] unit-test +[ { 1 2 } ] [ { 5 2 } "doc" get 4 prev-elt ] unit-test + +[ { 4 3 } ] [ { 0 3 } "doc" get 4 next-elt ] unit-test +[ { 5 10 } ] [ { 4 2 } "doc" get 4 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 977628cdc3..adb498df13 100644 --- 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 -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