From mboxrd@z Thu Jan  1 00:00:00 1970
Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail
From: Toshi Umehara <toshi@niceume.com>
Newsgroups: gmane.emacs.devel
Subject: Re: Scheme Mode and Regular Expression Literals
Date: Sun, 17 Mar 2024 09:28:58 +0900
Message-ID: <87zfuxln05.fsf@niceume.com>
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214";
	logging-data="12606"; mail-complaints-to="usenet@ciao.gmane.io"
Cc: Eli Zaretskii <eliz@gnu.org>, jcubic@onet.pl, emacs-devel@gnu.org
To: monnier@iro.umontreal.ca
Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Sun Mar 17 01:30:01 2024
Return-path: <emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org>
Envelope-to: ged-emacs-devel@m.gmane-mx.org
Original-Received: from lists.gnu.org ([209.51.188.17])
	by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
	(Exim 4.92)
	(envelope-from <emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org>)
	id 1rlePX-00037Y-Jv
	for ged-emacs-devel@m.gmane-mx.org; Sun, 17 Mar 2024 01:30:01 +0100
Original-Received: from localhost ([::1] helo=lists1p.gnu.org)
	by lists.gnu.org with esmtp (Exim 4.90_1)
	(envelope-from <emacs-devel-bounces@gnu.org>)
	id 1rleOo-0003wA-Ic; Sat, 16 Mar 2024 20:29:15 -0400
Original-Received: from eggs.gnu.org ([2001:470:142:3::10])
 by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <toshi@niceume.com>) id 1rleOk-0003vo-NB
 for emacs-devel@gnu.org; Sat, 16 Mar 2024 20:29:10 -0400
Original-Received: from wout4-smtp.messagingengine.com ([64.147.123.20])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <toshi@niceume.com>)
 id 1rleOh-0006Io-Mj; Sat, 16 Mar 2024 20:29:10 -0400
Original-Received: from compute2.internal (compute2.nyi.internal [10.202.2.46])
 by mailout.west.internal (Postfix) with ESMTP id B95693200406;
 Sat, 16 Mar 2024 20:29:02 -0400 (EDT)
Original-Received: from mailfrontend1 ([10.202.2.162])
 by compute2.internal (MEProxy); Sat, 16 Mar 2024 20:29:03 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=niceume.com; h=
 cc:cc:content-type:content-type:date:date:from:from:in-reply-to
 :in-reply-to:message-id:mime-version:reply-to:subject:subject:to
 :to; s=mesmtp; t=1710635342; x=1710721742; bh=b/+TDTebpt7xUCtlgl
 c5BcDKq1TPMx4AcECD2crCktY=; b=gb4BB62YPhD1+wQWgdk1cbco0EN87GkM4l
 4SKPnGP/BEYdfnCvj+e5oUTKoy1TTzUd8oCaE3kYMzkl1eT98i6RnWFQpj5AozBJ
 Tjh6GuD/CVjFPuSYDeF/uP0khSj+Pb2T1M4iFCyK75WWiAhImB9TnmszyreOct2m
 ozg1GtzoM=
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=
 messagingengine.com; h=cc:cc:content-type:content-type:date:date
 :feedback-id:feedback-id:from:from:in-reply-to:in-reply-to
 :message-id:mime-version:reply-to:subject:subject:to:to
 :x-me-proxy:x-me-proxy:x-me-sender:x-me-sender:x-sasl-enc; s=
 fm1; t=1710635342; x=1710721742; bh=b/+TDTebpt7xUCtlglc5BcDKq1TP
 Mx4AcECD2crCktY=; b=BGDnJ5WkLN2ZyZRjyrTHdI9Fn3vEOwYgpkYDTsS/TWEL
 YdWlvum37pgq/GUtdIs/vzJpiWvu8tQP60S2Ug+oyXK78b6ujGKBSPecwUCrpiSx
 p1bqTyPqWPZH3iggZD7X4QGtwt17D8BQQUzrvZCtRxQYWyKO/cBrxR8SCjt9zo4T
 mbIWDJmuQXNDJsaFVjueiyq1bMMOYsWvEix5VjzSMCHk3FkdIZoBoRKc0Gq2Q24c
 i8gWpNdnjYwxlbR7hjKZ5gcaEZN5WGWOtlrfXtosk+NJ7KEBodipoV87PaqoGsj5
 WQdlPJnqRU9iolk85FMSaH+H9fS6hfuHFAYlzVRf2Q==
