;;; replace.el --- replace commands for Emacs
-;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001, 2002,
-;; 2003, 2004, 2005 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001,
+;; 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,
;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
(defvar query-replace-history nil)
+(defvar query-replace-defaults nil
+ "Default values of FROM-STRING and TO-STRING for `query-replace'.
+This is a cons cell (FROM-STRING . TO-STRING), or nil if there is
+no default value.")
+
(defvar query-replace-interactive nil
"Non-nil means `query-replace' uses the last search string.
That becomes the \"string to replace\".")
: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-descr (string)
(mapconcat 'isearch-text-char-description string ""))
-(defun query-replace-read-from (string regexp-flag)
+(defun query-replace-read-from (prompt regexp-flag)
"Query and return the `from' argument of a query-replace operation.
The return value can also be a pair (FROM . TO) indicating that the user
wants to replace FROM with TO."
(if query-replace-interactive
(car (if regexp-flag regexp-search-ring search-ring))
- (let* ((lastfrom (car (symbol-value query-replace-from-history-variable)))
- (lastto (car (symbol-value query-replace-to-history-variable)))
+ (let* ((history-add-new-input nil)
(from
;; The save-excursion here is in case the user marks and copies
;; a region in order to specify the minibuffer input.
;; That should not clobber the region for the query-replace itself.
(save-excursion
- (when (equal lastfrom lastto)
- ;; Typically, this is because the two histlists are shared.
- (setq lastfrom (cadr (symbol-value
- query-replace-from-history-variable))))
(read-from-minibuffer
- (if (and lastto lastfrom)
- (format "%s (default %s -> %s): " string
- (query-replace-descr lastfrom)
- (query-replace-descr lastto))
- (format "%s: " string))
+ (if query-replace-defaults
+ (format "%s (default %s -> %s): " prompt
+ (query-replace-descr (car query-replace-defaults))
+ (query-replace-descr (cdr query-replace-defaults)))
+ (format "%s: " prompt))
nil nil nil
query-replace-from-history-variable
- nil t t))))
- (if (and (zerop (length from)) lastto lastfrom)
- (progn
- (set query-replace-from-history-variable
- (cdr (symbol-value query-replace-from-history-variable)))
- (cons lastfrom
- (query-replace-compile-replacement lastto regexp-flag)))
+ nil t))))
+ (if (and (zerop (length from)) query-replace-defaults)
+ (cons (car query-replace-defaults)
+ (query-replace-compile-replacement
+ (cdr query-replace-defaults) regexp-flag))
+ (add-to-history query-replace-from-history-variable from nil t)
;; Warn if user types \n or \t, but don't reject the input.
(and regexp-flag
(string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
to))
-(defun query-replace-read-to (from string regexp-flag)
+(defun query-replace-read-to (from prompt regexp-flag)
"Query and return the `to' argument of a query-replace operation."
(query-replace-compile-replacement
(save-excursion
- (read-from-minibuffer
- (format "%s %s with: " string (query-replace-descr from))
- nil nil nil
- query-replace-to-history-variable from t t))
+ (let* ((history-add-new-input nil)
+ (to (read-from-minibuffer
+ (format "%s %s with: " prompt (query-replace-descr from))
+ nil nil nil
+ query-replace-to-history-variable from t)))
+ (add-to-history query-replace-to-history-variable to nil t)
+ (setq query-replace-defaults (cons from to))
+ to))
regexp-flag))
-(defun query-replace-read-args (string regexp-flag &optional noerror)
+(defun query-replace-read-args (prompt regexp-flag &optional noerror)
(unless noerror
(barf-if-buffer-read-only))
- (let* ((from (query-replace-read-from string regexp-flag))
+ (let* ((from (query-replace-read-from prompt regexp-flag))
(to (if (consp from) (prog1 (cdr from) (setq from (car from)))
- (query-replace-read-to from string regexp-flag))))
+ (query-replace-read-to from prompt regexp-flag))))
(list from to current-prefix-arg)))
(defun query-replace (from-string to-string &optional delimited start end)
(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
In interactive calls, the replacement text may contain `\\,'
followed by a Lisp expression used as part of the replacement
text. Inside of that expression, `\\&' is a string denoting the
-whole match, `\\N' a partial matches, `\\#&' and `\\#N' the
-respective numeric values from `string-to-number', and `\\#'
-itself for `replace-count', the number of replacements occured so
-far.
+whole match, `\\N' a partial match, `\\#&' and `\\#N' the respective
+numeric values from `string-to-number', and `\\#' itself for
+`replace-count', the number of replacements occurred so far.
If your Lisp expression is an identifier and the next letter in
the replacement string would be interpreted as part of it, you
\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)))
\f
(defvar occur-mode-map
(let ((map (make-sparse-keymap)))
+ ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto].
(define-key map [mouse-2] 'occur-mode-mouse-goto)
(define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
(define-key map "\C-m" 'occur-mode-goto-occurrence)
(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'.")
:group 'matching)
(defcustom occur-hook nil
- "Hook run when `occur' is called."
+ "Hook run by Occur when there are any matches."
+ :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)
"Handle `revert-buffer' for Occur mode buffers."
(apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))
-(defun occur-mode-mouse-goto (event)
- "In Occur mode, go to the occurrence whose line you click on."
- (interactive "e")
- (let (pos)
- (save-excursion
- (set-buffer (window-buffer (posn-window (event-end event))))
- (save-excursion
- (goto-char (posn-point (event-end event)))
- (setq pos (occur-mode-find-occurrence))))
- (pop-to-buffer (marker-buffer pos))
- (goto-char pos)))
-
(defun occur-mode-find-occurrence ()
(let ((pos (get-text-property (point) 'occur-target)))
(unless pos
(error "Buffer for this occurrence was killed"))
pos))
-(defun occur-mode-goto-occurrence ()
+(defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence)
+(defun occur-mode-goto-occurrence (&optional event)
"Go to the occurrence the current line describes."
- (interactive)
- (let ((pos (occur-mode-find-occurrence)))
+ (interactive (list last-nonmenu-event))
+ (let ((pos
+ (if (null event)
+ ;; Actually `event-end' works correctly with a nil argument as
+ ;; well, so we could dispense with this test, but let's not
+ ;; rely on this undocumented behavior.
+ (occur-mode-find-occurrence)
+ (with-current-buffer (window-buffer (posn-window (event-end event)))
+ (save-excursion
+ (goto-char (posn-point (event-end event)))
+ (occur-mode-find-occurrence)))))
+ 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))
(goto-char (cond (reset (point-min))
((< argp 0) (line-beginning-position))
- ((line-end-position))))
+ ((> argp 0) (line-end-position))
+ ((point))))
(occur-find-match
(abs argp)
(if (> 0 argp)
#'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 "RoyalBlue4")
- (((class color) (min-colors 8))
+ :background "RoyalBlue3")
+ (((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)
:type 'face
:group 'matching)
+(defcustom occur-excluded-properties
+ '(read-only invisible intangible field mouse-face help-echo local-map keymap
+ yank-handler follow-link)
+ "*Text properties to discard when copying lines to the *Occur* buffer.
+The value should be a list of text properties to discard or t,
+which means to discard all text properties."
+ :type '(choice (const :tag "All" t) (repeat symbol))
+ :group 'matching
+ :version "22.1")
+
(defun occur-accumulate-lines (count &optional keep-props)
(save-excursion
(let ((forwardp (> count 0))
(if (fboundp 'jit-lock-fontify-now)
(jit-lock-fontify-now beg end)))
(push
- (funcall (if keep-props
- #'buffer-substring
- #'buffer-substring-no-properties)
- beg end)
+ (if (and keep-props (not (eq occur-excluded-properties t)))
+ (let ((str (buffer-substring beg end)))
+ (remove-list-of-text-properties
+ 0 (length str) occur-excluded-properties str)
+ str)
+ (buffer-substring-no-properties beg end))
result)
(forward-line (if forwardp 1 -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 "")
- default
- input))
- (when current-prefix-arg
- (prefix-numeric-value current-prefix-arg))))
-
-(defun occur-rename-buffer (&optional unique-p)
+ (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*.
-Here `original-buffer-name' is the buffer name were occur was originally run.
-When given the prefix argument, the renaming will not clobber the existing
-buffer(s) of that name, but use `generate-new-buffer-name' instead.
-You can add this to `occur-hook' if you always want a separate *Occur*
-buffer for each buffer where you invoke `occur'."
- (interactive "P")
+Here `original-buffer-name' is the buffer name were Occur was originally run.
+When given the prefix argument, or called non-interactively, the renaming
+will not clobber the existing buffer(s) of that name, but use
+`generate-new-buffer-name' instead. You can add this to `occur-hook'
+if you always want a separate *Occur* buffer for each buffer where you
+invoke `occur'."
+ (interactive "P\np")
(with-current-buffer
(if (eq major-mode 'occur-mode) (current-buffer) (get-buffer "*Occur*"))
(rename-buffer (concat "*Occur: "
(mapconcat #'buffer-name
(car (cddr occur-revert-arguments)) "/")
"*")
- unique-p)))
+ (or unique-p (not interactive-p)))))
(defun occur (regexp &optional nlines)
"Show all lines in the current buffer containing a match for REGEXP.
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))))
(defun multi-occur (bufs regexp &optional nlines)
"Show all lines in buffers BUFS containing a match for REGEXP.
This function acts on multiple buffers; otherwise, it is exactly like
-`occur'."
+`occur'. When you invoke this command interactively, you must specify
+the buffer names that you want, one by one."
(interactive
(cons
(let* ((bufs (list (read-buffer "First buffer to search: "
(occur-read-primary-args)))
(occur-1 regexp nlines bufs))
-(defun multi-occur-by-filename-regexp (bufregexp regexp &optional nlines)
- "Show all lines matching REGEXP in buffers named by BUFREGEXP.
+(defun multi-occur-in-matching-buffers (bufregexp regexp &optional allbufs)
+ "Show all lines matching REGEXP in buffers specified by BUFREGEXP.
+Normally BUFREGEXP matches against each buffer's visited file name,
+but if you specify a prefix argument, it matches against the buffer name.
See also `multi-occur'."
(interactive
(cons
(let* ((default (car regexp-history))
(input
(read-from-minibuffer
- "List lines in buffers whose filename matches regexp: "
+ (if current-prefix-arg
+ "List lines in buffers whose names match regexp: "
+ "List lines in buffers whose filenames match regexp: ")
nil
nil
nil
input))
(occur-read-primary-args)))
(when bufregexp
- (occur-1 regexp nlines
+ (occur-1 regexp nil
(delq nil
(mapcar (lambda (buf)
- (when (and (buffer-file-name buf)
- (string-match bufregexp
- (buffer-file-name buf)))
+ (when (if allbufs
+ (string-match bufregexp
+ (buffer-name buf))
+ (and (buffer-file-name buf)
+ (string-match bufregexp
+ (buffer-file-name buf))))
buf))
(buffer-list))))))
(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 t)))
+ nil list-matching-lines-face
+ (not (eq occur-excluded-properties t)))))
(let* ((bufcount (length active-bufs))
(diff (- (length bufs) bufcount)))
(message "Searched %d buffer%s%s; %s match%s for `%s'"
(if (= count 1) "" "es")
regexp))
(setq occur-revert-arguments (list regexp nlines bufs))
- (if (> count 0)
- (progn
- (display-buffer occur-buf)
- (setq next-error-last-buffer occur-buf))
- (kill-buffer occur-buf)))
- (setq buffer-read-only t)
- (set-buffer-modified-p nil)
- (run-hooks 'occur-hook)))))
+ (if (= count 0)
+ (kill-buffer occur-buf)
+ (display-buffer occur-buf)
+ (setq next-error-last-buffer occur-buf)
+ (setq buffer-read-only t)
+ (set-buffer-modified-p nil)
+ (run-hooks 'occur-hook)))))))
(defun occur-engine-add-prefix (lines)
(mapcar
(endpt nil)
(marker nil)
(curstring "")
+ (inhibit-field-text-motion t)
(headerpt (with-current-buffer out-buf (point))))
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(or coding
;; Set CODING only if the current buffer locally
;; binds buffer-file-coding-system.
(text-property-not-all begpt endpt 'fontified t))
(if (fboundp 'jit-lock-fontify-now)
(jit-lock-fontify-now begpt endpt)))
- (setq curstring (buffer-substring begpt endpt))
- ;; Depropertize the string, and maybe
- ;; highlight the matches
+ (if (and keep-props (not (eq occur-excluded-properties t)))
+ (progn
+ (setq curstring (buffer-substring begpt endpt))
+ (remove-list-of-text-properties
+ 0 (length curstring) occur-excluded-properties curstring))
+ (setq curstring (buffer-substring-no-properties begpt endpt)))
+ ;; Highlight the matches
(let ((len (length curstring))
(start 0))
- (unless keep-props
- (set-text-properties 0 len nil curstring))
(while (and (< start len)
(string-match regexp curstring start))
(add-text-properties
(append
(when prefix-face
`(font-lock-face prefix-face))
- '(occur-prefix t)))
+ `(occur-prefix t mouse-face (highlight)
+ occur-target ,marker follow-link t
+ help-echo "mouse-2: go to this occurrence")))
;; We don't put `mouse-face' on the newline,
;; because that loses. And don't put it
;; on context lines to reduce flicker.
- (propertize curstring 'mouse-face 'highlight)
- "\n"))
+ (propertize curstring 'mouse-face (list 'highlight)
+ 'occur-target marker
+ 'follow-link t
+ 'help-echo
+ "mouse-2: go to this occurrence")
+ ;; Add marker at eol, but no mouse props.
+ (propertize "\n" 'occur-target marker)))
(data
(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))
(end (progn (insert data) (point))))
(unless (= nlines 0)
- (insert "-------\n"))
- (add-text-properties
- beg end
- `(occur-target ,marker help-echo "mouse-2: go to this occurrence")))))
+ (insert "-------\n")))))
(goto-char endpt))
(if endpt
(progn
;; 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.
E to edit the replacement string"
"Help message while in `query-replace'.")
-(defvar query-replace-map (make-sparse-keymap)
+(defvar query-replace-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map " " 'act)
+ (define-key map "\d" 'skip)
+ (define-key map [delete] 'skip)
+ (define-key map [backspace] 'skip)
+ (define-key map "y" 'act)
+ (define-key map "n" 'skip)
+ (define-key map "Y" 'act)
+ (define-key map "N" 'skip)
+ (define-key map "e" 'edit-replacement)
+ (define-key map "E" 'edit-replacement)
+ (define-key map "," 'act-and-show)
+ (define-key map "q" 'exit)
+ (define-key map "\r" 'exit)
+ (define-key map [return] 'exit)
+ (define-key map "." 'act-and-exit)
+ (define-key map "\C-r" 'edit)
+ (define-key map "\C-w" 'delete-and-edit)
+ (define-key map "\C-l" 'recenter)
+ (define-key map "!" 'automatic)
+ (define-key map "^" 'backup)
+ (define-key map "\C-h" 'help)
+ (define-key map [f1] 'help)
+ (define-key map [help] 'help)
+ (define-key map "?" 'help)
+ (define-key map "\C-g" 'quit)
+ (define-key map "\C-]" 'quit)
+ (define-key map "\e" 'exit-prefix)
+ (define-key map [escape] 'exit-prefix)
+ map)
"Keymap that defines the responses to questions in `query-replace'.
The \"bindings\" in this map are not commands; they are answers.
The valid answers include `act', `skip', `act-and-show',
`exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
`automatic', `backup', `exit-prefix', and `help'.")
-(define-key query-replace-map " " 'act)
-(define-key query-replace-map "\d" 'skip)
-(define-key query-replace-map [delete] 'skip)
-(define-key query-replace-map [backspace] 'skip)
-(define-key query-replace-map "y" 'act)
-(define-key query-replace-map "n" 'skip)
-(define-key query-replace-map "Y" 'act)
-(define-key query-replace-map "N" 'skip)
-(define-key query-replace-map "e" 'edit-replacement)
-(define-key query-replace-map "E" 'edit-replacement)
-(define-key query-replace-map "," 'act-and-show)
-(define-key query-replace-map "q" 'exit)
-(define-key query-replace-map "\r" 'exit)
-(define-key query-replace-map [return] 'exit)
-(define-key query-replace-map "." 'act-and-exit)
-(define-key query-replace-map "\C-r" 'edit)
-(define-key query-replace-map "\C-w" 'delete-and-edit)
-(define-key query-replace-map "\C-l" 'recenter)
-(define-key query-replace-map "!" 'automatic)
-(define-key query-replace-map "^" 'backup)
-(define-key query-replace-map "\C-h" 'help)
-(define-key query-replace-map [f1] 'help)
-(define-key query-replace-map [help] 'help)
-(define-key query-replace-map "?" 'help)
-(define-key query-replace-map "\C-g" 'quit)
-(define-key query-replace-map "\C-]" 'quit)
-(define-key query-replace-map "\e" 'exit-prefix)
-(define-key query-replace-map [escape] 'exit-prefix)
-
(defun replace-match-string-symbols (n)
"Process a list (and any sub-lists), expanding certain symbols.
Symbol Expands To
# replace-count
Note that these symbols must be preceeded by a backslash in order to
-type them."
- (while n
+type them using Lisp syntax."
+ (while (consp n)
(cond
((consp (car n))
(replace-match-string-symbols (car n))) ;Process sub-list
(defun replace-match-data (integers reuse &optional new)
"Like `match-data', but markers in REUSE get invalidated.
-If NEW is non-NIL, it is set and returned instead of fresh data,
+If NEW is non-nil, it is set and returned instead of fresh data,
but coerced to the correct value of INTEGERS."
(or (and new
(progn
check for `\\?' is made to save time. MATCH-DATA is used for the
replacement. In case editing is done, it is changed to use markers.
-The return value is non-NIL if there has been no `\\?' or NOEDIT was
+The return value is non-nil if there has been no `\\?' or NOEDIT was
passed in. If LITERAL is set, no checking is done, anyway."
(unless (or literal noedit)
(setq noedit t)
(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)
- (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.
+ (setq nonempty-match
+ (/= (nth 0 real-match-data) (nth 1 real-match-data)))
+
+ ;; If the match is empty, record that the next one can't be
+ ;; adjacent.
+
+ ;; Otherwise, if matching a regular expression, do the next
+ ;; match now, since the replacement for this match may
+ ;; affect whether the next match is adjacent to this one.
+ ;; If that match is empty, don't use it.
+ (setq match-again
+ (and nonempty-match
+ (or (not regexp-flag)
+ (and (looking-at search-string)
+ (let ((match (match-data)))
+ (and (/= (nth 0 match) (nth 1 match))
+ match))))))
+
;; Optionally ignore matches that have a read-only property.
(unless (and query-replace-skip-read-only
(text-property-not-all
- (match-beginning 0) (match-end 0)
+ (nth 0 real-match-data) (nth 1 real-match-data)
'read-only nil))
- ;; Record whether the match is nonempty, to avoid an infinite loop
- ;; repeatedly matching the same empty string.
- (setq nonempty-match
- (/= (nth 0 real-match-data) (nth 1 real-match-data)))
-
- ;; If the match is empty, record that the next one can't be
- ;; adjacent.
-
- ;; Otherwise, if matching a regular expression, do the next
- ;; match now, since the replacement for this match may
- ;; affect whether the next match is adjacent to this one.
- ;; If that match is empty, don't use it.
- (setq match-again
- (and nonempty-match
- (or (not regexp-flag)
- (and (looking-at search-string)
- (let ((match (match-data)))
- (and (/= (nth 0 match) (nth 1 match))
- match))))))
-
;; Calculate the replacement string, if necessary.
(when replacements
(set-match-data real-match-data)
(setq next-replacement
(funcall (car replacements) (cdr replacements)
- replace-count)
- noedit nil))
+ replace-count)))
(if (not query-flag)
(let ((inhibit-read-only
query-replace-skip-read-only))
(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"
(if replace-overlay
(move-overlay replace-overlay match-beg match-end (current-buffer))
(setq replace-overlay (make-overlay match-beg match-end))
- (overlay-put replace-overlay 'priority 1) ;higher than lazy overlays
+ (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
(overlay-put replace-overlay 'face 'query-replace)))
(if query-replace-lazy-highlight
(let ((isearch-string string)
(isearch-regexp regexp)
+ (search-whitespace-regexp nil)
(isearch-case-fold-search case-fold))
(isearch-lazy-highlight-new-loop range-beg range-end))))