X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b03f96dc5a6651d1dc84b81b2a15cad6908b9809..9d4a179053a6fc56b763d74a794b061f3c3aa9fb:/lisp/emacs-lisp/re-builder.el diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 24cd0628b8..9b73bea065 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -1,17 +1,16 @@ -;;; re-builder.el --- building Regexps with visual feedback +;;; re-builder.el --- building Regexps with visual feedback -*- lexical-binding: t -*- -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1999-2013 Free Software Foundation, Inc. ;; Author: Detlev Zundel ;; Keywords: matching, lisp, tools ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,9 +18,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -41,7 +38,7 @@ ;; the target buffer are marked automatically with colored overlays ;; (for non-color displays see below) giving you feedback over the ;; extents of the matched (sub) expressions. The (non-)validity is -;; shown only in the modeline without throwing the errors at you. If +;; shown only in the mode line without throwing the errors at you. If ;; you want to know the reason why RE Builder considers it as invalid ;; call `reb-force-update' ("\C-c\C-u") which should reveal the error. @@ -62,15 +59,13 @@ ;; even the auto updates go all the way. Forcing an update overrides ;; this limit allowing an easy way to see all matches. -;; Currently `re-builder' understands five different forms of input, -;; namely `read', `string', `rx', `sregex' and `lisp-re' syntax. Read +;; Currently `re-builder' understands three different forms of input, +;; namely `read', `string', and `rx' syntax. Read ;; syntax and string syntax are both delimited by `"'s and behave ;; according to their name. With the `string' syntax there's no need ;; to escape the backslashes and double quotes simplifying the editing ;; somewhat. The other three allow editing of symbolic regular -;; expressions supported by the packages of the same name. (`lisp-re' -;; is a package by me and its support may go away as it is nearly the -;; same as the `sregex' package in Emacs) +;; expressions supported by the packages of the same name. ;; Editing symbolic expressions is done through a major mode derived ;; from `emacs-lisp-mode' so you'll get all the good stuff like @@ -79,7 +74,7 @@ ;; When editing a symbolic regular expression, only the first ;; expression in the RE Builder buffer is considered, which helps ;; limiting the extent of the expression like the `"'s do for the text -;; modes. For the `sregex' syntax the function `sregex' is applied to +;; modes. For the `rx' syntax the function `rx-to-string' is applied to ;; the evaluated expression read. So you can use quoted arguments ;; with something like '("findme") or you can construct arguments to ;; your hearts delight with a valid ELisp expression. (The compiled @@ -109,8 +104,8 @@ ;;; Code: ;; On XEmacs, load the overlay compatibility library -(if (not (fboundp 'make-overlay)) - (require 'overlay)) +(unless (fboundp 'make-overlay) + (require 'overlay)) ;; User customizable variables (defgroup re-builder nil @@ -119,27 +114,25 @@ :prefix "reb-") (defcustom reb-blink-delay 0.5 - "*Seconds to blink cursor for next/previous match in RE Builder." + "Seconds to blink cursor for next/previous match in RE Builder." :group 're-builder :type 'number) (defcustom reb-mode-hook nil - "*Hooks to run on entering RE Builder mode." + "Hooks to run on entering RE Builder mode." :group 're-builder :type 'hook) (defcustom reb-re-syntax 'read - "*Syntax for the REs in the RE Builder. -Can either be `read', `string', `sregex', `lisp-re', `rx'." + "Syntax for the REs in the RE Builder. +Can either be `read', `string', or `rx'." :group 're-builder :type '(choice (const :tag "Read syntax" read) (const :tag "String syntax" string) - (const :tag "`sregex' syntax" sregex) - (const :tag "`lisp-re' syntax" lisp-re) (const :tag "`rx' syntax" rx))) (defcustom reb-auto-match-limit 200 - "*Positive integer limiting the matches for RE Builder auto updates. + "Positive integer limiting the matches for RE Builder auto updates. Set it to nil if you don't want limits here." :group 're-builder :type '(restricted-sexp :match-alternatives @@ -232,7 +225,8 @@ Except for Lisp syntax this is the same as `reb-regexp'.") ;; Define the local "\C-c" keymap (defvar reb-mode-map - (let ((map (make-sparse-keymap))) + (let ((map (make-sparse-keymap)) + (menu-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) @@ -242,37 +236,60 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (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) + (define-key map [menu-bar reb-mode] (cons "Re-Builder" menu-map)) + (define-key menu-map [rq] + '(menu-item "Quit" reb-quit + :help "Quit the RE Builder mode")) + (define-key menu-map [rt] + '(menu-item "Case sensitive" reb-toggle-case + :button (:toggle . (with-current-buffer + reb-target-buffer + (null case-fold-search))) + :help "Toggle case sensitivity of searches for RE Builder target buffer")) + (define-key menu-map [rb] + '(menu-item "Change target buffer..." reb-change-target-buffer + :help "Change the target buffer and display it in the target window")) + (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 [re] + '(menu-item "Enter subexpression mode" reb-enter-subexp-mode + :help "Enter the subexpression mode in the RE Builder")) + (define-key menu-map [ru] + '(menu-item "Force update" reb-force-update + :help "Force an update in the RE Builder target window without a match limit")) + (define-key menu-map [rn] + '(menu-item "Go to next match" reb-next-match + :help "Go to next match in the RE Builder target window")) + (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 [rc] + '(menu-item "Copy current RE" reb-copy + :help "Copy current RE into the kill ring for later insertion")) map) "Keymap used by the RE Builder.") -(defun reb-mode () - "Major mode for interactively building Regular Expressions. -\\{reb-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'reb-mode - mode-name "RE Builder") +(define-derived-mode reb-mode nil "RE Builder" + "Major mode for interactively building Regular Expressions." (set (make-local-variable 'blink-matching-paren) nil) - (use-local-map reb-mode-map) - (reb-mode-common) - (run-mode-hooks 'reb-mode-hook)) + (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)) (define-derived-mode reb-lisp-mode emacs-lisp-mode "RE Builder Lisp" "Major mode for interactively building symbolic Regular Expressions." - (cond ((eq reb-re-syntax 'lisp-re) ; Pull in packages - (require 'lisp-re)) ; as needed - ((eq reb-re-syntax 'sregex) ; sregex is not autoloaded - (require 'sregex)) ; right now.. - ((eq reb-re-syntax 'rx) ; rx-to-string is autoloaded - (require 'rx))) ; require rx anyway + ;; Pull in packages as needed + (cond ((memq reb-re-syntax '(sregex rx)) ; rx-to-string is autoloaded + (require 'rx))) ; require rx anyway (reb-mode-common)) -;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from -;; `emacs-lisp-mode' -(define-key reb-lisp-mode-map "\C-c" - (lookup-key reb-mode-map "\C-c")) - (defvar reb-subexp-mode-map (let ((m (make-keymap))) (suppress-keymap m) @@ -292,12 +309,9 @@ Except for Lisp syntax this is the same as `reb-regexp'.") mode-line-buffer-identification '(25 . ("%b" reb-mode-string reb-valid-string))) (reb-update-modestring) - (make-local-variable 'after-change-functions) - (add-hook 'after-change-functions - 'reb-auto-update) + (add-hook 'after-change-functions 'reb-auto-update nil t) ;; At least make the overlays go away if the buffer is killed - (make-local-variable 'reb-kill-buffer) - (add-hook 'kill-buffer-hook 'reb-kill-buffer) + (add-hook 'kill-buffer-hook 'reb-kill-buffer nil t) (reb-auto-update nil nil nil)) (defun reb-color-display-p () @@ -311,7 +325,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (defsubst reb-lisp-syntax-p () "Return non-nil if RE Builder uses a Lisp syntax." - (memq reb-re-syntax '(lisp-re sregex rx))) + (memq reb-re-syntax '(sregex rx))) (defmacro reb-target-binding (symbol) "Return binding for SYMBOL in the RE Builder target buffer." @@ -324,7 +338,12 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (goto-char (+ 2 (point-min))) (cond ((reb-lisp-syntax-p) (reb-lisp-mode)) - (t (reb-mode)))) + (t (reb-mode))) + (reb-do-update)) + +(defun reb-mode-buffer-p () + "Return non-nil if the current buffer is a RE Builder buffer." + (memq major-mode '(reb-mode reb-lisp-mode))) ;;; This is to help people find this in Apropos. ;;;###autoload @@ -332,18 +351,25 @@ Except for Lisp syntax this is the same as `reb-regexp'.") ;;;###autoload (defun re-builder () - "Construct a regexp interactively." - (interactive) + "Construct a regexp interactively. +This command makes the current buffer the \"target\" buffer of +the regexp builder. It displays a buffer named \"*RE-Builder*\" +in another window, initially containing an empty regexp. +As you edit the regexp in the \"*RE-Builder*\" buffer, the +matching parts of the target buffer will be highlighted." + (interactive) (if (and (string= (buffer-name) reb-buffer) - (memq major-mode '(reb-mode reb-lisp-mode))) + (reb-mode-buffer-p)) (message "Already in the RE Builder") - (if reb-target-buffer - (reb-delete-overlays)) + (when reb-target-buffer + (reb-delete-overlays)) (setq reb-target-buffer (current-buffer) - reb-target-window (selected-window) - reb-window-config (current-window-configuration)) - (select-window (split-window (selected-window) (- (window-height) 4))) + reb-target-window (selected-window)) + (select-window (or (get-buffer-window reb-buffer) + (progn + (setq reb-window-config (current-window-configuration)) + (split-window (selected-window) (- (window-height) 4))))) (switch-to-buffer (get-buffer-create reb-buffer)) (reb-initialize-buffer))) @@ -385,7 +411,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (reb-assert-buffer-in-window) (with-selected-window reb-target-window (if (not (re-search-forward reb-regexp (point-max) t)) - (message "No more matches.") + (message "No more matches") (reb-show-subexp (or (and reb-subexp-mode reb-subexp-displayed) 0) t)))) @@ -403,7 +429,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (or (and reb-subexp-mode reb-subexp-displayed) 0) t) (goto-char p) - (message "No more matches."))))) + (message "No more matches"))))) (defun reb-toggle-case () "Toggle case sensitivity of searches for RE Builder target buffer." @@ -432,7 +458,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (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 "`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. @@ -441,12 +467,12 @@ the match should already be marked by an overlay. On other displays jump to the beginning and the end of it. If the optional PAUSE is non-nil then pause at the end in any case." (with-selected-window reb-target-window - (if (not (reb-color-display-p)) - (progn (goto-char (match-beginning subexp)) - (sit-for reb-blink-delay))) + (unless (reb-color-display-p) + (goto-char (match-beginning subexp)) + (sit-for reb-blink-delay)) (goto-char (match-end subexp)) - (if (or (not (reb-color-display-p)) pause) - (sit-for reb-blink-delay)))) + (when (or (not (reb-color-display-p)) pause) + (sit-for reb-blink-delay)))) (defun reb-quit-subexp-mode () "Quit the subexpression mode in the RE Builder." @@ -464,10 +490,10 @@ Optional argument SYNTAX must be specified if called non-interactively." (list (intern (completing-read "Select syntax: " (mapcar (lambda (el) (cons (symbol-name el) 1)) - '(read string lisp-re sregex rx)) + '(read string sregex rx)) nil t (symbol-name reb-re-syntax))))) - (if (memq syntax '(read string lisp-re sregex rx)) + (if (memq syntax '(read string sregex rx)) (let ((buffer (get-buffer reb-buffer))) (setq reb-re-syntax syntax) (when buffer @@ -485,7 +511,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (reb-update-regexp) (reb-update-overlays subexp)) -(defun reb-auto-update (beg end lenold &optional force) +(defun reb-auto-update (_beg _end _lenold &optional force) "Called from `after-update-functions' to update the display. BEG, END and LENOLD are passed in from the hook. An actual update is only done if the regexp has changed or if the @@ -494,10 +520,8 @@ optional fourth argument FORCE is non-nil." (new-valid (condition-case nil (progn - (if (or (reb-update-regexp) force) - (progn - (reb-assert-buffer-in-window) - (reb-do-update))) + (when (or (reb-update-regexp) force) + (reb-do-update)) "") (error " *invalid*")))) (setq reb-valid-string new-valid) @@ -506,14 +530,14 @@ optional fourth argument FORCE is non-nil." ;; Through the caching of the re a change invalidating the syntax ;; for symbolic expressions will not delete the overlays so we ;; catch it here - (if (and (reb-lisp-syntax-p) - (not (string= prev-valid new-valid)) - (string= prev-valid "")) - (reb-delete-overlays)))) + (when (and (reb-lisp-syntax-p) + (not (string= prev-valid new-valid)) + (string= prev-valid "")) + (reb-delete-overlays)))) (defun reb-delete-overlays () "Delete all RE Builder overlays in the `reb-target-buffer' buffer." - (if (buffer-live-p reb-target-buffer) + (when (buffer-live-p reb-target-buffer) (with-current-buffer reb-target-buffer (mapc 'delete-overlay reb-overlays) (setq reb-overlays nil)))) @@ -541,15 +565,15 @@ optional fourth argument FORCE is non-nil." (interactive) (setq reb-subexp-displayed - (or subexp (string-to-number (format "%c" last-command-char)))) + (or subexp (string-to-number (format "%c" last-command-event)))) (reb-update-modestring) (reb-do-update reb-subexp-displayed)) (defun reb-kill-buffer () "When the RE Builder buffer is killed make sure no overlays stay around." - (if (member major-mode '(reb-mode reb-lisp-mode)) - (reb-delete-overlays))) + (when (reb-mode-buffer-p) + (reb-delete-overlays))) ;; The next functions are the interface between the regexp and @@ -593,12 +617,7 @@ optional fourth argument FORCE is non-nil." (defun reb-cook-regexp (re) "Return RE after processing it according to `reb-re-syntax'." - (cond ((eq reb-re-syntax 'lisp-re) - (if (fboundp 'lre-compile-string) - (lre-compile-string (eval (car (read-from-string re)))))) - ((eq reb-re-syntax 'sregex) - (apply 'sregex (eval (car (read-from-string re))))) - ((eq reb-re-syntax 'rx) + (cond ((memq reb-re-syntax '(sregex rx)) (rx-to-string (eval (car (read-from-string re))))) (t re))) @@ -613,8 +632,8 @@ Return t if the (cooked) expression changed." (not (string= oldre re)) (setq reb-regexp re) ;; Only update the source re for the lisp formats - (if (reb-lisp-syntax-p) - (setq reb-regexp-src re-src))))))) + (when (reb-lisp-syntax-p) + (setq reb-regexp-src re-src))))))) ;; And now the real core of the whole thing @@ -635,46 +654,45 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (matches 0) (submatches 0) firstmatch) - (save-excursion - (set-buffer reb-target-buffer) + (with-current-buffer reb-target-buffer (reb-delete-overlays) (goto-char (point-min)) (while (and (not (eobp)) (re-search-forward re (point-max) t) (or (not reb-auto-match-limit) (< matches reb-auto-match-limit))) - (if (= 0 (length (match-string 0))) - (unless (eobp) - (forward-char 1))) + (when (and (= 0 (length (match-string 0))) + (not (eobp))) + (forward-char 1)) (let ((i 0) suffix max-suffix) (setq matches (1+ matches)) (while (<= i subexps) - (if (and (or (not subexp) (= subexp i)) - (match-beginning i)) - (let ((overlay (make-overlay (match-beginning i) - (match-end i))) - ;; When we have exceeded the number of provided faces, - ;; cycle thru them where `max-suffix' denotes the maximum - ;; suffix for `reb-match-*' that has been defined and - ;; `suffix' the suffix calculated for the current match. - (face - (cond - (max-suffix - (if (= suffix max-suffix) - (setq suffix 1) - (setq suffix (1+ suffix))) - (intern-soft (format "reb-match-%d" suffix))) - ((intern-soft (format "reb-match-%d" i))) - ((setq max-suffix (1- i)) - (setq suffix 1) - ;; `reb-match-1' must exist. - 'reb-match-1)))) - (unless firstmatch (setq firstmatch (match-data))) - (setq reb-overlays (cons overlay reb-overlays) - submatches (1+ submatches)) - (overlay-put overlay 'face face) - (overlay-put overlay 'priority i))) + (when (and (or (not subexp) (= subexp i)) + (match-beginning i)) + (let ((overlay (make-overlay (match-beginning i) + (match-end i))) + ;; When we have exceeded the number of provided faces, + ;; cycle thru them where `max-suffix' denotes the maximum + ;; suffix for `reb-match-*' that has been defined and + ;; `suffix' the suffix calculated for the current match. + (face + (cond + (max-suffix + (if (= suffix max-suffix) + (setq suffix 1) + (setq suffix (1+ suffix))) + (intern-soft (format "reb-match-%d" suffix))) + ((intern-soft (format "reb-match-%d" i))) + ((setq max-suffix (1- i)) + (setq suffix 1) + ;; `reb-match-1' must exist. + 'reb-match-1)))) + (unless firstmatch (setq firstmatch (match-data))) + (setq reb-overlays (cons overlay reb-overlays) + submatches (1+ submatches)) + (overlay-put overlay 'face face) + (overlay-put overlay 'priority i))) (setq i (1+ i)))))) (let ((count (if subexp submatches matches))) (message "%s %smatch%s%s" @@ -684,11 +702,22 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (if (and reb-auto-match-limit (= reb-auto-match-limit count)) " (limit reached)" ""))) - (if firstmatch - (progn (store-match-data firstmatch) - (reb-show-subexp (or subexp 0)))))) + (when firstmatch + (store-match-data firstmatch) + (reb-show-subexp (or subexp 0))))) + +;; The End +(defun re-builder-unload-function () + "Unload the RE Builder library." + (when (buffer-live-p (get-buffer reb-buffer)) + (with-current-buffer reb-buffer + (remove-hook 'after-change-functions 'reb-auto-update t) + (remove-hook 'kill-buffer-hook 'reb-kill-buffer t) + (when (reb-mode-buffer-p) + (reb-delete-overlays)))) + ;; continue standard unloading + nil) (provide 're-builder) -;;; arch-tag: 5c5515ac-4085-4524-a421-033f44f032e7 ;;; re-builder.el ends here