X-ME-Sender: <xms:TTn2ZbU1b3LK1qGuz7IibWTkgbG_ZV-5i1oBN30iWVVdXkpQ-wFBew>
 <xme:TTn2ZTmYbGQUcMLXxum5p4LXQmTd3tIVYz37AimgN3hlxA3BM_0kuBWz6kro-TrDO
 M_KuqlxqGCGAMnk9Q>
X-ME-Received: <xmr:TTn2ZXZe7Axmsg7LF4v2Miwlsmd788fwfmoQ8xv5YiYbr3cAarR9xy7SJvTcE5wqh2pM9mnzVCc3PqGetO0yR-tFCPicXnfYJllycFA5Uw>
X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgedvledrkeefgddvfecutefuodetggdotefrodftvf
 curfhrohhfihhlvgemucfhrghsthforghilhdpqfgfvfdpuffrtefokffrpgfnqfghnecu
 uegrihhlohhuthemuceftddtnecusecvtfgvtghiphhivghnthhsucdlqddutddtmdenuc
 fjughrpefhvffujgevfffkgggtsehmtderredttddtnecuhfhrohhmpefvohhshhhiucgf
 mhgvhhgrrhgruceothhoshhhihesnhhitggvuhhmvgdrtghomheqnecuggftrfgrthhtvg
 hrnhepffejhedttedutdevvdduheejgeeluefhkeevveehkeeiheevgedvteelhfeiteei
 necuvehluhhsthgvrhfuihiivgeptdenucfrrghrrghmpehmrghilhhfrhhomhepthhosh
 hhihesnhhitggvuhhmvgdrtghomh
X-ME-Proxy: <xmx:TTn2ZWWoLYvYn9CQYe5zX0f9GM9w0M-AHBMbYSEt7G9HDA73wlMOMA>
 <xmx:Tjn2ZVk1G1dqCp6BiEBhIAEqyRBIkk-RPdbQo4nm0EKRQURTERtpdw>
 <xmx:Tjn2ZTdJdmUW0evYdGhABeE3y0etVsmb13TCITyM4TXp6BDEH8Eb2A>
 <xmx:Tjn2ZfEndhz_uQ0XwGC5RbUd-r6vPyNLdy0ELk6XCc2QwtYZdwFoIg>
 <xmx:Tjn2Zbj-Uy_a2ITsFY9WblbJsn7oCDn6mqR8tS8AEHwhEDrdVcpWiA>
Feedback-ID: iaf1147ca:Fastmail
Original-Received: by mail.messagingengine.com (Postfix) with ESMTPA; Sat,
 16 Mar 2024 20:29:00 -0400 (EDT)
In-Reply-To: jwv5xxplzh6.fsf-monnier+emacs@gnu.org
Received-SPF: pass client-ip=64.147.123.20; envelope-from=toshi@niceume.com;
 helo=wout4-smtp.messagingengine.com
X-Spam_score_int: -27
X-Spam_score: -2.8
X-Spam_bar: --
X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
 DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1,
 RCVD_IN_DNSWL_LOW=-0.7, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001,
 T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-BeenThere: emacs-devel@gnu.org
X-Mailman-Version: 2.1.29
Precedence: list
List-Id: "Emacs development discussions." <emacs-devel.gnu.org>
List-Unsubscribe: <https://lists.gnu.org/mailman/options/emacs-devel>,
 <mailto:emacs-devel-request@gnu.org?subject=unsubscribe>
List-Archive: <https://lists.gnu.org/archive/html/emacs-devel>
List-Post: <mailto:emacs-devel@gnu.org>
List-Help: <mailto:emacs-devel-request@gnu.org?subject=help>
List-Subscribe: <https://lists.gnu.org/mailman/listinfo/emacs-devel>,
 <mailto:emacs-devel-request@gnu.org?subject=subscribe>
Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org
Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org
Xref: news.gmane.io gmane.emacs.devel:317127
Archived-At: <http://permalink.gmane.org/gmane.emacs.devel/317127>

--=-=-=
Content-Type: text/plain


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


--=-=-=
Content-Type: text/x-patch
Content-Disposition: attachment; filename=scheme-regexp.patch
Content-Description: Enable dealing with regular expression literal

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.

--=-=-=
Content-Type: text/plain


-- 
Toshi (Toshihiro Umehara)

--=-=-=--