Line data Source code
1 : ;;; replace.el --- replace commands for Emacs -*- lexical-binding: t -*-
2 :
3 : ;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2017 Free
4 : ;; Software Foundation, Inc.
5 :
6 : ;; Maintainer: emacs-devel@gnu.org
7 : ;; Package: emacs
8 :
9 : ;; This file is part of GNU Emacs.
10 :
11 : ;; GNU Emacs is free software: you can redistribute it and/or modify
12 : ;; it under the terms of the GNU General Public License as published by
13 : ;; the Free Software Foundation, either version 3 of the License, or
14 : ;; (at your option) any later version.
15 :
16 : ;; GNU Emacs is distributed in the hope that it will be useful,
17 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 : ;; GNU General Public License for more details.
20 :
21 : ;; You should have received a copy of the GNU General Public License
22 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 :
24 : ;;; Commentary:
25 :
26 : ;; This package supplies the string and regular-expression replace functions
27 : ;; documented in the Emacs user's manual.
28 :
29 : ;;; Code:
30 :
31 : (eval-when-compile (require 'cl-lib))
32 :
33 : (defcustom case-replace t
34 : "Non-nil means `query-replace' should preserve case in replacements."
35 : :type 'boolean
36 : :group 'matching)
37 :
38 : (defcustom replace-char-fold nil
39 : "Non-nil means replacement commands should do character folding in matches.
40 : This means, for instance, that \\=' will match a large variety of
41 : unicode quotes.
42 : This variable affects `query-replace' and `replace-string', but not
43 : `replace-regexp'."
44 : :type 'boolean
45 : :group 'matching
46 : :version "25.1")
47 :
48 : (defcustom replace-lax-whitespace nil
49 : "Non-nil means `query-replace' matches a sequence of whitespace chars.
50 : When you enter a space or spaces in the strings to be replaced,
51 : it will match any sequence matched by the regexp `search-whitespace-regexp'."
52 : :type 'boolean
53 : :group 'matching
54 : :version "24.3")
55 :
56 : (defcustom replace-regexp-lax-whitespace nil
57 : "Non-nil means `query-replace-regexp' matches a sequence of whitespace chars.
58 : When you enter a space or spaces in the regexps to be replaced,
59 : it will match any sequence matched by the regexp `search-whitespace-regexp'."
60 : :type 'boolean
61 : :group 'matching
62 : :version "24.3")
63 :
64 : (defvar query-replace-history nil
65 : "Default history list for query-replace commands.
66 : See `query-replace-from-history-variable' and
67 : `query-replace-to-history-variable'.")
68 :
69 : (defvar query-replace-defaults nil
70 : "Default values of FROM-STRING and TO-STRING for `query-replace'.
71 : This is a list of cons cells (FROM-STRING . TO-STRING), or nil
72 : if there are no default values.")
73 :
74 : (defvar query-replace-interactive nil
75 : "Non-nil means `query-replace' uses the last search string.
76 : That becomes the \"string to replace\".")
77 : (make-obsolete-variable 'query-replace-interactive
78 : "use `M-n' to pull the last incremental search string
79 : to the minibuffer that reads the string to replace, or invoke replacements
80 : from Isearch by using a key sequence like `C-s C-s M-%'." "24.3")
81 :
82 : (defcustom query-replace-from-to-separator " → "
83 : "String that separates FROM and TO in the history of replacement pairs.
84 : When nil, the pair will not be added to the history (same behavior
85 : as in emacs 24.5)."
86 : :group 'matching
87 : :type '(choice
88 : (const :tag "Disabled" nil)
89 : string)
90 : :version "25.1")
91 :
92 : (defcustom query-replace-from-history-variable 'query-replace-history
93 : "History list to use for the FROM argument of `query-replace' commands.
94 : The value of this variable should be a symbol; that symbol
95 : is used as a variable to hold a history list for the strings
96 : or patterns to be replaced."
97 : :group 'matching
98 : :type 'symbol
99 : :version "20.3")
100 :
101 : (defcustom query-replace-to-history-variable 'query-replace-history
102 : "History list to use for the TO argument of `query-replace' commands.
103 : The value of this variable should be a symbol; that symbol
104 : is used as a variable to hold a history list for replacement
105 : strings or patterns."
106 : :group 'matching
107 : :type 'symbol
108 : :version "20.3")
109 :
110 : (defcustom query-replace-skip-read-only nil
111 : "Non-nil means `query-replace' and friends ignore read-only matches."
112 : :type 'boolean
113 : :group 'matching
114 : :version "22.1")
115 :
116 : (defcustom query-replace-show-replacement t
117 : "Non-nil means show substituted replacement text in the minibuffer.
118 : This variable affects only `query-replace-regexp'."
119 : :type 'boolean
120 : :group 'matching
121 : :version "23.1")
122 :
123 : (defcustom query-replace-highlight t
124 : "Non-nil means to highlight matches during query replacement."
125 : :type 'boolean
126 : :group 'matching)
127 :
128 : (defcustom query-replace-lazy-highlight t
129 : "Controls the lazy-highlighting during query replacements.
130 : When non-nil, all text in the buffer matching the current match
131 : is highlighted lazily using isearch lazy highlighting (see
132 : `lazy-highlight-initial-delay' and `lazy-highlight-interval')."
133 : :type 'boolean
134 : :group 'lazy-highlight
135 : :group 'matching
136 : :version "22.1")
137 :
138 : (defface query-replace
139 : '((t (:inherit isearch)))
140 : "Face for highlighting query replacement matches."
141 : :group 'matching
142 : :version "22.1")
143 :
144 : (defvar replace-count 0
145 : "Number of replacements done so far.
146 : See `replace-regexp' and `query-replace-regexp-eval'.")
147 :
148 : (defun query-replace-descr (string)
149 0 : (mapconcat 'isearch-text-char-description string ""))
150 :
151 : (defun query-replace--split-string (string)
152 : "Split string STRING at a substring with property `separator'."
153 0 : (let* ((length (length string))
154 0 : (split-pos (text-property-any 0 length 'separator t string)))
155 0 : (if (not split-pos)
156 0 : (substring-no-properties string)
157 0 : (cons (substring-no-properties string 0 split-pos)
158 0 : (substring-no-properties
159 0 : string (or (text-property-not-all
160 0 : (1+ split-pos) length 'separator t string)
161 0 : length)
162 0 : length)))))
163 :
164 : (defun query-replace-read-from (prompt regexp-flag)
165 : "Query and return the `from' argument of a query-replace operation.
166 : The return value can also be a pair (FROM . TO) indicating that the user
167 : wants to replace FROM with TO."
168 0 : (if query-replace-interactive
169 0 : (car (if regexp-flag regexp-search-ring search-ring))
170 0 : (let* ((history-add-new-input nil)
171 : (separator-string
172 0 : (when query-replace-from-to-separator
173 : ;; Check if the first non-whitespace char is displayable
174 0 : (if (char-displayable-p
175 0 : (string-to-char (replace-regexp-in-string
176 0 : " " "" query-replace-from-to-separator)))
177 0 : query-replace-from-to-separator
178 0 : " -> ")))
179 : (separator
180 0 : (when separator-string
181 0 : (propertize separator-string
182 0 : 'display separator-string
183 : 'face 'minibuffer-prompt
184 0 : 'separator t)))
185 : (minibuffer-history
186 0 : (append
187 0 : (when separator
188 0 : (mapcar (lambda (from-to)
189 0 : (concat (query-replace-descr (car from-to))
190 0 : separator
191 0 : (query-replace-descr (cdr from-to))))
192 0 : query-replace-defaults))
193 0 : (symbol-value query-replace-from-history-variable)))
194 : (minibuffer-allow-text-properties t) ; separator uses text-properties
195 : (prompt
196 0 : (cond ((and query-replace-defaults separator)
197 0 : (format "%s (default %s): " prompt (car minibuffer-history)))
198 0 : (query-replace-defaults
199 0 : (format "%s (default %s -> %s): " prompt
200 0 : (query-replace-descr (caar query-replace-defaults))
201 0 : (query-replace-descr (cdar query-replace-defaults))))
202 0 : (t (format "%s: " prompt))))
203 : (from
204 : ;; The save-excursion here is in case the user marks and copies
205 : ;; a region in order to specify the minibuffer input.
206 : ;; That should not clobber the region for the query-replace itself.
207 0 : (save-excursion
208 0 : (minibuffer-with-setup-hook
209 : (lambda ()
210 0 : (setq-local text-property-default-nonsticky
211 0 : (append '((separator . t) (face . t))
212 0 : text-property-default-nonsticky)))
213 0 : (if regexp-flag
214 0 : (read-regexp prompt nil 'minibuffer-history)
215 0 : (read-from-minibuffer
216 0 : prompt nil nil nil nil (car search-ring) t)))))
217 : (to))
218 0 : (if (and (zerop (length from)) query-replace-defaults)
219 0 : (cons (caar query-replace-defaults)
220 0 : (query-replace-compile-replacement
221 0 : (cdar query-replace-defaults) regexp-flag))
222 0 : (setq from (query-replace--split-string from))
223 0 : (when (consp from) (setq to (cdr from) from (car from)))
224 0 : (add-to-history query-replace-from-history-variable from nil t)
225 : ;; Warn if user types \n or \t, but don't reject the input.
226 0 : (and regexp-flag
227 0 : (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
228 0 : (let ((match (match-string 3 from)))
229 0 : (cond
230 0 : ((string= match "\\n")
231 0 : (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
232 0 : ((string= match "\\t")
233 0 : (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
234 0 : (sit-for 2)))
235 0 : (if (not to)
236 0 : from
237 0 : (add-to-history query-replace-to-history-variable to nil t)
238 0 : (add-to-history 'query-replace-defaults (cons from to) nil t)
239 0 : (cons from (query-replace-compile-replacement to regexp-flag)))))))
240 :
241 : (defun query-replace-compile-replacement (to regexp-flag)
242 : "Maybe convert a regexp replacement TO to Lisp.
243 : Returns a list suitable for `perform-replace' if necessary,
244 : the original string if not."
245 0 : (if (and regexp-flag
246 0 : (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))
247 0 : (let (pos list char)
248 0 : (while
249 0 : (progn
250 0 : (setq pos (match-end 0))
251 0 : (push (substring to 0 (- pos 2)) list)
252 0 : (setq char (aref to (1- pos))
253 0 : to (substring to pos))
254 0 : (cond ((eq char ?\#)
255 0 : (push '(number-to-string replace-count) list))
256 0 : ((eq char ?\,)
257 0 : (setq pos (read-from-string to))
258 0 : (push `(replace-quote ,(car pos)) list)
259 0 : (let ((end
260 : ;; Swallow a space after a symbol
261 : ;; if there is a space.
262 0 : (if (and (or (symbolp (car pos))
263 : ;; Swallow a space after 'foo
264 : ;; but not after (quote foo).
265 0 : (and (eq (car-safe (car pos)) 'quote)
266 0 : (not (= ?\( (aref to 0)))))
267 0 : (eq (string-match " " to (cdr pos))
268 0 : (cdr pos)))
269 0 : (1+ (cdr pos))
270 0 : (cdr pos))))
271 0 : (setq to (substring to end)))))
272 0 : (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)))
273 0 : (setq to (nreverse (delete "" (cons to list))))
274 0 : (replace-match-string-symbols to)
275 0 : (cons 'replace-eval-replacement
276 0 : (if (cdr to)
277 0 : (cons 'concat to)
278 0 : (car to))))
279 0 : to))
280 :
281 :
282 : (defun query-replace-read-to (from prompt regexp-flag)
283 : "Query and return the `to' argument of a query-replace operation."
284 0 : (query-replace-compile-replacement
285 0 : (save-excursion
286 0 : (let* ((history-add-new-input nil)
287 0 : (to (read-from-minibuffer
288 0 : (format "%s %s with: " prompt (query-replace-descr from))
289 : nil nil nil
290 0 : query-replace-to-history-variable from t)))
291 0 : (add-to-history query-replace-to-history-variable to nil t)
292 0 : (add-to-history 'query-replace-defaults (cons from to) nil t)
293 0 : to))
294 0 : regexp-flag))
295 :
296 : (defun query-replace-read-args (prompt regexp-flag &optional noerror)
297 0 : (unless noerror
298 0 : (barf-if-buffer-read-only))
299 0 : (let* ((from (query-replace-read-from prompt regexp-flag))
300 0 : (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
301 0 : (query-replace-read-to from prompt regexp-flag))))
302 0 : (list from to
303 0 : (and current-prefix-arg (not (eq current-prefix-arg '-)))
304 0 : (and current-prefix-arg (eq current-prefix-arg '-)))))
305 :
306 : (defun query-replace (from-string to-string &optional delimited start end backward region-noncontiguous-p)
307 : "Replace some occurrences of FROM-STRING with TO-STRING.
308 : As each match is found, the user must type a character saying
309 : what to do with it. For directions, type \\[help-command] at that time.
310 :
311 : In Transient Mark mode, if the mark is active, operate on the contents
312 : of the region. Otherwise, operate from point to the end of the buffer's
313 : accessible portion.
314 :
315 : In interactive use, the prefix arg (non-nil DELIMITED in
316 : non-interactive use), means replace only matches surrounded by
317 : word boundaries. A negative prefix arg means replace backward.
318 :
319 : Use \\<minibuffer-local-map>\\[next-history-element] \
320 : to pull the last incremental search string to the minibuffer
321 : that reads FROM-STRING, or invoke replacements from
322 : incremental search with a key sequence like `C-s C-s M-%'
323 : to use its current search string as the string to replace.
324 :
325 : Matching is independent of case if `case-fold-search' is non-nil and
326 : FROM-STRING has no uppercase letters. Replacement transfers the case
327 : pattern of the old text to the new text, if `case-replace' and
328 : `case-fold-search' are non-nil and FROM-STRING has no uppercase
329 : letters. (Transferring the case pattern means that if the old text
330 : matched is all caps, or capitalized, then its replacement is upcased
331 : or capitalized.)
332 :
333 : Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
334 : ignore hidden matches if `search-invisible' is nil, and ignore more
335 : matches using `isearch-filter-predicate'.
336 :
337 : If `replace-lax-whitespace' is non-nil, a space or spaces in the string
338 : to be replaced will match a sequence of whitespace chars defined by the
339 : regexp in `search-whitespace-regexp'.
340 :
341 : If `replace-char-fold' is non-nil, matching uses character folding,
342 : i.e. it ignores diacritics and other differences between equivalent
343 : character strings.
344 :
345 : Fourth and fifth arg START and END specify the region to operate on.
346 :
347 : To customize possible responses, change the bindings in `query-replace-map'."
348 : (interactive
349 0 : (let ((common
350 0 : (query-replace-read-args
351 0 : (concat "Query replace"
352 0 : (if current-prefix-arg
353 0 : (if (eq current-prefix-arg '-) " backward" " word")
354 0 : "")
355 0 : (if (use-region-p) " in region" ""))
356 0 : nil)))
357 0 : (list (nth 0 common) (nth 1 common) (nth 2 common)
358 : ;; These are done separately here
359 : ;; so that command-history will record these expressions
360 : ;; rather than the values they had this time.
361 0 : (if (use-region-p) (region-beginning))
362 0 : (if (use-region-p) (region-end))
363 0 : (nth 3 common)
364 0 : (if (use-region-p) (region-noncontiguous-p)))))
365 0 : (perform-replace from-string to-string t nil delimited nil nil start end backward region-noncontiguous-p))
366 :
367 : (define-key esc-map "%" 'query-replace)
368 :
369 : (defun query-replace-regexp (regexp to-string &optional delimited start end backward region-noncontiguous-p)
370 : "Replace some things after point matching REGEXP with TO-STRING.
371 : As each match is found, the user must type a character saying
372 : what to do with it. For directions, type \\[help-command] at that time.
373 :
374 : In Transient Mark mode, if the mark is active, operate on the contents
375 : of the region. Otherwise, operate from point to the end of the buffer's
376 : accessible portion.
377 :
378 : Use \\<minibuffer-local-map>\\[next-history-element] \
379 : to pull the last incremental search regexp to the minibuffer
380 : that reads REGEXP, or invoke replacements from
381 : incremental search with a key sequence like `C-M-s C-M-s C-M-%'
382 : to use its current search regexp as the regexp to replace.
383 :
384 : Matching is independent of case if `case-fold-search' is non-nil and
385 : REGEXP has no uppercase letters. Replacement transfers the case
386 : pattern of the old text to the new text, if `case-replace' and
387 : `case-fold-search' are non-nil and REGEXP has no uppercase letters.
388 : \(Transferring the case pattern means that if the old text matched is
389 : all caps, or capitalized, then its replacement is upcased or
390 : capitalized.)
391 :
392 : Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
393 : ignore hidden matches if `search-invisible' is nil, and ignore more
394 : matches using `isearch-filter-predicate'.
395 :
396 : If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
397 : to be replaced will match a sequence of whitespace chars defined by the
398 : regexp in `search-whitespace-regexp'.
399 :
400 : This function is not affected by `replace-char-fold'.
401 :
402 : Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
403 : only matches surrounded by word boundaries. A negative prefix arg means
404 : replace backward.
405 :
406 : Fourth and fifth arg START and END specify the region to operate on.
407 :
408 : In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
409 : and `\\=\\N' (where N is a digit) stands for whatever matched
410 : the Nth `\\(...\\)' (1-based) in REGEXP. The `\\(...\\)' groups are
411 : counted from 1.
412 : `\\?' lets you edit the replacement text in the minibuffer
413 : at the given position for each replacement.
414 :
415 : In interactive calls, the replacement text can contain `\\,'
416 : followed by a Lisp expression. Each
417 : replacement evaluates that expression to compute the replacement
418 : string. Inside of that expression, `\\&' is a string denoting the
419 : whole match as a string, `\\N' for a partial match, `\\#&' and `\\#N'
420 : for the whole or a partial match converted to a number with
421 : `string-to-number', and `\\#' itself for the number of replacements
422 : done so far (starting with zero).
423 :
424 : If the replacement expression is a symbol, write a space after it
425 : to terminate it. One space there, if any, will be discarded.
426 :
427 : When using those Lisp features interactively in the replacement
428 : text, TO-STRING is actually made a list instead of a string.
429 : Use \\[repeat-complex-command] after this command for details."
430 : (interactive
431 0 : (let ((common
432 0 : (query-replace-read-args
433 0 : (concat "Query replace"
434 0 : (if current-prefix-arg
435 0 : (if (eq current-prefix-arg '-) " backward" " word")
436 0 : "")
437 : " regexp"
438 0 : (if (use-region-p) " in region" ""))
439 0 : t)))
440 0 : (list (nth 0 common) (nth 1 common) (nth 2 common)
441 : ;; These are done separately here
442 : ;; so that command-history will record these expressions
443 : ;; rather than the values they had this time.
444 0 : (if (use-region-p) (region-beginning))
445 0 : (if (use-region-p) (region-end))
446 0 : (nth 3 common)
447 0 : (if (use-region-p) (region-noncontiguous-p)))))
448 0 : (perform-replace regexp to-string t t delimited nil nil start end backward region-noncontiguous-p))
449 :
450 : (define-key esc-map [?\C-%] 'query-replace-regexp)
451 :
452 : (defun query-replace-regexp-eval (regexp to-expr &optional delimited start end)
453 : "Replace some things after point matching REGEXP with the result of TO-EXPR.
454 :
455 : Interactive use of this function is deprecated in favor of the
456 : `\\,' feature of `query-replace-regexp'. For non-interactive use, a loop
457 : using `search-forward-regexp' and `replace-match' is preferred.
458 :
459 : As each match is found, the user must type a character saying
460 : what to do with it. For directions, type \\[help-command] at that time.
461 :
462 : TO-EXPR is a Lisp expression evaluated to compute each replacement. It may
463 : reference `replace-count' to get the number of replacements already made.
464 : If the result of TO-EXPR is not a string, it is converted to one using
465 : `prin1-to-string' with the NOESCAPE argument (which see).
466 :
467 : For convenience, when entering TO-EXPR interactively, you can use `\\&'
468 : to stand for whatever matched the whole of REGEXP, and `\\N' (where
469 : N is a digit) to stand for whatever matched the Nth `\\(...\\)' (1-based)
470 : in REGEXP.
471 :
472 : Use `\\#&' or `\\#N' if you want a number instead of a string.
473 : In interactive use, `\\#' in itself stands for `replace-count'.
474 :
475 : In Transient Mark mode, if the mark is active, operate on the contents
476 : of the region. Otherwise, operate from point to the end of the buffer's
477 : accessible portion.
478 :
479 : Use \\<minibuffer-local-map>\\[next-history-element] \
480 : to pull the last incremental search regexp to the minibuffer
481 : that reads REGEXP.
482 :
483 : Preserves case in each replacement if `case-replace' and `case-fold-search'
484 : are non-nil and REGEXP has no uppercase letters.
485 :
486 : Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
487 : ignore hidden matches if `search-invisible' is nil, and ignore more
488 : matches using `isearch-filter-predicate'.
489 :
490 : If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
491 : to be replaced will match a sequence of whitespace chars defined by the
492 : regexp in `search-whitespace-regexp'.
493 :
494 : This function is not affected by `replace-char-fold'.
495 :
496 : Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
497 : only matches that are surrounded by word boundaries.
498 : Fourth and fifth arg START and END specify the region to operate on."
499 : (declare (obsolete "use the `\\,' feature of `query-replace-regexp'
500 : for interactive calls, and `search-forward-regexp'/`replace-match'
501 : for Lisp calls." "22.1"))
502 : (interactive
503 0 : (progn
504 0 : (barf-if-buffer-read-only)
505 0 : (let* ((from
506 : ;; Let-bind the history var to disable the "foo -> bar"
507 : ;; default. Maybe we shouldn't disable this default, but
508 : ;; for now I'll leave it off. --Stef
509 0 : (let ((query-replace-defaults nil))
510 0 : (query-replace-read-from "Query replace regexp" t)))
511 0 : (to (list (read-from-minibuffer
512 0 : (format "Query replace regexp %s with eval: "
513 0 : (query-replace-descr from))
514 0 : nil nil t query-replace-to-history-variable from t))))
515 : ;; We make TO a list because replace-match-string-symbols requires one,
516 : ;; and the user might enter a single token.
517 0 : (replace-match-string-symbols to)
518 0 : (list from (car to) current-prefix-arg
519 0 : (if (use-region-p) (region-beginning))
520 0 : (if (use-region-p) (region-end))))))
521 0 : (perform-replace regexp (cons 'replace-eval-replacement to-expr)
522 0 : t 'literal delimited nil nil start end))
523 :
524 : (defun map-query-replace-regexp (regexp to-strings &optional n start end)
525 : "Replace some matches for REGEXP with various strings, in rotation.
526 : The second argument TO-STRINGS contains the replacement strings, separated
527 : by spaces. This command works like `query-replace-regexp' except that
528 : each successive replacement uses the next successive replacement string,
529 : wrapping around from the last such string to the first.
530 :
531 : In Transient Mark mode, if the mark is active, operate on the contents
532 : of the region. Otherwise, operate from point to the end of the buffer's
533 : accessible portion.
534 :
535 : Non-interactively, TO-STRINGS may be a list of replacement strings.
536 :
537 : Interactively, reads the regexp using `read-regexp'.
538 : Use \\<minibuffer-local-map>\\[next-history-element] \
539 : to pull the last incremental search regexp to the minibuffer
540 : that reads REGEXP.
541 :
542 : A prefix argument N says to use each replacement string N times
543 : before rotating to the next.
544 : Fourth and fifth arg START and END specify the region to operate on."
545 : (interactive
546 0 : (let* ((from (read-regexp "Map query replace (regexp): " nil
547 0 : query-replace-from-history-variable))
548 0 : (to (read-from-minibuffer
549 0 : (format "Query replace %s with (space-separated strings): "
550 0 : (query-replace-descr from))
551 : nil nil nil
552 0 : query-replace-to-history-variable from t)))
553 0 : (list from to
554 0 : (and current-prefix-arg
555 0 : (prefix-numeric-value current-prefix-arg))
556 0 : (if (use-region-p) (region-beginning))
557 0 : (if (use-region-p) (region-end)))))
558 0 : (let (replacements)
559 0 : (if (listp to-strings)
560 0 : (setq replacements to-strings)
561 0 : (while (/= (length to-strings) 0)
562 0 : (if (string-match " " to-strings)
563 0 : (setq replacements
564 0 : (append replacements
565 0 : (list (substring to-strings 0
566 0 : (string-match " " to-strings))))
567 0 : to-strings (substring to-strings
568 0 : (1+ (string-match " " to-strings))))
569 0 : (setq replacements (append replacements (list to-strings))
570 0 : to-strings ""))))
571 0 : (perform-replace regexp replacements t t nil n nil start end)))
572 :
573 : (defun replace-string (from-string to-string &optional delimited start end backward)
574 : "Replace occurrences of FROM-STRING with TO-STRING.
575 : Preserve case in each match if `case-replace' and `case-fold-search'
576 : are non-nil and FROM-STRING has no uppercase letters.
577 : \(Preserving case means that if the string matched is all caps, or capitalized,
578 : then its replacement is upcased or capitalized.)
579 :
580 : Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
581 : ignore hidden matches if `search-invisible' is nil, and ignore more
582 : matches using `isearch-filter-predicate'.
583 :
584 : If `replace-lax-whitespace' is non-nil, a space or spaces in the string
585 : to be replaced will match a sequence of whitespace chars defined by the
586 : regexp in `search-whitespace-regexp'.
587 :
588 : If `replace-char-fold' is non-nil, matching uses character folding,
589 : i.e. it ignores diacritics and other differences between equivalent
590 : character strings.
591 :
592 : Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
593 : only matches surrounded by word boundaries. A negative prefix arg means
594 : replace backward.
595 :
596 : Operates on the region between START and END (if both are nil, from point
597 : to the end of the buffer). Interactively, if Transient Mark mode is
598 : enabled and the mark is active, operates on the contents of the region;
599 : otherwise from point to the end of the buffer's accessible portion.
600 :
601 : Use \\<minibuffer-local-map>\\[next-history-element] \
602 : to pull the last incremental search string to the minibuffer
603 : that reads FROM-STRING.
604 :
605 : This function is usually the wrong thing to use in a Lisp program.
606 : What you probably want is a loop like this:
607 : (while (search-forward FROM-STRING nil t)
608 : (replace-match TO-STRING nil t))
609 : which will run faster and will not set the mark or print anything.
610 : \(You may need a more complex loop if FROM-STRING can match the null string
611 : and TO-STRING is also null.)"
612 : (declare (interactive-only
613 : "use `search-forward' and `replace-match' instead."))
614 : (interactive
615 0 : (let ((common
616 0 : (query-replace-read-args
617 0 : (concat "Replace"
618 0 : (if current-prefix-arg
619 0 : (if (eq current-prefix-arg '-) " backward" " word")
620 0 : "")
621 : " string"
622 0 : (if (use-region-p) " in region" ""))
623 0 : nil)))
624 0 : (list (nth 0 common) (nth 1 common) (nth 2 common)
625 0 : (if (use-region-p) (region-beginning))
626 0 : (if (use-region-p) (region-end))
627 0 : (nth 3 common))))
628 0 : (perform-replace from-string to-string nil nil delimited nil nil start end backward))
629 :
630 : (defun replace-regexp (regexp to-string &optional delimited start end backward)
631 : "Replace things after point matching REGEXP with TO-STRING.
632 : Preserve case in each match if `case-replace' and `case-fold-search'
633 : are non-nil and REGEXP has no uppercase letters.
634 :
635 : Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
636 : ignore hidden matches if `search-invisible' is nil, and ignore more
637 : matches using `isearch-filter-predicate'.
638 :
639 : If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
640 : to be replaced will match a sequence of whitespace chars defined by the
641 : regexp in `search-whitespace-regexp'.
642 :
643 : This function is not affected by `replace-char-fold'
644 :
645 : In Transient Mark mode, if the mark is active, operate on the contents
646 : of the region. Otherwise, operate from point to the end of the buffer's
647 : accessible portion.
648 :
649 : Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
650 : only matches surrounded by word boundaries. A negative prefix arg means
651 : replace backward.
652 :
653 : Fourth and fifth arg START and END specify the region to operate on.
654 :
655 : In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
656 : and `\\=\\N' (where N is a digit) stands for whatever matched
657 : the Nth `\\(...\\)' (1-based) in REGEXP.
658 : `\\?' lets you edit the replacement text in the minibuffer
659 : at the given position for each replacement.
660 :
661 : In interactive calls, the replacement text may contain `\\,'
662 : followed by a Lisp expression used as part of the replacement
663 : text. Inside of that expression, `\\&' is a string denoting the
664 : whole match, `\\N' a partial match, `\\#&' and `\\#N' the respective
665 : numeric values from `string-to-number', and `\\#' itself for
666 : `replace-count', the number of replacements occurred so far, starting
667 : from zero.
668 :
669 : If your Lisp expression is an identifier and the next letter in
670 : the replacement string would be interpreted as part of it, you
671 : can wrap it with an expression like `\\,(or \\#)'. Incidentally,
672 : for this particular case you may also enter `\\#' in the
673 : replacement text directly.
674 :
675 : When using those Lisp features interactively in the replacement
676 : text, TO-STRING is actually made a list instead of a string.
677 : Use \\[repeat-complex-command] after this command for details.
678 :
679 : Use \\<minibuffer-local-map>\\[next-history-element] \
680 : to pull the last incremental search regexp to the minibuffer
681 : that reads REGEXP.
682 :
683 : This function is usually the wrong thing to use in a Lisp program.
684 : What you probably want is a loop like this:
685 : (while (re-search-forward REGEXP nil t)
686 : (replace-match TO-STRING nil nil))
687 : which will run faster and will not set the mark or print anything."
688 : (declare (interactive-only
689 : "use `re-search-forward' and `replace-match' instead."))
690 : (interactive
691 0 : (let ((common
692 0 : (query-replace-read-args
693 0 : (concat "Replace"
694 0 : (if current-prefix-arg
695 0 : (if (eq current-prefix-arg '-) " backward" " word")
696 0 : "")
697 : " regexp"
698 0 : (if (use-region-p) " in region" ""))
699 0 : t)))
700 0 : (list (nth 0 common) (nth 1 common) (nth 2 common)
701 0 : (if (use-region-p) (region-beginning))
702 0 : (if (use-region-p) (region-end))
703 0 : (nth 3 common))))
704 0 : (perform-replace regexp to-string nil t delimited nil nil start end backward))
705 :
706 :
707 : (defvar regexp-history nil
708 : "History list for some commands that read regular expressions.
709 :
710 : Maximum length of the history list is determined by the value
711 : of `history-length', which see.")
712 :
713 : (defvar occur-collect-regexp-history '("\\1")
714 : "History of regexp for occur's collect operation")
715 :
716 : (defcustom read-regexp-defaults-function nil
717 : "Function that provides default regexp(s) for `read-regexp'.
718 : This function should take no arguments and return one of: nil, a
719 : regexp, or a list of regexps. Interactively, `read-regexp' uses
720 : the return value of this function for its DEFAULT argument.
721 :
722 : As an example, set this variable to `find-tag-default-as-regexp'
723 : to default to the symbol at point.
724 :
725 : To provide different default regexps for different commands,
726 : the function that you set this to can check `this-command'."
727 : :type '(choice
728 : (const :tag "No default regexp reading function" nil)
729 : (const :tag "Latest regexp history" regexp-history-last)
730 : (function-item :tag "Tag at point"
731 : find-tag-default)
732 : (function-item :tag "Tag at point as regexp"
733 : find-tag-default-as-regexp)
734 : (function-item :tag "Tag at point as symbol regexp"
735 : find-tag-default-as-symbol-regexp)
736 : (function :tag "Your choice of function"))
737 : :group 'matching
738 : :version "24.4")
739 :
740 : (defun read-regexp-suggestions ()
741 : "Return a list of standard suggestions for `read-regexp'.
742 : By default, the list includes the tag at point, the last isearch regexp,
743 : the last isearch string, and the last replacement regexp. `read-regexp'
744 : appends the list returned by this function to the end of values available
745 : via \\<minibuffer-local-map>\\[next-history-element]."
746 0 : (list
747 0 : (find-tag-default-as-regexp)
748 0 : (find-tag-default-as-symbol-regexp)
749 0 : (car regexp-search-ring)
750 0 : (regexp-quote (or (car search-ring) ""))
751 0 : (car (symbol-value query-replace-from-history-variable))))
752 :
753 : (defun read-regexp (prompt &optional defaults history)
754 : "Read and return a regular expression as a string.
755 : Prompt with the string PROMPT. If PROMPT ends in \":\" (followed by
756 : optional whitespace), use it as-is. Otherwise, add \": \" to the end,
757 : possibly preceded by the default result (see below).
758 :
759 : The optional argument DEFAULTS can be either: nil, a string, a list
760 : of strings, or a symbol. We use DEFAULTS to construct the default
761 : return value in case of empty input.
762 :
763 : If DEFAULTS is a string, we use it as-is.
764 :
765 : If DEFAULTS is a list of strings, the first element is the
766 : default return value, but all the elements are accessible
767 : using the history command \\<minibuffer-local-map>\\[next-history-element].
768 :
769 : If DEFAULTS is a non-nil symbol, then if `read-regexp-defaults-function'
770 : is non-nil, we use that in place of DEFAULTS in the following:
771 : If DEFAULTS is the symbol `regexp-history-last', we use the first
772 : element of HISTORY (if specified) or `regexp-history'.
773 : If DEFAULTS is a function, we call it with no arguments and use
774 : what it returns, which should be either nil, a string, or a list of strings.
775 :
776 : We append the standard values from `read-regexp-suggestions' to DEFAULTS
777 : before using it.
778 :
779 : If the first element of DEFAULTS is non-nil (and if PROMPT does not end
780 : in \":\", followed by optional whitespace), we add it to the prompt.
781 :
782 : The optional argument HISTORY is a symbol to use for the history list.
783 : If nil, uses `regexp-history'."
784 0 : (let* ((defaults
785 0 : (if (and defaults (symbolp defaults))
786 0 : (cond
787 0 : ((eq (or read-regexp-defaults-function defaults)
788 0 : 'regexp-history-last)
789 0 : (car (symbol-value (or history 'regexp-history))))
790 0 : ((functionp (or read-regexp-defaults-function defaults))
791 0 : (funcall (or read-regexp-defaults-function defaults))))
792 0 : defaults))
793 0 : (default (if (consp defaults) (car defaults) defaults))
794 0 : (suggestions (if (listp defaults) defaults (list defaults)))
795 0 : (suggestions (append suggestions (read-regexp-suggestions)))
796 0 : (suggestions (delete-dups (delq nil (delete "" suggestions))))
797 : ;; Do not automatically add default to the history for empty input.
798 : (history-add-new-input nil)
799 0 : (input (read-from-minibuffer
800 0 : (cond ((string-match-p ":[ \t]*\\'" prompt)
801 0 : prompt)
802 0 : ((and default (> (length default) 0))
803 0 : (format "%s (default %s): " prompt
804 0 : (query-replace-descr default)))
805 : (t
806 0 : (format "%s: " prompt)))
807 0 : nil nil nil (or history 'regexp-history) suggestions t)))
808 0 : (if (equal input "")
809 : ;; Return the default value when the user enters empty input.
810 0 : (prog1 (or default input)
811 0 : (when default
812 0 : (add-to-history (or history 'regexp-history) default)))
813 : ;; Otherwise, add non-empty input to the history and return input.
814 0 : (prog1 input
815 0 : (add-to-history (or history 'regexp-history) input)))))
816 :
817 :
818 : (defalias 'delete-non-matching-lines 'keep-lines)
819 : (defalias 'delete-matching-lines 'flush-lines)
820 : (defalias 'count-matches 'how-many)
821 :
822 :
823 : (defun keep-lines-read-args (prompt)
824 : "Read arguments for `keep-lines' and friends.
825 : Prompt for a regexp with PROMPT.
826 : Value is a list, (REGEXP)."
827 0 : (list (read-regexp prompt) nil nil t))
828 :
829 : (defun keep-lines (regexp &optional rstart rend interactive)
830 : "Delete all lines except those containing matches for REGEXP.
831 : A match split across lines preserves all the lines it lies in.
832 : When called from Lisp (and usually interactively as well, see below)
833 : applies to all lines starting after point.
834 :
835 : If REGEXP contains upper case characters (excluding those preceded by `\\')
836 : and `search-upper-case' is non-nil, the matching is case-sensitive.
837 :
838 : Second and third arg RSTART and REND specify the region to operate on.
839 : This command operates on (the accessible part of) all lines whose
840 : accessible part is entirely contained in the region determined by RSTART
841 : and REND. (A newline ending a line counts as part of that line.)
842 :
843 : Interactively, in Transient Mark mode when the mark is active, operate
844 : on all lines whose accessible part is entirely contained in the region.
845 : Otherwise, the command applies to all lines starting after point.
846 : When calling this function from Lisp, you can pretend that it was
847 : called interactively by passing a non-nil INTERACTIVE argument.
848 :
849 : This function starts looking for the next match from the end of
850 : the previous match. Hence, it ignores matches that overlap
851 : a previously found match."
852 : (interactive
853 0 : (progn
854 0 : (barf-if-buffer-read-only)
855 0 : (keep-lines-read-args "Keep lines containing match for regexp")))
856 0 : (if rstart
857 0 : (progn
858 0 : (goto-char (min rstart rend))
859 0 : (setq rend
860 0 : (progn
861 0 : (save-excursion
862 0 : (goto-char (max rstart rend))
863 0 : (unless (or (bolp) (eobp))
864 0 : (forward-line 0))
865 0 : (point-marker)))))
866 0 : (if (and interactive (use-region-p))
867 0 : (setq rstart (region-beginning)
868 0 : rend (progn
869 0 : (goto-char (region-end))
870 0 : (unless (or (bolp) (eobp))
871 0 : (forward-line 0))
872 0 : (point-marker)))
873 0 : (setq rstart (point)
874 0 : rend (point-max-marker)))
875 0 : (goto-char rstart))
876 0 : (save-excursion
877 0 : (or (bolp) (forward-line 1))
878 0 : (let ((start (point))
879 : (case-fold-search
880 0 : (if (and case-fold-search search-upper-case)
881 0 : (isearch-no-upper-case-p regexp t)
882 0 : case-fold-search)))
883 0 : (while (< (point) rend)
884 : ;; Start is first char not preserved by previous match.
885 0 : (if (not (re-search-forward regexp rend 'move))
886 0 : (delete-region start rend)
887 0 : (let ((end (save-excursion (goto-char (match-beginning 0))
888 0 : (forward-line 0)
889 0 : (point))))
890 : ;; Now end is first char preserved by the new match.
891 0 : (if (< start end)
892 0 : (delete-region start end))))
893 :
894 0 : (setq start (save-excursion (forward-line 1) (point)))
895 : ;; If the match was empty, avoid matching again at same place.
896 0 : (and (< (point) rend)
897 0 : (= (match-beginning 0) (match-end 0))
898 0 : (forward-char 1)))))
899 0 : (set-marker rend nil)
900 : nil)
901 :
902 :
903 : (defun flush-lines (regexp &optional rstart rend interactive)
904 : "Delete lines containing matches for REGEXP.
905 : When called from Lisp (and usually when called interactively as
906 : well, see below), applies to the part of the buffer after point.
907 : The line point is in is deleted if and only if it contains a
908 : match for regexp starting after point.
909 :
910 : If REGEXP contains upper case characters (excluding those preceded by `\\')
911 : and `search-upper-case' is non-nil, the matching is case-sensitive.
912 :
913 : Second and third arg RSTART and REND specify the region to operate on.
914 : Lines partially contained in this region are deleted if and only if
915 : they contain a match entirely contained in it.
916 :
917 : Interactively, in Transient Mark mode when the mark is active, operate
918 : on the contents of the region. Otherwise, operate from point to the
919 : end of (the accessible portion of) the buffer. When calling this function
920 : from Lisp, you can pretend that it was called interactively by passing
921 : a non-nil INTERACTIVE argument.
922 :
923 : If a match is split across lines, all the lines it lies in are deleted.
924 : They are deleted _before_ looking for the next match. Hence, a match
925 : starting on the same line at which another match ended is ignored."
926 : (interactive
927 0 : (progn
928 0 : (barf-if-buffer-read-only)
929 0 : (keep-lines-read-args "Flush lines containing match for regexp")))
930 0 : (if rstart
931 0 : (progn
932 0 : (goto-char (min rstart rend))
933 0 : (setq rend (copy-marker (max rstart rend))))
934 0 : (if (and interactive (use-region-p))
935 0 : (setq rstart (region-beginning)
936 0 : rend (copy-marker (region-end)))
937 0 : (setq rstart (point)
938 0 : rend (point-max-marker)))
939 0 : (goto-char rstart))
940 0 : (let ((case-fold-search
941 0 : (if (and case-fold-search search-upper-case)
942 0 : (isearch-no-upper-case-p regexp t)
943 0 : case-fold-search)))
944 0 : (save-excursion
945 0 : (while (and (< (point) rend)
946 0 : (re-search-forward regexp rend t))
947 0 : (delete-region (save-excursion (goto-char (match-beginning 0))
948 0 : (forward-line 0)
949 0 : (point))
950 0 : (progn (forward-line 1) (point))))))
951 0 : (set-marker rend nil)
952 : nil)
953 :
954 :
955 : (defun how-many (regexp &optional rstart rend interactive)
956 : "Print and return number of matches for REGEXP following point.
957 : When called from Lisp and INTERACTIVE is omitted or nil, just return
958 : the number, do not print it; if INTERACTIVE is t, the function behaves
959 : in all respects as if it had been called interactively.
960 :
961 : If REGEXP contains upper case characters (excluding those preceded by `\\')
962 : and `search-upper-case' is non-nil, the matching is case-sensitive.
963 :
964 : Second and third arg RSTART and REND specify the region to operate on.
965 :
966 : Interactively, in Transient Mark mode when the mark is active, operate
967 : on the contents of the region. Otherwise, operate from point to the
968 : end of (the accessible portion of) the buffer.
969 :
970 : This function starts looking for the next match from the end of
971 : the previous match. Hence, it ignores matches that overlap
972 : a previously found match."
973 : (interactive
974 0 : (keep-lines-read-args "How many matches for regexp"))
975 0 : (save-excursion
976 0 : (if rstart
977 0 : (if rend
978 0 : (progn
979 0 : (goto-char (min rstart rend))
980 0 : (setq rend (max rstart rend)))
981 0 : (goto-char rstart)
982 0 : (setq rend (point-max)))
983 0 : (if (and interactive (use-region-p))
984 0 : (setq rstart (region-beginning)
985 0 : rend (region-end))
986 0 : (setq rstart (point)
987 0 : rend (point-max)))
988 0 : (goto-char rstart))
989 0 : (let ((count 0)
990 : opoint
991 : (case-fold-search
992 0 : (if (and case-fold-search search-upper-case)
993 0 : (isearch-no-upper-case-p regexp t)
994 0 : case-fold-search)))
995 0 : (while (and (< (point) rend)
996 0 : (progn (setq opoint (point))
997 0 : (re-search-forward regexp rend t)))
998 0 : (if (= opoint (point))
999 0 : (forward-char 1)
1000 0 : (setq count (1+ count))))
1001 0 : (when interactive (message "%d occurrence%s"
1002 0 : count
1003 0 : (if (= count 1) "" "s")))
1004 0 : count)))
1005 :
1006 :
1007 : (defvar occur-menu-map
1008 : (let ((map (make-sparse-keymap)))
1009 : (bindings--define-key map [next-error-follow-minor-mode]
1010 : '(menu-item "Auto Occurrence Display"
1011 : next-error-follow-minor-mode
1012 : :help "Display another occurrence when moving the cursor"
1013 : :button (:toggle . (and (boundp 'next-error-follow-minor-mode)
1014 : next-error-follow-minor-mode))))
1015 : (bindings--define-key map [separator-1] menu-bar-separator)
1016 : (bindings--define-key map [kill-this-buffer]
1017 : '(menu-item "Kill Occur Buffer" kill-this-buffer
1018 : :help "Kill the current *Occur* buffer"))
1019 : (bindings--define-key map [quit-window]
1020 : '(menu-item "Quit Occur Window" quit-window
1021 : :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame"))
1022 : (bindings--define-key map [revert-buffer]
1023 : '(menu-item "Revert Occur Buffer" revert-buffer
1024 : :help "Replace the text in the *Occur* buffer with the results of rerunning occur"))
1025 : (bindings--define-key map [clone-buffer]
1026 : '(menu-item "Clone Occur Buffer" clone-buffer
1027 : :help "Create and return a twin copy of the current *Occur* buffer"))
1028 : (bindings--define-key map [occur-rename-buffer]
1029 : '(menu-item "Rename Occur Buffer" occur-rename-buffer
1030 : :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*."))
1031 : (bindings--define-key map [occur-edit-buffer]
1032 : '(menu-item "Edit Occur Buffer" occur-edit-mode
1033 : :help "Edit the *Occur* buffer and apply changes to the original buffers."))
1034 : (bindings--define-key map [separator-2] menu-bar-separator)
1035 : (bindings--define-key map [occur-mode-goto-occurrence-other-window]
1036 : '(menu-item "Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window
1037 : :help "Go to the occurrence the current line describes, in another window"))
1038 : (bindings--define-key map [occur-mode-goto-occurrence]
1039 : '(menu-item "Go To Occurrence" occur-mode-goto-occurrence
1040 : :help "Go to the occurrence the current line describes"))
1041 : (bindings--define-key map [occur-mode-display-occurrence]
1042 : '(menu-item "Display Occurrence" occur-mode-display-occurrence
1043 : :help "Display in another window the occurrence the current line describes"))
1044 : (bindings--define-key map [occur-next]
1045 : '(menu-item "Move to Next Match" occur-next
1046 : :help "Move to the Nth (default 1) next match in an Occur mode buffer"))
1047 : (bindings--define-key map [occur-prev]
1048 : '(menu-item "Move to Previous Match" occur-prev
1049 : :help "Move to the Nth (default 1) previous match in an Occur mode buffer"))
1050 : map)
1051 : "Menu keymap for `occur-mode'.")
1052 :
1053 : (defvar occur-mode-map
1054 : (let ((map (make-sparse-keymap)))
1055 : ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto].
1056 : (define-key map [mouse-2] 'occur-mode-mouse-goto)
1057 : (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
1058 : (define-key map "e" 'occur-edit-mode)
1059 : (define-key map "\C-m" 'occur-mode-goto-occurrence)
1060 : (define-key map "o" 'occur-mode-goto-occurrence-other-window)
1061 : (define-key map "\C-o" 'occur-mode-display-occurrence)
1062 : (define-key map "\M-n" 'occur-next)
1063 : (define-key map "\M-p" 'occur-prev)
1064 : (define-key map "r" 'occur-rename-buffer)
1065 : (define-key map "c" 'clone-buffer)
1066 : (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
1067 : (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map))
1068 : map)
1069 : "Keymap for `occur-mode'.")
1070 :
1071 : (defvar occur-revert-arguments nil
1072 : "Arguments to pass to `occur-1' to revert an Occur mode buffer.
1073 : See `occur-revert-function'.")
1074 : (make-variable-buffer-local 'occur-revert-arguments)
1075 : (put 'occur-revert-arguments 'permanent-local t)
1076 :
1077 : (defcustom occur-mode-hook '(turn-on-font-lock)
1078 : "Hook run when entering Occur mode."
1079 : :type 'hook
1080 : :group 'matching)
1081 :
1082 : (defcustom occur-hook nil
1083 : "Hook run by Occur when there are any matches."
1084 : :type 'hook
1085 : :group 'matching)
1086 :
1087 : (defcustom occur-mode-find-occurrence-hook nil
1088 : "Hook run by Occur after locating an occurrence.
1089 : This will be called with the cursor position at the occurrence. An application
1090 : for this is to reveal context in an outline-mode when the occurrence is hidden."
1091 : :type 'hook
1092 : :group 'matching)
1093 :
1094 : (put 'occur-mode 'mode-class 'special)
1095 : (define-derived-mode occur-mode special-mode "Occur"
1096 : "Major mode for output from \\[occur].
1097 : \\<occur-mode-map>Move point to one of the items in this buffer, then use
1098 : \\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to.
1099 : Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
1100 :
1101 : \\{occur-mode-map}"
1102 0 : (set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
1103 0 : (setq next-error-function 'occur-next-error))
1104 :
1105 :
1106 : ;;; Occur Edit mode
1107 :
1108 : (defvar occur-edit-mode-map
1109 : (let ((map (make-sparse-keymap)))
1110 : (set-keymap-parent map text-mode-map)
1111 : (define-key map [mouse-2] 'occur-mode-mouse-goto)
1112 : (define-key map "\C-c\C-c" 'occur-cease-edit)
1113 : (define-key map "\C-o" 'occur-mode-display-occurrence)
1114 : (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
1115 : (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map))
1116 : map)
1117 : "Keymap for `occur-edit-mode'.")
1118 :
1119 : (define-derived-mode occur-edit-mode occur-mode "Occur-Edit"
1120 : "Major mode for editing *Occur* buffers.
1121 : In this mode, changes to the *Occur* buffer are also applied to
1122 : the originating buffer.
1123 :
1124 : To return to ordinary Occur mode, use \\[occur-cease-edit]."
1125 0 : (setq buffer-read-only nil)
1126 0 : (add-hook 'after-change-functions 'occur-after-change-function nil t)
1127 0 : (message (substitute-command-keys
1128 0 : "Editing: Type \\[occur-cease-edit] to return to Occur mode.")))
1129 :
1130 : (defun occur-cease-edit ()
1131 : "Switch from Occur Edit mode to Occur mode."
1132 : (interactive)
1133 0 : (when (derived-mode-p 'occur-edit-mode)
1134 0 : (occur-mode)
1135 0 : (message "Switching to Occur mode.")))
1136 :
1137 : (defun occur-after-change-function (beg end length)
1138 0 : (save-excursion
1139 0 : (goto-char beg)
1140 0 : (let* ((line-beg (line-beginning-position))
1141 0 : (m (get-text-property line-beg 'occur-target))
1142 0 : (buf (marker-buffer m))
1143 : col)
1144 0 : (when (and (get-text-property line-beg 'occur-prefix)
1145 0 : (not (get-text-property end 'occur-prefix)))
1146 0 : (when (= length 0)
1147 : ;; Apply occur-target property to inserted (e.g. yanked) text.
1148 0 : (put-text-property beg end 'occur-target m)
1149 : ;; Did we insert a newline? Occur Edit mode can't create new
1150 : ;; Occur entries; just discard everything after the newline.
1151 0 : (save-excursion
1152 0 : (and (search-forward "\n" end t)
1153 0 : (delete-region (1- (point)) end))))
1154 0 : (let* ((line (- (line-number-at-pos)
1155 0 : (line-number-at-pos (window-start))))
1156 0 : (readonly (with-current-buffer buf buffer-read-only))
1157 0 : (win (or (get-buffer-window buf)
1158 0 : (display-buffer buf
1159 : '(nil (inhibit-same-window . t)
1160 0 : (inhibit-switch-frame . t)))))
1161 0 : (line-end (line-end-position))
1162 0 : (text (save-excursion
1163 0 : (goto-char (next-single-property-change
1164 0 : line-beg 'occur-prefix nil
1165 0 : line-end))
1166 0 : (setq col (- (point) line-beg))
1167 0 : (buffer-substring-no-properties (point) line-end))))
1168 0 : (with-selected-window win
1169 0 : (goto-char m)
1170 0 : (recenter line)
1171 0 : (if readonly
1172 0 : (message "Buffer `%s' is read only." buf)
1173 0 : (delete-region (line-beginning-position) (line-end-position))
1174 0 : (insert text))
1175 0 : (move-to-column col)))))))
1176 :
1177 :
1178 : (defun occur-revert-function (_ignore1 _ignore2)
1179 : "Handle `revert-buffer' for Occur mode buffers."
1180 0 : (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))
1181 :
1182 : (defun occur-mode-find-occurrence ()
1183 0 : (let ((pos (get-text-property (point) 'occur-target)))
1184 0 : (unless pos
1185 0 : (error "No occurrence on this line"))
1186 0 : (unless (buffer-live-p (marker-buffer pos))
1187 0 : (error "Buffer for this occurrence was killed"))
1188 0 : pos))
1189 :
1190 : (defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence)
1191 : (defun occur-mode-goto-occurrence (&optional event)
1192 : "Go to the occurrence on the current line."
1193 0 : (interactive (list last-nonmenu-event))
1194 0 : (let ((pos
1195 0 : (if (null event)
1196 : ;; Actually `event-end' works correctly with a nil argument as
1197 : ;; well, so we could dispense with this test, but let's not
1198 : ;; rely on this undocumented behavior.
1199 0 : (occur-mode-find-occurrence)
1200 0 : (with-current-buffer (window-buffer (posn-window (event-end event)))
1201 0 : (save-excursion
1202 0 : (goto-char (posn-point (event-end event)))
1203 0 : (occur-mode-find-occurrence))))))
1204 0 : (pop-to-buffer (marker-buffer pos))
1205 0 : (goto-char pos)
1206 0 : (run-hooks 'occur-mode-find-occurrence-hook)))
1207 :
1208 : (defun occur-mode-goto-occurrence-other-window ()
1209 : "Go to the occurrence the current line describes, in another window."
1210 : (interactive)
1211 0 : (let ((pos (occur-mode-find-occurrence)))
1212 0 : (switch-to-buffer-other-window (marker-buffer pos))
1213 0 : (goto-char pos)
1214 0 : (run-hooks 'occur-mode-find-occurrence-hook)))
1215 :
1216 : (defun occur-mode-display-occurrence ()
1217 : "Display in another window the occurrence the current line describes."
1218 : (interactive)
1219 0 : (let ((pos (occur-mode-find-occurrence))
1220 : window)
1221 0 : (setq window (display-buffer (marker-buffer pos) t))
1222 : ;; This is the way to set point in the proper window.
1223 0 : (save-selected-window
1224 0 : (select-window window)
1225 0 : (goto-char pos)
1226 0 : (run-hooks 'occur-mode-find-occurrence-hook))))
1227 :
1228 : (defun occur-find-match (n search message)
1229 0 : (if (not n) (setq n 1))
1230 0 : (let ((r))
1231 0 : (while (> n 0)
1232 0 : (setq r (funcall search (point) 'occur-match))
1233 0 : (and r
1234 0 : (get-text-property r 'occur-match)
1235 0 : (setq r (funcall search r 'occur-match)))
1236 0 : (if r
1237 0 : (goto-char r)
1238 0 : (error message))
1239 0 : (setq n (1- n)))))
1240 :
1241 : (defun occur-next (&optional n)
1242 : "Move to the Nth (default 1) next match in an Occur mode buffer."
1243 : (interactive "p")
1244 0 : (occur-find-match n #'next-single-property-change "No more matches"))
1245 :
1246 : (defun occur-prev (&optional n)
1247 : "Move to the Nth (default 1) previous match in an Occur mode buffer."
1248 : (interactive "p")
1249 0 : (occur-find-match n #'previous-single-property-change "No earlier matches"))
1250 :
1251 : (defun occur-next-error (&optional argp reset)
1252 : "Move to the Nth (default 1) next match in an Occur mode buffer.
1253 : Compatibility function for \\[next-error] invocations."
1254 : (interactive "p")
1255 : ;; we need to run occur-find-match from within the Occur buffer
1256 0 : (with-current-buffer
1257 : ;; Choose the buffer and make it current.
1258 0 : (if (next-error-buffer-p (current-buffer))
1259 0 : (current-buffer)
1260 0 : (next-error-find-buffer nil nil
1261 : (lambda ()
1262 0 : (eq major-mode 'occur-mode))))
1263 :
1264 0 : (goto-char (cond (reset (point-min))
1265 0 : ((< argp 0) (line-beginning-position))
1266 0 : ((> argp 0) (line-end-position))
1267 0 : ((point))))
1268 0 : (occur-find-match
1269 0 : (abs argp)
1270 0 : (if (> 0 argp)
1271 0 : #'previous-single-property-change
1272 0 : #'next-single-property-change)
1273 0 : "No more matches")
1274 : ;; In case the *Occur* buffer is visible in a nonselected window.
1275 0 : (let ((win (get-buffer-window (current-buffer) t)))
1276 0 : (if win (set-window-point win (point))))
1277 0 : (occur-mode-goto-occurrence)))
1278 :
1279 : (defface match
1280 : '((((class color) (min-colors 88) (background light))
1281 : :background "yellow1")
1282 : (((class color) (min-colors 88) (background dark))
1283 : :background "RoyalBlue3")
1284 : (((class color) (min-colors 8) (background light))
1285 : :background "yellow" :foreground "black")
1286 : (((class color) (min-colors 8) (background dark))
1287 : :background "blue" :foreground "white")
1288 : (((type tty) (class mono))
1289 : :inverse-video t)
1290 : (t :background "gray"))
1291 : "Face used to highlight matches permanently."
1292 : :group 'matching
1293 : :group 'basic-faces
1294 : :version "22.1")
1295 :
1296 : (defcustom list-matching-lines-default-context-lines 0
1297 : "Default number of context lines included around `list-matching-lines' matches.
1298 : A negative number means to include that many lines before the match.
1299 : A positive number means to include that many lines both before and after."
1300 : :type 'integer
1301 : :group 'matching)
1302 :
1303 : (defalias 'list-matching-lines 'occur)
1304 :
1305 : (defcustom list-matching-lines-face 'match
1306 : "Face used by \\[list-matching-lines] to show the text that matches.
1307 : If the value is nil, don't highlight the matching portions specially."
1308 : :type 'face
1309 : :group 'matching)
1310 :
1311 : (defcustom list-matching-lines-buffer-name-face 'underline
1312 : "Face used by \\[list-matching-lines] to show the names of buffers.
1313 : If the value is nil, don't highlight the buffer names specially."
1314 : :type 'face
1315 : :group 'matching)
1316 :
1317 : (defcustom list-matching-lines-current-line-face 'lazy-highlight
1318 : "Face used by \\[list-matching-lines] to highlight the current line."
1319 : :type 'face
1320 : :group 'matching
1321 : :version "26.1")
1322 :
1323 : (defcustom list-matching-lines-jump-to-current-line nil
1324 : "If non-nil, \\[list-matching-lines] shows the current line highlighted.
1325 : Set the point right after such line when there are matches after it."
1326 : :type 'boolean
1327 : :group 'matching
1328 : :version "26.1")
1329 :
1330 : (defcustom list-matching-lines-prefix-face 'shadow
1331 : "Face used by \\[list-matching-lines] to show the prefix column.
1332 : If the face doesn't differ from the default face,
1333 : don't highlight the prefix with line numbers specially."
1334 : :type 'face
1335 : :group 'matching
1336 : :version "24.4")
1337 :
1338 : (defcustom occur-excluded-properties
1339 : '(read-only invisible intangible field mouse-face help-echo local-map keymap
1340 : yank-handler follow-link)
1341 : "Text properties to discard when copying lines to the *Occur* buffer.
1342 : The value should be a list of text properties to discard or t,
1343 : which means to discard all text properties."
1344 : :type '(choice (const :tag "All" t) (repeat symbol))
1345 : :group 'matching
1346 : :version "22.1")
1347 :
1348 : (defun occur-read-primary-args ()
1349 0 : (let* ((perform-collect (consp current-prefix-arg))
1350 0 : (regexp (read-regexp (if perform-collect
1351 : "Collect strings matching regexp"
1352 0 : "List lines matching regexp")
1353 0 : 'regexp-history-last)))
1354 0 : (list regexp
1355 0 : (if perform-collect
1356 : ;; Perform collect operation
1357 0 : (if (zerop (regexp-opt-depth regexp))
1358 : ;; No subexpression so collect the entire match.
1359 : "\\&"
1360 : ;; Get the regexp for collection pattern.
1361 0 : (let ((default (car occur-collect-regexp-history)))
1362 0 : (read-regexp
1363 0 : (format "Regexp to collect (default %s): " default)
1364 0 : default 'occur-collect-regexp-history)))
1365 : ;; Otherwise normal occur takes numerical prefix argument.
1366 0 : (when current-prefix-arg
1367 0 : (prefix-numeric-value current-prefix-arg))))))
1368 :
1369 : (defun occur-rename-buffer (&optional unique-p interactive-p)
1370 : "Rename the current *Occur* buffer to *Occur: original-buffer-name*.
1371 : Here `original-buffer-name' is the buffer name where Occur was originally run.
1372 : When given the prefix argument, or called non-interactively, the renaming
1373 : will not clobber the existing buffer(s) of that name, but use
1374 : `generate-new-buffer-name' instead. You can add this to `occur-hook'
1375 : if you always want a separate *Occur* buffer for each buffer where you
1376 : invoke `occur'."
1377 : (interactive "P\np")
1378 0 : (with-current-buffer
1379 0 : (if (eq major-mode 'occur-mode) (current-buffer) (get-buffer "*Occur*"))
1380 0 : (rename-buffer (concat "*Occur: "
1381 0 : (mapconcat #'buffer-name
1382 0 : (car (cddr occur-revert-arguments)) "/")
1383 0 : "*")
1384 0 : (or unique-p (not interactive-p)))))
1385 :
1386 : ;; Region limits when `occur' applies on a region.
1387 : (defvar occur--region-start nil)
1388 : (defvar occur--region-end nil)
1389 : (defvar occur--matches-threshold nil)
1390 : (defvar occur--orig-line nil)
1391 : (defvar occur--orig-line-str nil)
1392 : (defvar occur--final-pos nil)
1393 :
1394 : (defun occur (regexp &optional nlines region)
1395 : "Show all lines in the current buffer containing a match for REGEXP.
1396 : If a match spreads across multiple lines, all those lines are shown.
1397 :
1398 : Each match is extended to include complete lines. Only non-overlapping
1399 : matches are considered. (Note that extending matches to complete
1400 : lines could cause some of the matches to overlap; if so, they will not
1401 : be shown as separate matches.)
1402 :
1403 : Each line is displayed with NLINES lines before and after, or -NLINES
1404 : before if NLINES is negative.
1405 : NLINES defaults to `list-matching-lines-default-context-lines'.
1406 : Interactively it is the prefix arg.
1407 :
1408 : Optional arg REGION, if non-nil, mean restrict search to the
1409 : specified region. Otherwise search the entire buffer.
1410 : REGION must be a list of (START . END) positions as returned by
1411 : `region-bounds'.
1412 :
1413 : The lines are shown in a buffer named `*Occur*'.
1414 : It serves as a menu to find any of the occurrences in this buffer.
1415 : \\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
1416 : If `list-matching-lines-jump-to-current-line' is non-nil, then show
1417 : the current line highlighted with `list-matching-lines-current-line-face'
1418 : and set point at the first match after such line.
1419 :
1420 : If REGEXP contains upper case characters (excluding those preceded by `\\')
1421 : and `search-upper-case' is non-nil, the matching is case-sensitive.
1422 :
1423 : When NLINES is a string or when the function is called
1424 : interactively with prefix argument without a number (`C-u' alone
1425 : as prefix) the matching strings are collected into the `*Occur*'
1426 : buffer by using NLINES as a replacement regexp. NLINES may
1427 : contain \\& and \\N which convention follows `replace-match'.
1428 : For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and
1429 : \"\\1\" for NLINES collects all the function names in a lisp
1430 : program. When there is no parenthesized subexpressions in REGEXP
1431 : the entire match is collected. In any case the searched buffer
1432 : is not modified."
1433 : (interactive
1434 0 : (nconc (occur-read-primary-args)
1435 0 : (and (use-region-p) (list (region-bounds)))))
1436 0 : (let* ((start (and (caar region) (max (caar region) (point-min))))
1437 0 : (end (and (cdar region) (min (cdar region) (point-max))))
1438 0 : (in-region-p (or start end)))
1439 0 : (when in-region-p
1440 0 : (or start (setq start (point-min)))
1441 0 : (or end (setq end (point-max))))
1442 0 : (let ((occur--region-start start)
1443 0 : (occur--region-end end)
1444 : (occur--matches-threshold
1445 0 : (and in-region-p
1446 0 : (line-number-at-pos (min start end))))
1447 : (occur--orig-line
1448 0 : (line-number-at-pos (point)))
1449 : (occur--orig-line-str
1450 0 : (buffer-substring-no-properties
1451 0 : (line-beginning-position)
1452 0 : (line-end-position))))
1453 0 : (save-excursion ; If no matches `occur-1' doesn't restore the point.
1454 0 : (and in-region-p (narrow-to-region start end))
1455 0 : (occur-1 regexp nlines (list (current-buffer)))
1456 0 : (and in-region-p (widen))))))
1457 :
1458 : (defvar ido-ignore-item-temp-list)
1459 :
1460 : (defun multi-occur (bufs regexp &optional nlines)
1461 : "Show all lines in buffers BUFS containing a match for REGEXP.
1462 : This function acts on multiple buffers; otherwise, it is exactly like
1463 : `occur'. When you invoke this command interactively, you must specify
1464 : the buffer names that you want, one by one.
1465 : See also `multi-occur-in-matching-buffers'."
1466 : (interactive
1467 0 : (cons
1468 0 : (let* ((bufs (list (read-buffer "First buffer to search: "
1469 0 : (current-buffer) t)))
1470 : (buf nil)
1471 0 : (ido-ignore-item-temp-list bufs))
1472 0 : (while (not (string-equal
1473 0 : (setq buf (read-buffer
1474 0 : (if (eq read-buffer-function #'ido-read-buffer)
1475 : "Next buffer to search (C-j to end): "
1476 0 : "Next buffer to search (RET to end): ")
1477 0 : nil t))
1478 0 : ""))
1479 0 : (cl-pushnew buf bufs)
1480 0 : (setq ido-ignore-item-temp-list bufs))
1481 0 : (nreverse (mapcar #'get-buffer bufs)))
1482 0 : (occur-read-primary-args)))
1483 0 : (occur-1 regexp nlines bufs))
1484 :
1485 : (defun multi-occur-in-matching-buffers (bufregexp regexp &optional allbufs)
1486 : "Show all lines matching REGEXP in buffers specified by BUFREGEXP.
1487 : Normally BUFREGEXP matches against each buffer's visited file name,
1488 : but if you specify a prefix argument, it matches against the buffer name.
1489 : See also `multi-occur'."
1490 : (interactive
1491 0 : (cons
1492 0 : (let* ((default (car regexp-history))
1493 : (input
1494 0 : (read-regexp
1495 0 : (if current-prefix-arg
1496 : "List lines in buffers whose names match regexp: "
1497 0 : "List lines in buffers whose filenames match regexp: "))))
1498 0 : (if (equal input "")
1499 0 : default
1500 0 : input))
1501 0 : (occur-read-primary-args)))
1502 0 : (when bufregexp
1503 0 : (occur-1 regexp nil
1504 0 : (delq nil
1505 0 : (mapcar (lambda (buf)
1506 0 : (when (if allbufs
1507 0 : (string-match bufregexp
1508 0 : (buffer-name buf))
1509 0 : (and (buffer-file-name buf)
1510 0 : (string-match bufregexp
1511 0 : (buffer-file-name buf))))
1512 0 : buf))
1513 0 : (buffer-list))))))
1514 :
1515 : (defun occur-regexp-descr (regexp)
1516 0 : (format " for %s\"%s\""
1517 0 : (or (get-text-property 0 'isearch-regexp-function-descr regexp)
1518 0 : "")
1519 0 : (if (get-text-property 0 'isearch-string regexp)
1520 0 : (propertize
1521 0 : (query-replace-descr
1522 0 : (get-text-property 0 'isearch-string regexp))
1523 0 : 'help-echo regexp)
1524 0 : (query-replace-descr regexp))))
1525 :
1526 : (defun occur-1 (regexp nlines bufs &optional buf-name)
1527 0 : (unless (and regexp (not (equal regexp "")))
1528 0 : (error "Occur doesn't work with the empty regexp"))
1529 0 : (unless buf-name
1530 0 : (setq buf-name "*Occur*"))
1531 0 : (let (occur-buf
1532 0 : (active-bufs (delq nil (mapcar #'(lambda (buf)
1533 0 : (when (buffer-live-p buf) buf))
1534 0 : bufs))))
1535 : ;; Handle the case where one of the buffers we're searching is the
1536 : ;; output buffer. Just rename it.
1537 0 : (when (member buf-name (mapcar 'buffer-name active-bufs))
1538 0 : (with-current-buffer (get-buffer buf-name)
1539 0 : (rename-uniquely)))
1540 :
1541 : ;; Now find or create the output buffer.
1542 : ;; If we just renamed that buffer, we will make a new one here.
1543 0 : (setq occur-buf (get-buffer-create buf-name))
1544 :
1545 0 : (with-current-buffer occur-buf
1546 0 : (if (stringp nlines)
1547 0 : (fundamental-mode) ;; This is for collect operation.
1548 0 : (occur-mode))
1549 0 : (let ((inhibit-read-only t)
1550 : ;; Don't generate undo entries for creation of the initial contents.
1551 : (buffer-undo-list t)
1552 : (occur--final-pos nil))
1553 0 : (erase-buffer)
1554 0 : (let ((count
1555 0 : (if (stringp nlines)
1556 : ;; Treat nlines as a regexp to collect.
1557 0 : (let ((bufs active-bufs)
1558 : (count 0))
1559 0 : (while bufs
1560 0 : (with-current-buffer (car bufs)
1561 0 : (save-excursion
1562 0 : (goto-char (point-min))
1563 0 : (while (re-search-forward regexp nil t)
1564 : ;; Insert the replacement regexp.
1565 0 : (let ((str (match-substitute-replacement nlines)))
1566 0 : (if str
1567 0 : (with-current-buffer occur-buf
1568 0 : (insert str)
1569 0 : (setq count (1+ count))
1570 0 : (or (zerop (current-column))
1571 0 : (insert "\n"))))))))
1572 0 : (setq bufs (cdr bufs)))
1573 0 : count)
1574 : ;; Perform normal occur.
1575 0 : (occur-engine
1576 0 : regexp active-bufs occur-buf
1577 0 : (or nlines list-matching-lines-default-context-lines)
1578 0 : (if (and case-fold-search search-upper-case)
1579 0 : (isearch-no-upper-case-p regexp t)
1580 0 : case-fold-search)
1581 0 : list-matching-lines-buffer-name-face
1582 0 : (if (face-differs-from-default-p list-matching-lines-prefix-face)
1583 0 : list-matching-lines-prefix-face)
1584 0 : list-matching-lines-face
1585 0 : (not (eq occur-excluded-properties t))))))
1586 0 : (let* ((bufcount (length active-bufs))
1587 0 : (diff (- (length bufs) bufcount)))
1588 0 : (message "Searched %d buffer%s%s; %s match%s%s"
1589 0 : bufcount (if (= bufcount 1) "" "s")
1590 0 : (if (zerop diff) "" (format " (%d killed)" diff))
1591 0 : (if (zerop count) "no" (format "%d" count))
1592 0 : (if (= count 1) "" "es")
1593 : ;; Don't display regexp if with remaining text
1594 : ;; it is longer than window-width.
1595 0 : (if (> (+ (length (or (get-text-property 0 'isearch-string regexp)
1596 0 : regexp))
1597 0 : 42)
1598 0 : (window-width))
1599 0 : "" (occur-regexp-descr regexp))))
1600 0 : (setq occur-revert-arguments (list regexp nlines bufs))
1601 0 : (if (= count 0)
1602 0 : (kill-buffer occur-buf)
1603 0 : (display-buffer occur-buf)
1604 0 : (when occur--final-pos
1605 0 : (set-window-point
1606 0 : (get-buffer-window occur-buf 'all-frames)
1607 0 : occur--final-pos))
1608 0 : (setq next-error-last-buffer occur-buf)
1609 0 : (setq buffer-read-only t)
1610 0 : (set-buffer-modified-p nil)
1611 0 : (run-hooks 'occur-hook)))))))
1612 :
1613 : (defun occur-engine (regexp buffers out-buf nlines case-fold
1614 : title-face prefix-face match-face keep-props)
1615 0 : (with-current-buffer out-buf
1616 0 : (let ((global-lines 0) ;; total count of matching lines
1617 : (global-matches 0) ;; total count of matches
1618 : (coding nil)
1619 0 : (case-fold-search case-fold)
1620 0 : (in-region-p (and occur--region-start occur--region-end))
1621 0 : (multi-occur-p (cdr buffers)))
1622 : ;; Map over all the buffers
1623 0 : (dolist (buf buffers)
1624 0 : (when (buffer-live-p buf)
1625 0 : (let ((lines 0) ;; count of matching lines
1626 : (matches 0) ;; count of matches
1627 : (curr-line ;; line count
1628 0 : (or occur--matches-threshold 1))
1629 0 : (orig-line occur--orig-line)
1630 0 : (orig-line-str occur--orig-line-str)
1631 : (orig-line-shown-p)
1632 : (prev-line nil) ;; line number of prev match endpt
1633 : (prev-after-lines nil) ;; context lines of prev match
1634 : (matchbeg 0)
1635 : (origpt nil)
1636 : (begpt nil)
1637 : (endpt nil)
1638 : (finalpt nil)
1639 : (marker nil)
1640 : (curstring "")
1641 : (ret nil)
1642 : (inhibit-field-text-motion t)
1643 0 : (headerpt (with-current-buffer out-buf (point))))
1644 0 : (with-current-buffer buf
1645 0 : (or coding
1646 : ;; Set CODING only if the current buffer locally
1647 : ;; binds buffer-file-coding-system.
1648 0 : (not (local-variable-p 'buffer-file-coding-system))
1649 0 : (setq coding buffer-file-coding-system))
1650 0 : (save-excursion
1651 0 : (goto-char (point-min)) ;; begin searching in the buffer
1652 0 : (while (not (eobp))
1653 0 : (setq origpt (point))
1654 0 : (when (setq endpt (re-search-forward regexp nil t))
1655 0 : (setq lines (1+ lines)) ;; increment matching lines count
1656 0 : (setq matchbeg (match-beginning 0))
1657 : ;; Get beginning of first match line and end of the last.
1658 0 : (save-excursion
1659 0 : (goto-char matchbeg)
1660 0 : (setq begpt (line-beginning-position))
1661 0 : (goto-char endpt)
1662 0 : (setq endpt (line-end-position)))
1663 : ;; Sum line numbers up to the first match line.
1664 0 : (setq curr-line (+ curr-line (count-lines origpt begpt)))
1665 0 : (setq marker (make-marker))
1666 0 : (set-marker marker matchbeg)
1667 0 : (setq curstring (occur-engine-line begpt endpt keep-props))
1668 : ;; Highlight the matches
1669 0 : (let ((len (length curstring))
1670 : (start 0))
1671 : ;; Count empty lines that don't use next loop (Bug#22062).
1672 0 : (when (zerop len)
1673 0 : (setq matches (1+ matches)))
1674 0 : (while (and (< start len)
1675 0 : (string-match regexp curstring start))
1676 0 : (setq matches (1+ matches))
1677 0 : (add-text-properties
1678 0 : (match-beginning 0) (match-end 0)
1679 0 : '(occur-match t) curstring)
1680 0 : (when match-face
1681 : ;; Add `match-face' to faces copied from the buffer.
1682 0 : (add-face-text-property
1683 0 : (match-beginning 0) (match-end 0)
1684 0 : match-face nil curstring))
1685 : ;; Avoid infloop (Bug#7593).
1686 0 : (let ((end (match-end 0)))
1687 0 : (setq start (if (= start end) (1+ start) end)))))
1688 : ;; Generate the string to insert for this match
1689 0 : (let* ((match-prefix
1690 : ;; Using 7 digits aligns tabs properly.
1691 0 : (apply #'propertize (format "%7d:" curr-line)
1692 0 : (append
1693 0 : (when prefix-face
1694 0 : `(font-lock-face ,prefix-face))
1695 0 : `(occur-prefix t mouse-face (highlight)
1696 : ;; Allow insertion of text at
1697 : ;; the end of the prefix (for
1698 : ;; Occur Edit mode).
1699 : front-sticky t rear-nonsticky t
1700 0 : occur-target ,marker follow-link t
1701 0 : help-echo "mouse-2: go to this occurrence"))))
1702 : (match-str
1703 : ;; We don't put `mouse-face' on the newline,
1704 : ;; because that loses. And don't put it
1705 : ;; on context lines to reduce flicker.
1706 0 : (propertize curstring 'mouse-face (list 'highlight)
1707 0 : 'occur-target marker
1708 : 'follow-link t
1709 : 'help-echo
1710 0 : "mouse-2: go to this occurrence"))
1711 : (out-line
1712 0 : (concat
1713 0 : match-prefix
1714 : ;; Add non-numeric prefix to all non-first lines
1715 : ;; of multi-line matches.
1716 0 : (replace-regexp-in-string
1717 : "\n"
1718 0 : (if prefix-face
1719 0 : (propertize "\n :" 'font-lock-face prefix-face)
1720 0 : "\n :")
1721 0 : match-str)
1722 : ;; Add marker at eol, but no mouse props.
1723 0 : (propertize "\n" 'occur-target marker)))
1724 : (data
1725 0 : (if (= nlines 0)
1726 : ;; The simple display style
1727 0 : out-line
1728 : ;; The complex multi-line display style.
1729 0 : (setq ret (occur-context-lines
1730 0 : out-line nlines keep-props begpt endpt
1731 0 : curr-line prev-line prev-after-lines
1732 0 : prefix-face))
1733 : ;; Set first elem of the returned list to `data',
1734 : ;; and the second elem to `prev-after-lines'.
1735 0 : (setq prev-after-lines (nth 1 ret))
1736 0 : (nth 0 ret))))
1737 : ;; Actually insert the match display data
1738 0 : (with-current-buffer out-buf
1739 0 : (when (and list-matching-lines-jump-to-current-line
1740 0 : (not multi-occur-p)
1741 0 : (not orig-line-shown-p)
1742 0 : (>= curr-line orig-line))
1743 0 : (insert
1744 0 : (concat
1745 0 : (propertize
1746 0 : (format "%7d:%s" orig-line orig-line-str)
1747 0 : 'face list-matching-lines-current-line-face
1748 : 'mouse-face 'mode-line-highlight
1749 0 : 'help-echo "Current line") "\n"))
1750 0 : (setq orig-line-shown-p t finalpt (point)))
1751 0 : (insert data)))
1752 0 : (goto-char endpt))
1753 0 : (if endpt
1754 0 : (progn
1755 : ;; Sum line numbers between first and last match lines.
1756 0 : (setq curr-line (+ curr-line (count-lines begpt endpt)
1757 : ;; Add 1 for empty last match line since
1758 : ;; count-lines returns 1 line less.
1759 0 : (if (and (bolp) (eolp)) 1 0)))
1760 : ;; On to the next match...
1761 0 : (forward-line 1))
1762 0 : (goto-char (point-max)))
1763 0 : (setq prev-line (1- curr-line)))
1764 : ;; Insert original line if haven't done yet.
1765 0 : (when (and list-matching-lines-jump-to-current-line
1766 0 : (not multi-occur-p)
1767 0 : (not orig-line-shown-p))
1768 0 : (with-current-buffer out-buf
1769 0 : (insert
1770 0 : (concat
1771 0 : (propertize
1772 0 : (format "%7d:%s" orig-line orig-line-str)
1773 0 : 'face list-matching-lines-current-line-face
1774 : 'mouse-face 'mode-line-highlight
1775 0 : 'help-echo "Current line") "\n"))))
1776 : ;; Flush remaining context after-lines.
1777 0 : (when prev-after-lines
1778 0 : (with-current-buffer out-buf
1779 0 : (insert (apply #'concat (occur-engine-add-prefix
1780 0 : prev-after-lines prefix-face)))))))
1781 0 : (when (not (zerop lines)) ;; is the count zero?
1782 0 : (setq global-lines (+ global-lines lines)
1783 0 : global-matches (+ global-matches matches))
1784 0 : (with-current-buffer out-buf
1785 0 : (goto-char headerpt)
1786 0 : (let ((beg (point))
1787 : end)
1788 0 : (insert (propertize
1789 0 : (format "%d match%s%s%s in buffer: %s%s\n"
1790 0 : matches (if (= matches 1) "" "es")
1791 : ;; Don't display the same number of lines
1792 : ;; and matches in case of 1 match per line.
1793 0 : (if (= lines matches)
1794 0 : "" (format " in %d line%s"
1795 0 : lines (if (= lines 1) "" "s")))
1796 : ;; Don't display regexp for multi-buffer.
1797 0 : (if (> (length buffers) 1)
1798 0 : "" (occur-regexp-descr regexp))
1799 0 : (buffer-name buf)
1800 0 : (if in-region-p
1801 0 : (format " within region: %d-%d"
1802 0 : occur--region-start
1803 0 : occur--region-end)
1804 0 : ""))
1805 0 : 'read-only t))
1806 0 : (setq end (point))
1807 0 : (add-text-properties beg end `(occur-title ,buf))
1808 0 : (when title-face
1809 0 : (add-face-text-property beg end title-face))
1810 0 : (goto-char (if finalpt
1811 0 : (setq occur--final-pos
1812 0 : (cl-incf finalpt (- end beg)))
1813 0 : (point-min)))))))))
1814 : ;; Display total match count and regexp for multi-buffer.
1815 0 : (when (and (not (zerop global-lines)) (> (length buffers) 1))
1816 0 : (goto-char (point-min))
1817 0 : (let ((beg (point))
1818 : end)
1819 0 : (insert (format "%d match%s%s total%s:\n"
1820 0 : global-matches (if (= global-matches 1) "" "es")
1821 : ;; Don't display the same number of lines
1822 : ;; and matches in case of 1 match per line.
1823 0 : (if (= global-lines global-matches)
1824 0 : "" (format " in %d line%s"
1825 0 : global-lines (if (= global-lines 1) "" "s")))
1826 0 : (occur-regexp-descr regexp)))
1827 0 : (setq end (point))
1828 0 : (when title-face
1829 0 : (add-face-text-property beg end title-face)))
1830 0 : (goto-char (point-min)))
1831 0 : (if coding
1832 : ;; CODING is buffer-file-coding-system of the first buffer
1833 : ;; that locally binds it. Let's use it also for the output
1834 : ;; buffer.
1835 0 : (set-buffer-file-coding-system coding))
1836 : ;; Return the number of matches
1837 0 : global-matches)))
1838 :
1839 : (defun occur-engine-line (beg end &optional keep-props)
1840 0 : (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
1841 0 : (text-property-not-all beg end 'fontified t))
1842 0 : (if (fboundp 'jit-lock-fontify-now)
1843 0 : (jit-lock-fontify-now beg end)))
1844 0 : (if (and keep-props (not (eq occur-excluded-properties t)))
1845 0 : (let ((str (buffer-substring beg end)))
1846 0 : (remove-list-of-text-properties
1847 0 : 0 (length str) occur-excluded-properties str)
1848 0 : str)
1849 0 : (buffer-substring-no-properties beg end)))
1850 :
1851 : (defun occur-engine-add-prefix (lines &optional prefix-face)
1852 0 : (mapcar
1853 0 : #'(lambda (line)
1854 0 : (concat (if prefix-face
1855 0 : (propertize " :" 'font-lock-face prefix-face)
1856 0 : " :")
1857 0 : line "\n"))
1858 0 : lines))
1859 :
1860 : (defun occur-accumulate-lines (count &optional keep-props pt)
1861 0 : (save-excursion
1862 0 : (when pt
1863 0 : (goto-char pt))
1864 0 : (let ((forwardp (> count 0))
1865 : result beg end moved)
1866 0 : (while (not (or (zerop count)
1867 0 : (if forwardp
1868 0 : (eobp)
1869 0 : (and (bobp) (not moved)))))
1870 0 : (setq count (+ count (if forwardp -1 1)))
1871 0 : (setq beg (line-beginning-position)
1872 0 : end (line-end-position))
1873 0 : (push (occur-engine-line beg end keep-props) result)
1874 0 : (setq moved (= 0 (forward-line (if forwardp 1 -1)))))
1875 0 : (nreverse result))))
1876 :
1877 : ;; Generate context display for occur.
1878 : ;; OUT-LINE is the line where the match is.
1879 : ;; NLINES and KEEP-PROPS are args to occur-engine.
1880 : ;; CURR-LINE is line count of the current match,
1881 : ;; PREV-LINE is line count of the previous match,
1882 : ;; PREV-AFTER-LINES is a list of after-context lines of the previous match.
1883 : ;; Generate a list of lines, add prefixes to all but OUT-LINE,
1884 : ;; then concatenate them all together.
1885 : (defun occur-context-lines (out-line nlines keep-props begpt endpt
1886 : curr-line prev-line prev-after-lines
1887 : &optional prefix-face)
1888 : ;; Find after- and before-context lines of the current match.
1889 0 : (let ((before-lines
1890 0 : (nreverse (cdr (occur-accumulate-lines
1891 0 : (- (1+ (abs nlines))) keep-props begpt))))
1892 : (after-lines
1893 0 : (cdr (occur-accumulate-lines
1894 0 : (1+ nlines) keep-props endpt)))
1895 : separator)
1896 :
1897 : ;; Combine after-lines of the previous match
1898 : ;; with before-lines of the current match.
1899 :
1900 0 : (when prev-after-lines
1901 : ;; Don't overlap prev after-lines with current before-lines.
1902 0 : (if (>= (+ prev-line (length prev-after-lines))
1903 0 : (- curr-line (length before-lines)))
1904 0 : (setq prev-after-lines
1905 0 : (butlast prev-after-lines
1906 0 : (- (length prev-after-lines)
1907 0 : (- curr-line prev-line (length before-lines) 1))))
1908 : ;; Separate non-overlapping context lines with a dashed line.
1909 0 : (setq separator "-------\n")))
1910 :
1911 0 : (when prev-line
1912 : ;; Don't overlap current before-lines with previous match line.
1913 0 : (if (<= (- curr-line (length before-lines))
1914 0 : prev-line)
1915 0 : (setq before-lines
1916 0 : (nthcdr (- (length before-lines)
1917 0 : (- curr-line prev-line 1))
1918 0 : before-lines))
1919 : ;; Separate non-overlapping before-context lines.
1920 0 : (unless (> nlines 0)
1921 0 : (setq separator "-------\n"))))
1922 :
1923 0 : (list
1924 : ;; Return a list where the first element is the output line.
1925 0 : (apply #'concat
1926 0 : (append
1927 0 : (if prev-after-lines
1928 0 : (occur-engine-add-prefix prev-after-lines prefix-face))
1929 0 : (if separator
1930 0 : (list (if prefix-face
1931 0 : (propertize separator 'font-lock-face prefix-face)
1932 0 : separator)))
1933 0 : (occur-engine-add-prefix before-lines prefix-face)
1934 0 : (list out-line)))
1935 : ;; And the second element is the list of context after-lines.
1936 0 : (if (> nlines 0) after-lines))))
1937 :
1938 :
1939 : ;; It would be nice to use \\[...], but there is no reasonable way
1940 : ;; to make that display both SPC and Y.
1941 : (defconst query-replace-help
1942 : "Type Space or `y' to replace one match, Delete or `n' to skip to next,
1943 : RET or `q' to exit, Period to replace one match and exit,
1944 : Comma to replace but not move point immediately,
1945 : C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
1946 : C-w to delete match and recursive edit,
1947 : C-l to clear the screen, redisplay, and offer same replacement again,
1948 : ! to replace all remaining matches in this buffer with no more questions,
1949 : ^ to move point back to previous match,
1950 : u to undo previous replacement,
1951 : U to undo all replacements,
1952 : E to edit the replacement string.
1953 : In multi-buffer replacements type `Y' to replace all remaining
1954 : matches in all remaining buffers with no more questions,
1955 : `N' to skip to the next buffer without replacing remaining matches
1956 : in the current buffer."
1957 : "Help message while in `query-replace'.")
1958 :
1959 : (defvar query-replace-map
1960 : (let ((map (make-sparse-keymap)))
1961 : (define-key map " " 'act)
1962 : (define-key map "\d" 'skip)
1963 : (define-key map [delete] 'skip)
1964 : (define-key map [backspace] 'skip)
1965 : (define-key map "y" 'act)
1966 : (define-key map "n" 'skip)
1967 : (define-key map "Y" 'act)
1968 : (define-key map "N" 'skip)
1969 : (define-key map "e" 'edit-replacement)
1970 : (define-key map "E" 'edit-replacement)
1971 : (define-key map "," 'act-and-show)
1972 : (define-key map "q" 'exit)
1973 : (define-key map "\r" 'exit)
1974 : (define-key map [return] 'exit)
1975 : (define-key map "." 'act-and-exit)
1976 : (define-key map "\C-r" 'edit)
1977 : (define-key map "\C-w" 'delete-and-edit)
1978 : (define-key map "\C-l" 'recenter)
1979 : (define-key map "!" 'automatic)
1980 : (define-key map "^" 'backup)
1981 : (define-key map "u" 'undo)
1982 : (define-key map "U" 'undo-all)
1983 : (define-key map "\C-h" 'help)
1984 : (define-key map [f1] 'help)
1985 : (define-key map [help] 'help)
1986 : (define-key map "?" 'help)
1987 : (define-key map "\C-g" 'quit)
1988 : (define-key map "\C-]" 'quit)
1989 : (define-key map "\C-v" 'scroll-up)
1990 : (define-key map "\M-v" 'scroll-down)
1991 : (define-key map [next] 'scroll-up)
1992 : (define-key map [prior] 'scroll-down)
1993 : (define-key map [?\C-\M-v] 'scroll-other-window)
1994 : (define-key map [M-next] 'scroll-other-window)
1995 : (define-key map [?\C-\M-\S-v] 'scroll-other-window-down)
1996 : (define-key map [M-prior] 'scroll-other-window-down)
1997 : ;; Binding ESC would prohibit the M-v binding. Instead, callers
1998 : ;; should check for ESC specially.
1999 : ;; (define-key map "\e" 'exit-prefix)
2000 : (define-key map [escape] 'exit-prefix)
2001 : map)
2002 : "Keymap of responses to questions posed by commands like `query-replace'.
2003 : The \"bindings\" in this map are not commands; they are answers.
2004 : The valid answers include `act', `skip', `act-and-show',
2005 : `act-and-exit', `exit', `exit-prefix', `recenter', `scroll-up',
2006 : `scroll-down', `scroll-other-window', `scroll-other-window-down',
2007 : `edit', `edit-replacement', `delete-and-edit', `automatic',
2008 : `backup', `undo', `undo-all', `quit', and `help'.
2009 :
2010 : This keymap is used by `y-or-n-p' as well as `query-replace'.")
2011 :
2012 : (defvar multi-query-replace-map
2013 : (let ((map (make-sparse-keymap)))
2014 : (set-keymap-parent map query-replace-map)
2015 : (define-key map "Y" 'automatic-all)
2016 : (define-key map "N" 'exit-current)
2017 : map)
2018 : "Keymap that defines additional bindings for multi-buffer replacements.
2019 : It extends its parent map `query-replace-map' with new bindings to
2020 : operate on a set of buffers/files. The difference with its parent map
2021 : is the additional answers `automatic-all' to replace all remaining
2022 : matches in all remaining buffers with no more questions, and
2023 : `exit-current' to skip remaining matches in the current buffer
2024 : and to continue with the next buffer in the sequence.")
2025 :
2026 : (defun replace-match-string-symbols (n)
2027 : "Process a list (and any sub-lists), expanding certain symbols.
2028 : Symbol Expands To
2029 : N (match-string N) (where N is a string of digits)
2030 : #N (string-to-number (match-string N))
2031 : & (match-string 0)
2032 : #& (string-to-number (match-string 0))
2033 : # replace-count
2034 :
2035 : Note that these symbols must be preceded by a backslash in order to
2036 : type them using Lisp syntax."
2037 0 : (while (consp n)
2038 0 : (cond
2039 0 : ((consp (car n))
2040 0 : (replace-match-string-symbols (car n))) ;Process sub-list
2041 0 : ((symbolp (car n))
2042 0 : (let ((name (symbol-name (car n))))
2043 0 : (cond
2044 0 : ((string-match "^[0-9]+$" name)
2045 0 : (setcar n (list 'match-string (string-to-number name))))
2046 0 : ((string-match "^#[0-9]+$" name)
2047 0 : (setcar n (list 'string-to-number
2048 0 : (list 'match-string
2049 0 : (string-to-number (substring name 1))))))
2050 0 : ((string= "&" name)
2051 0 : (setcar n '(match-string 0)))
2052 0 : ((string= "#&" name)
2053 0 : (setcar n '(string-to-number (match-string 0))))
2054 0 : ((string= "#" name)
2055 0 : (setcar n 'replace-count))))))
2056 0 : (setq n (cdr n))))
2057 :
2058 : (defun replace-eval-replacement (expression count)
2059 0 : (let* ((replace-count count)
2060 : (replacement
2061 0 : (condition-case err
2062 0 : (eval expression)
2063 : (error
2064 0 : (error "Error evaluating replacement expression: %S" err)))))
2065 0 : (if (stringp replacement)
2066 0 : replacement
2067 0 : (prin1-to-string replacement t))))
2068 :
2069 : (defun replace-quote (replacement)
2070 : "Quote a replacement string.
2071 : This just doubles all backslashes in REPLACEMENT and
2072 : returns the resulting string. If REPLACEMENT is not
2073 : a string, it is first passed through `prin1-to-string'
2074 : with the `noescape' argument set.
2075 :
2076 : `match-data' is preserved across the call."
2077 0 : (save-match-data
2078 0 : (replace-regexp-in-string "\\\\" "\\\\"
2079 0 : (if (stringp replacement)
2080 0 : replacement
2081 0 : (prin1-to-string replacement t))
2082 0 : t t)))
2083 :
2084 : (defun replace-loop-through-replacements (data count)
2085 : ;; DATA is a vector containing the following values:
2086 : ;; 0 next-rotate-count
2087 : ;; 1 repeat-count
2088 : ;; 2 next-replacement
2089 : ;; 3 replacements
2090 0 : (if (= (aref data 0) count)
2091 0 : (progn
2092 0 : (aset data 0 (+ count (aref data 1)))
2093 0 : (let ((next (cdr (aref data 2))))
2094 0 : (aset data 2 (if (consp next) next (aref data 3))))))
2095 0 : (car (aref data 2)))
2096 :
2097 : (defun replace-match-data (integers reuse &optional new)
2098 : "Like `match-data', but markers in REUSE get invalidated.
2099 : If NEW is non-nil, it is set and returned instead of fresh data,
2100 : but coerced to the correct value of INTEGERS."
2101 0 : (or (and new
2102 0 : (progn
2103 0 : (set-match-data new)
2104 0 : (and (eq new reuse)
2105 0 : (eq (null integers) (markerp (car reuse)))
2106 0 : new)))
2107 0 : (match-data integers reuse t)))
2108 :
2109 : (defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data
2110 : &optional backward)
2111 : "Make a replacement with `replace-match', editing `\\?'.
2112 : FIXEDCASE, LITERAL are passed to `replace-match' (which see).
2113 : After possibly editing it (if `\\?' is present), NEWTEXT is also
2114 : passed to `replace-match'. If NOEDIT is true, no check for `\\?'
2115 : is made (to save time).
2116 : MATCH-DATA is used for the replacement, and is a data structure
2117 : as returned from the `match-data' function.
2118 : In case editing is done, it is changed to use markers. BACKWARD is
2119 : used to reverse the replacement direction.
2120 :
2121 : The return value is non-nil if there has been no `\\?' or NOEDIT was
2122 : passed in. If LITERAL is set, no checking is done, anyway."
2123 0 : (unless (or literal noedit)
2124 0 : (setq noedit t)
2125 0 : (while (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\\\?\\)"
2126 0 : newtext)
2127 0 : (setq newtext
2128 0 : (read-string "Edit replacement string: "
2129 0 : (prog1
2130 0 : (cons
2131 0 : (replace-match "" t t newtext 3)
2132 0 : (1+ (match-beginning 3)))
2133 0 : (setq match-data
2134 0 : (replace-match-data
2135 0 : nil match-data match-data))))
2136 0 : noedit nil)))
2137 0 : (set-match-data match-data)
2138 0 : (replace-match newtext fixedcase literal)
2139 : ;; `replace-match' leaves point at the end of the replacement text,
2140 : ;; so move point to the beginning when replacing backward.
2141 0 : (when backward (goto-char (nth 0 match-data)))
2142 0 : noedit)
2143 :
2144 : (defvar replace-update-post-hook nil
2145 : "Function(s) to call after query-replace has found a match in the buffer.")
2146 :
2147 : (defvar replace-search-function nil
2148 : "Function to use when searching for strings to replace.
2149 : It is used by `query-replace' and `replace-string', and is called
2150 : with three arguments, as if it were `search-forward'.")
2151 :
2152 : (defvar replace-re-search-function nil
2153 : "Function to use when searching for regexps to replace.
2154 : It is used by `query-replace-regexp', `replace-regexp',
2155 : `query-replace-regexp-eval', and `map-query-replace-regexp'.
2156 : It is called with three arguments, as if it were
2157 : `re-search-forward'.")
2158 :
2159 : (defun replace-search (search-string limit regexp-flag delimited-flag
2160 : case-fold &optional backward)
2161 : "Search for the next occurrence of SEARCH-STRING to replace."
2162 : ;; Let-bind global isearch-* variables to values used
2163 : ;; to search the next replacement. These let-bindings
2164 : ;; should be effective both at the time of calling
2165 : ;; `isearch-search-fun-default' and also at the
2166 : ;; time of funcalling `search-function'.
2167 : ;; These isearch-* bindings can't be placed higher
2168 : ;; outside of this function because then another I-search
2169 : ;; used after `recursive-edit' might override them.
2170 0 : (let* ((isearch-regexp regexp-flag)
2171 0 : (isearch-regexp-function (or delimited-flag
2172 0 : (and replace-char-fold
2173 0 : (not regexp-flag)
2174 0 : #'char-fold-to-regexp)))
2175 : (isearch-lax-whitespace
2176 0 : replace-lax-whitespace)
2177 : (isearch-regexp-lax-whitespace
2178 0 : replace-regexp-lax-whitespace)
2179 0 : (isearch-case-fold-search case-fold)
2180 : (isearch-adjusted nil)
2181 : (isearch-nonincremental t) ; don't use lax word mode
2182 0 : (isearch-forward (not backward))
2183 : (search-function
2184 0 : (or (if regexp-flag
2185 0 : replace-re-search-function
2186 0 : replace-search-function)
2187 0 : (isearch-search-fun-default))))
2188 0 : (funcall search-function search-string limit t)))
2189 :
2190 : (defvar replace-overlay nil)
2191 :
2192 : (defun replace-highlight (match-beg match-end range-beg range-end
2193 : search-string regexp-flag delimited-flag
2194 : case-fold &optional backward)
2195 0 : (if query-replace-highlight
2196 0 : (if replace-overlay
2197 0 : (move-overlay replace-overlay match-beg match-end (current-buffer))
2198 0 : (setq replace-overlay (make-overlay match-beg match-end))
2199 0 : (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
2200 0 : (overlay-put replace-overlay 'face 'query-replace)))
2201 0 : (if query-replace-lazy-highlight
2202 0 : (let ((isearch-string search-string)
2203 0 : (isearch-regexp regexp-flag)
2204 0 : (isearch-regexp-function delimited-flag)
2205 : (isearch-lax-whitespace
2206 0 : replace-lax-whitespace)
2207 : (isearch-regexp-lax-whitespace
2208 0 : replace-regexp-lax-whitespace)
2209 0 : (isearch-case-fold-search case-fold)
2210 0 : (isearch-forward (not backward))
2211 0 : (isearch-other-end match-beg)
2212 : (isearch-error nil))
2213 0 : (isearch-lazy-highlight-new-loop range-beg range-end))))
2214 :
2215 : (defun replace-dehighlight ()
2216 0 : (when replace-overlay
2217 0 : (delete-overlay replace-overlay))
2218 0 : (when query-replace-lazy-highlight
2219 0 : (lazy-highlight-cleanup lazy-highlight-cleanup)
2220 0 : (setq isearch-lazy-highlight-last-string nil))
2221 : ;; Close overlays opened by `isearch-range-invisible' in `perform-replace'.
2222 0 : (isearch-clean-overlays))
2223 :
2224 : ;; A macro because we push STACK, i.e. a local var in `perform-replace'.
2225 : (defmacro replace--push-stack (replaced search-str next-replace stack)
2226 : (declare (indent 0) (debug (form form form gv-place)))
2227 2 : `(push (list (point) ,replaced
2228 : ;;; If the replacement has already happened, all we need is the
2229 : ;;; current match start and end. We could get this with a trivial
2230 : ;;; match like
2231 : ;;; (save-excursion (goto-char (match-beginning 0))
2232 : ;;; (search-forward (match-string 0))
2233 : ;;; (match-data t))
2234 : ;;; if we really wanted to avoid manually constructing match data.
2235 : ;;; Adding current-buffer is necessary so that match-data calls can
2236 : ;;; return markers which are appropriate for editing.
2237 2 : (if ,replaced
2238 : (list
2239 : (match-beginning 0) (match-end 0) (current-buffer))
2240 : (match-data t))
2241 2 : ,search-str ,next-replace)
2242 2 : ,stack))
2243 :
2244 : (defun perform-replace (from-string replacements
2245 : query-flag regexp-flag delimited-flag
2246 : &optional repeat-count map start end backward region-noncontiguous-p)
2247 : "Subroutine of `query-replace'. Its complexity handles interactive queries.
2248 : Don't use this in your own program unless you want to query and set the mark
2249 : just as `query-replace' does. Instead, write a simple loop like this:
2250 :
2251 : (while (re-search-forward \"foo[ \\t]+bar\" nil t)
2252 : (replace-match \"foobar\" nil nil))
2253 :
2254 : which will run faster and probably do exactly what you want. Please
2255 : see the documentation of `replace-match' to find out how to simulate
2256 : `case-replace'.
2257 :
2258 : This function returns nil if and only if there were no matches to
2259 : make, or the user didn't cancel the call.
2260 :
2261 : REPLACEMENTS is either a string, a list of strings, or a cons cell
2262 : containing a function and its first argument. The function is
2263 : called to generate each replacement like this:
2264 : (funcall (car replacements) (cdr replacements) replace-count)
2265 : It must return a string."
2266 0 : (or map (setq map query-replace-map))
2267 0 : (and query-flag minibuffer-auto-raise
2268 0 : (raise-frame (window-frame (minibuffer-window))))
2269 0 : (let* ((case-fold-search
2270 0 : (if (and case-fold-search search-upper-case)
2271 0 : (isearch-no-upper-case-p from-string regexp-flag)
2272 0 : case-fold-search))
2273 0 : (nocasify (not (and case-replace case-fold-search)))
2274 0 : (literal (or (not regexp-flag) (eq regexp-flag 'literal)))
2275 0 : (search-string from-string)
2276 : (real-match-data nil) ; The match data for the current match.
2277 : (next-replacement nil)
2278 : ;; This is non-nil if we know there is nothing for the user
2279 : ;; to edit in the replacement.
2280 : (noedit nil)
2281 : (keep-going t)
2282 : (stack nil)
2283 : (search-string-replaced nil) ; last string matching `from-string'
2284 : (next-replacement-replaced nil) ; replacement string
2285 : ; (substituted regexp)
2286 : (last-was-undo)
2287 : (last-was-act-and-show)
2288 : (update-stack t)
2289 : (replace-count 0)
2290 : (skip-read-only-count 0)
2291 : (skip-filtered-count 0)
2292 : (skip-invisible-count 0)
2293 : (nonempty-match nil)
2294 : (multi-buffer nil)
2295 : (recenter-last-op nil) ; Start cycling order with initial position.
2296 :
2297 : ;; If non-nil, it is marker saying where in the buffer to stop.
2298 : (limit nil)
2299 : ;; Use local binding in add-function below.
2300 0 : (isearch-filter-predicate isearch-filter-predicate)
2301 : (region-bounds nil)
2302 :
2303 : ;; Data for the next match. If a cons, it has the same format as
2304 : ;; (match-data); otherwise it is t if a match is possible at point.
2305 : (match-again t)
2306 :
2307 : (message
2308 0 : (if query-flag
2309 0 : (apply 'propertize
2310 0 : (substitute-command-keys
2311 0 : "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")
2312 0 : minibuffer-prompt-properties))))
2313 :
2314 : ;; Unless a single contiguous chunk is selected, operate on multiple chunks.
2315 0 : (when region-noncontiguous-p
2316 0 : (setq region-bounds
2317 0 : (mapcar (lambda (position)
2318 0 : (cons (copy-marker (car position))
2319 0 : (copy-marker (cdr position))))
2320 0 : (funcall region-extract-function 'bounds)))
2321 0 : (add-function :after-while isearch-filter-predicate
2322 : (lambda (start end)
2323 0 : (delq nil (mapcar
2324 : (lambda (bounds)
2325 0 : (and
2326 0 : (>= start (car bounds))
2327 0 : (<= start (cdr bounds))
2328 0 : (>= end (car bounds))
2329 0 : (<= end (cdr bounds))))
2330 0 : region-bounds)))))
2331 :
2332 : ;; If region is active, in Transient Mark mode, operate on region.
2333 0 : (if backward
2334 0 : (when end
2335 0 : (setq limit (copy-marker (min start end)))
2336 0 : (goto-char (max start end))
2337 0 : (deactivate-mark))
2338 0 : (when start
2339 0 : (setq limit (copy-marker (max start end)))
2340 0 : (goto-char (min start end))
2341 0 : (deactivate-mark)))
2342 :
2343 : ;; If last typed key in previous call of multi-buffer perform-replace
2344 : ;; was `automatic-all', don't ask more questions in next files
2345 0 : (when (eq (lookup-key map (vector last-input-event)) 'automatic-all)
2346 0 : (setq query-flag nil multi-buffer t))
2347 :
2348 0 : (cond
2349 0 : ((stringp replacements)
2350 0 : (setq next-replacement replacements
2351 0 : replacements nil))
2352 0 : ((stringp (car replacements)) ; If it isn't a string, it must be a cons
2353 0 : (or repeat-count (setq repeat-count 1))
2354 0 : (setq replacements (cons 'replace-loop-through-replacements
2355 0 : (vector repeat-count repeat-count
2356 0 : replacements replacements)))))
2357 :
2358 0 : (when query-replace-lazy-highlight
2359 0 : (setq isearch-lazy-highlight-last-string nil))
2360 :
2361 0 : (push-mark)
2362 0 : (undo-boundary)
2363 0 : (unwind-protect
2364 : ;; Loop finding occurrences that perhaps should be replaced.
2365 0 : (while (and keep-going
2366 0 : (if backward
2367 0 : (not (or (bobp) (and limit (<= (point) limit))))
2368 0 : (not (or (eobp) (and limit (>= (point) limit)))))
2369 : ;; Use the next match if it is already known;
2370 : ;; otherwise, search for a match after moving forward
2371 : ;; one char if progress is required.
2372 0 : (setq real-match-data
2373 0 : (cond ((consp match-again)
2374 0 : (goto-char (if backward
2375 0 : (nth 0 match-again)
2376 0 : (nth 1 match-again)))
2377 0 : (replace-match-data
2378 0 : t real-match-data match-again))
2379 : ;; MATCH-AGAIN non-nil means accept an
2380 : ;; adjacent match.
2381 0 : (match-again
2382 0 : (and
2383 0 : (replace-search search-string limit
2384 0 : regexp-flag delimited-flag
2385 0 : case-fold-search backward)
2386 : ;; For speed, use only integers and
2387 : ;; reuse the list used last time.
2388 0 : (replace-match-data t real-match-data)))
2389 0 : ((and (if backward
2390 0 : (> (1- (point)) (point-min))
2391 0 : (< (1+ (point)) (point-max)))
2392 0 : (or (null limit)
2393 0 : (if backward
2394 0 : (> (1- (point)) limit)
2395 0 : (< (1+ (point)) limit))))
2396 : ;; If not accepting adjacent matches,
2397 : ;; move one char to the right before
2398 : ;; searching again. Undo the motion
2399 : ;; if the search fails.
2400 0 : (let ((opoint (point)))
2401 0 : (forward-char (if backward -1 1))
2402 0 : (if (replace-search search-string limit
2403 0 : regexp-flag delimited-flag
2404 0 : case-fold-search backward)
2405 0 : (replace-match-data
2406 0 : t real-match-data)
2407 0 : (goto-char opoint)
2408 0 : nil))))))
2409 :
2410 : ;; Record whether the match is nonempty, to avoid an infinite loop
2411 : ;; repeatedly matching the same empty string.
2412 0 : (setq nonempty-match
2413 0 : (/= (nth 0 real-match-data) (nth 1 real-match-data)))
2414 :
2415 : ;; If the match is empty, record that the next one can't be
2416 : ;; adjacent.
2417 :
2418 : ;; Otherwise, if matching a regular expression, do the next
2419 : ;; match now, since the replacement for this match may
2420 : ;; affect whether the next match is adjacent to this one.
2421 : ;; If that match is empty, don't use it.
2422 0 : (setq match-again
2423 0 : (and nonempty-match
2424 0 : (or (not regexp-flag)
2425 0 : (and (if backward
2426 0 : (looking-back search-string nil)
2427 0 : (looking-at search-string))
2428 0 : (let ((match (match-data)))
2429 0 : (and (/= (nth 0 match) (nth 1 match))
2430 0 : match))))))
2431 :
2432 0 : (cond
2433 : ;; Optionally ignore matches that have a read-only property.
2434 0 : ((not (or (not query-replace-skip-read-only)
2435 0 : (not (text-property-not-all
2436 0 : (nth 0 real-match-data) (nth 1 real-match-data)
2437 0 : 'read-only nil))))
2438 0 : (setq skip-read-only-count (1+ skip-read-only-count)))
2439 : ;; Optionally filter out matches.
2440 0 : ((not (funcall isearch-filter-predicate
2441 0 : (nth 0 real-match-data) (nth 1 real-match-data)))
2442 0 : (setq skip-filtered-count (1+ skip-filtered-count)))
2443 : ;; Optionally ignore invisible matches.
2444 0 : ((not (or (eq search-invisible t)
2445 : ;; Don't open overlays for automatic replacements.
2446 0 : (and (not query-flag) search-invisible)
2447 : ;; Open hidden overlays for interactive replacements.
2448 0 : (not (isearch-range-invisible
2449 0 : (nth 0 real-match-data) (nth 1 real-match-data)))))
2450 0 : (setq skip-invisible-count (1+ skip-invisible-count)))
2451 : (t
2452 : ;; Calculate the replacement string, if necessary.
2453 0 : (when replacements
2454 0 : (set-match-data real-match-data)
2455 0 : (setq next-replacement
2456 0 : (funcall (car replacements) (cdr replacements)
2457 0 : replace-count)))
2458 0 : (if (not query-flag)
2459 0 : (progn
2460 0 : (unless (or literal noedit)
2461 0 : (replace-highlight
2462 0 : (nth 0 real-match-data) (nth 1 real-match-data)
2463 0 : start end search-string
2464 0 : regexp-flag delimited-flag case-fold-search backward))
2465 0 : (setq noedit
2466 0 : (replace-match-maybe-edit
2467 0 : next-replacement nocasify literal
2468 0 : noedit real-match-data backward)
2469 0 : replace-count (1+ replace-count)))
2470 0 : (undo-boundary)
2471 0 : (let (done replaced key def)
2472 : ;; Loop reading commands until one of them sets done,
2473 : ;; which means it has finished handling this
2474 : ;; occurrence. Any command that sets `done' should
2475 : ;; leave behind proper match data for the stack.
2476 : ;; Commands not setting `done' need to adjust
2477 : ;; `real-match-data'.
2478 0 : (while (not done)
2479 0 : (set-match-data real-match-data)
2480 0 : (run-hooks 'replace-update-post-hook) ; Before `replace-highlight'.
2481 0 : (replace-highlight
2482 0 : (match-beginning 0) (match-end 0)
2483 0 : start end search-string
2484 0 : regexp-flag delimited-flag case-fold-search backward)
2485 : ;; Obtain the matched groups: needed only when
2486 : ;; regexp-flag non nil.
2487 0 : (when (and last-was-undo regexp-flag)
2488 0 : (setq last-was-undo nil
2489 : real-match-data
2490 0 : (save-excursion
2491 0 : (goto-char (match-beginning 0))
2492 0 : (looking-at search-string)
2493 0 : (match-data t real-match-data))))
2494 : ;; Matched string and next-replacement-replaced
2495 : ;; stored in stack.
2496 0 : (setq search-string-replaced (buffer-substring-no-properties
2497 0 : (match-beginning 0)
2498 0 : (match-end 0))
2499 : next-replacement-replaced
2500 0 : (query-replace-descr
2501 0 : (save-match-data
2502 0 : (set-match-data real-match-data)
2503 0 : (match-substitute-replacement
2504 0 : next-replacement nocasify literal))))
2505 : ;; Bind message-log-max so we don't fill up the
2506 : ;; message log with a bunch of identical messages.
2507 0 : (let ((message-log-max nil)
2508 : (replacement-presentation
2509 0 : (if query-replace-show-replacement
2510 0 : (save-match-data
2511 0 : (set-match-data real-match-data)
2512 0 : (match-substitute-replacement next-replacement
2513 0 : nocasify literal))
2514 0 : next-replacement)))
2515 0 : (message message
2516 0 : (query-replace-descr from-string)
2517 0 : (query-replace-descr replacement-presentation)))
2518 0 : (setq key (read-event))
2519 : ;; Necessary in case something happens during
2520 : ;; read-event that clobbers the match data.
2521 0 : (set-match-data real-match-data)
2522 0 : (setq key (vector key))
2523 0 : (setq def (lookup-key map key))
2524 : ;; Restore the match data while we process the command.
2525 0 : (cond ((eq def 'help)
2526 0 : (with-output-to-temp-buffer "*Help*"
2527 0 : (princ
2528 0 : (concat "Query replacing "
2529 0 : (if delimited-flag
2530 0 : (or (and (symbolp delimited-flag)
2531 0 : (get delimited-flag
2532 0 : 'isearch-message-prefix))
2533 0 : "word ") "")
2534 0 : (if regexp-flag "regexp " "")
2535 0 : (if backward "backward " "")
2536 0 : from-string " with "
2537 0 : next-replacement ".\n\n"
2538 0 : (substitute-command-keys
2539 0 : query-replace-help)))
2540 0 : (with-current-buffer standard-output
2541 0 : (help-mode))))
2542 0 : ((eq def 'exit)
2543 0 : (setq keep-going nil)
2544 0 : (setq done t))
2545 0 : ((eq def 'exit-current)
2546 0 : (setq multi-buffer t keep-going nil done t))
2547 0 : ((eq def 'backup)
2548 0 : (if stack
2549 0 : (let ((elt (pop stack)))
2550 0 : (goto-char (nth 0 elt))
2551 0 : (setq replaced (nth 1 elt)
2552 : real-match-data
2553 0 : (replace-match-data
2554 0 : t real-match-data
2555 0 : (nth 2 elt))))
2556 0 : (message "No previous match")
2557 0 : (ding 'no-terminate)
2558 0 : (sit-for 1)))
2559 0 : ((or (eq def 'undo) (eq def 'undo-all))
2560 0 : (if (null stack)
2561 0 : (progn
2562 0 : (message "Nothing to undo")
2563 0 : (ding 'no-terminate)
2564 0 : (sit-for 1))
2565 0 : (let ((stack-idx 0)
2566 0 : (stack-len (length stack))
2567 : (num-replacements 0)
2568 : search-string
2569 : next-replacement)
2570 0 : (while (and (< stack-idx stack-len)
2571 0 : stack
2572 0 : (or (null replaced) last-was-act-and-show))
2573 0 : (let* ((elt (nth stack-idx stack)))
2574 0 : (setq
2575 0 : stack-idx (1+ stack-idx)
2576 0 : replaced (nth 1 elt)
2577 : ;; Bind swapped values
2578 : ;; (search-string <--> replacement)
2579 0 : search-string (nth (if replaced 4 3) elt)
2580 0 : next-replacement (nth (if replaced 3 4) elt)
2581 0 : search-string-replaced search-string
2582 0 : next-replacement-replaced next-replacement
2583 0 : last-was-act-and-show nil)
2584 :
2585 0 : (when (and (= stack-idx stack-len)
2586 0 : (and (null replaced) (not last-was-act-and-show))
2587 0 : (zerop num-replacements))
2588 0 : (message "Nothing to undo")
2589 0 : (ding 'no-terminate)
2590 0 : (sit-for 1))
2591 :
2592 0 : (when replaced
2593 0 : (setq stack (nthcdr stack-idx stack))
2594 0 : (goto-char (nth 0 elt))
2595 0 : (set-match-data (nth 2 elt))
2596 0 : (setq real-match-data
2597 0 : (save-excursion
2598 0 : (goto-char (match-beginning 0))
2599 0 : (looking-at search-string)
2600 0 : (match-data t (nth 2 elt)))
2601 : noedit
2602 0 : (replace-match-maybe-edit
2603 0 : next-replacement nocasify literal
2604 0 : noedit real-match-data backward)
2605 0 : replace-count (1- replace-count)
2606 : real-match-data
2607 0 : (save-excursion
2608 0 : (goto-char (match-beginning 0))
2609 0 : (looking-at next-replacement)
2610 0 : (match-data t (nth 2 elt))))
2611 : ;; Set replaced nil to keep in loop
2612 0 : (when (eq def 'undo-all)
2613 0 : (setq replaced nil
2614 0 : stack-len (- stack-len stack-idx)
2615 : stack-idx 0
2616 : num-replacements
2617 0 : (1+ num-replacements))))))
2618 0 : (when (and (eq def 'undo-all)
2619 0 : (null (zerop num-replacements)))
2620 0 : (message "Undid %d %s" num-replacements
2621 0 : (if (= num-replacements 1)
2622 : "replacement"
2623 0 : "replacements"))
2624 0 : (ding 'no-terminate)
2625 0 : (sit-for 1)))
2626 0 : (setq replaced nil last-was-undo t last-was-act-and-show nil)))
2627 0 : ((eq def 'act)
2628 0 : (or replaced
2629 0 : (setq noedit
2630 0 : (replace-match-maybe-edit
2631 0 : next-replacement nocasify literal
2632 0 : noedit real-match-data backward)
2633 0 : replace-count (1+ replace-count)))
2634 0 : (setq done t replaced t update-stack (not last-was-act-and-show)))
2635 0 : ((eq def 'act-and-exit)
2636 0 : (or replaced
2637 0 : (setq noedit
2638 0 : (replace-match-maybe-edit
2639 0 : next-replacement nocasify literal
2640 0 : noedit real-match-data backward)
2641 0 : replace-count (1+ replace-count)))
2642 0 : (setq keep-going nil)
2643 0 : (setq done t replaced t))
2644 0 : ((eq def 'act-and-show)
2645 0 : (unless replaced
2646 0 : (setq noedit
2647 0 : (replace-match-maybe-edit
2648 0 : next-replacement nocasify literal
2649 0 : noedit real-match-data backward)
2650 0 : replace-count (1+ replace-count)
2651 0 : real-match-data (replace-match-data
2652 0 : t real-match-data)
2653 0 : replaced t last-was-act-and-show t)
2654 0 : (replace--push-stack
2655 0 : replaced
2656 0 : search-string-replaced
2657 0 : next-replacement-replaced stack)))
2658 0 : ((or (eq def 'automatic) (eq def 'automatic-all))
2659 0 : (or replaced
2660 0 : (setq noedit
2661 0 : (replace-match-maybe-edit
2662 0 : next-replacement nocasify literal
2663 0 : noedit real-match-data backward)
2664 0 : replace-count (1+ replace-count)))
2665 0 : (setq done t query-flag nil replaced t)
2666 0 : (if (eq def 'automatic-all) (setq multi-buffer t)))
2667 0 : ((eq def 'skip)
2668 0 : (setq done t update-stack (not last-was-act-and-show)))
2669 0 : ((eq def 'recenter)
2670 : ;; `this-command' has the value `query-replace',
2671 : ;; so we need to bind it to `recenter-top-bottom'
2672 : ;; to allow it to detect a sequence of `C-l'.
2673 0 : (let ((this-command 'recenter-top-bottom)
2674 : (last-command 'recenter-top-bottom))
2675 0 : (recenter-top-bottom)))
2676 0 : ((eq def 'edit)
2677 0 : (let ((opos (point-marker)))
2678 0 : (setq real-match-data (replace-match-data
2679 0 : nil real-match-data
2680 0 : real-match-data))
2681 0 : (goto-char (match-beginning 0))
2682 0 : (save-excursion
2683 0 : (save-window-excursion
2684 0 : (recursive-edit)))
2685 0 : (goto-char opos)
2686 0 : (set-marker opos nil))
2687 : ;; Before we make the replacement,
2688 : ;; decide whether the search string
2689 : ;; can match again just after this match.
2690 0 : (if (and regexp-flag nonempty-match)
2691 0 : (setq match-again (and (looking-at search-string)
2692 0 : (match-data)))))
2693 : ;; Edit replacement.
2694 0 : ((eq def 'edit-replacement)
2695 0 : (setq real-match-data (replace-match-data
2696 0 : nil real-match-data
2697 0 : real-match-data)
2698 : next-replacement
2699 0 : (read-string "Edit replacement string: "
2700 0 : next-replacement)
2701 0 : noedit nil)
2702 0 : (if replaced
2703 0 : (set-match-data real-match-data)
2704 0 : (setq noedit
2705 0 : (replace-match-maybe-edit
2706 0 : next-replacement nocasify literal noedit
2707 0 : real-match-data backward)
2708 0 : replaced t))
2709 0 : (setq done t))
2710 :
2711 0 : ((eq def 'delete-and-edit)
2712 0 : (replace-match "" t t)
2713 0 : (setq real-match-data (replace-match-data
2714 0 : nil real-match-data))
2715 0 : (replace-dehighlight)
2716 0 : (save-excursion (recursive-edit))
2717 0 : (setq replaced t))
2718 : ;; Note: we do not need to treat `exit-prefix'
2719 : ;; specially here, since we reread
2720 : ;; any unrecognized character.
2721 : (t
2722 0 : (setq this-command 'mode-exited)
2723 0 : (setq keep-going nil)
2724 0 : (setq unread-command-events
2725 0 : (append (listify-key-sequence key)
2726 0 : unread-command-events))
2727 0 : (setq done t)))
2728 0 : (when query-replace-lazy-highlight
2729 : ;; Force lazy rehighlighting only after replacements.
2730 0 : (if (not (memq def '(skip backup)))
2731 0 : (setq isearch-lazy-highlight-last-string nil)))
2732 0 : (unless (eq def 'recenter)
2733 : ;; Reset recenter cycling order to initial position.
2734 0 : (setq recenter-last-op nil)))
2735 : ;; Record previous position for ^ when we move on.
2736 : ;; Change markers to numbers in the match data
2737 : ;; since lots of markers slow down editing.
2738 0 : (when update-stack
2739 0 : (replace--push-stack
2740 0 : replaced
2741 0 : search-string-replaced
2742 0 : next-replacement-replaced stack))
2743 0 : (setq next-replacement-replaced nil
2744 : search-string-replaced nil
2745 0 : last-was-act-and-show nil))))))
2746 0 : (replace-dehighlight))
2747 0 : (or unread-command-events
2748 0 : (message "Replaced %d occurrence%s%s"
2749 0 : replace-count
2750 0 : (if (= replace-count 1) "" "s")
2751 0 : (if (> (+ skip-read-only-count
2752 0 : skip-filtered-count
2753 0 : skip-invisible-count) 0)
2754 0 : (format " (skipped %s)"
2755 0 : (mapconcat
2756 : 'identity
2757 0 : (delq nil (list
2758 0 : (if (> skip-read-only-count 0)
2759 0 : (format "%s read-only"
2760 0 : skip-read-only-count))
2761 0 : (if (> skip-invisible-count 0)
2762 0 : (format "%s invisible"
2763 0 : skip-invisible-count))
2764 0 : (if (> skip-filtered-count 0)
2765 0 : (format "%s filtered out"
2766 0 : skip-filtered-count))))
2767 0 : ", "))
2768 0 : "")))
2769 0 : (or (and keep-going stack) multi-buffer)))
2770 :
2771 : (provide 'replace)
2772 :
2773 : ;;; replace.el ends here
|