GNU bug report logs - #6347
re-builder.el initial patch

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 6347 in the body.
You can then email your comments to 6347 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Lennart Borgman <lennart.borgman <at> gmail.com>
To: Emacs Bugs <bug-gnu-emacs <at> gnu.org>
Subject: re-builder.el initial patch
Date: Fri, 4 Jun 2010 04:26:38 +0200

[Message part 1 (text/plain, inline)]

Here is an initial path for re-builder.el. It tries to add the following:

- Syntax-hilighting in re-builder window
- Some small menu fixes
- copy regexp did not take care of new lines
- Try to stay where you are when starting re-builder

Comments?

I will add copying to regexp from target buffer later.

[re-builder-1.diff (text/x-patch, attachment)]

Message #8 received at 6347 <at> debbugs.gnu.org (full text, mbox):

From: Lars Ingebrigtsen <larsi <at> gnus.org>
To: Lennart Borgman <lennart.borgman <at> gmail.com>
Cc: 6347 <at> debbugs.gnu.org
Subject: Re: bug#6347: re-builder.el initial patch
Date: Fri, 26 Feb 2016 17:30:07 +1030

[Message part 1 (text/plain, inline)]

Lennart Borgman <lennart.borgman <at> gmail.com> writes:

> Here is an initial path for re-builder.el. It tries to add the following:
>
> - Syntax-hilighting in re-builder window
> - Some small menu fixes
> - copy regexp did not take care of new lines
> - Try to stay where you are when starting re-builder
>
> Comments?

Looks good to me.  It didn't quite apply, so I made the obvious changes,
and new version appended below.

This probably needs an etc/NEWS item.  Could you submit one?

[reb.diff (text/x-diff, inline)]

diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 01e5241..64103a9 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -240,6 +240,7 @@ reb-mode-map
     (define-key menu-map [rq]
       '(menu-item "Quit" reb-quit
 		  :help "Quit the RE Builder mode"))
+    (define-key menu-map [div1] '(menu-item "--"))
     (define-key menu-map [rt]
       '(menu-item "Case sensitive" reb-toggle-case
 		  :button (:toggle . (with-current-buffer
@@ -252,6 +253,7 @@ reb-mode-map
     (define-key menu-map [rs]
       '(menu-item "Change syntax..." reb-change-syntax
 		  :help "Change the syntax used by the RE Builder"))
+    (define-key menu-map [div2] '(menu-item "--"))
     (define-key menu-map [re]
       '(menu-item "Enter subexpression mode" reb-enter-subexp-mode
 		  :help "Enter the subexpression mode in the RE Builder"))
@@ -264,6 +266,7 @@ reb-mode-map
     (define-key menu-map [rp]
       '(menu-item "Go to previous match" reb-prev-match
 		  :help "Go to previous match in the RE Builder target window"))
+    (define-key menu-map [div3] '(menu-item "--"))
     (define-key menu-map [rc]
       '(menu-item "Copy current RE" reb-copy
 		  :help "Copy current RE into the kill ring for later insertion"))
@@ -339,6 +342,7 @@ reb-initialize-buffer
   (cond ((reb-lisp-syntax-p)
          (reb-lisp-mode))
         (t (reb-mode)))
+  (reb-restart-font-lock)
   (reb-do-update))
 
 (defun reb-mode-buffer-p ()
@@ -371,6 +375,7 @@ re-builder
 			 (setq reb-window-config (current-window-configuration))
 			 (split-window (selected-window) (- (window-height) 4)))))
     (switch-to-buffer (get-buffer-create reb-buffer))
+    (font-lock-mode 1)
     (reb-initialize-buffer)))
 
 (defun reb-change-target-buffer (buf)
@@ -447,7 +452,9 @@ reb-copy
   (reb-update-regexp)
   (let ((re (with-output-to-string
 	      (print (reb-target-binding reb-regexp)))))
-    (kill-new (substring re 1 (1- (length re))))
+    (setq re (substring re 1 (1- (length re))))
+    (setq re (replace-regexp-in-string "\n" "\\n" re nil t))
+    (kill-new re)
     (message "Regexp copied to kill-ring")))
 
 ;; The subexpression mode is not electric because the number of
@@ -483,6 +490,8 @@ reb-quit-subexp-mode
   (use-local-map reb-mode-map)
   (reb-do-update))
 
