X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=blobdiff_plain;f=basis%2Fmultiline%2Fmultiline.factor;h=c6d5576347a7122ed29eab33f6b27b209e756b57;hp=2e8f8eb4c497d1fb9252ee15b1b554f2d6645a6f;hb=f2db336221c17d3dafc0faf85371a86a330242f7;hpb=6521b8a254f8cce8782f568a659280d0cd319476

diff --git a/basis/multiline/multiline.factor b/basis/multiline/multiline.factor
index 2e8f8eb4c4..c6d5576347 100644
--- a/basis/multiline/multiline.factor
+++ b/basis/multiline/multiline.factor
@@ -1,63 +1,85 @@
 ! Copyright (C) 2007 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces make parser lexer kernel sequences words
-quotations math accessors locals ;
+USING: accessors kernel lexer make math namespaces parser
+quotations sequences strings.parser.private words ;
 IN: multiline
 
 <PRIVATE
-: next-line-text ( -- str )
-    lexer get dup next-line line-text>> ;
 
-: (parse-here) ( -- )
-    next-line-text [
+: rest-of-line ( lexer -- seq )
+    [ line-text>> ] [ column>> ] bi tail ;
+
+: next-line-text ( lexer -- str ? )
+    [ next-line ] [ line-text>> ] [ still-parsing? ] tri ;
+
+: (parse-here) ( lexer -- )
+    dup next-line-text [
         dup ";" =
-        [ drop lexer get next-line ]
-        [ % "\n" % (parse-here) ] if
-    ] [ ";" unexpected-eof ] if* ;
+        [ drop next-line ]
+        [ % CHAR: \n , (parse-here) ] if
+    ] [ ";" throw-unexpected-eof ] if ;
+
 PRIVATE>
 
+ERROR: text-found-before-eol string ;
+
 : parse-here ( -- str )
-    [ (parse-here) ] "" make but-last
-    lexer get next-line ;
+    [
+        lexer get
+        dup rest-of-line [ text-found-before-eol ] unless-empty
+        (parse-here)
+    ] "" make but-last ;
 
 SYNTAX: STRING:
-    CREATE-WORD
+    scan-new-word
     parse-here 1quotation
-    (( -- string )) define-inline ;
+    ( -- string ) define-inline ;
 
 <PRIVATE
 
-:: (parse-multiline-string) ( i end -- j )
-    lexer get line-text>> :> text
-    text [
-        end text i start* [| j |
+:: (scan-multiline-string) ( i end lexer -- j )
+    lexer line-text>> :> text
+    lexer still-parsing? [
+        i text end subseq-index-from [| j |
             i j text subseq % j end length +
         ] [
-            text i short tail % CHAR: \n ,
-            lexer get next-line
-            0 end (parse-multiline-string)
+            text i index-or-length tail % CHAR: \n ,
+            lexer next-line
+            0 end lexer (scan-multiline-string)
         ] if*
-    ] [ end unexpected-eof ] if ;
-        
-PRIVATE>
+    ] [ end throw-unexpected-eof ] if ;
 
-: parse-multiline-string ( end-text -- str )
+:: (parse-multiline-string) ( end-text lexer skip-n-chars -- str )
     [
-        lexer get
-        [ 1+ swap (parse-multiline-string) ]
-        change-column drop
+        lexer
+        [ skip-n-chars + end-text lexer (scan-multiline-string) ]
+        change-column check-space
     ] "" make ;
 
-SYNTAX: <"
-    "\">" parse-multiline-string parsed ;
-
-SYNTAX: <'
-    "'>" parse-multiline-string parsed ;
+: advance-same-line ( lexer text -- )
+    length [ + ] curry change-column drop ;
 
-SYNTAX: {'
-    "'}" parse-multiline-string parsed ;
+PRIVATE>
 
-SYNTAX: {"
-    "\"}" parse-multiline-string parsed ;
+: parse-multiline-string ( end-text -- str )
+    lexer get 1 (parse-multiline-string) ;
 
 SYNTAX: /* "*/" parse-multiline-string drop ;
+
+SYNTAX: (( "))" parse-multiline-string drop ;
+
+SYNTAX: [[ "]]" parse-multiline-string suffix! ;
+SYNTAX: [=[ "]=]" parse-multiline-string suffix! ;
+SYNTAX: [==[ "]==]" parse-multiline-string suffix! ;
+SYNTAX: [===[ "]===]" parse-multiline-string suffix! ;
+SYNTAX: [====[ "]====]" parse-multiline-string suffix! ;
+SYNTAX: [=====[ "]=====]" parse-multiline-string suffix! ;
+SYNTAX: [======[ "]======]" parse-multiline-string suffix! ;
+
+SYNTAX: ![[ "]]" parse-multiline-string drop ;
+SYNTAX: ![=[ "]=]" parse-multiline-string drop ;
+SYNTAX: ![==[ "]==]" parse-multiline-string drop ;
+SYNTAX: ![===[ "]===]" parse-multiline-string drop ;
+SYNTAX: ![====[ "]====]" parse-multiline-string drop ;
+SYNTAX: ![=====[ "]=====]" parse-multiline-string drop ;
+SYNTAX: ![======[ "]======]" parse-multiline-string drop ;