master 0f504dde338: (scheme-syntax-propertize-sexp-comment): Handle nested sexp-comments

[Stefan Monnier]

branch: master
commit 0f504dde3388687d1214182fa519354146947635
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    (scheme-syntax-propertize-sexp-comment): Handle nested sexp-comments
    
    Well, I'm not completely sure this will work right in all cases,
    because I've been confused about this in the past.
    It works in my test case, at least.
    
    * lisp/progmodes/scheme.el (scheme-syntax-propertize-sexp-comment):
    Look for nested `#;` and mark them appropriately.
---
 etc/NEWS                 |  1 +
 lisp/progmodes/scheme.el | 43 +++++++++++++++++++++++++++++++++----------
 2 files changed, 34 insertions(+), 10 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 1b86a968c5d..903c60ac97e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1222,6 +1222,7 @@ interactive Python interpreter specified by 
'python-interpreter'.
 
 Scheme mode now handles regular expression literal #/regexp/ that is
 available in some Scheme implementations.
+Also, it should now handle nested sexp-comments.
 
 ** use-package
 
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index 8652abeb817..79d076ff145 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -50,6 +50,7 @@
 ;;; Code:
 
 (require 'lisp-mode)
+(eval-when-compile 'subr-x)             ;For `named-let'.
 
 (defvar scheme-mode-syntax-table
   (let ((st (make-syntax-table))
@@ -426,18 +427,40 @@ See `run-hooks'."
    (point) end))
 
 (defun scheme-syntax-propertize-sexp-comment (end)
-  (let ((state (syntax-ppss)))
+  (let ((state (syntax-ppss))
+        (checked (point)))
     (when (eq 2 (nth 7 state))
       ;; It's a sexp-comment.  Tell parse-partial-sexp where it ends.
-      (condition-case nil
-          (progn
-            (goto-char (+ 2 (nth 8 state)))
-            ;; FIXME: this doesn't handle the case where the sexp
-            ;; itself contains a #; comment.
-            (forward-sexp 1)
-            (put-text-property (1- (point)) (point)
-                               'syntax-table (string-to-syntax "> cn")))
-        (scan-error (goto-char end))))))
+      (named-let loop ((startpos (+ 2 (nth 8 state))))
+        (let ((found nil))
+          (while
+              (progn
+                (setq found nil)
+                (condition-case nil
+                    (progn
+                      (goto-char startpos)
+                      (forward-sexp 1)
+                      (setq found (point)))
+                  (scan-error (goto-char end)))
+                ;; If there's a nested `#;', the syntax-tables will normally
+                ;; consider the `;' to start a normal comment, so the
+                ;; (forward-sexp 1) above may have landed at the wrong place.
+                ;; So look for `#;' in the text over which we jumped, and
+                ;; mark those we found as nested sexp-comments.
+                (let ((limit (or found end)))
+                  (when (< checked limit)
+                    (goto-char checked)
+                    (when (re-search-forward "\\(#\\);" limit 'move)
+                      (setq checked (point))
+                      (put-text-property (match-beginning 1) (match-end 1)
+                                         'syntax-table
+                                         (string-to-syntax "< cn"))
+                      (loop (point)))
+                    (< (point) limit)))))
+          (when found
+            (goto-char found)
+            (put-text-property (1- found) found
+                               'syntax-table (string-to-syntax "> cn"))))))))
 
 (defun scheme-syntax-propertize-regexp (end)
   (let* ((state (syntax-ppss))