* bug#6347: re-builder.el initial patch
@ 2010-06-04 2:26 Lennart Borgman
2016-02-26 7:00 ` Lars Ingebrigtsen
0 siblings, 1 reply; 3+ messages in thread
From: Lennart Borgman @ 2010-06-04 2:26 UTC (permalink / raw
To: 6347
[-- Attachment #1: Type: text/plain, Size: 305 bytes --]
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.
[-- Attachment #2: re-builder-1.diff --]
[-- Type: text/x-patch, Size: 9392 bytes --]
=== modified file 'lisp/emacs-lisp/re-builder.el'
--- trunk/lisp/emacs-lisp/re-builder.el 2010-01-13 08:35:10 +0000
+++ patched/lisp/emacs-lisp/re-builder.el 2010-06-04 02:17:08 +0000
@@ -245,6 +245,7 @@
(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 . case-fold-search)
@@ -255,6 +256,7 @@
(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"))
@@ -267,6 +269,7 @@
(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"))
@@ -343,6 +346,7 @@
(cond ((reb-lisp-syntax-p)
(reb-lisp-mode))
(t (reb-mode)))
+ (reb-restart-font-lock)
(reb-do-update))
(defun reb-mode-buffer-p ()
@@ -370,6 +374,7 @@
(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)
@@ -446,7 +451,9 @@
(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
@@ -482,6 +489,8 @@
(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."
@@ -490,7 +499,8 @@
(completing-read "Select syntax: "
(mapcar (lambda (el) (cons (symbol-name el) 1))
'(read string lisp-re 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 lisp-re sregex rx))
(let ((buffer (get-buffer reb-buffer)))
@@ -657,8 +667,14 @@
(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))
@@ -693,6 +709,9 @@
;; `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)
@@ -707,7 +726,7 @@
(= 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
@@ -723,6 +742,124 @@
;; 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)
;; arch-tag: 5c5515ac-4085-4524-a421-033f44f032e7
^ permalink raw reply [flat|nested] 3+ messages in thread
* bug#6347: re-builder.el initial patch
2010-06-04 2:26 bug#6347: re-builder.el initial patch Lennart Borgman
@ 2016-02-26 7:00 ` Lars Ingebrigtsen
2019-06-27 17:09 ` Lars Ingebrigtsen
0 siblings, 1 reply; 3+ messages in thread
From: Lars Ingebrigtsen @ 2016-02-26 7:00 UTC (permalink / raw
To: Lennart Borgman; +Cc: 6347
[-- Attachment #1: Type: text/plain, Size: 485 bytes --]
Lennart Borgman <lennart.borgman@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?
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: reb.diff --]
[-- Type: text/x-diff, Size: 9322 bytes --]
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
[-- Attachment #3: Type: text/plain, Size: 105 bytes --]
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply related [flat|nested] 3+ messages in thread
* bug#6347: re-builder.el initial patch
2016-02-26 7:00 ` Lars Ingebrigtsen
@ 2019-06-27 17:09 ` Lars Ingebrigtsen
0 siblings, 0 replies; 3+ messages in thread
From: Lars Ingebrigtsen @ 2019-06-27 17:09 UTC (permalink / raw
To: Lennart Borgman; +Cc: 6347
Lars Ingebrigtsen <larsi@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
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2019-06-27 17:09 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2010-06-04 2:26 bug#6347: re-builder.el initial patch Lennart Borgman
2016-02-26 7:00 ` Lars Ingebrigtsen
2019-06-27 17:09 ` Lars Ingebrigtsen
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.