diff options
Diffstat (limited to 'lisp/emacs-lisp/re-builder.el')
-rw-r--r-- | lisp/emacs-lisp/re-builder.el | 127 |
1 files changed, 69 insertions, 58 deletions
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index d460407a803..0f9b60730f3 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -211,24 +211,23 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (defvar reb-valid-string "" "String in mode line showing validity of RE.") +(put 'reb-valid-string 'risky-local-variable t) (defconst reb-buffer "*RE-Builder*" "Buffer to use for the RE Builder.") ;; Define the local "\C-c" keymap -(defvar reb-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'reb-toggle-case) - (define-key map "\C-c\C-q" 'reb-quit) - (define-key map "\C-c\C-w" 'reb-copy) - (define-key map "\C-c\C-s" 'reb-next-match) - (define-key map "\C-c\C-r" 'reb-prev-match) - (define-key map "\C-c\C-i" 'reb-change-syntax) - (define-key map "\C-c\C-e" 'reb-enter-subexp-mode) - (define-key map "\C-c\C-b" 'reb-change-target-buffer) - (define-key map "\C-c\C-u" 'reb-force-update) - map) - "Keymap used by the RE Builder.") +(defvar-keymap reb-mode-map + :doc "Keymap used by the RE Builder." + "C-c C-c" #'reb-toggle-case + "C-c C-q" #'reb-quit + "C-c C-w" #'reb-copy + "C-c C-s" #'reb-next-match + "C-c C-r" #'reb-prev-match + "C-c C-i" #'reb-change-syntax + "C-c C-e" #'reb-enter-subexp-mode + "C-c C-b" #'reb-change-target-buffer + "C-c C-u" #'reb-force-update) (easy-menu-define reb-mode-menu reb-mode-map "Menu for the RE Builder." @@ -263,31 +262,35 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (setq-local blink-matching-paren nil) (reb-mode-common)) -(defvar reb-lisp-mode-map - (let ((map (make-sparse-keymap))) - ;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from - ;; `emacs-lisp-mode' - (define-key map "\C-c" (lookup-key reb-mode-map "\C-c")) - map)) +(defvar-keymap reb-lisp-mode-map + ;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from + ;; `emacs-lisp-mode' + "C-c" (keymap-lookup reb-mode-map "C-c")) (define-derived-mode reb-lisp-mode emacs-lisp-mode "RE Builder Lisp" "Major mode for interactively building symbolic Regular Expressions." ;; Pull in packages as needed - (cond ((memq reb-re-syntax '(sregex rx)) ; rx-to-string is autoloaded - (require 'rx))) ; require rx anyway + (when (eq reb-re-syntax 'rx) ; rx-to-string is autoloaded + (require 'rx)) ; require rx anyway (reb-mode-common)) -(defvar reb-subexp-mode-map - (let ((m (make-keymap))) - (suppress-keymap m) - ;; Again share the "\C-c" keymap for the commands - (define-key m "\C-c" (lookup-key reb-mode-map "\C-c")) - (define-key m "q" 'reb-quit-subexp-mode) - (dotimes (digit 10) - (define-key m (int-to-string digit) 'reb-display-subexp)) - m) - "Keymap used by the RE Builder for the subexpression mode.") +(defvar-keymap reb-subexp-mode-map + :doc "Keymap used by the RE Builder for the subexpression mode." + :full t :suppress t + ;; Again share the "\C-c" keymap for the commands + "C-c" (keymap-lookup reb-mode-map "C-c") + "q" #'reb-quit-subexp-mode + "0" #'reb-display-subexp + "1" #'reb-display-subexp + "2" #'reb-display-subexp + "3" #'reb-display-subexp + "4" #'reb-display-subexp + "5" #'reb-display-subexp + "6" #'reb-display-subexp + "7" #'reb-display-subexp + "8" #'reb-display-subexp + "9" #'reb-display-subexp) (defun reb-mode-common () "Setup functions common to functions `reb-mode' and `reb-lisp-mode'." @@ -306,13 +309,13 @@ Except for Lisp syntax this is the same as `reb-regexp'.") "Return t if display is capable of displaying colors." (eq 'color (frame-parameter nil 'display-type))) -(defsubst reb-lisp-syntax-p () - "Return non-nil if RE Builder uses a Lisp syntax." - (memq reb-re-syntax '(sregex rx))) +(defun reb-lisp-syntax-p () + "Return non-nil if RE Builder uses `rx' syntax." + (eq reb-re-syntax 'rx)) -(defmacro reb-target-binding (symbol) +(defun reb-target-value (symbol) "Return binding for SYMBOL in the RE Builder target buffer." - `(with-current-buffer reb-target-buffer ,symbol)) + (buffer-local-value symbol reb-target-buffer)) (defun reb-initialize-buffer () "Initialize the current buffer as a RE Builder buffer." @@ -323,7 +326,10 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (reb-lisp-mode)) (t (reb-mode))) (reb-restart-font-lock) - (reb-do-update)) + ;; When using `rx' syntax, the initial syntax () is invalid. But + ;; don't signal an error in that case. + (ignore-errors + (reb-do-update))) (defun reb-mode-buffer-p () "Return non-nil if the current buffer is a RE Builder buffer." @@ -364,7 +370,8 @@ provided in the Commentary section of this library." (get-buffer-create reb-buffer) `((display-buffer-in-direction) (direction . ,dir) - (dedicated . t)))))) + (dedicated . t) + (window-height . fit-window-to-buffer)))))) (font-lock-mode 1) (reb-initialize-buffer))) @@ -434,7 +441,7 @@ provided in the Commentary section of this library." (interactive) (reb-update-regexp) (let ((re (with-output-to-string - (print (reb-target-binding reb-regexp))))) + (print (reb-target-value 'reb-regexp))))) (setq re (substring re 1 (1- (length re)))) (setq re (string-replace "\n" "\\n" re)) (kill-new re) @@ -448,7 +455,8 @@ provided in the Commentary section of this library." (setq reb-subexp-mode t) (reb-update-modestring) (use-local-map reb-subexp-mode-map) - (message "`0'-`9' to display subexpressions `q' to quit subexp mode")) + (message (substitute-command-keys + "\\`0'-\\`9' to display subexpressions \\`q' to quit subexp mode"))) (defun reb-show-subexp (subexp &optional pause) "Visually show limit of subexpression SUBEXP of recent search. @@ -482,16 +490,17 @@ Optional argument SYNTAX must be specified if called non-interactively." (list (intern (completing-read (format-prompt "Select syntax" reb-re-syntax) - '(read string sregex rx) + '(read string rx) nil t nil nil (symbol-name reb-re-syntax) 'reb-change-syntax-hist)))) - (if (memq syntax '(read string sregex rx)) + (if (memq syntax '(read string rx)) (let ((buffer (get-buffer reb-buffer))) (setq reb-re-syntax syntax) (when buffer (with-current-buffer buffer - (reb-initialize-buffer)))) + (reb-initialize-buffer)) + (message "Switched syntax to `%s'" reb-re-syntax))) (error "Invalid syntax: %s" syntax))) @@ -510,12 +519,17 @@ An actual update is only done if the regexp has changed or if the optional fourth argument FORCE is non-nil." (let ((prev-valid reb-valid-string) (new-valid - (condition-case nil + (condition-case err (progn (when (or (reb-update-regexp) force) (reb-do-update)) "") - (error " *invalid*")))) + (error (propertize + (format " %s" + (if (and (consp (cdr err)) (stringp (cadr err))) + (format "%s: %s" (car err) (cadr err)) + (car err))) + 'face 'font-lock-warning-face))))) (setq reb-valid-string new-valid) (force-mode-line-update) @@ -546,7 +560,7 @@ optional fourth argument FORCE is non-nil." (if reb-subexp-mode (format " (subexp %s)" (or reb-subexp-displayed "-")) "") - (if (not (reb-target-binding case-fold-search)) + (if (not (reb-target-value 'case-fold-search)) " Case" ""))) (force-mode-line-update)) @@ -592,7 +606,7 @@ optional fourth argument FORCE is non-nil." (defun reb-insert-regexp () "Insert current RE." - (let ((re (or (reb-target-binding reb-regexp) + (let ((re (or (reb-target-value 'reb-regexp) (reb-empty-regexp)))) (cond ((eq reb-re-syntax 'read) (print re (current-buffer))) @@ -600,14 +614,14 @@ optional fourth argument FORCE is non-nil." (insert "\n\"" re "\"")) ;; For the Lisp syntax we need the "source" of the regexp ((reb-lisp-syntax-p) - (insert (or (reb-target-binding reb-regexp-src) + (insert (or (reb-target-value 'reb-regexp-src) (reb-empty-regexp))))))) (defun reb-cook-regexp (re) "Return RE after processing it according to `reb-re-syntax'." - (cond ((memq reb-re-syntax '(sregex rx)) - (rx-to-string (eval (car (read-from-string re))))) - (t re))) + (if (eq reb-re-syntax 'rx) + (rx-to-string (eval (car (read-from-string re)))) + re)) (defun reb-update-regexp () "Update the regexp for the target buffer. @@ -619,9 +633,8 @@ Return t if the (cooked) expression changed." (prog1 (not (string= oldre re)) (setq reb-regexp re) - ;; Only update the source re for the lisp formats - (when (reb-lisp-syntax-p) - (setq reb-regexp-src re-src))))))) + ;; Update the source re for the Lisp formats. + (setq reb-regexp-src re-src)))))) ;; And now the real core of the whole thing @@ -636,7 +649,7 @@ Return t if the (cooked) expression changed." (defun reb-update-overlays (&optional subexp) "Switch to `reb-target-buffer' and mark all matches of `reb-regexp'. If SUBEXP is non-nil mark only the corresponding sub-expressions." - (let* ((re (reb-target-binding reb-regexp)) + (let* ((re (reb-target-value 'reb-regexp)) (subexps (reb-count-subexps re)) (matches 0) (submatches 0) @@ -731,8 +744,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (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) + (eq 'font-lock-string-face face)) (throw 'found t)))))))) (defface reb-regexp-grouping-backslash @@ -813,7 +825,6 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (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) |