multiline: add HEREDOC: , slightly refactoring privates

basis/multiline/multiline-docs.factor

@@ -18,6 +18,16 @@ HELP: /*
            ""
 } ;
 
+HELP: HEREDOC:
+{ $syntax "HEREDOC: marker\n...text...marker" }
+{ $values { "marker" "a word (token)" } { "text" "arbitrary text" } { "" "a string" } }
+{ $description "A multiline string syntax with a user-specified terminating delimiter.  HEREDOC: reads the next word, and uses it as the 'close quote'.  All input from the beginning of the HEREDOC:'s next line, until the first appearance of the word's name, becomes a string.  The terminating word does not need to be at the beginning of a line.\n\nThe HEREDOC: line should not have anything after the delimiting word.  The delimiting word should be an alphanumeric token.  It should not be, as in some other languages, a \"quoted string\"." }
+{ $examples
+    { $example "USING: heredoc ;" "HEREDOC: END\nx\nEND" "! \"x\\n\"" }
+    { $example "HEREDOC: END\nxEND" "! \"x\"" }
+    { $example "2 5 HEREDOC: zap\nfoo\nbarzap subseq" "! \"o\\nb\"" }
+} ;
+
 { POSTPONE: <" POSTPONE: STRING: } related-words
 
 HELP: parse-multiline-string
@@ -29,6 +39,7 @@ ARTICLE: "multiline" "Multiline"
 "Multiline strings:"
 { $subsection POSTPONE: STRING: }
 { $subsection POSTPONE: <" }
+{ $subsection POSTPONE: HEREDOC: }
 "Multiline comments:"
 { $subsection POSTPONE: /* }
 "Writing new multiline parsing words:"

basis/multiline/multiline-tests.factor

@@ -19,3 +19,43 @@ world"> ] unit-test
 
 [ "\nhi" ] [ <"
 hi"> ] unit-test
+
+
+! HEREDOC:
+
+[ "foo\nbar\n" ] [ HEREDOC: END
+foo
+bar
+END ] unit-test
+
+[ "foo\nbar" ] [ HEREDOC: END
+foo
+barEND ] unit-test
+
+[ "" ] [ HEREDOC: END
+END ] unit-test
+
+[ " " ] [ HEREDOC: END
+ END ] unit-test
+
+[ "\n" ] [ HEREDOC: END
+
+END ] unit-test
+
+[ "x" ] [ HEREDOC: END
+xEND ] unit-test
+
+[ "xyz " ] [ HEREDOC: END
+xyz END ] unit-test
+
+[ "} ! * # \" «\n" ] [ HEREDOC: END
+} ! * # " «
+END ] unit-test
+
+[ 21 "foo\nbar" " HEREDOC: FOO\n FOO\n" 22 ] [ 21 HEREDOC: X
+foo
+barX HEREDOC: END ! mumble
+ HEREDOC: FOO
+ FOO
+END 22 ] unit-test
+

basis/multiline/multiline.factor

@@ -27,7 +27,7 @@ SYNTAX: STRING:
 
 <PRIVATE
 
-:: (parse-multiline-string) ( i end -- j )
+:: (scan-multiline-string) ( i end -- j )
     lexer get line-text>> :> text
     text [
         end text i start* [| j |
@@ -35,18 +35,21 @@ SYNTAX: STRING:
         ] [
             text i short tail % CHAR: \n ,
             lexer get next-line
-            0 end (parse-multiline-string)
+            0 end (scan-multiline-string)
         ] if*
     ] [ end unexpected-eof ] if ;
         
+:: (parse-multiline-string) ( end-text skip-n-chars -- str )
+    [
+        lexer get
+        [ skip-n-chars + end-text (scan-multiline-string) ]
+        change-column drop
+    ] "" make ;
+
 PRIVATE>
 
 : parse-multiline-string ( end-text -- str )
-    [
+    1 (parse-multiline-string) ;
-        lexer get
-        [ 1 + swap (parse-multiline-string) ]
-        change-column drop
-    ] "" make ;
 
 SYNTAX: <"
     "\">" parse-multiline-string parsed ;
@@ -61,3 +64,9 @@ SYNTAX: {"
     "\"}" parse-multiline-string parsed ;
 
 SYNTAX: /* "*/" parse-multiline-string drop ;
+
+SYNTAX: HEREDOC:
+    scan
+    lexer get next-line
+    0 (parse-multiline-string)
+    parsed ;