1;;; replace+.el --- Extensions to `replace.el'.
3;; Filename: replace+.el
4;; Description: Extensions to `replace.el'.
6;; Maintainer: Drew Adams
7;; Copyright (C) 1996-2007, Drew Adams, all rights reserved.
8;; Created: Tue Jan 30 15:01:06 1996
10;; Last-Updated: Sat Jun 02 16:02:11 2007 (-25200 Pacific Daylight Time)
13;; URL: http://www.emacswiki.org/cgi-bin/wiki/replace+.el
14;; Keywords: matching, help, internal, tools, local
15;; Compatibility: GNU Emacs 20.x, GNU Emacs 21.x, GNU Emacs 22.x
17;; Features that might be required by this library:
19;; `avoid', `faces', `faces+', `fit-frame', `frame-cmds',
20;; `frame-fns', `highlight', `isearch+', `misc-cmds', `misc-fns',
21;; `strings', `thingatpt', `thingatpt+'.
23;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27;; Extensions to `replace.el'.
29;; Functions defined here:
31;; `query-replace-w-options', `toggle-replace-w-completion'.
35;; `occur-highlight-linenum'.
37;; User options defined here:
39;; `replace-w-completion-flag', `search/replace-default-fn'.
41;; Internal variable defined here: `occur-regexp'.
45;; ***** NOTE: The following user option defined in `replace.el' has
46;; been REDEFINED HERE:
48;; `list-matching-lines-face'.
51;; ***** NOTE: The following functions defined in `replace.el' have
52;; been REDEFINED HERE:
54;; `flush-lines' - (Not needed for Emacs 21)
55;; 1. The prompt has been changed, to mention that
56;; only lines after point are affected.
57;; 2. The default regexp is provided by
58;; `search/replace-default-fn'.
59;; 3. An in-progress message has been added.
60;; `how-many' - (Not needed for Emacs 21)
61;; 1. Prompt changed: lines after point are affected.
62;; 2. Default regexp: `search/replace-default-fn'.
63;; 3. An in-progress message has been added.
64;; `keep-lines' - Same as `flush-lines'. (Not needed for Emacs 21)
65;; `occur' - 1. Default regexp is from `search/replace-default-fn'.
66;; 2. Regexp is saved as `occur-regexp' for use by
67;; `occur-mode-mouse-goto'
68;; `occur-mode-goto-occurrence', `occur-mode-display-occurrence',
69;; `occur-mode-goto-occurrence-other-window',
70;; `occur-mode-mouse-goto' - Highlights regexp in source buffer
71;; and visited linenum in occur buffer.
72;; `occur-read-primary-args' - (Emacs 21 only) Default regexps via
73;; `search/replace-default-fn'.
74;; `query-replace-read-args', - (Not needed for Emacs 21)
75;; 1. Uses `completing-read' if
76;; `replace-w-completion-flag' is
78;; 2. Default regexps are obtained via
79;; `search/replace-default-fn'.
80;; `query-replace-read-(from|to)' - Same as `query-replace-read-args',
84;; This file should be loaded after loading the standard GNU file
85;; `replace.el'. So, in your `~/.emacs' file, do this:
86;; (eval-after-load "replace" '(progn (require 'replace+)))
88;; Because standard variables such as `list-matching-lines-face' are
89;; predefined, this file overrides the standard definition. If you
90;; want a different value, you must set it after loading this file.
92;; For Emacs releases prior to Emacs 22, these Emacs 22 key bindings
95;; (define-key occur-mode-map "o" 'occur-mode-goto-occurrence-other-window)
96;; (define-key occur-mode-map "\C-o" 'occur-mode-display-occurrence))
98;; Suggested additional key binding:
100;; (substitute-key-definition 'query-replace 'query-replace-w-options
103;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
108;; Renamed highlight-regexp-region to hlt-highlight-regexp-region.
110;; Added: occur-mode-goto-occurrence-other-window, occur-mode-display-occurrence.
112;; query-replace-w-options: Select last occurrence, if isearchp-set-region-flag is non-nil.
113;; Added soft require of isearch+.el.
115;; No longer use display-in-minibuffer.
116;; query-replace-w-options: Simplified code.
118;; All calls to read-from-minibuffer: Use default arg, not initial-value arg.
120;; replace-w-completion-flag: Use defcustom.
121;; Use defface instead of define-face-const. Renamed face without "-face".
122;; Removed redefinition of list-matching-lines-face - do that in start-opt.el now.
123;; Removed require of def-face-const.
125;; Use nil as init-value arg in calls to completing-read, everywhere.
127;; Updated to work with Emacs 22.x.
129;; Renamed: replace-w-completion -> replace-w-completion-flag.
131;; Added occur-highlight-linenum-face.
133;; Refined to deal with Emacs 21 < 21.3.50 (soon to be 22.x)
135;; Updated for Emacs 21 also:
136;; query-replace-w-options:
137;; Added args start & end.
138;; Removed arg display-msgs, so can no longer simulate interactive-p.
139;; Uses query-replace-read-args.
140;; Added query-replace-read-(from|to) and occur-read-primary-args.
141;; Made some fns Emacs-20 only.
142;; Removed defaliases for keep-lines, flush-lines, and how-many.
143;; occur: New version for Emacs 21 via defadvice.
144;; Only require cl.el for compiling.
145;; occur-mode-mouse-goto, occur-mode-goto-occurrence:
146;; Redefined, using defadvice.
148;; Renamed resize-frame to fit-frame.
150;; Renamed shrink-frame-to-fit to resize-frame.
152;; flush-lines, keep-lines: Default regexp from search/replace-default-fn.
154;; 1. Added: replace-w-completion, toggle-replace-w-completion.
155;; 2. query-replace-read-args, query-replace-w-options: Now sensitive to
156;; replace-w-completion.
158;; Put escaped newlines on long-line strings.
160;; Added: flush-lines, keep-lines.
162;; occur: Explicitly call shrink-frame-to-fit each time, after displaying.
164;; 1. Added redefinition of query-replace-read-args.
165;; 2. perform-replace: cond -> case.
166;; 3. query-replace-w-options: message -> display-in-minibuffer (STRING).
168;; query-replace-w-options: Defaults for new and old are the same.
170;; 1. Added search/replace-default-fn.
171;; 2. query-replace-w-options, occur:
172;; symbol-name-nearest-point -> search/replace-default-fn.
174;; occur: Don't raise Occur frame if no occurrences.
176;; occur-mode-goto-occurrence, occur-mode-mouse-goto: Highlight last goto lineno.
178;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
180;; This program is free software; you can redistribute it and/or modify
181;; it under the terms of the GNU General Public License as published by
182;; the Free Software Foundation; either version 2, or (at your option)
185;; This program is distributed in the hope that it will be useful,
186;; but WITHOUT ANY WARRANTY; without even the implied warranty of
187;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
188;; GNU General Public License for more details.
190;; You should have received a copy of the GNU General Public License
191;; along with this program; see the file COPYING. If not, write to
192;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
193;; Floor, Boston, MA 02110-1301, USA.
195;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
199;; Cannot do (require 'replace), because `replace.el' does no `provide'.
200;; Don't want to do a (load-library "replace") either, because it wouldn't
201;; allow doing (eval-after-load "replace" '(progn (require 'replace+)))
203(eval-when-compile (require 'cl)) ;; incf (plus, for Emacs 20: push, pop,
204 ;; and, for Emacs <20: cadr, when, unless)
206(require 'thingatpt nil t) ;; (no error if not found): word-at-point
207(require 'thingatpt+ nil t) ;; (no error if not found): symbol-name-nearest-point
208(require 'frame-cmds nil t) ;; (no error if not found): show-a-frame-on
209(require 'frame-fns nil t) ;; (no error if not found): get-a-frame
210(require 'fit-frame nil t) ;; (no error if not found): fit-frame
211(require 'highlight nil t) ;; (no error if not found): hlt-highlight-regexp-region
212(require 'isearch+ nil t) ;; (no error if not found):
213 ;; isearchp-set-region-flag, set-region-around-search-target
217(defface occur-highlight-linenum '((t (:foreground "Red")))
218 "*Face to use to highlight line number of visited hit lines."
219 :group 'matching :group 'faces)
221;; This is defined in `faces.el', Emacs 22. This definition is adapted to Emacs 20.
222(unless (facep 'minibuffer-prompt)
223 (defface minibuffer-prompt '((((background dark)) (:foreground "cyan"))
224 (t (:foreground "dark blue")))
225 "Face for minibuffer prompts."
226 :group 'basic-faces))
229(defvar occur-regexp nil "Search pattern used by `occur' command.") ; Internal variable.
232(defcustom replace-w-completion-flag nil
233 "*Non-nil means use minibuffer completion for replacement commands
234such as `query-replace'. With completion, to insert a SPC or TAB
235char, you will need to preceed it by `\\[quoted-insert]'. If this is
236inconvenient, set this variable to nil."
237 :type 'boolean :group 'matching)
240(defun toggle-replace-w-completion (force-p)
241 "Toggle whether to use minibuffer completion for replacement commands
242such as `query-replace'.
243Non-nil prefix arg FORCE-P => Use completion iff FORCE-P >= 0.
245Note that with completion, to insert a SPC or TAB character you will
246need to preceed it by `\\[quoted-insert]'.
248This toggles the value of option `replace-w-completion-flag'."
251 (if (natnump (prefix-numeric-value force-p))
252 (setq replace-w-completion-flag t)
253 (setq replace-w-completion-flag nil))
254 (setq replace-w-completion-flag (not replace-w-completion-flag)))) ; Toggle.
256(defvar search/replace-default-fn
257 (if (fboundp 'symbol-name-nearest-point)
258 'symbol-name-nearest-point
260 "*Fn of 0 args called to provide default input for search/replacement
261functions such as \\[query-replace-w-options] and \\[occur].
263Some reasonable choices are defined in `thingatpt+.el':
264`word-nearest-point', `symbol-name-nearest-point', `sexp-nearest-point'")
268;; REPLACES ORIGINAL in `replace.el'.
269;; 1. Uses `completing-read' if `replace-w-completion-flag' is non-nil.
270;; 2. Default values are provided by `search/replace-default-fn'.
272;; You can still use the history lists, and you can still enter
273;; nothing to repeat the previous query replacement operation.
275;; However, in addition, this provides an initial value by
276;; `search/replace-default-fn'.
278;; TEST IS TEMPORARY - will be changed to (string-match "22.x" emacs-version) after 22.x release
280(when (or (string-match "22." emacs-version) (string-match "21.3.50" emacs-version))
281 (defun query-replace-read-from (string regexp-flag)
282 "Query and return the `from' argument of a query-replace operation.
283The return value can also be a pair (FROM . TO) indicating that the user
284wants to replace FROM with TO.
285Non-nil `replace-w-completion-flag' means you can use completion."
286 (if query-replace-interactive
287 (car (if regexp-flag regexp-search-ring search-ring))
288 (let* ((default (if (fboundp search/replace-default-fn)
289 (funcall search/replace-default-fn)
290 (car (symbol-value query-replace-from-history-variable))))
291 (lastto (car (symbol-value query-replace-to-history-variable)))
292 (lastfrom (car (symbol-value query-replace-from-history-variable)))
295 ;; Use second, not first, if the two history items are the same (e.g. shared lists).
296 (when (equal lastfrom lastto)
297 (setq lastfrom (cadr (symbol-value query-replace-from-history-variable))))
298 (if (and lastto lastfrom)
299 (format "%s. OLD (empty means %s -> %s): " string (query-replace-descr lastfrom)
300 (query-replace-descr lastto))
301 (concat string ". OLD: "))))
302 ;; The save-excursion here is in case the user marks and copies
303 ;; a region in order to specify the minibuffer input.
304 ;; That should not clobber the region for the query-replace itself.
305 (from (save-excursion
306 (if replace-w-completion-flag
307 (completing-read from-prompt obarray nil nil nil
308 query-replace-from-history-variable default t)
309 (if query-replace-interactive
310 (car (if regexp-flag regexp-search-ring search-ring))
311 (read-from-minibuffer from-prompt nil nil nil
312 query-replace-from-history-variable default t))))))
313 (if (and (zerop (length from)) lastto lastfrom)
314 (cons lastfrom lastto)
315 ;; Warn if user types \n or \t, but don't reject the input.
317 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
318 (let ((match (match-string 3 from)))
320 ((string= match "\\n")
321 (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
322 ((string= match "\\t")
323 (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
329;; REPLACES ORIGINAL in `replace.el'.
330;; 1. Uses `completing-read' if `replace-w-completion-flag' is non-nil.
331;; 2. Default values are provided by `search/replace-default-fn'.
333;; You can still use the history lists, and you can still enter
334;; nothing to repeat the previous query replacement operation.
336;; However, in addition, this provides an initial value by
337;; `search/replace-default-fn'.
339;; TEST IS TEMPORARY - will be changed to (string-match "22.x" emacs-version) after 22.x release
341(when (or (string-match "22." emacs-version) (string-match "21.3.50" emacs-version))
342 (defun query-replace-read-to (from string regexp-flag)
343 "Query and return the `to' argument of a query-replace operation."
344 (let* ((default (if (fboundp search/replace-default-fn)
345 (funcall search/replace-default-fn)
346 (car (symbol-value query-replace-to-history-variable))))
347 (to-prompt (format "%s. NEW (replacing %s): " string (query-replace-descr from)))
348 ;; The save-excursion here is in case the user marks and copies
349 ;; a region in order to specify the minibuffer input.
350 ;; That should not clobber the region for the query-replace itself.
352 (if replace-w-completion-flag
353 (completing-read to-prompt obarray nil nil nil
354 query-replace-to-history-variable default t)
355 (read-from-minibuffer to-prompt nil nil nil
356 query-replace-to-history-variable default t)))))
357 (when (and regexp-flag (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))
359 (while (progn (setq pos (match-end 0))
360 (push (substring to 0 (- pos 2)) list)
361 (setq char (aref to (1- pos))
362 to (substring to pos))
363 (cond ((eq char ?\#) (push '(number-to-string replace-count) list))
365 (setq pos (read-from-string to))
366 (push `(replace-quote ,(car pos)) list)
367 ;; Swallow a space after a symbol if there is a space.
368 (let ((end (if (and (or (symbolp (car pos))
369 ;; Swallow a space after 'foo
370 ;; but not after (quote foo).
371 (and (eq (car-safe (car pos)) 'quote)
372 (not (= ?\( (aref to 0)))))
373 (eq (string-match " " to (cdr pos))
377 (setq to (substring to end)))))
378 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)))
379 (setq to (nreverse (delete "" (cons to list)))))
380 (replace-match-string-symbols to)
381 (setq to (cons 'replace-eval-replacement
382 (if (> (length to) 1)
389;; The main difference between this and `query-replace' is in the treatment of the PREFIX
390;; arg. Only a positive (or nil) PREFIX value gives the same behavior. A negative PREFIX
391;; value does a regexp query replace. Another difference is that non-nil
392;; `isearchp-set-region-flag' means set the region around the last target occurrence.
394;; In Emacs 21, this has the same behavior as the versions of `query-replace-read-to' and
395;; `query-replace-read-from' defined here:
397;; 1. Uses `completing-read' if `replace-w-completion-flag' is non-nil.
398;; 2. Default values are provided by `search/replace-default-fn'.
400;; You can still use the history lists, and you can still enter
401;; nothing to repeat the previous query replacement operation.
402;; However, in addition, this provides an initial value by
403;; `search/replace-default-fn'.
405;; In Emacs 20, this has the same behavior as the version of `query-replace-read-args'
408;; 1. It uses `completing-read' if `replace-w-completion-flag' is non-nil.
409;; 2. The default regexps are provided by `search/replace-default-fn'.
412(defun query-replace-w-options (old new &optional prefix start end)
413 "Replace some occurrences of OLD text with NEW one.
414Fourth and fifth arg START and END specify the region to operate on.
416This is the same as commmand `query-replace', except for the treatment
419No PREFIX argument (nil) means replace literal string matches.
420Non-negative PREFIX argument means replace word matches.
421Negative PREFIX argument means replace regexp matches.
423Option `replace-w-completion-flag', if non-nil, provides for
424minibuffer completion while you type OLD and NEW. In that case, to
425insert a SPC or TAB character, you will need to preceed it by \
428If option `isearchp-set-region-flag' is non-nil, then select the last
431 (let* ((kind (cond ((and current-prefix-arg (natnump (prefix-numeric-value current-prefix-arg)))
433 (current-prefix-arg " REGEXP")
435 (common (query-replace-read-args (concat "Query replace" kind) (string= " REGEXP " kind))))
436 (list (nth 0 common) (nth 1 common) (nth 2 common)
437 ;; These are done separately here, so that command-history will record these expressions
438 ;; rather than the values they had this time.
439 (and transient-mark-mode mark-active (region-beginning))
440 (and transient-mark-mode mark-active (region-end)))))
441 (let ((kind (cond ((and prefix (natnump (prefix-numeric-value current-prefix-arg))) 'WORD)
446 (if (< emacs-major-version 21) (query-replace old new t) (query-replace old new t start end)))
448 (if (< emacs-major-version 21)
449 (query-replace-regexp old new)
450 (query-replace-regexp old new nil start end)))
452 (if (< emacs-major-version 21) (query-replace old new) (query-replace old new nil start end))))
453 (when (interactive-p) (message "query-replace %s `%s' by `%s'...done" kind old new)))
454 (when (and (boundp 'isearchp-set-region-flag) isearchp-set-region-flag)
455 (set-region-around-search-target))) ; Defined in `isearch+.el'.
458;; REPLACES ORIGINAL in `replace.el'.
459;; 1. Uses `completing-read' if `replace-w-completion-flag' is non-nil.
460;; 2. The default regexps are provided by `search/replace-default-fn'.
462;; TEST IS TEMPORARY - will be changed to (string-match "22.x" emacs-version) after 22.x release
464(unless (or (string-match "22." emacs-version) (string-match "21.3.50" emacs-version))
465 (defun query-replace-read-args (string regexp-flag &optional noerror)
466 "Read arguments for replacement functions such as `\\[query-replace]'.
467Option `replace-w-completion-flag', if non-nil, provides for
468minibuffer completion while you type the arguments. In that case, to
469insert a `SPC' or `TAB' character, you will need to preceed it by \
471 (unless noerror (barf-if-buffer-read-only))
472 (let* ((default (if (fboundp search/replace-default-fn)
473 (funcall search/replace-default-fn)
474 (car regexp-history)))
475 (old-prompt (concat string ". OLD (to be replaced): "))
476 (oldx (if replace-w-completion-flag
477 (completing-read old-prompt obarray nil nil nil
478 query-replace-from-history-variable default t)
479 (if query-replace-interactive
480 (car (if regexp-flag regexp-search-ring search-ring))
481 (read-from-minibuffer old-prompt nil nil nil
482 query-replace-from-history-variable default t))))
483 (new-prompt (format "NEW (replacing %s): " oldx))
484 (newx (if replace-w-completion-flag
485 (completing-read new-prompt obarray nil nil nil
486 query-replace-to-history-variable default t)
487 (read-from-minibuffer new-prompt nil nil nil
488 query-replace-to-history-variable default t))))
489 (list oldx newx current-prefix-arg))))
494;; REPLACES ORIGINAL in `replace.el':
495;; 1. Prompt changed, to mention that lines after point are affected.
496;; 2. The default regexp is provided by `search/replace-default-fn'.
497;; 3. An in-progress message has been added.
499(when (< emacs-major-version 21)
500 (defun keep-lines (regexp)
501 "Delete all lines after point except those with a match for REGEXP.
502A match split across lines preserves all the lines it lies in.
503Note that the lines are deleted, not killed to the kill-ring.
505If REGEXP contains upper case characters (excluding those preceded by `\\'),
506the matching is case-sensitive."
508 (list (read-from-minibuffer
509 "Keep lines after cursor that contain a match for REGEXP: "
510 (if (fboundp search/replace-default-fn)
511 (funcall search/replace-default-fn)
512 (car regexp-history))
513 nil nil 'regexp-history nil t)))
514 (when (interactive-p) (message "Deleting non-matching lines..."))
516 (unless (bolp) (forward-line 1))
517 (let ((start (point))
518 (case-fold-search (and case-fold-search
519 (isearch-no-upper-case-p regexp t))))
521 ;; Start is first char not preserved by previous match.
522 (if (not (re-search-forward regexp nil 'move))
523 (delete-region start (point-max))
524 (let ((end (save-excursion (goto-char (match-beginning 0))
525 (beginning-of-line) (point))))
526 ;; Now end is first char preserved by the new match.
527 (when (< start end) (delete-region start end))))
528 (setq start (save-excursion (forward-line 1) (point)))
529 ;; If the match was empty, avoid matching again at same place.
530 (and (not (eobp)) (= (match-beginning 0) (match-end 0))
532 (when (interactive-p) (message "Deleting non-matching lines...done"))))
536;; REPLACES ORIGINAL in `replace.el':
537;; 1. Prompt changed, to mention that lines after point are affected.
538;; 2. The default regexp is provided by `search/replace-default-fn'.
539;; 3. An in-progress message has been added.
541(when (< emacs-major-version 21)
542 (defun flush-lines (regexp)
543 "Delete lines after point that contain a match for REGEXP.
544If a match is split across lines, all the lines it lies in are deleted.
545Note that the lines are deleted, not killed to the kill-ring.
547If REGEXP contains upper case characters (excluding those preceded by `\\'),
548the matching is case-sensitive."
550 (list (read-from-minibuffer
551 "Delete lines after cursor that contain a match for REGEXP: "
552 (if (fboundp search/replace-default-fn)
553 (funcall search/replace-default-fn)
554 (car regexp-history))
555 nil nil 'regexp-history nil t)))
556 (when (interactive-p) (message "Deleting matching lines..."))
557 (let ((case-fold-search (and case-fold-search
558 (isearch-no-upper-case-p regexp t))))
560 (while (and (not (eobp)) (re-search-forward regexp nil t))
561 (delete-region (save-excursion (goto-char (match-beginning 0))
562 (beginning-of-line) (point))
563 (progn (forward-line 1) (point))))))
564 (when (interactive-p) (message "Deleting matching lines...done"))))
568;; REPLACES ORIGINAL in `replace.el':
569;; 1. Prompt changed, to mention that lines after point are affected.
570;; 2. The default regexp is provided by `search/replace-default-fn'.
571;; 3. An in-progress message has been added.
573(when (< emacs-major-version 21)
574 (defun how-many (regexp)
575 "Print number of matches for REGEXP following point.
577If REGEXP contains upper case characters (excluding those preceded by `\\'),
578the matching is case-sensitive."
579 (interactive (list (read-from-minibuffer
580 "Count matches after point for REGEXP: "
581 (if (fboundp search/replace-default-fn)
582 (funcall search/replace-default-fn)
583 (car regexp-history)) nil nil 'regexp-history nil t)))
584 (when (interactive-p) (message "Counting matches after point..."))
586 (case-fold-search (and case-fold-search
587 (isearch-no-upper-case-p regexp t)))
590 (while (and (not (eobp))
591 (progn (setq opoint (point))
592 (re-search-forward regexp nil t)))
593 (if (= opoint (point))
595 (setq count (1+ count))))
596 (message "%d matches after point." count)))))
600(defalias 'list-matching-lines 'occur)
604;; REPLACES ORIGINAL in `replace.el':
605;; 1. The default regexp is provided by `search/replace-default-fn'.
606;; 2. Regexp is saved as `occur-regexp' for use by `occur-mode-mouse-goto'
607;; and `occur-mode-goto-occurrence'.
609(when (< emacs-major-version 21)
610 (defun occur (regexp &optional nlines)
611 "Show all lines in the current buffer containing a match for REGEXP.
613If a match spreads across multiple lines, all those lines are shown.
615Each line is displayed with NLINES lines before and after,
616or -NLINES before if NLINES is negative. NLINES defaults to
617`list-matching-lines-default-context-lines'.
618Interactively it is the prefix arg.
620The lines are shown in a buffer named `*Occur*'. This serves as a
621menu to find any of the occurrences in the current buffer.
622\\<occur-mode-map>\\[describe-mode] in the `*Occur*' buffer will explain how.
624If REGEXP contains upper case characters (excluding those preceded by `\\'),
625the matching is case-sensitive."
627 (list (let ((default (if (fboundp search/replace-default-fn)
628 (funcall search/replace-default-fn)
629 (car regexp-history))))
630 (read-from-minibuffer "List lines matching regexp: "
631 nil nil nil 'regexp-history default t))
633 (setq occur-regexp regexp) ; Save for highlighting.
634 (let ((nlines (if nlines
635 (prefix-numeric-value nlines)
636 list-matching-lines-default-context-lines))
638 ;;flag to prevent printing separator for first match
639 (occur-num-matches 0)
640 (buffer (current-buffer))
641 (dir default-directory)
644 ;;position of most recent match
646 (case-fold-search (and case-fold-search
647 (isearch-no-upper-case-p regexp t)))
649 ;; Marker to the start of context immediately following
650 ;; the matched text in *Occur*.
653;;; (beginning-of-line)
654;;; (setq linenum (1+ (count-lines (point-min) (point))))
655;;; (setq prevpos (point)))
657 (goto-char (point-min))
658 ;; Check first whether there are any matches at all.
659 (if (not (re-search-forward regexp nil t))
660 (message "No matches for `%s'" regexp)
661 ;; Back up, so the search loop below will find the first match.
662 (goto-char (match-beginning 0))
663 (with-output-to-temp-buffer "*Occur*"
665 (set-buffer standard-output)
666 (setq default-directory dir)
667 ;; We will insert the number of lines, and "lines", later.
668 (insert " matching ")
669 (let ((print-escape-newlines t)) (prin1 regexp))
670 (insert " in buffer `" (buffer-name buffer) "'." ?\n)
672 (setq occur-buffer buffer)
673 (setq occur-nlines nlines)
674 (setq occur-command-arguments
675 (list regexp nlines)))
676 (when (eq buffer standard-output) (goto-char (point-max)))
678 ;; Find next match, but give up if prev match was at end of buffer.
679 (while (and (not (= prevpos (point-max)))
680 (re-search-forward regexp nil t))
681 (goto-char (match-beginning 0))
684 (setq linenum (+ linenum (count-lines prevpos (point)))))
685 (setq prevpos (point))
686 (goto-char (match-end 0))
688 ;;start point of text in source buffer to be put
691 (goto-char (match-beginning 0))
692 (forward-line (if (< nlines 0) nlines (- nlines)))
695 ;; end point of text in source buffer to be put
698 (goto-char (match-end 0))
700 (forward-line (1+ nlines))
704 ;; Amount of context before matching text
705 (- (match-beginning 0) start))
707 ;; Length of matching text
708 (- (match-end 0) (match-beginning 0)))
709 (tag (format "%5d" linenum))
710 (empty (make-string (length tag) ?\ ))
713 ;; Number of lines of context to show for current match.
715 ;; Marker pointing to end of match in source buffer.
717 ;; Marker pointing to start of text for one
721 ;; Marker pointing to end of text for one match
726 (setq occur-marker (make-marker))
727 (set-marker occur-marker (point))
728 (set-buffer standard-output)
729 (setq occur-num-matches (1+ occur-num-matches))
730 (or first (zerop nlines)
731 (insert "--------\n"))
734 ;; Insert matching text including context lines from
735 ;; source buffer into *Occur*
736 (set-marker text-beg (point))
737 (setq insertion-start (point))
738 (insert-buffer-substring buffer start end)
739 (or (and (/= (+ start match-beg) end)
740 (with-current-buffer buffer
741 (eq (char-before end) ?\n)))
743 (set-marker final-context-start
744 (+ (- (point) (- end (match-end 0)))
748 (goto-char (match-end 0))
752 (set-marker text-end (point))
754 ;; Highlight text that was matched.
755 (when list-matching-lines-face
757 (+ (marker-position text-beg) match-beg)
758 (+ (marker-position text-beg) match-beg match-len)
759 'face list-matching-lines-face))
761 ;; `occur-point' property is used by occur-next and
762 ;; occur-prev to move between matching lines.
764 (+ (marker-position text-beg) match-beg match-len)
765 (+ (marker-position text-beg) match-beg match-len 1)
768 ;; Now go back to the start of the matching text
769 ;; adding the space and colon to the start of each line.
770 (goto-char insertion-start)
771 ;; Insert space and colon for lines of context before match.
772 (setq tem (if (< linenum nlines)
780 ;; Insert line number and colon for the lines of
782 (let ((this-linenum linenum))
783 (while (< (point) final-context-start)
785 (setq tag (format "%5d" this-linenum)))
787;;; ;; DDA: Add mouse-face to line
788;;; (put-text-property (save-excursion
789;;; (beginning-of-line) (point))
790;;; (save-excursion (end-of-line) (point))
791;;; 'mouse-face 'underline)
792;;; ;; DDA: Highlight `grep-pattern' in compilation buffer, if possible.
793;;; (when (fboundp 'hlt-highlight-regexp-region)
794;;; (hlt-highlight-regexp-region
795;;; (save-excursion (beginning-of-line) (point))
796;;; (save-excursion (end-of-line) (point))
797;;; occur-regexp list-matching-lines-face))
801 (while (and (not (eobp)) (<= (point) final-context-start))
804 (setq this-linenum (1+ this-linenum))))
806 ;; Insert space and colon for lines of context after match.
807 (while (and (< (point) (point-max)) (< tem nlines))
812 ;; Add text properties. The `occur' prop is used to
813 ;; store the marker of the matching text in the
815 (put-text-property (marker-position text-beg)
816 (- (marker-position text-end) 1)
817 'mouse-face 'underline)
818 (put-text-property (marker-position text-beg)
819 (marker-position text-end)
821 (goto-char (point-max)))
823 (set-buffer standard-output)
824 ;; Go back to top of *Occur* and finish off by printing the
825 ;; number of matching lines.
826 (goto-char (point-min))
827 (let ((message-string
828 (if (= occur-num-matches 1)
830 (format "%d lines" occur-num-matches))))
831 (insert message-string)
832 (when (interactive-p)
833 (message "%s matched" message-string)))
834 (setq buffer-read-only t)))
835 (when (fboundp 'show-a-frame-on) ; Defined in `frame-cmds.el'.
836 (show-a-frame-on "*Occur*"))
837 (let ((fr (and (fboundp 'get-a-frame) ; Defined in `frame-fns.el'.
838 (get-a-frame "*Occur*"))))
839 (when (and fr (fboundp 'fit-frame)) ; Defined in `fit-frame.el'.
840 (fit-frame fr))))))))
844;; REPLACES ORIGINAL in `replace.el':
845;; Regexp is saved as `occur-regexp' for use by `occur-mode-mouse-goto' and `occur-mode-goto-occurrence'.
847(when (>= emacs-major-version 21)
848 (defadvice occur (before occur-save-regexp activate compile)
849 (setq occur-regexp regexp))) ; Save for highlighting.
853;; REPLACES ORIGINAL in `replace.el':
854;; The default regexp is provided by `search/replace-default-fn'.
856(when (>= emacs-major-version 21)
857 (defun occur-read-primary-args ()
858 (list (let* ((default (if (fboundp search/replace-default-fn)
859 (funcall search/replace-default-fn)
860 (car regexp-history)))
862 (read-from-minibuffer
864 (format "List lines matching regexp (default `%s'): "
865 (query-replace-descr default))
866 "List lines matching regexp: ")
867 nil nil nil 'regexp-history default)))
868 (if (equal input "") default input))
869 (and current-prefix-arg
870 (prefix-numeric-value current-prefix-arg)))))
874;; REPLACES ORIGINAL in `replace.el':
875;; Highlights visited linenum in occur buffer.
876;; Highlights regexp in source buffer.
878(defadvice occur-mode-mouse-goto (around occur-mode-mouse-goto-highlight activate compile)
879 "Highlight visited line number in occur buffer.
880Alo highlight occur regexp in source buffer."
882 (set-buffer (window-buffer (posn-window (event-end event))))
883 (goto-char (posn-point (event-end event)))
884 (when (fboundp 'hlt-highlight-regexp-region) ; Highlight goto lineno.
885 (let ((bol (save-excursion (beginning-of-line) (point))))
886 (hlt-highlight-regexp-region bol
888 (beginning-of-line) (search-forward ":" (+ bol 20) t) (point))
890 'occur-highlight-linenum))))
892 (when (fboundp 'hlt-highlight-regexp-region)
893 (hlt-highlight-regexp-region (save-excursion (beginning-of-line) (point))
894 (save-excursion (end-of-line) (point))
895 occur-regexp list-matching-lines-face)))
899;; REPLACES ORIGINAL in `replace.el':
900;; Highlights visited linenum in occur buffer.
901;; Highlights regexp in source buffer.
903(defadvice occur-mode-goto-occurrence (around occur-mode-goto-occurrence-highlight activate compile)
904 "Highlight visited line number in occur buffer.
905Also highlight occur regexp in source buffer."
906 (when (fboundp 'hlt-highlight-regexp-region) ; Highlight goto lineno.
907 (let ((bol (save-excursion (beginning-of-line) (point))))
908 (hlt-highlight-regexp-region bol
910 (beginning-of-line) (search-forward ":" (+ bol 20) t) (point))
912 'occur-highlight-linenum)))
914 (when (fboundp 'hlt-highlight-regexp-region)
915 (hlt-highlight-regexp-region (save-excursion (beginning-of-line) (point))
916 (save-excursion (end-of-line) (point))
917 occur-regexp list-matching-lines-face)))
919;; Bindings for Emacs prior to version 22.
920(unless (> emacs-major-version 21)
921 (define-key occur-mode-map "o" 'occur-mode-goto-occurrence-other-window)
922 (define-key occur-mode-map "\C-o" 'occur-mode-display-occurrence))
926;; REPLACES ORIGINAL in `replace.el' (Emacs 22):
927;; Highlights visited linenum in occur buffer.
928;; Highlights regexp in source buffer.
929(defun occur-mode-goto-occurrence-other-window ()
930 "Go to the occurrence the current line describes, in another window."
932 (when (fboundp 'hlt-highlight-regexp-region) ; Highlight goto lineno.
933 (let ((bol (save-excursion (beginning-of-line) (point))))
934 (hlt-highlight-regexp-region bol
936 (beginning-of-line) (search-forward ":" (+ bol 20) t) (point))
938 'occur-highlight-linenum)))
939 (let ((pos (occur-mode-find-occurrence)))
940 (switch-to-buffer-other-window (marker-buffer pos))
942 (when (fboundp 'hlt-highlight-regexp-region)
943 (hlt-highlight-regexp-region (save-excursion (beginning-of-line) (point))
944 (save-excursion (end-of-line) (point))
945 occur-regexp list-matching-lines-face))))
949;; REPLACES ORIGINAL in `replace.el' (Emacs 22):
950;; Highlights visited linenum in occur buffer.
951;; Highlights regexp in source buffer.
952(defun occur-mode-display-occurrence ()
953 "Display in another window the occurrence the current line describes."
955 (when (fboundp 'hlt-highlight-regexp-region) ; Highlight goto lineno.
956 (let ((bol (save-excursion (beginning-of-line) (point))))
957 (hlt-highlight-regexp-region bol
959 (beginning-of-line) (search-forward ":" (+ bol 20) t) (point))
961 'occur-highlight-linenum)))
962 (let ((pos (occur-mode-find-occurrence))
964 ;; Bind these to ensure `display-buffer' puts it in another window.
965 same-window-buffer-names
967 (setq window (display-buffer (marker-buffer pos)))
968 ;; This is the way to set point in the proper window.
969 (save-selected-window
970 (select-window window)
972 (when (fboundp 'hlt-highlight-regexp-region)
973 (hlt-highlight-regexp-region (save-excursion (beginning-of-line) (point))
974 (save-excursion (end-of-line) (point))
975 occur-regexp list-matching-lines-face)))))
980;;;Emacs19 ;; REPLACES ORIGINAL in `replace.el':
981;;;Emacs19 ;; When change markers to numbers (after query loop), ensure they are markers.
982;;;Emacs19 ;;;###autoload
983;;;Emacs19 (defun perform-replace (from-string replacements query-flag regexp-flag
984;;;Emacs19 delimited-flag &optional repeat-count map)
985;;;Emacs19 "Subroutine of `query-replace'. Its complexity handles interactive queries.
986;;;Emacs19 Don't use this in your own program unless you want to query and set the mark
987;;;Emacs19 just as `query-replace' does. Instead, write a simple loop like this:
988;;;Emacs19 (while (re-search-forward \"foo[ \t]+bar\" nil t)
989;;;Emacs19 (replace-match \"foobar\" nil nil))
990;;;Emacs19 which will run faster and probably do what you want."
991;;;Emacs19 (unless map (setq map query-replace-map))
992;;;Emacs19 (let ((nocasify (not (and case-fold-search case-replace
993;;;Emacs19 (string-equal from-string
994;;;Emacs19 (downcase from-string)))))
995;;;Emacs19 (literal (not regexp-flag))
996;;;Emacs19 (search-function (if regexp-flag 're-search-forward 'search-forward))
997;;;Emacs19 (search-string from-string)
998;;;Emacs19 (real-match-data nil) ; The match data for the current match.
999;;;Emacs19 (next-replacement nil)
1000;;;Emacs19 (replacement-index 0)
1001;;;Emacs19 (keep-going t)
1002;;;Emacs19 (stack nil)
1003;;;Emacs19 (next-rotate-count 0)
1004;;;Emacs19 (replace-count 0)
1005;;;Emacs19 (lastrepl nil) ; Position after last match considered.
1006;;;Emacs19 (match-again t)
1007;;;Emacs19 (message (and query-flag (substitute-command-keys "Query replacing %s \
1008;;;Emacs19 with %s: (\\<query-replace-map>\\[help] for help) "))))
1009;;;Emacs19 (if (stringp replacements)
1010;;;Emacs19 (setq next-replacement replacements)
1011;;;Emacs19 (unless repeat-count (setq repeat-count 1)))
1012;;;Emacs19 (when delimited-flag
1013;;;Emacs19 (setq search-function 're-search-forward)
1014;;;Emacs19 (setq search-string (concat "\\b" (if regexp-flag
1015;;;Emacs19 from-string
1016;;;Emacs19 (regexp-quote from-string))
1018;;;Emacs19 (push-mark)
1019;;;Emacs19 (undo-boundary)
1020;;;Emacs19 (unwind-protect
1021;;;Emacs19 ;; Loop finding occurrences that perhaps should be replaced.
1022;;;Emacs19 (while (and keep-going
1023;;;Emacs19 (not (eobp))
1024;;;Emacs19 (funcall search-function search-string nil t)
1025;;;Emacs19 ;; If the search string matches immediately after
1026;;;Emacs19 ;; the previous match, but it did not match there
1027;;;Emacs19 ;; before the replacement was done, ignore the match.
1028;;;Emacs19 (or (not (or (eq lastrepl (point))
1029;;;Emacs19 (and regexp-flag
1030;;;Emacs19 (eq lastrepl (match-beginning 0))
1031;;;Emacs19 (not match-again))))
1032;;;Emacs19 (and (not (eobp))
1033;;;Emacs19 ;; Don't replace the null string
1034;;;Emacs19 ;; right after end of previous replacement.
1035;;;Emacs19 (progn (forward-char 1)
1036;;;Emacs19 (funcall search-function search-string
1037;;;Emacs19 nil t)))))
1038;;;Emacs19 ;; Save the data associated with the real match.
1039;;;Emacs19 (setq real-match-data (match-data))
1040;;;Emacs19 ;; Before we make the replacement, decide whether the search string
1041;;;Emacs19 ;; can match again just after this match.
1042;;;Emacs19 (when regexp-flag (setq match-again (looking-at search-string)))
1043;;;Emacs19 ;; If time for a change, advance to next replacement string.
1044;;;Emacs19 (when (and (listp replacements) (= next-rotate-count replace-count))
1045;;;Emacs19 (incf next-rotate-count repeat-count)
1046;;;Emacs19 (setq next-replacement (nth replacement-index replacements))
1047;;;Emacs19 (setq replacement-index (% (1+ replacement-index)
1048;;;Emacs19 (length replacements))))
1049;;;Emacs19 (if (not query-flag)
1050;;;Emacs19 (progn (store-match-data real-match-data)
1051;;;Emacs19 (replace-match next-replacement nocasify literal)
1052;;;Emacs19 (incf replace-count))
1053;;;Emacs19 (undo-boundary)
1054;;;Emacs19 (let (done replaced key def)
1055;;;Emacs19 ;; Loop reading commands until one of them sets DONE,
1056;;;Emacs19 ;; which means it has finished handling this occurrence.
1057;;;Emacs19 (while (not done)
1058;;;Emacs19 (store-match-data real-match-data)
1059;;;Emacs19 (replace-highlight (match-beginning 0) (match-end 0))
1060;;;Emacs19 ;; Bind message-log-max so we don't fill up the message log
1061;;;Emacs19 ;; with a bunch of identical messages.
1062;;;Emacs19 (let ((message-log-max nil))
1063;;;Emacs19 (message message from-string next-replacement))
1064;;;Emacs19 (setq key (read-event))
1065;;;Emacs19 (setq key (vector key))
1066;;;Emacs19 (setq def (lookup-key map key))
1067;;;Emacs19 ;; Restore the match data while we process the command.
1068;;;Emacs19 (cond ((eq def 'help)
1069;;;Emacs19 (with-output-to-temp-buffer "*Help*"
1071;;;Emacs19 (concat "Query replacing "
1072;;;Emacs19 (if regexp-flag "regexp " "")
1073;;;Emacs19 from-string " by "
1074;;;Emacs19 next-replacement ".\n\n"
1075;;;Emacs19 (substitute-command-keys
1076;;;Emacs19 query-replace-help)))
1077;;;Emacs19 (save-excursion
1078;;;Emacs19 (set-buffer standard-output)
1079;;;Emacs19 (help-mode))))
1080;;;Emacs19 ((eq def 'exit)
1081;;;Emacs19 (setq keep-going nil)
1082;;;Emacs19 (setq done t))
1083;;;Emacs19 ((eq def 'backup)
1085;;;Emacs19 (let ((elt (car stack)))
1086;;;Emacs19 (goto-char (car elt))
1087;;;Emacs19 (setq replaced (eq t (cdr elt)))
1088;;;Emacs19 (unless replaced
1089;;;Emacs19 (store-match-data (cdr elt)))
1090;;;Emacs19 (pop stack))
1091;;;Emacs19 (message "No previous match")
1092;;;Emacs19 (ding 'no-terminate)
1093;;;Emacs19 (sit-for 1)))
1094;;;Emacs19 ((eq def 'act)
1095;;;Emacs19 (unless replaced
1096;;;Emacs19 (replace-match next-replacement nocasify literal))
1097;;;Emacs19 (setq done t) (setq replaced t))
1098;;;Emacs19 ((eq def 'act-and-exit)
1099;;;Emacs19 (unless replaced
1100;;;Emacs19 (replace-match next-replacement nocasify literal))
1101;;;Emacs19 (setq keep-going nil)
1102;;;Emacs19 (setq done t) (setq replaced t))
1103;;;Emacs19 ((eq def 'act-and-show)
1104;;;Emacs19 (unless replaced
1105;;;Emacs19 (replace-match next-replacement nocasify literal)
1106;;;Emacs19 (setq replaced t)))
1107;;;Emacs19 ((eq def 'automatic)
1108;;;Emacs19 (unless replaced
1109;;;Emacs19 (replace-match next-replacement nocasify literal))
1110;;;Emacs19 (setq done t)
1111;;;Emacs19 (setq query-flag nil)
1112;;;Emacs19 (setq replaced t))
1113;;;Emacs19 ((eq def 'skip)
1114;;;Emacs19 (setq done t))
1115;;;Emacs19 ((eq def 'recenter)
1116;;;Emacs19 (recenter nil))
1117;;;Emacs19 ((eq def 'edit)
1118;;;Emacs19 (message (substitute-command-keys
1119;;;Emacs19 "Recursive edit. Type \\[exit-recursive-edit] \
1120;;;Emacs19 to return to top level."))
1121;;;Emacs19 (store-match-data
1122;;;Emacs19 (prog1 (match-data)
1123;;;Emacs19 (save-excursion (recursive-edit))))
1124;;;Emacs19 ;; Before we make the replacement,
1125;;;Emacs19 ;; decide whether the search string
1126;;;Emacs19 ;; can match again just after this match.
1127;;;Emacs19 (when regexp-flag
1128;;;Emacs19 (setq match-again (looking-at search-string))))
1129;;;Emacs19 ((eq def 'delete-and-edit)
1130;;;Emacs19 (message (substitute-command-keys
1131;;;Emacs19 "Recursive edit. Type \\[exit-recursive-edit] \
1132;;;Emacs19 to return to top level."))
1133;;;Emacs19 (delete-region (match-beginning 0) (match-end 0))
1134;;;Emacs19 (store-match-data
1135;;;Emacs19 (prog1 (match-data)
1136;;;Emacs19 (save-excursion (recursive-edit))))
1137;;;Emacs19 (setq replaced t))
1138;;;Emacs19 ;; Note: we do not need to treat `exit-prefix'
1139;;;Emacs19 ;; specially here, since we reread
1140;;;Emacs19 ;; any unrecognized character.
1142;;;Emacs19 (setq this-command 'mode-exited)
1143;;;Emacs19 (setq keep-going nil)
1144;;;Emacs19 (setq unread-command-events
1145;;;Emacs19 (append (listify-key-sequence key)
1146;;;Emacs19 unread-command-events))
1147;;;Emacs19 (setq done t))))
1148;;;Emacs19 ;; Record previous position for ^ when we move on.
1149;;;Emacs19 ;; Change markers to numbers in the match data
1150;;;Emacs19 ;; since lots of markers slow down editing.
1151;;;Emacs19 (push (cons (point)
1152;;;Emacs19 (or replaced
1153;;;Emacs19 (mapcar (lambda (elt)
1154;;;Emacs19 (and (markerp elt)
1155;;;Emacs19 (prog1 (marker-position elt)
1156;;;Emacs19 (set-marker elt nil))))
1157;;;Emacs19 (match-data))))
1159;;;Emacs19 (when replaced (incf replace-count))))
1160;;;Emacs19 (setq lastrepl (point)))
1161;;;Emacs19 (replace-dehighlight))
1162;;;Emacs19 (or unread-command-events
1163;;;Emacs19 (message "Replaced %d occurrence%s"
1164;;;Emacs19 replace-count
1165;;;Emacs19 (if (= replace-count 1) "" "s")))
1166;;;Emacs19 (and keep-going stack)))
1169;;;;;;;;;;;;;;;;;;;;;;;
1173;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1174;;; replace+.el ends here