;;; replace.el --- replace commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001,
-;; 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
:group 'matching
:version "22.1")
+(defcustom query-replace-show-replacement t
+ "*Non-nil means to show what actual replacement text will be."
+ :type 'boolean
+ :group 'matching
+ :version "23.1")
+
(defcustom query-replace-highlight t
"*Non-nil means to highlight matches during query replacement."
:type 'boolean
(defun query-replace-regexp-eval (regexp to-expr &optional delimited start end)
"Replace some things after point matching REGEXP with the result of TO-EXPR.
+
+Interactive use of this function is deprecated in favor of the
+`\\,' feature of `query-replace-regexp'. For non-interactive use, a loop
+using `search-forward-regexp' and `replace-match' is preferred.
+
As each match is found, the user must type a character saying
what to do with it. For directions, type \\[help-command] at that time.
(perform-replace regexp (cons 'replace-eval-replacement to-expr)
t 'literal delimited nil nil start end))
+(make-obsolete 'query-replace-regexp-eval
+ "for interactive use, use the special `\\,' feature of
+`query-replace-regexp' instead. Non-interactively, a loop
+using `search-forward-regexp' and `replace-match' is preferred." "22.1")
+
(defun map-query-replace-regexp (regexp to-strings &optional n start end)
"Replace some matches for REGEXP with various strings, in rotation.
-The second argument TO-STRINGS contains the replacement strings,
-separated by spaces. Third arg DELIMITED (prefix arg if interactive),
-if non-nil, means replace only matches surrounded by word boundaries.
-This command works like `query-replace-regexp' except that each
-successive replacement uses the next successive replacement string,
+The second argument TO-STRINGS contains the replacement strings, separated
+by spaces. This command works like `query-replace-regexp' except that
+each successive replacement uses the next successive replacement string,
wrapping around from the last such string to the first.
In Transient Mark mode, if the mark is active, operate on the contents
\f
(defvar regexp-history nil
- "History list for some commands that read regular expressions.")
+ "History list for some commands that read regular expressions.
+
+Maximum length of the history list is determined by the value
+of `history-length', which see.")
(defalias 'delete-non-matching-lines 'keep-lines)
"Read arguments for `keep-lines' and friends.
Prompt for a regexp with PROMPT.
Value is a list, (REGEXP)."
- (list (read-from-minibuffer prompt nil nil nil
- 'regexp-history nil t)
- nil nil t))
+ (let* ((default (list
+ (regexp-quote
+ (or (funcall (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default))
+ ""))
+ (car regexp-search-ring)
+ (regexp-quote (or (car search-ring) ""))
+ (car (symbol-value
+ query-replace-from-history-variable))))
+ (default (delete-dups (delq nil (delete "" default)))))
+ (list (read-from-minibuffer prompt nil nil nil
+ 'regexp-history default t)
+ nil nil t)))
(defun keep-lines (regexp &optional rstart rend interactive)
"Delete all lines except those containing matches for REGEXP.
When called from Lisp (and usually interactively as well, see below)
applies to all lines starting after point.
-If REGEXP contains upper case characters (excluding those preceded by `\\'),
-the matching is case-sensitive.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
Second and third arg RSTART and REND specify the region to operate on.
This command operates on (the accessible part of) all lines whose
(save-excursion
(or (bolp) (forward-line 1))
(let ((start (point))
- (case-fold-search (and case-fold-search
- (isearch-no-upper-case-p regexp t))))
+ (case-fold-search
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)))
(while (< (point) rend)
;; Start is first char not preserved by previous match.
(if (not (re-search-forward regexp rend 'move))
The line point is in is deleted if and only if it contains a
match for regexp starting after point.
-If REGEXP contains upper case characters (excluding those preceded by `\\'),
-the matching is case-sensitive.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
Second and third arg RSTART and REND specify the region to operate on.
Lines partially contained in this region are deleted if and only if
(setq rstart (point)
rend (point-max-marker)))
(goto-char rstart))
- (let ((case-fold-search (and case-fold-search
- (isearch-no-upper-case-p regexp t))))
+ (let ((case-fold-search
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)))
(save-excursion
(while (and (< (point) rend)
(re-search-forward regexp rend t))
the number, do not print it; if INTERACTIVE is t, the function behaves
in all respects has if it had been called interactively.
-If REGEXP contains upper case characters (excluding those preceded by `\\'),
-the matching is case-sensitive.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
Second and third arg RSTART and REND specify the region to operate on.
(goto-char rstart))
(let ((count 0)
opoint
- (case-fold-search (and case-fold-search
- (isearch-no-upper-case-p regexp t))))
+ (case-fold-search
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)))
(while (and (< (point) rend)
(progn (setq opoint (point))
(re-search-forward regexp rend t)))
(define-key map "q" 'quit-window)
(define-key map "z" 'kill-this-buffer)
(define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
+ (define-key map [menu-bar] (make-sparse-keymap))
+ (define-key map [menu-bar occur]
+ (cons "Occur" map))
+ (define-key map [next-error-follow-minor-mode]
+ (menu-bar-make-mm-toggle next-error-follow-minor-mode
+ "Auto Occurrence Display"
+ "Display another occurrence when moving the cursor"))
+ (define-key map [separator-1] '("--"))
+ (define-key map [kill-this-buffer]
+ '("Kill occur buffer" . kill-this-buffer))
+ (define-key map [quit-window]
+ '("Quit occur window" . quit-window))
+ (define-key map [revert-buffer]
+ '("Revert occur buffer" . revert-buffer))
+ (define-key map [clone-buffer]
+ '("Clone occur buffer" . clone-buffer))
+ (define-key map [occur-rename-buffer]
+ '("Rename occur buffer" . occur-rename-buffer))
+ (define-key map [separator-2] '("--"))
+ (define-key map [occur-mode-goto-occurrence-other-window]
+ '("Go To Occurrence Other Window" . occur-mode-goto-occurrence-other-window))
+ (define-key map [occur-mode-goto-occurrence]
+ '("Go To Occurrence" . occur-mode-goto-occurrence))
+ (define-key map [occur-mode-display-occurrence]
+ '("Display Occurrence" . occur-mode-display-occurrence))
+ (define-key map [occur-next]
+ '("Move to next match" . occur-next))
+ (define-key map [occur-prev]
+ '("Move to previous match" . occur-prev))
map)
"Keymap for `occur-mode'.")
#'next-single-property-change)
"No more matches")
;; In case the *Occur* buffer is visible in a nonselected window.
- (set-window-point (get-buffer-window (current-buffer)) (point))
+ (let ((win (get-buffer-window (current-buffer) t)))
+ (if win (set-window-point win (point))))
(occur-mode-goto-occurrence)))
\f
(defface match
'((((class color) (min-colors 88) (background light))
- :background "Tan")
+ :background "yellow1")
(((class color) (min-colors 88) (background dark))
:background "RoyalBlue3")
- (((class color) (min-colors 8))
+ (((class color) (min-colors 8) (background light))
+ :background "yellow" :foreground "black")
+ (((class color) (min-colors 8) (background dark))
:background "blue" :foreground "white")
(((type tty) (class mono))
:inverse-video t)
(nreverse result))))
(defun occur-read-primary-args ()
- (list (let* ((default (car regexp-history))
- (input
- (read-from-minibuffer
- (if default
- (format "List lines matching regexp (default %s): "
- (query-replace-descr default))
- "List lines matching regexp: ")
- nil
- nil
- nil
- 'regexp-history
- default)))
- (if (equal input "")
- default
- input))
- (when current-prefix-arg
- (prefix-numeric-value current-prefix-arg))))
+ (let* ((default
+ (list (and transient-mark-mode mark-active
+ (regexp-quote
+ (buffer-substring-no-properties
+ (region-beginning) (region-end))))
+ (regexp-quote
+ (or (funcall
+ (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default))
+ ""))
+ (car regexp-search-ring)
+ (regexp-quote (or (car search-ring) ""))
+ (car (symbol-value
+ query-replace-from-history-variable))))
+ (default (delete-dups (delq nil (delete "" default))))
+ (input
+ (read-from-minibuffer
+ "List lines matching regexp: "
+ nil nil nil 'regexp-history default)))
+ (list input
+ (when current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)))))
(defun occur-rename-buffer (&optional unique-p interactive-p)
"Rename the current *Occur* buffer to *Occur: original-buffer-name*.
It serves as a menu to find any of the occurrences in this buffer.
\\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
-If REGEXP contains upper case characters (excluding those preceded by `\\'),
-the matching is case-sensitive."
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive."
(interactive (occur-read-primary-args))
(occur-1 regexp nlines (list (current-buffer))))
(with-current-buffer occur-buf
(occur-mode)
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ ;; Don't generate undo entries for creation of the initial contents.
+ (buffer-undo-list t))
(erase-buffer)
(let ((count (occur-engine
regexp active-bufs occur-buf
(or nlines list-matching-lines-default-context-lines)
- (and case-fold-search
- (isearch-no-upper-case-p regexp t))
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)
list-matching-lines-buffer-name-face
nil list-matching-lines-face
(not (eq occur-excluded-properties t)))))
title-face prefix-face match-face keep-props)
(with-current-buffer out-buf
(let ((globalcount 0)
- ;; Don't generate undo entries for creation of the initial contents.
- (buffer-undo-list t)
(coding nil))
;; Map over all the buffers
(dolist (buf buffers)
(if (= nlines 0)
;; The simple display style
out-line
- ;; The complex multi-line display
- ;; style. Generate a list of lines,
- ;; concatenate them all together.
- (apply #'concat
- (nconc
- (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ (abs nlines))) keep-props))))
- (list out-line)
- (if (> nlines 0)
- (occur-engine-add-prefix
- (cdr (occur-accumulate-lines (1+ nlines) keep-props)))))))))
+ ;; The complex multi-line display style.
+ (occur-context-lines out-line nlines keep-props)
+ )))
;; Actually insert the match display data
(with-current-buffer out-buf
(let ((beg (point))
;; Return the number of matches
globalcount)))
+;; Generate context display for occur.
+;; OUT-LINE is the line where the match is.
+;; NLINES and KEEP-PROPS are args to occur-engine.
+;; Generate a list of lines, add prefixes to all but OUT-LINE,
+;; then concatenate them all together.
+(defun occur-context-lines (out-line nlines keep-props)
+ (apply #'concat
+ (nconc
+ (occur-engine-add-prefix
+ (nreverse (cdr (occur-accumulate-lines
+ (- (1+ (abs nlines))) keep-props))))
+ (list out-line)
+ (if (> nlines 0)
+ (occur-engine-add-prefix
+ (cdr (occur-accumulate-lines (1+ nlines) keep-props)))))))
\f
;; It would be nice to use \\[...], but there is no reasonable way
;; to make that display both SPC and Y.
(or map (setq map query-replace-map))
(and query-flag minibuffer-auto-raise
(raise-frame (window-frame (minibuffer-window))))
- (let ((nocasify (not (and case-fold-search case-replace
- (string-equal from-string
- (downcase from-string)))))
- (case-fold-search (and case-fold-search
- (string-equal from-string
- (downcase from-string))))
- (literal (or (not regexp-flag) (eq regexp-flag 'literal)))
- (search-function (if regexp-flag 're-search-forward 'search-forward))
- (search-string from-string)
- (real-match-data nil) ; the match data for the current match
- (next-replacement nil)
- ;; This is non-nil if we know there is nothing for the user
- ;; to edit in the replacement.
- (noedit nil)
- (keep-going t)
- (stack nil)
- (replace-count 0)
- (nonempty-match nil)
-
- ;; If non-nil, it is marker saying where in the buffer to stop.
- (limit nil)
-
- ;; Data for the next match. If a cons, it has the same format as
- ;; (match-data); otherwise it is t if a match is possible at point.
- (match-again t)
-
- (message
- (if query-flag
- (substitute-command-keys
- "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) "))))
+ (let* ((case-fold-search
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p from-string regexp-flag)
+ case-fold-search))
+ (nocasify (not (and case-replace case-fold-search)))
+ (literal (or (not regexp-flag) (eq regexp-flag 'literal)))
+ (search-function (if regexp-flag 're-search-forward 'search-forward))
+ (search-string from-string)
+ (real-match-data nil) ; The match data for the current match.
+ (next-replacement nil)
+ ;; This is non-nil if we know there is nothing for the user
+ ;; to edit in the replacement.
+ (noedit nil)
+ (keep-going t)
+ (stack nil)
+ (replace-count 0)
+ (nonempty-match nil)
+
+ ;; If non-nil, it is marker saying where in the buffer to stop.
+ (limit nil)
+
+ ;; Data for the next match. If a cons, it has the same format as
+ ;; (match-data); otherwise it is t if a match is possible at point.
+ (match-again t)
+
+ (message
+ (if query-flag
+ (apply 'propertize
+ (substitute-command-keys
+ "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")
+ minibuffer-prompt-properties))))
;; If region is active, in Transient Mark mode, operate on region.
(when start
;; otherwise, search for a match after moving forward
;; one char if progress is required.
(setq real-match-data
- (if (consp match-again)
- (progn (goto-char (nth 1 match-again))
- (replace-match-data t
- real-match-data
- match-again))
- (and (or match-again
- ;; MATCH-AGAIN non-nil means we
- ;; accept an adjacent match. If
- ;; we don't, move one char to the
- ;; right. This takes us a
- ;; character too far at the end,
- ;; but this is undone after the
- ;; while-loop.
- (progn
- (forward-char 1)
- (not (or (eobp)
- (and limit (>= (point) limit))))))
- (funcall search-function search-string limit t)
- ;; For speed, use only integers and
- ;; reuse the list used last time.
- (replace-match-data t real-match-data)))))
+ (cond ((consp match-again)
+ (goto-char (nth 1 match-again))
+ (replace-match-data
+ t real-match-data match-again))
+ ;; MATCH-AGAIN non-nil means accept an
+ ;; adjacent match.
+ (match-again
+ (and
+ (funcall search-function search-string
+ limit t)
+ ;; For speed, use only integers and
+ ;; reuse the list used last time.
+ (replace-match-data t real-match-data)))
+ ((and (< (1+ (point)) (point-max))
+ (or (null limit)
+ (< (1+ (point)) limit)))
+ ;; If not accepting adjacent matches,
+ ;; move one char to the right before
+ ;; searching again. Undo the motion
+ ;; if the search fails.
+ (let ((opoint (point)))
+ (forward-char 1)
+ (if (funcall
+ search-function search-string
+ limit t)
+ (replace-match-data
+ t real-match-data)
+ (goto-char opoint)
+ nil))))))
;; Record whether the match is nonempty, to avoid an infinite loop
;; repeatedly matching the same empty string.
(or delimited-flag regexp-flag) case-fold-search)
;; Bind message-log-max so we don't fill up the message log
;; with a bunch of identical messages.
- (let ((message-log-max nil))
+ (let ((message-log-max nil)
+ (replacement-presentation
+ (if query-replace-show-replacement
+ (save-match-data
+ (set-match-data real-match-data)
+ (match-substitute-replacement next-replacement
+ nocasify literal))
+ next-replacement)))
(message message
(query-replace-descr from-string)
- (query-replace-descr next-replacement)))
+ (query-replace-descr replacement-presentation)))
(setq key (read-event))
;; Necessary in case something happens during read-event
;; that clobbers the match data.
(match-data t)))
stack)))))
- ;; The code preventing adjacent regexp matches in the condition
- ;; of the while-loop above will haven taken us one character
- ;; beyond the last replacement. Undo that.
- (when (and regexp-flag (not match-again) (> replace-count 0))
- (backward-char 1))
-
(replace-dehighlight))
(or unread-command-events
(message "Replaced %d occurrence%s"