! Copyright (C) 2006, 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays io kernel math models namespaces make
-sequences strings splitting combinators unicode.categories
-math.order math.ranges fry locals ;
+USING: accessors arrays fry kernel locals math math.order
+math.ranges models sequences splitting ;
QUALIFIED: models
IN: documents
: with-undo ( ..a document quot: ( ..a document -- ..b ) -- ..b )
[ t >>inside-undo? ] dip keep f >>inside-undo? drop ; inline
+! XXX: This is the old string-lines behavior, it would be nice
+! if we could update documents to work with the new string-lines
+! behavior.
+: doc-lines ( str -- seq )
+ dup [ "\r\n" member? ] any? [
+ "\n" split
+ [
+ but-last-slice [
+ "\r" ?tail drop "\r" split
+ ] map! drop
+ ] [
+ [ length 1 - ] keep [ "\r" split ] change-nth
+ ]
+ [ concat ]
+ tri
+ ] [
+ 1array
+ ] if ;
+
PRIVATE>
-: doc-range ( from to document -- string )
- [ 2dup ] dip
- '[ [ 2dup ] dip _ (doc-range) ] map-lines
- 2nip "\n" join ;
+:: doc-range ( from to document -- string )
+ from to [ [ from to ] dip document (doc-range) ] map-lines
+ "\n" join ;
: add-undo ( edit document -- )
dup inside-undo?>> [ 2drop ] [
:: set-doc-range ( string from to document -- )
from to = string empty? and [
- string string-lines :> new-lines
+ string doc-lines :> new-lines
new-lines from text+loc :> new-to
from to document doc-range :> old-string
old-string string from to new-to <edit> document add-undo
{ "" t } [ "\n" "\n" ?tail ] unit-test
{ "" f } [ "" "\n" ?tail ] unit-test
-{ { "" } } [ "" string-lines ] unit-test
-{ { "" "" } } [ "\n" string-lines ] unit-test
-{ { "" "" } } [ "\r" string-lines ] unit-test
-{ { "" "" } } [ "\r\n" string-lines ] unit-test
+{ { } } [ "" string-lines ] unit-test
+{ { "" } } [ "\n" string-lines ] unit-test
+{ { "" } } [ "\r" string-lines ] unit-test
+{ { "" } } [ "\r\n" string-lines ] unit-test
{ { "hello" } } [ "hello" string-lines ] unit-test
-{ { "hello" "" } } [ "hello\n" string-lines ] unit-test
-{ { "hello" "" } } [ "hello\r" string-lines ] unit-test
-{ { "hello" "" } } [ "hello\r\n" string-lines ] unit-test
+{ { "hello" } } [ "hello\n" string-lines ] unit-test
+{ { "hello" } } [ "hello\r" string-lines ] unit-test
+{ { "hello" } } [ "hello\r\n" string-lines ] unit-test
{ { "hello" "hi" } } [ "hello\nhi" string-lines ] unit-test
{ { "hello" "hi" } } [ "hello\rhi" string-lines ] unit-test
{ { "hello" "hi" } } [ "hello\r\nhi" string-lines ] unit-test
+{ { "hello" "" "" } } [ "hello\n\n\n" string-lines ] unit-test
-{ { "" } } [ SBUF" " string-lines ] unit-test
-{ { "" "" } } [ SBUF" \n" string-lines ] unit-test
-{ { "" "" } } [ SBUF" \r" string-lines ] unit-test
-{ { "" "" } } [ SBUF" \r\n" string-lines ] unit-test
+{ { } } [ SBUF" " string-lines ] unit-test
+{ { "" } } [ SBUF" \n" string-lines ] unit-test
+{ { "" } } [ SBUF" \r" string-lines ] unit-test
+{ { "" } } [ SBUF" \r\n" string-lines ] unit-test
{ { "hello" } } [ SBUF" hello" string-lines ] unit-test
-{ { "hello" "" } } [ SBUF" hello\n" string-lines ] unit-test
-{ { "hello" "" } } [ SBUF" hello\r" string-lines ] unit-test
-{ { "hello" "" } } [ SBUF" hello\r\n" string-lines ] unit-test
+{ { "hello" } } [ SBUF" hello\n" string-lines ] unit-test
+{ { "hello" } } [ SBUF" hello\r" string-lines ] unit-test
+{ { "hello" } } [ SBUF" hello\r\n" string-lines ] unit-test
{ { "hello" "hi" } } [ SBUF" hello\nhi" string-lines ] unit-test
{ { "hello" "hi" } } [ SBUF" hello\rhi" string-lines ] unit-test
{ { "hello" "hi" } } [ SBUF" hello\r\nhi" string-lines ] unit-test
+{ { "hello" "" "" } } [ SBUF" hello\n\n\n" string-lines ] unit-test
{ { "hey" "world" "what's" "happening" } }
[ "heyAworldBwhat'sChappening" [ LETTER? ] split-when ] unit-test
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math sequences sequences.private strings
-sbufs ;
+USING: arrays combinators kernel math sequences
+sequences.private strings sbufs ;
IN: splitting
<PRIVATE
GENERIC: string-lines ( str -- seq )
M: string string-lines
- dup [ "\r\n" member? ] any? [
- "\n" split
- [
- but-last-slice [
- "\r" ?tail drop "\r" split
- ] map! drop
- ] [
- [ length 1 - ] keep [ "\r" split ] change-nth
- ]
- [ concat ]
- tri
- ] [
- 1array
- ] if ;
+ [ V{ } clone 0 ] dip [ 2dup bounds-check? ] [
+ 2dup [ "\r\n" member? ] find-from swapd [
+ over [ [ nip length ] keep ] unless
+ [ subseq suffix! ] 2keep [ 1 + ] dip
+ ] dip CHAR: \r eq? [
+ 2dup ?nth CHAR: \n eq? [ [ 1 + ] dip ] when
+ ] when
+ ] while 2drop { } like ;
M: sbuf string-lines "" like string-lines ;