;;; re-builder.el --- building Regexps with visual feedback
-;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
;; Author: Detlev Zundel <dzu@gnu.org>
;; Keywords: matching, lisp, tools
;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; call `reb-force-update' ("\C-c\C-u") which should reveal the error.
;; The target buffer can be changed with `reb-change-target-buffer'
-;; ("\C-c\C-b"). Changing the target buffer automatically removes
+;; ("\C-c\C-b"). Changing the target buffer automatically removes
;; the overlays from the old buffer and displays the new one in the
;; target window.
;; 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 four different forms of input,
-;; namely `read', `string', `sregex' and `lisp-re' syntax. Read
+;; Currently `re-builder' understands five different forms of input,
+;; namely `read', `string', `rx', `sregex' and `lisp-re' 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 two allow editing of symbolic regular
+;; 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)
(if (not (fboundp 'make-overlay))
(require 'overlay))
-;; User costomizable variables
+;; User customizable variables
(defgroup re-builder nil
"Options for the RE Builder."
:group 'lisp
(const :tag "String syntax" string)
(const :tag "`sregex' syntax" sregex)
(const :tag "`lisp-re' syntax" lisp-re)
+ (const :tag "`rx' syntax" rx)
(value: string)))
(defcustom reb-auto-match-limit 200
:group 're-builder)
(defface reb-match-3
- '((((class color) (background light))
+ '((((min-colors 88) (class color) (background light))
+ :background "yellow1")
+ (((class color) (background light))
:background "yellow")
(((class color) (background dark))
:background "sienna4")
"Buffer to use for the RE Builder.")
;; Define the local "\C-c" keymap
-(defvar reb-mode-map nil
+(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.")
-(if (not reb-mode-map)
- (progn
- (setq reb-mode-map (make-sparse-keymap))
- (define-key reb-mode-map "\C-c\C-c" 'reb-toggle-case)
- (define-key reb-mode-map "\C-c\C-q" 'reb-quit)
- (define-key reb-mode-map "\C-c\C-w" 'reb-copy)
- (define-key reb-mode-map "\C-c\C-s" 'reb-next-match)
- (define-key reb-mode-map "\C-c\C-r" 'reb-prev-match)
- (define-key reb-mode-map "\C-c\C-i" 'reb-change-syntax)
- (define-key reb-mode-map "\C-c\C-e" 'reb-enter-subexp-mode)
- (define-key reb-mode-map "\C-c\C-b" 'reb-change-target-buffer)
- (define-key reb-mode-map "\C-c\C-u" 'reb-force-update)))
-
(defun reb-mode ()
"Major mode for interactively building Regular Expressions.
\\{reb-mode-map}"
(kill-all-local-variables)
(setq major-mode 'reb-mode
mode-name "RE Builder")
+ (set (make-local-variable 'blink-matching-paren) nil)
(use-local-map reb-mode-map)
(reb-mode-common)
- (run-hooks 'reb-mode-hook))
+ (run-mode-hooks 'reb-mode-hook))
(define-derived-mode reb-lisp-mode
emacs-lisp-mode "RE Builder Lisp"
(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..
+ (require 'sregex)) ; right now..
+ ((eq reb-re-syntax '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
(add-hook 'kill-buffer-hook 'reb-kill-buffer)
(reb-auto-update nil nil nil))
-
-;; Handy macro for doing things in other windows
-(defmacro reb-with-current-window (window &rest body)
- "With WINDOW selected evaluate BODY forms and reselect previous window."
-
- (let ((oldwindow (make-symbol "*oldwindow*")))
- `(let ((,oldwindow (selected-window)))
- (select-window ,window)
- (unwind-protect
- (progn
- ,@body)
- (select-window ,oldwindow)))))
-(put 'reb-with-current-window 'lisp-indent-function 0)
-
(defun reb-color-display-p ()
"Return t if display is capable of displaying colors."
(eq 'color
;; emacs/xemacs compatibility
(if (fboundp 'frame-parameter)
(frame-parameter (selected-frame) 'display-type)
- (frame-property (selected-frame) 'display-type))))
+ (if (fboundp 'frame-property)
+ (frame-property (selected-frame) 'display-type)))))
(defsubst reb-lisp-syntax-p ()
"Return non-nil if RE Builder uses a Lisp syntax."
- (memq reb-re-syntax '(lisp-re sregex)))
+ (memq reb-re-syntax '(lisp-re sregex rx)))
(defmacro reb-target-binding (symbol)
"Return binding for SYMBOL in the RE Builder target buffer."
`(with-current-buffer reb-target-buffer ,symbol))
+(defun reb-initialize-buffer ()
+ "Initialize the current buffer as a RE Builder buffer."
+ (erase-buffer)
+ (reb-insert-regexp)
+ (goto-char (+ 2 (point-min)))
+ (cond ((reb-lisp-syntax-p)
+ (reb-lisp-mode))
+ (t (reb-mode))))
+
+;;; This is to help people find this in Apropos.
+;;;###autoload
+(defalias 'regexp-builder 're-builder)
;;;###autoload
(defun re-builder ()
- "Call up the RE Builder for the current window."
+ "Construct a regexp interactively."
(interactive)
(if (and (string= (buffer-name) reb-buffer)
reb-window-config (current-window-configuration))
(select-window (split-window (selected-window) (- (window-height) 4)))
(switch-to-buffer (get-buffer-create reb-buffer))
- (erase-buffer)
- (reb-insert-regexp)
- (goto-char (+ 2 (point-min)))
- (cond
- ((reb-lisp-syntax-p)
- (reb-lisp-mode))
- (t (reb-mode)))))
+ (reb-initialize-buffer)))
(defun reb-change-target-buffer (buf)
"Change the target buffer and display it in the target window."
(reb-update-modestring))))
(defun reb-force-update ()
- "Forces an update in the RE Builder target window without a match limit."
+ "Force an update in the RE Builder target window without a match limit."
(interactive)
(let ((reb-auto-match-limit nil))
(interactive)
(reb-assert-buffer-in-window)
- (reb-with-current-window
- reb-target-window
+ (with-selected-window reb-target-window
(if (not (re-search-forward reb-regexp (point-max) t))
(message "No more matches.")
(reb-show-subexp
(interactive)
(reb-assert-buffer-in-window)
- (reb-with-current-window reb-target-window
- (goto-char (1- (point)))
- (if (not (re-search-backward reb-regexp (point-min) t))
- (message "No more matches.")
- (reb-show-subexp
- (or (and reb-subexp-mode reb-subexp-displayed) 0)
- t))))
+ (with-selected-window reb-target-window
+ (let ((p (point)))
+ (goto-char (1- p))
+ (if (re-search-backward reb-regexp (point-min) t)
+ (reb-show-subexp
+ (or (and reb-subexp-mode reb-subexp-displayed) 0)
+ t)
+ (goto-char p)
+ (message "No more matches.")))))
(defun reb-toggle-case ()
"Toggle case sensitivity of searches for RE Builder target buffer."
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."
- (reb-with-current-window reb-target-window
+ (with-selected-window reb-target-window
(if (not (reb-color-display-p))
(progn (goto-char (match-beginning subexp))
(sit-for reb-blink-delay)))
(list (intern
(completing-read "Select syntax: "
(mapcar (lambda (el) (cons (symbol-name el) 1))
- '(read string lisp-re sregex))
+ '(read string lisp-re sregex rx))
nil t (symbol-name reb-re-syntax)))))
- (if (memq syntax '(read string lisp-re sregex))
+ (if (memq syntax '(read string lisp-re sregex rx))
(let ((buffer (get-buffer reb-buffer)))
(setq reb-re-syntax syntax)
- (if buffer
- (with-current-buffer buffer
- (erase-buffer)
- (reb-insert-regexp)
- (goto-char (+ 2 (point-min)))
- (cond ((reb-lisp-syntax-p)
- (reb-lisp-mode))
- (t (reb-mode))))))
+ (when buffer
+ (with-current-buffer buffer
+ (reb-initialize-buffer))))
(error "Invalid syntax: %s" syntax)))
(interactive)
(setq reb-subexp-displayed
- (or subexp (string-to-int (format "%c" last-command-char))))
+ (or subexp (string-to-number (format "%c" last-command-char))))
(reb-update-modestring)
(reb-do-update reb-subexp-displayed))
(defun reb-cook-regexp (re)
"Return RE after processing it according to `reb-re-syntax'."
(cond ((eq reb-re-syntax 'lisp-re)
- (lre-compile-string (eval (car (read-from-string 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)
+ (rx-to-string (eval (car (read-from-string re)))))
(t re)))
(defun reb-update-regexp ()
beg (match-end 0)))
i))
-
(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))
(subexps (reb-count-subexps re))
(matches 0)
(or (not reb-auto-match-limit)
(< matches reb-auto-match-limit)))
(if (= 0 (length (match-string 0)))
- (error "Empty regular expression!"))
- (let ((i 0))
+ (error "Empty regular expression!"))
+ (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)))
- (face-name (format "reb-match-%d" i)))
- (if (not firstmatch)
- (setq firstmatch (match-data)))
+ ;; 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
- (or (intern-soft face-name)
- (error "Too many subexpressions - face `%s' not defined"
- face-name )))
+ (overlay-put overlay 'face face)
(overlay-put overlay 'priority i)))
(setq i (1+ i))))))
(let ((count (if subexp submatches matches)))
- (message"%s %smatch(es)%s"
+ (message "%s %smatch%s%s"
(if (= 0 count) "No" (int-to-string count))
(if subexp "subexpression " "")
+ (if (= 1 count) "" "es")
(if (and reb-auto-match-limit
(= reb-auto-match-limit count))
" (limit reached)" "")))