From: Lars Ingebrigtsen <larsi@gnus.org>
To: Lennart Borgman <lennart.borgman@gmail.com>
Cc: 6347@debbugs.gnu.org
Subject: bug#6347: re-builder.el initial patch
Date: Fri, 26 Feb 2016 17:30:07 +1030 [thread overview]
Message-ID: <8737sgt0qw.fsf@gnus.org> (raw)
In-Reply-To: <AANLkTim-AGGj-QAC6f_nYx9mO_uo9vl75dWsSaDM6F19@mail.gmail.com> (Lennart Borgman's message of "Fri, 4 Jun 2010 04:26:38 +0200")
[-- 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
next prev parent reply other threads:[~2016-02-26 7:00 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2010-06-04 2:26 bug#6347: re-builder.el initial patch Lennart Borgman
2016-02-26 7:00 ` Lars Ingebrigtsen [this message]
2019-06-27 17:09 ` Lars Ingebrigtsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=8737sgt0qw.fsf@gnus.org \
--to=larsi@gnus.org \
--cc=6347@debbugs.gnu.org \
--cc=lennart.borgman@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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.