Have ." and s" parse single-line, and the string recognizer parse multiline

Author: forthy42

debugs.fs

@@ -137,13 +137,8 @@ s" You've reached a !!FIXME!! marker" exception constant FIXME#
     \G word that should never be reached
     FIXME# throw ;
 
-
 \ warn beginners that double numbers clash with floating points
 
-[IFUNDEF] ?warning \ fix compilation problem
-    Defer ?warning
-[THEN]
-
 :is ?warning ( f xt -- )
     \ if f, output a warning by EXECUTEing xt
     swap warnings @ 0<> and if
@@ -196,6 +191,11 @@ s" You've reached a !!FIXME!! marker" exception constant FIXME#
 
 ' ?warn-dp is ?warn#
 
+\ eof warning
+
+:is eof-warning ( -- )
+    state @ [: ." EOF reached while " get-state id. ;] ?warning ;
+
 \ replacing one word with another
 
 : >colon-body ( xt -- addr )

gforth.el

@@ -328,8 +328,8 @@ PARSED-TYPE specifies what kind of text is parsed. It should be
 	("\\([&#]-?[0-9a-f.]+\\|\\(0x-?\\|\\$-?\\)[0-9a-f.]+\\|%-?[01]+\\)"
 	 immediate (font-lock-constant-face . 3))
 	("\"[^\"]**" immediate (font-lock-string-face . 1)
-	 "[\"\n]" nil string (font-lock-string-face . 1))
-	("\".*\""
+	 "[\"]" nil string (font-lock-string-face . 1))
+	("\"[[:ascii:][:nonascii:]]*?\""
 	 immediate (font-lock-string-face . 3))
 	("[a-z\-0-9]+(" immediate (font-lock-comment-face . 1)
 	 "[)]" nil comment (font-lock-comment-face . 1))

kernel/input.fs

@@ -200,14 +200,15 @@ defer line-end-hook ( -- ) \ gforth
 \G called at every end-of-line when text-interpreting from a file    
 \ alternatively we could use a wrapper for REFILL
 ' noop is line-end-hook
+Defer eof-warning
+' noop is eof-warning
 
 : read-loop1 ( i*x -- j*x )
     BEGIN  refill  WHILE  interpret line-end-hook REPEAT ;
 
 : read-loop ( i*x -- j*x ) \ gforth-internal
     \G refill and interpret a file until EOF
-    ['] read-loop1 bt-rp0-wrapper
-    state @ warning" EOF reached while compiling" ;
+    ['] read-loop1 bt-rp0-wrapper eof-warning ;
 
 Variable second-ctrl-c 0 second-ctrl-c !
 

quotes.fs

@@ -85,33 +85,35 @@ create \-escape-table
     endif
     c, char+ ;
 
-Defer string-lineend
 $Variable mlstringpos
 
 s" End of string expected" exception >r
 
-: singleline-strings ( -- ) \ gforth-experimental
-    \G set strings to end within a line (default).
-    [: ( -- never ) [ r@ ]L throw ;] is string-lineend ;
-
-: multiline-strings ( -- ) \ gforth-experimental
-    \G set strings to span multiple lines
-    [: ( -- parse-area parse-end ) #lf c,
-	source-id 0= IF
-	    success-color ."  string" default-color cr
-	    input-color  THEN
-	refill  IF  source  ELSE
-	    mlstringpos get-stack 2 - -rot 2>r restore-input drop
-	    2r> source drop + swap input-lexeme!  [ r> ]L throw  THEN
-	over + ;] is string-lineend ;
-
-singleline-strings
-
-: \"-parse ( "string"<"> -- c-addr u ) \ gforth-internal  backslash-quote-parse
+: singleline-string ( -- never ) \ gforth-experimental
+    \G throw exception when string reaches the end of a line
+    [ r@ ]L throw ;
+
+: multiline-string ( -- parse-area parse-end ) \ gforth-experimental
+    \G parses multiline strings
+    #lf c,
+    source-id 0= IF
+	success-color ."  string" default-color cr
+	input-color  THEN
+    refill  IF
+	source
+	\ skip auto-indent blanks
+	mlstringpos stack> dup mlstringpos >stack
+	0 U+DO  over c@ bl = IF  1 safe/string  THEN  LOOP
+    ELSE
+	mlstringpos get-stack 2 - -rot 2>r restore-input drop
+	2r> source drop + swap input-lexeme!  [ r> ]L throw  THEN
+    over + ;
+
+: \"-parse ( "string"<"> xt -- c-addr u ) \ gforth-internal  backslash-quote-parse
 \G parses string, translating @code{\}-escapes to characters (as in
 \G C).  The resulting string resides at @code{here}.  See @code{S\"}
 \G for the supported @code{\-escapes}.
-    here >r
+    { xt: string-lineend } here >r
     save-input input-lexeme 2@ swap source drop - rot 2 + mlstringpos set-stack
     >in @ chars source chars over + >r + begin ( parse-area R: here parse-end )
 	dup r@ u>= IF
@@ -130,8 +132,8 @@ singleline-strings
     here r> - dup negate allot
     here swap char/ ;
 
-:noname \"-parse save-mem ;
-:noname \"-parse save-mem 2dup postpone sliteral drop free throw ;
+:noname ['] singleline-string \"-parse save-mem ;
+:noname ['] singleline-string \"-parse save-mem 2dup postpone sliteral drop free throw ;
 interpret/compile: s\" ( Interpretation 'ccc"' -- c-addr u )	\ core-ext,file-ext s-backslash-quote
 \G Interpretation: Parse the string @i{ccc} delimited by a @code{"}
 \G (but not @code{\"}), and convert escaped characters as described
@@ -146,7 +148,7 @@ interpret/compile: s\" ( Interpretation 'ccc"' -- c-addr u )	\ core-ext,file-ext
 \G Run-time @code{( -- c-addr u )}: Push a descriptor for the
 \G resulting string.
 
-:noname \"-parse type ;
+:noname ['] singleline-string \"-parse type ;
 :noname postpone s\" postpone type ;
 interpret/compile: .\" ( compilation 'ccc"' -- ; run-time -- )	\ gforth	dot-backslash-quote
 \G Like @code{."}, but translates C-like \-escape-sequences (see

rec-string.fs

@@ -26,7 +26,8 @@ s" Scanned string not in input buffer" exception >r
 
 : scan-string ( addr u -- addr' u' )
     2dup ?in-inbuf
-    drop source drop - 1+ >in ! \"-parse  save-mem ;
+    drop source drop - 1+ >in !
+    ['] multiline-string \"-parse  save-mem ;
 
 : slit,  postpone sliteral ;