splitting: make string-lines more correctly handle line terminator.

basis/documents/documents.factor

@@ -1,8 +1,7 @@
 ! 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
 
@@ -112,12 +111,30 @@ CONSTANT: doc-start { 0 0 }
 : 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 ] [
@@ -127,7 +144,7 @@ PRIVATE>
 
 :: 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

core/splitting/splitting-tests.factor

@@ -46,29 +46,31 @@ unit-test
 { "" 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

core/splitting/splitting.factor

@@ -1,7 +1,7 @@
 ! 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
@@ -109,19 +109,13 @@ 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 ;