Add more fontification to regexp builder mode
* lisp/emacs-lisp/re-builder.el (reb-copy): Work in the presence of newlines in the regexps. (reb-change-syntax): Use a dedicated history variable. (reb-fontify-string-re): Fontify sub-matches. (reb-regexp-grouping-backslash, reb-regexp-grouping-construct): New faces. (reb-string-font-lock-keywords): New variable. (reb-mark-non-matching-parenthesis): Match parenthesis. (reb-restart-font-lock): New function. * lisp/emacs-lisp/re-builder.el (reb-mode-map): Add divider some dividers (bug#6347).
This commit is contained in:
Lennart Borgman
Lars Ingebrigtsen
parent
2fbcda71a9
commit
c1234ca9c3
1 changed files with 141 additions and 4 deletions
|
|
@ -240,6 +240,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
|
|||
(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 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
|
|||
(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 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
|
|||
(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 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
|
|||
(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 @@ matching parts of the target buffer will be highlighted."
|
|||
(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 @@ matching parts of the target buffer will be highlighted."
|
|||
(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 @@ If the optional PAUSE is non-nil then pause at the end in any case."
|
|||
(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 @@ Optional argument SYNTAX must be specified if called non-interactively."
|
|||
(completing-read
|
||||
(format "Select syntax (default %s): " reb-re-syntax)
|
||||
'(read string sregex rx)
|
||||
nil t nil nil (symbol-name reb-re-syntax)))))
|
||||
nil t nil nil (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 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
|
|||
(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 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
|
|||
;; `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 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
|
|||
(= 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 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
|
|||
;; 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
|
||||
(message "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 (left-pars
|
||||
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."
|
||||
(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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue