comparison lisp/emacs-lisp/re-builder.el @ 88155:d7ddb3e565de

sync with trunk

88154:8ce476d3ba36

;;; re-builder.el --- building Regexps with visual feedback

;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.

;; Author: Detlev Zundel <[e-mail]>
;; Keywords: matching, lisp, tools

;; This file is part of GNU Emacs.

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; When I have to come up with regular expressions that are more
;; complex than simple string matchers, especially if they contain sub

;; shown only in the modeline 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.

;; The target buffer can be changed with `reb-change-target-buffer'
;; ("\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.

;; The `re-builder' keeps the focus while updating the matches in the
;; target buffer so corrections are easy to incorporate.  If you are

;; can be limited by `reb-auto-match-limit' so that they should not
;; have a negative impact on the editing.  Setting it to nil makes
;; 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
;; 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
;; 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)

;; Editing symbolic expressions is done through a major mode derived

  :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)
		 (value: string)))

(defcustom reb-auto-match-limit 200
  "*Positive integer limiting the matches for RE Builder auto updates.
Set it to nil if you don't want limits here."

     :inverse-video t))
  "Used for displaying the second matching subexpression."
  :group 're-builder)

(defface reb-match-3
  '((((class color) (background light))
     :background "yellow")
    (((class color) (background dark))
     :background "sienna4")
    (t
     :inverse-video t))

(defconst reb-buffer "*RE-Builder*"
  "Buffer to use for the RE Builder.")

;; Define the local "\C-c" keymap
(defvar reb-mode-map nil
  "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}"
  (interactive)
  (kill-all-local-variables)
  (setq major-mode 'reb-mode
        mode-name "RE Builder")
  (use-local-map reb-mode-map)
  (reb-mode-common)
  (run-hooks 'reb-mode-hook))

(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..
  (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"

  ;; 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)
  (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))))

(defsubst reb-lisp-syntax-p ()
  "Return non-nil if RE Builder uses a Lisp syntax."
  (memq reb-re-syntax '(lisp-re sregex)))

(defmacro reb-target-binding (symbol)
  "Return binding for SYMBOL in the RE Builder target buffer."
  `(with-current-buffer reb-target-buffer ,symbol))


;;;###autoload
(defun re-builder ()
  "Call up the RE Builder for the current window."
  (interactive)

  (if (and (string= (buffer-name) reb-buffer)
           (memq major-mode '(reb-mode reb-lisp-mode)))
      (message "Already in the RE Builder")

    (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)))
    (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)))))

(defun reb-change-target-buffer (buf)
  "Change the target buffer and display it in the target window."
  (interactive "bSet target buffer to: ")

      (reb-do-update
       (if reb-subexp-mode reb-subexp-displayed nil))
      (reb-update-modestring))))

(defun reb-force-update ()
  "Forces an update in the RE Builder target window without a match limit."
  (interactive)

  (let ((reb-auto-match-limit nil))
    (reb-update-overlays
     (if reb-subexp-mode reb-subexp-displayed nil))))

(defun reb-next-match ()
  "Go to next match in the RE Builder target window."
  (interactive)

  (reb-assert-buffer-in-window)
  (reb-with-current-window
    reb-target-window
    (if (not (re-search-forward reb-regexp (point-max) t))
	(message "No more matches.")
      (reb-show-subexp
       (or (and reb-subexp-mode reb-subexp-displayed) 0)
       t))))

(defun reb-prev-match ()
  "Go to previous match in the RE Builder target window."
  (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))))

(defun reb-toggle-case ()
  "Toggle case sensitivity of searches for RE Builder target buffer."
  (interactive)

  "Visually show limit of subexpression SUBEXP of recent search.
On color displays this just puts point to the end of the expression as
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
    (if (not (reb-color-display-p))
	(progn (goto-char (match-beginning subexp))
	       (sit-for reb-blink-delay)))
    (goto-char (match-end subexp))
    (if (or (not (reb-color-display-p)) pause)

Optional argument SYNTAX must be specified if called non-interactively."
  (interactive
   (list (intern
	  (completing-read "Select syntax: "
			   (mapcar (lambda (el) (cons (symbol-name el) 1))
				   '(read string lisp-re sregex))
			   nil t (symbol-name reb-re-syntax)))))

  (if (memq syntax '(read string lisp-re sregex))
      (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))))))
    (error "Invalid syntax: %s" syntax)))


;; Non-interactive functions below
(defun reb-do-update (&optional subexp)

  (reb-update-regexp)
  (reb-update-overlays subexp))

(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
optional fourth argument FORCE is non-nil."
  (let ((prev-valid reb-valid-string)
	(new-valid
	 (condition-case nil

(defun reb-display-subexp (&optional subexp)
  "Highlight only subexpression SUBEXP in the RE Builder."
  (interactive)

  (setq reb-subexp-displayed
	(or subexp (string-to-int (format "%c" last-command-char))))
  (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."

		     (reb-empty-regexp)))))))

(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)))))
	((eq reb-re-syntax 'sregex)
	 (apply 'sregex (eval (car (read-from-string re)))))
	(t re)))

(defun reb-update-regexp ()
  "Update the regexp for the target buffer.
Return t if the (cooked) expression changed."

		       (error "Too many subexpressions - face `%s' not defined"
			      face-name )))
		  (overlay-put overlay 'priority i)))
	    (setq i (1+ i))))))
    (let ((count (if subexp submatches matches)))
      (message"%s %smatch(es)%s"
	       (if (= 0 count) "No" (int-to-string count))
	       (if subexp "subexpression " "")
	       (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))))))

(provide 're-builder)

;;; re-builder.el ends here

88155:d7ddb3e565de

;;; re-builder.el --- building Regexps with visual feedback

;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
;;   2005 Free Software Foundation, Inc.

;; Author: Detlev Zundel <[e-mail]>
;; Keywords: matching, lisp, tools

;; This file is part of GNU Emacs.

;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; 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.

;;; Commentary:

;; When I have to come up with regular expressions that are more
;; complex than simple string matchers, especially if they contain sub

;; shown only in the modeline 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.

;; The target buffer can be changed with `reb-change-target-buffer'
;; ("\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.

;; The `re-builder' keeps the focus while updating the matches in the
;; target buffer so corrections are easy to incorporate.  If you are

;; can be limited by `reb-auto-match-limit' so that they should not
;; have a negative impact on the editing.  Setting it to nil makes
;; 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
;; 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)

;; Editing symbolic expressions is done through a major mode derived

  :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)
		 (value: string)))

(defcustom reb-auto-match-limit 200
  "*Positive integer limiting the matches for RE Builder auto updates.
Set it to nil if you don't want limits here."

     :inverse-video t))
  "Used for displaying the second matching subexpression."
  :group 're-builder)

(defface reb-match-3
  '((((min-colors 88) (class color) (background light))
     :background "yellow1")
    (((class color) (background light))
     :background "yellow")
    (((class color) (background dark))
     :background "sienna4")
    (t
     :inverse-video 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.")

(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")
  (use-local-map reb-mode-map)
  (reb-mode-common)
  (run-mode-hooks 'reb-mode-hook))

(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
  (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"

  ;; 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)
  (reb-auto-update nil nil nil))

(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)
	(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 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 ()
  "Construct a regexp interactively."
  (interactive)

  (if (and (string= (buffer-name) reb-buffer)
           (memq major-mode '(reb-mode reb-lisp-mode)))
      (message "Already in the RE Builder")

    (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)))
    (switch-to-buffer (get-buffer-create reb-buffer))
    (reb-initialize-buffer)))

(defun reb-change-target-buffer (buf)
  "Change the target buffer and display it in the target window."
  (interactive "bSet target buffer to: ")

      (reb-do-update
       (if reb-subexp-mode reb-subexp-displayed nil))
      (reb-update-modestring))))

(defun reb-force-update ()
  "Force an update in the RE Builder target window without a match limit."
  (interactive)

  (let ((reb-auto-match-limit nil))
    (reb-update-overlays
     (if reb-subexp-mode reb-subexp-displayed nil))))

(defun reb-next-match ()
  "Go to next match in the RE Builder target window."
  (interactive)

  (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.")
      (reb-show-subexp
       (or (and reb-subexp-mode reb-subexp-displayed) 0)
       t))))

(defun reb-prev-match ()
  "Go to previous match in the RE Builder target window."
  (interactive)

  (reb-assert-buffer-in-window)
  (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."
  (interactive)

  "Visually show limit of subexpression SUBEXP of recent search.
On color displays this just puts point to the end of the expression as
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)))
    (goto-char (match-end subexp))
    (if (or (not (reb-color-display-p)) pause)

Optional argument SYNTAX must be specified if called non-interactively."
  (interactive
   (list (intern
	  (completing-read "Select syntax: "
			   (mapcar (lambda (el) (cons (symbol-name el) 1))
				   '(read string lisp-re sregex rx))
			   nil t (symbol-name reb-re-syntax)))))

  (if (memq syntax '(read string lisp-re sregex rx))
      (let ((buffer (get-buffer reb-buffer)))
	(setq reb-re-syntax syntax)
	(when buffer
          (with-current-buffer buffer
            (reb-initialize-buffer))))
    (error "Invalid syntax: %s" syntax)))


;; Non-interactive functions below
(defun reb-do-update (&optional subexp)

  (reb-update-regexp)
  (reb-update-overlays subexp))

(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
optional fourth argument FORCE is non-nil."
  (let ((prev-valid reb-valid-string)
	(new-valid
	 (condition-case nil

(defun reb-display-subexp (&optional subexp)
  "Highlight only subexpression SUBEXP in the RE Builder."
  (interactive)

  (setq reb-subexp-displayed
	(or subexp (string-to-number (format "%c" last-command-char))))
  (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."

		     (reb-empty-regexp)))))))

(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)
	 (rx-to-string (eval (car (read-from-string re)))))
	(t re)))

(defun reb-update-regexp ()
  "Update the regexp for the target buffer.
Return t if the (cooked) expression changed."

		       (error "Too many subexpressions - face `%s' not defined"
			      face-name )))
		  (overlay-put overlay 'priority i)))
	    (setq i (1+ i))))))
    (let ((count (if subexp submatches matches)))
      (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)" "")))
    (if firstmatch
	(progn (store-match-data firstmatch)
	       (reb-show-subexp (or subexp 0))))))

(provide 're-builder)

;;; arch-tag: 5c5515ac-4085-4524-a421-033f44f032e7
;;; re-builder.el ends here