From 255aadda192c99abdaecb0caebf59a9b5272fcac Mon Sep 17 00:00:00 2001
From: Sean Whitton <spwhitton@spwhitton.name>
Date: Sun, 12 Mar 2023 13:50:31 -0700
Subject: new reader macro #>>EOF>>

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
---
 doc/news.rst              |  9 +++++++++
 emacs/consfigurator.el.in |  8 ++++----
 src/reader.lisp           | 17 ++++++++++++++++-
 3 files changed, 29 insertions(+), 5 deletions(-)

diff --git a/doc/news.rst b/doc/news.rst
index 58ca80a..bc45564 100644
--- a/doc/news.rst
+++ b/doc/news.rst
@@ -26,6 +26,15 @@ you should review this document and see if your consfig needs updating.
 1.2.4 (unreleased)
 ------------------
 
+- New reader macro ``#>>EOF>>`` which is like ``#>EOF>`` except that it skips
+  over the remainder of the current line and its newline.  This is more like
+  how heredocs work in other languages.  For the sake of future extension, the
+  remainder of the line after the ``#>>EOF>>`` should not contain anything
+  other than a single-line comment.
+
+  (This is not a breaking change because the existing implementation for
+  ``#>EOF>`` does not permit using terminators beginning with ``>``.)
+
 - New tutorial, "Defining new properties".
 
 - Extract docstrings and use them to generate API references in the manual.
diff --git a/emacs/consfigurator.el.in b/emacs/consfigurator.el.in
index d029b90..0555b28 100644
--- a/emacs/consfigurator.el.in
+++ b/emacs/consfigurator.el.in
@@ -131,11 +131,11 @@ Modes that use this should add `syntax-propertize-multiline' to
     (let (case-fold-search)
       (funcall
        (syntax-propertize-rules
-	("#>\\([^>]+\\)>\\([^z-a]\\)"
-	 (2 (ignore
+	("#\\(>>?\\)\\(.+?\\)\\1\\([^z-a]\\)"
+	 (3 (ignore
 	     (or (in-string-or-comment-p)
-		 (let ((beg (match-beginning 2))
-		       (ender (match-string 1)))
+		 (let ((beg (match-beginning 3))
+		       (ender (match-string 2)))
 		   (put-text-property beg (1+ beg) 'syntax-table
 				      (cons (eval-when-compile
 					      (car (string-to-syntax "!")))
diff --git a/src/reader.lisp b/src/reader.lisp
index 48fd878..e4f15b9 100644
--- a/src/reader.lisp
+++ b/src/reader.lisp
@@ -17,10 +17,25 @@
 
 (in-package :consfigurator)
 
+(defun read-heredoc (stream char arg)
+  "Like CL-HEREDOC:READ-HEREDOC but treat #>EOF> and #>>EOF>> differently:
+#>>EOF>> skips over the remainder of the current line and its newline.
+For the sake of future extension, the remainder of the line after the #>>EOF>>
+should not contain anything other than a single-line comment."
+  (if (char= (peek-char nil stream t :eof t) char)
+      ;; #>>EOF>> -- ignore the rest of the line.
+      (progn (read-char stream t :eof t)
+             (let* ((delim (make-string 2 :initial-element char))
+                    (ender (cl-heredoc:read-until-match stream delim)))
+               (read-line stream t :eof t)
+               (cl-heredoc:read-until-match stream ender)))
+      ;; #>EOF> -- just use the normal READ-HEREDOC.
+      (cl-heredoc:read-heredoc stream char arg)))
+
 (named-readtables:defreadtable :consfigurator
   (:merge :standard)
   (:dispatch-macro-char #\# #\? #'cl-interpol:interpol-reader)
-  (:dispatch-macro-char #\# #\> #'cl-heredoc:read-heredoc))
+  (:dispatch-macro-char #\# #\> #'read-heredoc))
 
 (named-readtables:defreadtable :consfigurator.without-read-eval
   (:merge :consfigurator)
-- 
cgit v1.2.3