+(defvar reb-change-syntax-hist nil)
+
 (defun reb-change-syntax (&optional syntax)
   "Change the syntax used by the RE Builder.
 Optional argument SYNTAX must be specified if called non-interactively."
@@ -491,7 +500,8 @@ reb-change-syntax
 	  (completing-read "Select syntax: "
 			   (mapcar (lambda (el) (cons (symbol-name el) 1))
 				   '(read string sregex rx))
-			   nil t (symbol-name reb-re-syntax)))))
+			   nil t (symbol-name reb-re-syntax)
+                           'reb-change-syntax-hist))))
 
   (if (memq syntax '(read string sregex rx))
       (let ((buffer (get-buffer reb-buffer)))
@@ -653,8 +663,14 @@ reb-update-overlays
 	 (subexps (reb-count-subexps re))
 	 (matches 0)
 	 (submatches 0)
-	 firstmatch)
+	 firstmatch
+         here
+         firstmatch-after-here)
     (with-current-buffer reb-target-buffer
+        (setq here
+              (if reb-target-window
+                  (with-selected-window reb-target-window (window-point))
+                (point)))
       (reb-delete-overlays)
       (goto-char (point-min))
       (while (and (not (eobp))
@@ -689,6 +705,9 @@ reb-update-overlays
 			;; `reb-match-1' must exist.
 			'reb-match-1))))
 		(unless firstmatch (setq firstmatch (match-data)))
+                (unless firstmatch-after-here
+                  (when (> (point) here)
+                    (setq firstmatch-after-here (match-data))))
 		(setq reb-overlays (cons overlay reb-overlays)
 		      submatches (1+ submatches))
 		(overlay-put overlay 'face face)
@@ -703,7 +722,7 @@ reb-update-overlays
 			(= reb-auto-match-limit count))
 		   " (limit reached)" "")))
     (when firstmatch
-      (store-match-data firstmatch)
+      (store-match-data (or firstmatch-after-here firstmatch))
       (reb-show-subexp (or subexp 0)))))
 
 ;; The End
@@ -718,6 +737,124 @@ re-builder-unload-function
   ;; continue standard unloading
   nil)
 
+(defun reb-fontify-string-re (bound)
+  (catch 'found
+    ;; The following loop is needed to continue searching after matches
+    ;; that do not occur in strings.  The associated regexp matches one
+    ;; of `\\\\' `\\(' `\\(?:' `\\|' `\\)'.  `\\\\' has been included to
+    ;; avoid highlighting, for example, `\\(' in `\\\\('.
+    (when (memq reb-re-syntax '(read string))
+      (while (re-search-forward
+              (if (eq reb-re-syntax 'read)
+                  ;; Copied from font-lock.el
+                  "\\(\\\\\\\\\\)\\(?:\\(\\\\\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)"
+                "\\(\\\\\\)\\(?:\\(\\\\\\)\\|\\((\\(?:\\?[0-9]*:\\)?\\|[|)]\\)\\)")
+                bound t)
+        (unless (match-beginning 2)
+          (let ((face (get-text-property (1- (point)) 'face)))
+            (when (or (and (listp face)
+                           (memq 'font-lock-string-face face))
+                      (eq 'font-lock-string-face face)
+                      t)
+              (throw 'found t))))))))
+
+(defface reb-regexp-grouping-backslash
+  '((t :inherit font-lock-keyword-face :weight bold :underline t))
+  "Font Lock mode face for backslashes in Lisp regexp grouping constructs."
+  :group 're-builder)
+
+(defface reb-regexp-grouping-construct
+  '((t :inherit font-lock-keyword-face :weight bold :underline t))
+  "Font Lock mode face used to highlight grouping constructs in Lisp regexps."
+  :group 're-builder)
+
+(defconst reb-string-font-lock-keywords
+  (eval-when-compile
+  '(((reb-fontify-string-re
+      (1 'reb-regexp-grouping-backslash prepend)
+      (3 'reb-regexp-grouping-construct prepend))
+     (reb-mark-non-matching-parenthesis))
+    nil)))
+
+(defsubst reb-while (limit counter where)
+  (let ((count (symbol-value counter)))
+    (if (= count limit)
+        (progn
+          (msgtrc "Reached (while limit=%s, where=%s)" limit where)
+          nil)
+      (set counter (1+ count)))))
+
+(defun reb-mark-non-matching-parenthesis (bound)
+  ;; We have a small string, check the whole of it, but wait until
+  ;; everything else is fontified.
+  (when (>= bound (point-max))
+    (let ((here (point))
+          left-pars
+          (n-reb 0)
+          faces-here
+          )
+      (goto-char (point-min))
+      (while (and (reb-while 100 'n-reb "mark-par")
+                  (not (eobp)))
+        (skip-chars-forward "^()")
+        (unless (eobp)
+          (setq faces-here (get-text-property (point) 'face))
+          ;; It is already fontified, use that info:
+          (when (or (eq 'reb-regexp-grouping-construct faces-here)
+                    (and (listp faces-here)
+                         (memq 'reb-regexp-grouping-construct faces-here)))
+            (cond ((eq (char-after) ?\()
+                   (setq left-pars (cons (point) left-pars)))
+                  ((eq (char-after) ?\))
+                   (if left-pars
+                       (setq left-pars (cdr left-pars))
+                     (put-text-property (point) (1+ (point))
+                                        'face 'font-lock-warning-face)))
+                  (t (message "markpar: char-after=%s" (char-to-string (char-after))))))
+          (forward-char)))
+      (dolist (lp left-pars)
+        (put-text-property lp (1+ lp)
+                           'face 'font-lock-warning-face)))))
+
+(require 'rx)
+(defconst reb-rx-font-lock-keywords
+  (let ((constituents (mapcar (lambda (rec) (symbol-name (car rec))) rx-constituents))
+        (syntax (mapcar (lambda (rec) (symbol-name (car rec))) rx-syntax))
+        (categories (mapcar (lambda (rec) (symbol-name (car rec))) rx-categories)))
+    `(
+      (,(concat "(" (regexp-opt (list "rx-to-string") t) "[[:space:]]")
+       (1 font-lock-function-name-face))
+      (,(concat "(" (regexp-opt (list "rx") t) "[[:space:]]")
+       (1 font-lock-preprocessor-face))
+      (,(concat "(category[[:space:]]+" (regexp-opt categories t) ")")
+       (1 font-lock-variable-name-face))
+      (,(concat "(syntax[[:space:]]+" (regexp-opt syntax t) ")")
+       (1 font-lock-type-face))
+      (,(concat "(" (regexp-opt constituents t))
+       (1 font-lock-keyword-face))
+      )))
+
+(defun reb-restart-font-lock ()
+  "Restart `font-lock-mode' to fit current regexp format."
+  ;;(set-default 'font-lock-keywords nil)
+  ;;(set-default 'font-lock-set-defaults nil)
+  (message "reb-restart-font-lock re-re-syntax=%s" reb-re-syntax)
+  (with-current-buffer (get-buffer reb-buffer)
+    (let ((font-lock-is-on font-lock-mode))
+      (font-lock-mode -1)
+      (kill-local-variable 'font-lock-set-defaults)
+      ;;(set (make-local-variable 'reb-re-syntax) 'string)
+      ;;(set (make-local-variable 'reb-re-syntax) 'rx)
+      (setq font-lock-defaults
+            (cond
+             ((memq reb-re-syntax '(read string))
+              reb-string-font-lock-keywords)
+             ((eq reb-re-syntax 'rx)
+              '(reb-rx-font-lock-keywords
+                nil))
+             (t nil)))
+      (when font-lock-is-on (font-lock-mode 1)))))
+
 (provide 're-builder)
 
 ;;; re-builder.el ends here

[Message part 3 (text/plain, inline)]

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Message #11 received at 6347 <at> debbugs.gnu.org (full text, mbox):

From: Lars Ingebrigtsen <larsi <at> gnus.org>
To: Lennart Borgman <lennart.borgman <at> gmail.com>
Cc: 6347 <at> debbugs.gnu.org
Subject: Re: bug#6347: re-builder.el initial patch
Date: Thu, 27 Jun 2019 19:09:12 +0200

Lars Ingebrigtsen <larsi <at> gnus.org> writes:

> Looks good to me.  It didn't quite apply, so I made the obvious changes,
> and new version appended below.
>
> This probably needs an etc/NEWS item.  Could you submit one?

And it doesn't really need it, so I've just applied the patch.  Just
took ten years.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.