Re: Scheme Mode and Regular Expression Literals

[Toshi Umehara <toshi@niceume.com>]

[-- Attachment #1: Type: text/plain, Size: 3575 bytes --]


After reading your suggestions, I've created new functions to deal with
regular expression syntax. This approach consists of two procedures.

1. scheme-syntax-propertize-regexp-1 detects starts of regular
expressoin (#/). If it finds a start, it continues to try to find its
corresponding end.

2. scheme-syntax-propertize-regexp-2 detects ends of regular expression
(/) out of comments but within strings that start with #. The second
procedure is introduced, to deal with cases where regular expression is
written in multiline.

The following code can be put in init.el, and patch for
/lisp/progmodes/scheme.el is attached. I hope this is useful, thanks.


#+BEGIN_SRC
(add-hook
 'scheme-mode-hook
 (lambda ()
   (setq-local
    syntax-propertize-function
    (lambda (beg end)
      (goto-char beg)
      (scheme-syntax-propertize-sexp-comment (point) end)
      (funcall
       (syntax-propertize-rules
        ("\\(#\\);" (1 (prog1 "< cn"
                         (scheme-syntax-propertize-sexp-comment
                          (point) end))))
        )
       (point) end)
      ;; For regular expression literals
      (scheme-syntax-propertize-regexp-1 end)
      (scheme-syntax-propertize-regexp-2 end)
      ))))

(defun scheme-match-regexp-start (limit)
  (re-search-forward
   (rx
    (or
     bol
     space
     (in "[('")
     )
    (group "#")
    "/"
    )
   limit
   t
   )
  )

(defun scheme-match-regexp-end (limit)
  (re-search-forward
   (rx
     (group "/")
     )
   limit
   t
   )
  )

(defun scheme-syntax-propertize-regexp-1 (end)
  (while (scheme-match-regexp-start end)
    (let* ((state (save-excursion
                    (syntax-ppss (match-beginning 1))))
           (within-str (nth 3 state))
           (within-comm (nth 4 state)))
      (if (and (not within-comm) (not within-str))
          (progn
            (put-text-property
             (match-beginning 1)
             (1+ (match-beginning 1))
             'syntax-table (string-to-syntax "|"))
            (let ((end-found nil))
              (while
                  (and
                   (not end-found)
                   (scheme-match-regexp-end end))
                (if
                    (not (char-equal
                          (char-before (match-beginning 1))
                          ?\\ ))
                    (progn
                      (put-text-property
                       (match-beginning 1)
                       (1+ (match-beginning 1))
                       'syntax-table (string-to-syntax "|"))
                      (setq end-found t)
                      )))))))))

(defun scheme-syntax-propertize-regexp-2 (end)
  (let ((end-found nil))
    (while (scheme-match-regexp-end end)
      (let* ((state (save-excursion
                      (syntax-ppss (match-beginning 1))))
             (within-str (nth 3 state))
             (within-comm (nth 4 state))
             (start-delim-pos (nth 8 state)))
        (if (and (not within-comm)
                 within-str
                 (string=
                  (buffer-substring-no-properties
                   start-delim-pos
                   (1+ start-delim-pos))
                  "#")
                 (not (char-equal
                       (char-before (match-beginning 1))
                       ?\\ )))
            (progn
                    (put-text-property
                     (match-beginning 1)
                     (1+ (match-beginning 1))
                     'syntax-table (string-to-syntax "|"))
                    (setq end-found t)
                    ))))))
#+END_SRC


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Enable dealing with regular expression literal --]
[-- Type: text/x-patch, Size: 3271 bytes --]

diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index 67abab6913d..d1980463859 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -414,7 +414,10 @@ scheme-syntax-propertize
    (syntax-propertize-rules
     ("\\(#\\);" (1 (prog1 "< cn"
                      (scheme-syntax-propertize-sexp-comment (point) end)))))
-   (point) end))
+   (point) end)
+  (scheme-syntax-propertize-regexp-1 end)
+  (scheme-syntax-propertize-regexp-2 end)
+  )
 
 (defun scheme-syntax-propertize-sexp-comment (_ end)
   (let ((state (syntax-ppss)))
@@ -430,6 +433,87 @@ scheme-syntax-propertize-sexp-comment
                                'syntax-table (string-to-syntax "> cn")))
         (scan-error (goto-char end))))))
 
+(defun scheme-match-regexp-start (limit)
+  (re-search-forward
+   (rx
+    (or
+     bol
+     space
+     (in "[('")
+     )
+    (group "#")
+    "/"
+    )
+   limit
+   t
+   )
+  )
+
+(defun scheme-match-regexp-end (limit)
+  (re-search-forward
+   (rx
+     (group "/")
+     )
+   limit
+   t
+   )
+  )
+
+(defun scheme-syntax-propertize-regexp-1 (end)
+  (while (scheme-match-regexp-start end)
+    (let* ((state (save-excursion
+                    (syntax-ppss (match-beginning 1))))
+           (within-str (nth 3 state))
+           (within-comm (nth 4 state)))
+      (if (and (not within-comm) (not within-str))
+          (progn
+            (put-text-property
+             (match-beginning 1)
+             (1+ (match-beginning 1))
+             'syntax-table (string-to-syntax "|"))
+            (let ((end-found nil))
+              (while
+                  (and
+                   (not end-found)
+                   (scheme-match-regexp-end end))
+                (if
+                    (not (char-equal
+                          (char-before (match-beginning 1))
+                          ?\\ ))
+                    (progn
+                      (put-text-property
+                       (match-beginning 1)
+                       (1+ (match-beginning 1))
+                       'syntax-table (string-to-syntax "|"))
+                      (setq end-found t)
+                      )))))))))
+
+(defun scheme-syntax-propertize-regexp-2 (end)
+  (let ((end-found nil))
+    (while (scheme-match-regexp-end end)
+      (let* ((state (save-excursion
+                      (syntax-ppss (match-beginning 1))))
+             (within-str (nth 3 state))
+             (within-comm (nth 4 state))
+             (start-delim-pos (nth 8 state)))
+        (if (and (not within-comm)
+                 within-str
+                 (string=
+                  (buffer-substring-no-properties
+                   start-delim-pos
+                   (1+ start-delim-pos))
+                  "#")
+                 (not (char-equal
+                       (char-before (match-beginning 1))
+                       ?\\ )))
+            (progn
+                    (put-text-property
+                     (match-beginning 1)
+                     (1+ (match-beginning 1))
+                     'syntax-table (string-to-syntax "|"))
+                    (setq end-found t)
+                    ))))))
+
 ;;;###autoload
 (define-derived-mode dsssl-mode scheme-mode "DSSSL"
   "Major mode for editing DSSSL code.

[-- Attachment #3: Type: text/plain, Size: 31 bytes --]


-- 
Toshi (Toshihiro Umehara)