;;; re-builder.el --- building Regexps with visual feedback
-;; Copyright (C) 1999, 2000, 2001, 2002, 2004, 2005 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
(if (not (fboundp 'make-overlay))
(require 'overlay))
-;; User costomizable variables
+;; User customizable variables
(defgroup re-builder nil
"Options for the RE Builder."
:group 'lisp
(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-mode-hooks 'reb-mode-hook))
(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."
"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
-(defun regexp-builder ()
- "Alias for `re-builder': Construct a regexp interactively."
- (interactive)
- (re-builder))
+(defalias 'regexp-builder 're-builder)
;;;###autoload
(defun re-builder ()
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."
(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)))
(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)))
(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)
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)))