;;; 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 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]
+ '(menu-item "Kill occur buffer" kill-this-buffer
+ :help "Kill the current *Occur* buffer"))
+ (define-key map [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]
+ '(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]
+ '(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]
+ '(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]
+ '(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]
+ '(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]
+ '(menu-item "Display Occurrence" occur-mode-display-occurrence
+ :help "Display in another window the occurrence the current line describes"))
+ (define-key map [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]
+ '(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 ()
- (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 "")
+ (let* ((default (car regexp-history))
+ (defaults
+ (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))))
+ (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 "List lines matching regexp (default %s): "
+ (query-replace-descr default))
+ "List lines matching regexp: ")
+ nil nil nil 'regexp-history defaults)))
+ (list (if (equal input "")
default
- input))
- (when current-prefix-arg
- (prefix-numeric-value current-prefix-arg))))
+ (prog1 input
+ (add-to-history 'regexp-history 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))))
(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
(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)))))
(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.
(and query-flag minibuffer-auto-raise
(raise-frame (window-frame (minibuffer-window))))
(let* ((case-fold-search
- (and case-fold-search
- (isearch-no-upper-case-p from-string regexp-flag)))
+ (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))
(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.
HCoop / bpt / emacs.git / blobdiff