;;; 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
;; 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
;; 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 <http://www.gnu.org/licenses/>.
;;; Commentary:
Maximum length of the history list is determined by the value
of `history-length', which see.")
+(defun read-regexp (prompt &optional default)
+ "Read regexp as a string using the regexp history and some useful defaults.
+Prompt for a regular expression with PROMPT (without a colon and
+space) in the minibuffer. The optional string argument DEFAULT
+provides the basic default value, that is returned on typing RET.
+Additional defaults are the string at point, the last isearch regexp,
+the last isearch string, and the last replacement regexp."
+ (let* ((defaults
+ (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))))
+ (defaults (delete-dups (delq nil (delete "" defaults))))
+ ;; Don't add automatically the car of defaults for empty input
+ (history-add-new-input nil)
+ (input
+ (read-from-minibuffer
+ (if default
+ (format "%s (default %s): " prompt (query-replace-descr default))
+ (format "%s: " prompt))
+ nil nil nil 'regexp-history defaults t)))
+ (if (equal input "")
+ default
+ (prog1 input
+ (add-to-history 'regexp-history input)))))
+
(defalias 'delete-non-matching-lines 'keep-lines)
(defalias 'delete-matching-lines 'flush-lines)
"Read arguments for `keep-lines' and friends.
Prompt for a regexp with PROMPT.
Value is a list, (REGEXP)."
- (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)))
+ (list (read-regexp prompt) nil nil t))
(defun keep-lines (regexp &optional rstart rend interactive)
"Delete all lines except those containing matches for REGEXP.
(interactive
(progn
(barf-if-buffer-read-only)
- (keep-lines-read-args "Keep lines (containing match for regexp): ")))
+ (keep-lines-read-args "Keep lines containing match for regexp")))
(if rstart
(progn
(goto-char (min rstart rend))
(interactive
(progn
(barf-if-buffer-read-only)
- (keep-lines-read-args "Flush lines (containing match for regexp): ")))
+ (keep-lines-read-args "Flush lines containing match for regexp")))
(if rstart
(progn
(goto-char (min rstart rend))
a previously found match."
(interactive
- (keep-lines-read-args "How many matches for (regexp): "))
+ (keep-lines-read-args "How many matches for regexp"))
(save-excursion
(if rstart
(progn
"Display another occurrence when moving the cursor"))
(define-key map [separator-1] '("--"))
(define-key map [kill-this-buffer]
- '("Kill occur buffer" . kill-this-buffer))
+ '(menu-item "Kill occur buffer" kill-this-buffer
+ :help "Kill the current *Occur* buffer"))
(define-key map [quit-window]
- '("Quit occur window" . quit-window))
+ '(menu-item "Quit occur window" quit-window
+ :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame"))
(define-key map [revert-buffer]
- '("Revert occur buffer" . revert-buffer))
+ '(menu-item "Revert occur buffer" revert-buffer
+ :help "Replace the text in the *Occur* buffer with the results of rerunning occur"))
(define-key map [clone-buffer]
- '("Clone occur buffer" . clone-buffer))
+ '(menu-item "Clone occur buffer" clone-buffer
+ :help "Create and return a twin copy of the current *Occur* buffer"))
(define-key map [occur-rename-buffer]
- '("Rename occur buffer" . occur-rename-buffer))
+ '(menu-item "Rename occur buffer" occur-rename-buffer
+ :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*."))
(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))
+ '(menu-item "Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window
+ :help "Go to the occurrence the current line describes, in another window"))
(define-key map [occur-mode-goto-occurrence]
- '("Go To Occurrence" . occur-mode-goto-occurrence))
+ '(menu-item "Go To Occurrence" occur-mode-goto-occurrence
+ :help "Go to the occurrence the current line describes"))
(define-key map [occur-mode-display-occurrence]
- '("Display Occurrence" . occur-mode-display-occurrence))
+ '(menu-item "Display Occurrence" occur-mode-display-occurrence
+ :help "Display in another window the occurrence the current line describes"))
(define-key map [occur-next]
- '("Move to next match" . occur-next))
+ '(menu-item "Move to next match" occur-next
+ :help "Move to the Nth (default 1) next match in an Occur mode buffer"))
(define-key map [occur-prev]
- '("Move to previous match" . occur-prev))
+ '(menu-item "Move to previous match" occur-prev
+ :help "Move to the Nth (default 1) previous match in an Occur mode buffer"))
map)
"Keymap for `occur-mode'.")
:type 'hook
:group 'matching)
+(defcustom occur-mode-find-occurrence-hook nil
+ "Hook run by Occur after locating an occurrence.
+This will be called with the cursor position at the occurrence. An application
+for this is to reveal context in an outline-mode when the occurrence is hidden."
+ :type 'hook
+ :group 'matching)
+
(put 'occur-mode 'mode-class 'special)
(defun occur-mode ()
"Major mode for output from \\[occur].
same-window-buffer-names
same-window-regexps)
(pop-to-buffer (marker-buffer pos))
- (goto-char pos)))
+ (goto-char pos)
+ (run-hooks 'occur-mode-find-occurrence-hook)))
(defun occur-mode-goto-occurrence-other-window ()
"Go to the occurrence the current line describes, in another window."
(interactive)
(let ((pos (occur-mode-find-occurrence)))
(switch-to-buffer-other-window (marker-buffer pos))
- (goto-char pos)))
+ (goto-char pos)
+ (run-hooks 'occur-mode-find-occurrence-hook)))
(defun occur-mode-display-occurrence ()
"Display in another window the occurrence the current line describes."
;; This is the way to set point in the proper window.
(save-selected-window
(select-window window)
- (goto-char pos))))
+ (goto-char pos)
+ (run-hooks 'occur-mode-find-occurrence-hook))))
(defun occur-find-match (n search message)
(if (not n) (setq n 1))
(nreverse result))))
(defun occur-read-primary-args ()
- (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)))))
+ (list (read-regexp "List lines matching regexp"
+ (car regexp-history))
+ (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*.
(buffer-list))))))
(defun occur-1 (regexp nlines bufs &optional buf-name)
+ (unless (and regexp (not (equal regexp "")))
+ (error "Occur doesn't work with the empty regexp"))
(unless buf-name
(setq buf-name "*Occur*"))
(let (occur-buf
(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.
`exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
`automatic', `backup', `exit-prefix', and `help'.")
+(defvar multi-query-replace-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map query-replace-map)
+ (define-key map "Y" 'automatic-all)
+ (define-key map "N" 'exit-current)
+ map)
+ "Keymap that defines additional bindings for multi-buffer replacements.
+It extends its parent map `query-replace-map' with new bindings to
+operate on a set of buffers/files. The difference with its parent map
+is the additional answers `automatic-all' to replace all remaining
+matches in all remaining buffers with no more questions, and
+`exit-current' to skip remaining matches in the current buffer
+and to continue with the next buffer in the sequence.")
+
(defun replace-match-string-symbols (n)
"Process a list (and any sub-lists), expanding certain symbols.
Symbol Expands To
(replace-match newtext fixedcase literal)
noedit)
+(defvar replace-search-function 'search-forward
+ "Function to use when searching for strings to replace.
+It is used by `query-replace' and `replace-string', and is called
+with three arguments, as if it were `search-forward'.")
+
+(defvar replace-re-search-function 're-search-forward
+ "Function to use when searching for regexps to replace.
+It is used by `query-replace-regexp', `replace-regexp',
+`query-replace-regexp-eval', and `map-query-replace-regexp'.
+It is called with three arguments, as if it were
+`re-search-forward'.")
+
(defun perform-replace (from-string replacements
query-flag regexp-flag delimited-flag
&optional repeat-count map start end)
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-function
+ (if regexp-flag
+ replace-re-search-function
+ replace-search-function))
(search-string from-string)
(real-match-data nil) ; The match data for the current match.
(next-replacement nil)
(stack nil)
(replace-count 0)
(nonempty-match nil)
+ (multi-buffer nil)
;; If non-nil, it is marker saying where in the buffer to stop.
(limit nil)
(goto-char (min start end))
(deactivate-mark))
+ ;; If last typed key in previous call of multi-buffer perform-replace
+ ;; was `automatic-all', don't ask more questions in next files
+ (when (eq (lookup-key map (vector last-input-char)) 'automatic-all)
+ (setq query-flag nil multi-buffer t))
+
;; REPLACEMENTS is either a string, a list of strings, or a cons cell
;; containing a function and its first argument. The function is
;; called to generate each replacement like this:
((eq def 'exit)
(setq keep-going nil)
(setq done t))
+ ((eq def 'exit-current)
+ (setq multi-buffer t keep-going nil done t))
((eq def 'backup)
(if stack
(let ((elt (pop stack)))
real-match-data (replace-match-data
t real-match-data)
replaced t)))
- ((eq def 'automatic)
+ ((or (eq def 'automatic) (eq def 'automatic-all))
(or replaced
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal
noedit real-match-data)
replace-count (1+ replace-count)))
- (setq done t query-flag nil replaced t))
+ (setq done t query-flag nil replaced t)
+ (if (eq def 'automatic-all) (setq multi-buffer t)))
((eq def 'skip)
(setq done t))
((eq def 'recenter)
(message "Replaced %d occurrence%s"
replace-count
(if (= replace-count 1) "" "s")))
- (and keep-going stack)))
+ (or (and keep-going stack) multi-buffer)))
(defvar replace-overlay nil)
HCoop / bpt / emacs.git / blobdiff