lisp/replace.el

   1 ;;; replace.el --- replace commands for Emacs
   2
   3 ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001,
   4 ;;   2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
   5
   6 ;; Maintainer: FSF
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This package supplies the string and regular-expression replace functions
  28 ;; documented in the Emacs user's manual.
  29
  30 ;;; Code:
  31
  32 (defcustom case-replace t
  33   "*Non-nil means `query-replace' should preserve case in replacements."
  34   :type 'boolean
  35   :group 'matching)
  36
  37 (defvar query-replace-history nil)
  38
  39 (defvar query-replace-defaults nil
  40   "Default values of FROM-STRING and TO-STRING for `query-replace'.
  41 This is a cons cell (FROM-STRING . TO-STRING), or nil if there is
  42 no default value.")
  43
  44 (defvar query-replace-interactive nil
  45   "Non-nil means `query-replace' uses the last search string.
  46 That becomes the \"string to replace\".")
  47
  48 (defcustom query-replace-from-history-variable 'query-replace-history
  49   "History list to use for the FROM argument of `query-replace' commands.
  50 The value of this variable should be a symbol; that symbol
  51 is used as a variable to hold a history list for the strings
  52 or patterns to be replaced."
  53   :group 'matching
  54   :type 'symbol
  55   :version "20.3")
  56
  57 (defcustom query-replace-to-history-variable 'query-replace-history
  58   "History list to use for the TO argument of `query-replace' commands.
  59 The value of this variable should be a symbol; that symbol
  60 is used as a variable to hold a history list for replacement
  61 strings or patterns."
  62   :group 'matching
  63   :type 'symbol
  64   :version "20.3")
  65
  66 (defcustom query-replace-skip-read-only nil
  67   "*Non-nil means `query-replace' and friends ignore read-only matches."
  68   :type 'boolean
  69   :group 'matching
  70   :version "22.1")
  71
  72 (defcustom query-replace-show-replacement t
  73   "*Non-nil means to show what actual replacement text will be."
  74   :type 'boolean
  75   :group 'matching
  76   :version "23.1")
  77
  78 (defcustom query-replace-highlight t
  79   "*Non-nil means to highlight matches during query replacement."
  80   :type 'boolean
  81   :group 'matching)
  82
  83 (defcustom query-replace-lazy-highlight t
  84   "*Controls the lazy-highlighting during query replacements.
  85 When non-nil, all text in the buffer matching the current match
  86 is highlighted lazily using isearch lazy highlighting (see
  87 `lazy-highlight-initial-delay' and `lazy-highlight-interval')."
  88   :type 'boolean
  89   :group 'lazy-highlight
  90   :group 'matching
  91   :version "22.1")
  92
  93 (defface query-replace
  94   '((t (:inherit isearch)))
  95   "Face for highlighting query replacement matches."
  96   :group 'matching
  97   :version "22.1")
  98
  99 (defun query-replace-descr (string)
 100   (mapconcat 'isearch-text-char-description string ""))
 101
 102 (defun query-replace-read-from (prompt regexp-flag)
 103   "Query and return the `from' argument of a query-replace operation.
 104 The return value can also be a pair (FROM . TO) indicating that the user
 105 wants to replace FROM with TO."
 106   (if query-replace-interactive
 107       (car (if regexp-flag regexp-search-ring search-ring))
 108     (let* ((history-add-new-input nil)
 109            (from
 110             ;; The save-excursion here is in case the user marks and copies
 111             ;; a region in order to specify the minibuffer input.
 112             ;; That should not clobber the region for the query-replace itself.
 113             (save-excursion
 114               (read-from-minibuffer
 115                (if query-replace-defaults
 116                    (format "%s (default %s -> %s): " prompt
 117                            (query-replace-descr (car query-replace-defaults))
 118                            (query-replace-descr (cdr query-replace-defaults)))
 119                  (format "%s: " prompt))
 120                nil nil nil
 121                query-replace-from-history-variable
 122                nil t))))
 123       (if (and (zerop (length from)) query-replace-defaults)
 124           (cons (car query-replace-defaults)
 125                 (query-replace-compile-replacement
 126                  (cdr query-replace-defaults) regexp-flag))
 127         (add-to-history query-replace-from-history-variable from nil t)
 128         ;; Warn if user types \n or \t, but don't reject the input.
 129         (and regexp-flag
 130              (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
 131              (let ((match (match-string 3 from)))
 132                (cond
 133                 ((string= match "\\n")
 134                  (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
 135                 ((string= match "\\t")
 136                  (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
 137                (sit-for 2)))
 138         from))))
 139
 140 (defun query-replace-compile-replacement (to regexp-flag)
 141   "Maybe convert a regexp replacement TO to Lisp.
 142 Returns a list suitable for `perform-replace' if necessary,
 143 the original string if not."
 144   (if (and regexp-flag
 145            (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))
 146       (let (pos list char)
 147         (while
 148             (progn
 149               (setq pos (match-end 0))
 150               (push (substring to 0 (- pos 2)) list)
 151               (setq char (aref to (1- pos))
 152                     to (substring to pos))
 153               (cond ((eq char ?\#)
 154                      (push '(number-to-string replace-count) list))
 155                     ((eq char ?\,)
 156                      (setq pos (read-from-string to))
 157                      (push `(replace-quote ,(car pos)) list)
 158                      (let ((end
 159                             ;; Swallow a space after a symbol
 160                             ;; if there is a space.
 161                             (if (and (or (symbolp (car pos))
 162                                          ;; Swallow a space after 'foo
 163                                          ;; but not after (quote foo).
 164                                          (and (eq (car-safe (car pos)) 'quote)
 165                                               (not (= ?\( (aref to 0)))))
 166                                      (eq (string-match " " to (cdr pos))
 167                                          (cdr pos)))
 168                                 (1+ (cdr pos))
 169                               (cdr pos))))
 170                        (setq to (substring to end)))))
 171               (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)))
 172         (setq to (nreverse (delete "" (cons to list))))
 173         (replace-match-string-symbols to)
 174         (cons 'replace-eval-replacement
 175               (if (cdr to)
 176                   (cons 'concat to)
 177                 (car to))))
 178     to))
 179
 180
 181 (defun query-replace-read-to (from prompt regexp-flag)
 182   "Query and return the `to' argument of a query-replace operation."
 183   (query-replace-compile-replacement
 184    (save-excursion
 185      (let* ((history-add-new-input nil)
 186             (to (read-from-minibuffer
 187                  (format "%s %s with: " prompt (query-replace-descr from))
 188                  nil nil nil
 189                  query-replace-to-history-variable from t)))
 190        (add-to-history query-replace-to-history-variable to nil t)
 191        (setq query-replace-defaults (cons from to))
 192        to))
 193    regexp-flag))
 194
 195 (defun query-replace-read-args (prompt regexp-flag &optional noerror)
 196   (unless noerror
 197     (barf-if-buffer-read-only))
 198   (let* ((from (query-replace-read-from prompt regexp-flag))
 199          (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
 200                (query-replace-read-to from prompt regexp-flag))))
 201     (list from to current-prefix-arg)))
 202
 203 (defun query-replace (from-string to-string &optional delimited start end)
 204   "Replace some occurrences of FROM-STRING with TO-STRING.
 205 As each match is found, the user must type a character saying
 206 what to do with it.  For directions, type \\[help-command] at that time.
 207
 208 In Transient Mark mode, if the mark is active, operate on the contents
 209 of the region.  Otherwise, operate from point to the end of the buffer.
 210
 211 If `query-replace-interactive' is non-nil, the last incremental search
 212 string is used as FROM-STRING--you don't have to specify it with the
 213 minibuffer.
 214
 215 Matching is independent of case if `case-fold-search' is non-nil and
 216 FROM-STRING has no uppercase letters.  Replacement transfers the case
 217 pattern of the old text to the new text, if `case-replace' and
 218 `case-fold-search' are non-nil and FROM-STRING has no uppercase
 219 letters.  \(Transferring the case pattern means that if the old text
 220 matched is all caps, or capitalized, then its replacement is upcased
 221 or capitalized.)
 222
 223 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
 224 only matches surrounded by word boundaries.
 225 Fourth and fifth arg START and END specify the region to operate on.
 226
 227 To customize possible responses, change the \"bindings\" in `query-replace-map'."
 228   (interactive (let ((common
 229                       (query-replace-read-args
 230                        (if (and transient-mark-mode mark-active)
 231                          "Query replace in region"
 232                          "Query replace")
 233                          nil)))
 234                  (list (nth 0 common) (nth 1 common) (nth 2 common)
 235                        ;; These are done separately here
 236                        ;; so that command-history will record these expressions
 237                        ;; rather than the values they had this time.
 238                        (if (and transient-mark-mode mark-active)
 239                            (region-beginning))
 240                        (if (and transient-mark-mode mark-active)
 241                            (region-end)))))
 242   (perform-replace from-string to-string t nil delimited nil nil start end))
 243
 244 (define-key esc-map "%" 'query-replace)
 245
 246 (defun query-replace-regexp (regexp to-string &optional delimited start end)
 247   "Replace some things after point matching REGEXP with TO-STRING.
 248 As each match is found, the user must type a character saying
 249 what to do with it.  For directions, type \\[help-command] at that time.
 250
 251 In Transient Mark mode, if the mark is active, operate on the contents
 252 of the region.  Otherwise, operate from point to the end of the buffer.
 253
 254 If `query-replace-interactive' is non-nil, the last incremental search
 255 regexp is used as REGEXP--you don't have to specify it with the
 256 minibuffer.
 257
 258 Matching is independent of case if `case-fold-search' is non-nil and
 259 REGEXP has no uppercase letters.  Replacement transfers the case
 260 pattern of the old text to the new text, if `case-replace' and
 261 `case-fold-search' are non-nil and REGEXP has no uppercase letters.
 262 \(Transferring the case pattern means that if the old text matched is
 263 all caps, or capitalized, then its replacement is upcased or
 264 capitalized.)
 265
 266 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
 267 only matches surrounded by word boundaries.
 268 Fourth and fifth arg START and END specify the region to operate on.
 269
 270 In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
 271 and `\\=\\N' (where N is a digit) stands for
 272 whatever what matched the Nth `\\(...\\)' in REGEXP.
 273 `\\?' lets you edit the replacement text in the minibuffer
 274 at the given position for each replacement.
 275
 276 In interactive calls, the replacement text can contain `\\,'
 277 followed by a Lisp expression.  Each
 278 replacement evaluates that expression to compute the replacement
 279 string.  Inside of that expression, `\\&' is a string denoting the
 280 whole match as a string, `\\N' for a partial match, `\\#&' and `\\#N'
 281 for the whole or a partial match converted to a number with
 282 `string-to-number', and `\\#' itself for the number of replacements
 283 done so far (starting with zero).
 284
 285 If the replacement expression is a symbol, write a space after it
 286 to terminate it.  One space there, if any, will be discarded.
 287
 288 When using those Lisp features interactively in the replacement
 289 text, TO-STRING is actually made a list instead of a string.
 290 Use \\[repeat-complex-command] after this command for details."
 291   (interactive
 292    (let ((common
 293           (query-replace-read-args
 294            (if (and transient-mark-mode mark-active)
 295                "Query replace regexp in region"
 296              "Query replace regexp")
 297            t)))
 298      (list (nth 0 common) (nth 1 common) (nth 2 common)
 299            ;; These are done separately here
 300            ;; so that command-history will record these expressions
 301            ;; rather than the values they had this time.
 302            (if (and transient-mark-mode mark-active)
 303                (region-beginning))
 304            (if (and transient-mark-mode mark-active)
 305                (region-end)))))
 306   (perform-replace regexp to-string t t delimited nil nil start end))
 307
 308 (define-key esc-map [?\C-%] 'query-replace-regexp)
 309
 310 (defun query-replace-regexp-eval (regexp to-expr &optional delimited start end)
 311   "Replace some things after point matching REGEXP with the result of TO-EXPR.
 312
 313 Interactive use of this function is deprecated in favor of the
 314 `\\,' feature of `query-replace-regexp'.  For non-interactive use, a loop
 315 using `search-forward-regexp' and `replace-match' is preferred.
 316
 317 As each match is found, the user must type a character saying
 318 what to do with it.  For directions, type \\[help-command] at that time.
 319
 320 TO-EXPR is a Lisp expression evaluated to compute each replacement.  It may
 321 reference `replace-count' to get the number of replacements already made.
 322 If the result of TO-EXPR is not a string, it is converted to one using
 323 `prin1-to-string' with the NOESCAPE argument (which see).
 324
 325 For convenience, when entering TO-EXPR interactively, you can use `\\&' or
 326 `\\0' to stand for whatever matched the whole of REGEXP, and `\\N' (where
 327 N is a digit) to stand for whatever matched the Nth `\\(...\\)' in REGEXP.
 328 Use `\\#&' or `\\#N' if you want a number instead of a string.
 329 In interactive use, `\\#' in itself stands for `replace-count'.
 330
 331 In Transient Mark mode, if the mark is active, operate on the contents
 332 of the region.  Otherwise, operate from point to the end of the buffer.
 333
 334 If `query-replace-interactive' is non-nil, the last incremental search
 335 regexp is used as REGEXP--you don't have to specify it with the
 336 minibuffer.
 337
 338 Preserves case in each replacement if `case-replace' and `case-fold-search'
 339 are non-nil and REGEXP has no uppercase letters.
 340
 341 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
 342 only matches that are surrounded by word boundaries.
 343 Fourth and fifth arg START and END specify the region to operate on."
 344   (interactive
 345    (progn
 346    (barf-if-buffer-read-only)
 347    (let* ((from
 348            ;; Let-bind the history var to disable the "foo -> bar" default.
 349            ;; Maybe we shouldn't disable this default, but for now I'll
 350            ;; leave it off.  --Stef
 351            (let ((query-replace-to-history-variable nil))
 352              (query-replace-read-from "Query replace regexp" t)))
 353           (to (list (read-from-minibuffer
 354                      (format "Query replace regexp %s with eval: "
 355                              (query-replace-descr from))
 356                      nil nil t query-replace-to-history-variable from t))))
 357      ;; We make TO a list because replace-match-string-symbols requires one,
 358      ;; and the user might enter a single token.
 359      (replace-match-string-symbols to)
 360      (list from (car to) current-prefix-arg
 361            (if (and transient-mark-mode mark-active)
 362                (region-beginning))
 363            (if (and transient-mark-mode mark-active)
 364                (region-end))))))
 365   (perform-replace regexp (cons 'replace-eval-replacement to-expr)
 366                    t 'literal delimited nil nil start end))
 367
 368 (make-obsolete 'query-replace-regexp-eval
 369   "for interactive use, use the special `\\,' feature of
 370 `query-replace-regexp' instead.  Non-interactively, a loop
 371 using `search-forward-regexp' and `replace-match' is preferred." "22.1")
 372
 373 (defun map-query-replace-regexp (regexp to-strings &optional n start end)
 374   "Replace some matches for REGEXP with various strings, in rotation.
 375 The second argument TO-STRINGS contains the replacement strings, separated
 376 by spaces.  This command works like `query-replace-regexp' except that
 377 each successive replacement uses the next successive replacement string,
 378 wrapping around from the last such string to the first.
 379
 380 In Transient Mark mode, if the mark is active, operate on the contents
 381 of the region.  Otherwise, operate from point to the end of the buffer.
 382
 383 Non-interactively, TO-STRINGS may be a list of replacement strings.
 384
 385 If `query-replace-interactive' is non-nil, the last incremental search
 386 regexp is used as REGEXP--you don't have to specify it with the minibuffer.
 387
 388 A prefix argument N says to use each replacement string N times
 389 before rotating to the next.
 390 Fourth and fifth arg START and END specify the region to operate on."
 391   (interactive
 392    (let* ((from (if query-replace-interactive
 393                     (car regexp-search-ring)
 394                   (read-from-minibuffer "Map query replace (regexp): "
 395                                         nil nil nil
 396                                         'query-replace-history nil t)))
 397           (to (read-from-minibuffer
 398                (format "Query replace %s with (space-separated strings): "
 399                        (query-replace-descr from))
 400                nil nil nil
 401                'query-replace-history from t)))
 402      (list from to
 403            (and current-prefix-arg
 404                 (prefix-numeric-value current-prefix-arg))
 405            (if (and transient-mark-mode mark-active)
 406                (region-beginning))
 407            (if (and transient-mark-mode mark-active)
 408                (region-end)))))
 409   (let (replacements)
 410     (if (listp to-strings)
 411         (setq replacements to-strings)
 412       (while (/= (length to-strings) 0)
 413         (if (string-match " " to-strings)
 414             (setq replacements
 415                   (append replacements
 416                           (list (substring to-strings 0
 417                                            (string-match " " to-strings))))
 418                   to-strings (substring to-strings
 419                                        (1+ (string-match " " to-strings))))
 420           (setq replacements (append replacements (list to-strings))
 421                 to-strings ""))))
 422     (perform-replace regexp replacements t t nil n nil start end)))
 423
 424 (defun replace-string (from-string to-string &optional delimited start end)
 425   "Replace occurrences of FROM-STRING with TO-STRING.
 426 Preserve case in each match if `case-replace' and `case-fold-search'
 427 are non-nil and FROM-STRING has no uppercase letters.
 428 \(Preserving case means that if the string matched is all caps, or capitalized,
 429 then its replacement is upcased or capitalized.)
 430
 431 In Transient Mark mode, if the mark is active, operate on the contents
 432 of the region.  Otherwise, operate from point to the end of the buffer.
 433
 434 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
 435 only matches surrounded by word boundaries.
 436 Fourth and fifth arg START and END specify the region to operate on.
 437
 438 If `query-replace-interactive' is non-nil, the last incremental search
 439 string is used as FROM-STRING--you don't have to specify it with the
 440 minibuffer.
 441
 442 This function is usually the wrong thing to use in a Lisp program.
 443 What you probably want is a loop like this:
 444   (while (search-forward FROM-STRING nil t)
 445     (replace-match TO-STRING nil t))
 446 which will run faster and will not set the mark or print anything.
 447 \(You may need a more complex loop if FROM-STRING can match the null string
 448 and TO-STRING is also null.)"
 449   (interactive
 450    (let ((common
 451           (query-replace-read-args
 452            (if (and transient-mark-mode mark-active)
 453                "Replace string in region"
 454              "Replace string")
 455            nil)))
 456      (list (nth 0 common) (nth 1 common) (nth 2 common)
 457            (if (and transient-mark-mode mark-active)
 458                (region-beginning))
 459            (if (and transient-mark-mode mark-active)
 460                (region-end)))))
 461   (perform-replace from-string to-string nil nil delimited nil nil start end))
 462
 463 (defun replace-regexp (regexp to-string &optional delimited start end)
 464   "Replace things after point matching REGEXP with TO-STRING.
 465 Preserve case in each match if `case-replace' and `case-fold-search'
 466 are non-nil and REGEXP has no uppercase letters.
 467
 468 In Transient Mark mode, if the mark is active, operate on the contents
 469 of the region.  Otherwise, operate from point to the end of the buffer.
 470
 471 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
 472 only matches surrounded by word boundaries.
 473 Fourth and fifth arg START and END specify the region to operate on.
 474
 475 In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
 476 and `\\=\\N' (where N is a digit) stands for
 477 whatever what matched the Nth `\\(...\\)' in REGEXP.
 478 `\\?' lets you edit the replacement text in the minibuffer
 479 at the given position for each replacement.
 480
 481 In interactive calls, the replacement text may contain `\\,'
 482 followed by a Lisp expression used as part of the replacement
 483 text.  Inside of that expression, `\\&' is a string denoting the
 484 whole match, `\\N' a partial match, `\\#&' and `\\#N' the respective
 485 numeric values from `string-to-number', and `\\#' itself for
 486 `replace-count', the number of replacements occurred so far.
 487
 488 If your Lisp expression is an identifier and the next letter in
 489 the replacement string would be interpreted as part of it, you
 490 can wrap it with an expression like `\\,(or \\#)'.  Incidentally,
 491 for this particular case you may also enter `\\#' in the
 492 replacement text directly.
 493
 494 When using those Lisp features interactively in the replacement
 495 text, TO-STRING is actually made a list instead of a string.
 496 Use \\[repeat-complex-command] after this command for details.
 497
 498 If `query-replace-interactive' is non-nil, the last incremental search
 499 regexp is used as REGEXP--you don't have to specify it with the minibuffer.
 500
 501 This function is usually the wrong thing to use in a Lisp program.
 502 What you probably want is a loop like this:
 503   (while (re-search-forward REGEXP nil t)
 504     (replace-match TO-STRING nil nil))
 505 which will run faster and will not set the mark or print anything."
 506   (interactive
 507    (let ((common
 508           (query-replace-read-args
 509            (if (and transient-mark-mode mark-active)
 510                "Replace regexp in region"
 511              "Replace regexp")
 512            t)))
 513      (list (nth 0 common) (nth 1 common) (nth 2 common)
 514            (if (and transient-mark-mode mark-active)
 515                (region-beginning))
 516            (if (and transient-mark-mode mark-active)
 517                (region-end)))))
 518   (perform-replace regexp to-string nil t delimited nil nil start end))
 519
 520 \f
 521 (defvar regexp-history nil
 522   "History list for some commands that read regular expressions.")
 523
 524
 525 (defalias 'delete-non-matching-lines 'keep-lines)
 526 (defalias 'delete-matching-lines 'flush-lines)
 527 (defalias 'count-matches 'how-many)
 528
 529
 530 (defun keep-lines-read-args (prompt)
 531   "Read arguments for `keep-lines' and friends.
 532 Prompt for a regexp with PROMPT.
 533 Value is a list, (REGEXP)."
 534   (let* ((default (list
 535                    (regexp-quote
 536                     (or (funcall (or find-tag-default-function
 537                                      (get major-mode 'find-tag-default-function)
 538                                      'find-tag-default))
 539                         ""))
 540                    (car regexp-search-ring)
 541                    (regexp-quote (or (car search-ring) ""))
 542                    (car (symbol-value
 543                          query-replace-from-history-variable))))
 544          (default (delete-dups (delq nil (delete "" default)))))
 545     (list (read-from-minibuffer prompt nil nil nil
 546                                 'regexp-history default t)
 547           nil nil t)))
 548
 549 (defun keep-lines (regexp &optional rstart rend interactive)
 550   "Delete all lines except those containing matches for REGEXP.
 551 A match split across lines preserves all the lines it lies in.
 552 When called from Lisp (and usually interactively as well, see below)
 553 applies to all lines starting after point.
 554
 555 If REGEXP contains upper case characters (excluding those preceded by `\\'),
 556 the matching is case-sensitive.
 557
 558 Second and third arg RSTART and REND specify the region to operate on.
 559 This command operates on (the accessible part of) all lines whose
 560 accessible part is entirely contained in the region determined by RSTART
 561 and REND.  (A newline ending a line counts as part of that line.)
 562
 563 Interactively, in Transient Mark mode when the mark is active, operate
 564 on all lines whose accessible part is entirely contained in the region.
 565 Otherwise, the command applies to all lines starting after point.
 566 When calling this function from Lisp, you can pretend that it was
 567 called interactively by passing a non-nil INTERACTIVE argument.
 568
 569 This function starts looking for the next match from the end of
 570 the previous match.  Hence, it ignores matches that overlap
 571 a previously found match."
 572
 573   (interactive
 574    (progn
 575      (barf-if-buffer-read-only)
 576      (keep-lines-read-args "Keep lines (containing match for regexp): ")))
 577   (if rstart
 578       (progn
 579         (goto-char (min rstart rend))
 580         (setq rend
 581               (progn
 582                 (save-excursion
 583                   (goto-char (max rstart rend))
 584                   (unless (or (bolp) (eobp))
 585                     (forward-line 0))
 586                   (point-marker)))))
 587     (if (and interactive transient-mark-mode mark-active)
 588         (setq rstart (region-beginning)
 589               rend (progn
 590                      (goto-char (region-end))
 591                      (unless (or (bolp) (eobp))
 592                        (forward-line 0))
 593                      (point-marker)))
 594       (setq rstart (point)
 595             rend (point-max-marker)))
 596     (goto-char rstart))
 597   (save-excursion
 598     (or (bolp) (forward-line 1))
 599     (let ((start (point))
 600           (case-fold-search  (and case-fold-search
 601                                   (isearch-no-upper-case-p regexp t))))
 602       (while (< (point) rend)
 603         ;; Start is first char not preserved by previous match.
 604         (if (not (re-search-forward regexp rend 'move))
 605             (delete-region start rend)
 606           (let ((end (save-excursion (goto-char (match-beginning 0))
 607                                      (forward-line 0)
 608                                      (point))))
 609             ;; Now end is first char preserved by the new match.
 610             (if (< start end)
 611                 (delete-region start end))))
 612
 613         (setq start (save-excursion (forward-line 1) (point)))
 614         ;; If the match was empty, avoid matching again at same place.
 615         (and (< (point) rend)
 616              (= (match-beginning 0) (match-end 0))
 617              (forward-char 1)))))
 618   (set-marker rend nil)
 619   nil)
 620
 621
 622 (defun flush-lines (regexp &optional rstart rend interactive)
 623  "Delete lines containing matches for REGEXP.
 624 When called from Lisp (and usually when called interactively as
 625 well, see below), applies to the part of the buffer after point.
 626 The line point is in is deleted if and only if it contains a
 627 match for regexp starting after point.
 628
 629 If REGEXP contains upper case characters (excluding those preceded by `\\'),
 630 the matching is case-sensitive.
 631
 632 Second and third arg RSTART and REND specify the region to operate on.
 633 Lines partially contained in this region are deleted if and only if
 634 they contain a match entirely contained in it.
 635
 636 Interactively, in Transient Mark mode when the mark is active, operate
 637 on the contents of the region.  Otherwise, operate from point to the
 638 end of (the accessible portion of) the buffer.  When calling this function
 639 from Lisp, you can pretend that it was called interactively by passing
 640 a non-nil INTERACTIVE argument.
 641
 642 If a match is split across lines, all the lines it lies in are deleted.
 643 They are deleted _before_ looking for the next match.  Hence, a match
 644 starting on the same line at which another match ended is ignored."
 645
 646   (interactive
 647    (progn
 648      (barf-if-buffer-read-only)
 649      (keep-lines-read-args "Flush lines (containing match for regexp): ")))
 650   (if rstart
 651       (progn
 652         (goto-char (min rstart rend))
 653         (setq rend (copy-marker (max rstart rend))))
 654     (if (and interactive transient-mark-mode mark-active)
 655         (setq rstart (region-beginning)
 656               rend (copy-marker (region-end)))
 657       (setq rstart (point)
 658             rend (point-max-marker)))
 659     (goto-char rstart))
 660   (let ((case-fold-search (and case-fold-search
 661                                (isearch-no-upper-case-p regexp t))))
 662     (save-excursion
 663       (while (and (< (point) rend)
 664                   (re-search-forward regexp rend t))
 665         (delete-region (save-excursion (goto-char (match-beginning 0))
 666                                        (forward-line 0)
 667                                        (point))
 668                        (progn (forward-line 1) (point))))))
 669   (set-marker rend nil)
 670   nil)
 671
 672
 673 (defun how-many (regexp &optional rstart rend interactive)
 674   "Print and return number of matches for REGEXP following point.
 675 When called from Lisp and INTERACTIVE is omitted or nil, just return
 676 the number, do not print it; if INTERACTIVE is t, the function behaves
 677 in all respects has if it had been called interactively.
 678
 679 If REGEXP contains upper case characters (excluding those preceded by `\\'),
 680 the matching is case-sensitive.
 681
 682 Second and third arg RSTART and REND specify the region to operate on.
 683
 684 Interactively, in Transient Mark mode when the mark is active, operate
 685 on the contents of the region.  Otherwise, operate from point to the
 686 end of (the accessible portion of) the buffer.
 687
 688 This function starts looking for the next match from the end of
 689 the previous match.  Hence, it ignores matches that overlap
 690 a previously found match."
 691
 692   (interactive
 693    (keep-lines-read-args "How many matches for (regexp): "))
 694   (save-excursion
 695     (if rstart
 696         (progn
 697           (goto-char (min rstart rend))
 698           (setq rend (max rstart rend)))
 699       (if (and interactive transient-mark-mode mark-active)
 700           (setq rstart (region-beginning)
 701                 rend (region-end))
 702         (setq rstart (point)
 703               rend (point-max)))
 704       (goto-char rstart))
 705     (let ((count 0)
 706           opoint
 707           (case-fold-search (and case-fold-search
 708                                  (isearch-no-upper-case-p regexp t))))
 709       (while (and (< (point) rend)
 710                   (progn (setq opoint (point))
 711                          (re-search-forward regexp rend t)))
 712         (if (= opoint (point))
 713             (forward-char 1)
 714           (setq count (1+ count))))
 715       (when interactive (message "%d occurrence%s"
 716                                  count
 717                                  (if (= count 1) "" "s")))
 718       count)))
 719
 720 \f
 721 (defvar occur-mode-map
 722   (let ((map (make-sparse-keymap)))
 723     ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto].
 724     (define-key map [mouse-2] 'occur-mode-mouse-goto)
 725     (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
 726     (define-key map "\C-m" 'occur-mode-goto-occurrence)
 727     (define-key map "o" 'occur-mode-goto-occurrence-other-window)
 728     (define-key map "\C-o" 'occur-mode-display-occurrence)
 729     (define-key map "\M-n" 'occur-next)
 730     (define-key map "\M-p" 'occur-prev)
 731     (define-key map "r" 'occur-rename-buffer)
 732     (define-key map "c" 'clone-buffer)
 733     (define-key map "g" 'revert-buffer)
 734     (define-key map "q" 'quit-window)
 735     (define-key map "z" 'kill-this-buffer)
 736     (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
 737     (define-key map [menu-bar] (make-sparse-keymap))
 738     (define-key map [menu-bar occur]
 739       (cons "Occur" map))
 740     (define-key map [next-error-follow-minor-mode]
 741       (menu-bar-make-mm-toggle next-error-follow-minor-mode
 742                                "Auto Occurrence Display"
 743                                "Display another occurrence when moving the cursor"))
 744     (define-key map [separator-1] '("--"))
 745     (define-key map [kill-this-buffer]
 746       '("Kill occur buffer" . kill-this-buffer))
 747     (define-key map [quit-window]
 748       '("Quit occur window" . quit-window))
 749     (define-key map [revert-buffer]
 750       '("Revert occur buffer" . revert-buffer))
 751     (define-key map [clone-buffer]
 752       '("Clone occur buffer" . clone-buffer))
 753     (define-key map [occur-rename-buffer]
 754       '("Rename occur buffer" . occur-rename-buffer))
 755     (define-key map [separator-2] '("--"))
 756     (define-key map [occur-mode-goto-occurrence-other-window]
 757       '("Go To Occurrence Other Window" . occur-mode-goto-occurrence-other-window))
 758     (define-key map [occur-mode-goto-occurrence]
 759       '("Go To Occurrence" . occur-mode-goto-occurrence))
 760     (define-key map [occur-mode-display-occurrence]
 761       '("Display Occurrence" . occur-mode-display-occurrence))
 762     (define-key map [occur-next]
 763       '("Move to next match" . occur-next))
 764     (define-key map [occur-prev]
 765       '("Move to previous match" . occur-prev))
 766     map)
 767   "Keymap for `occur-mode'.")
 768
 769 (defvar occur-revert-arguments nil
 770   "Arguments to pass to `occur-1' to revert an Occur mode buffer.
 771 See `occur-revert-function'.")
 772
 773 (defcustom occur-mode-hook '(turn-on-font-lock)
 774   "Hook run when entering Occur mode."
 775   :type 'hook
 776   :group 'matching)
 777
 778 (defcustom occur-hook nil
 779   "Hook run by Occur when there are any matches."
 780   :type 'hook
 781   :group 'matching)
 782
 783 (put 'occur-mode 'mode-class 'special)
 784 (defun occur-mode ()
 785   "Major mode for output from \\[occur].
 786 \\<occur-mode-map>Move point to one of the items in this buffer, then use
 787 \\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to.
 788 Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
 789
 790 \\{occur-mode-map}"
 791   (interactive)
 792   (kill-all-local-variables)
 793   (use-local-map occur-mode-map)
 794   (setq major-mode 'occur-mode)
 795   (setq mode-name "Occur")
 796   (set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
 797   (make-local-variable 'occur-revert-arguments)
 798   (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
 799   (setq next-error-function 'occur-next-error)
 800   (run-mode-hooks 'occur-mode-hook))
 801
 802 (defun occur-revert-function (ignore1 ignore2)
 803   "Handle `revert-buffer' for Occur mode buffers."
 804   (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))
 805
 806 (defun occur-mode-find-occurrence ()
 807   (let ((pos (get-text-property (point) 'occur-target)))
 808     (unless pos
 809       (error "No occurrence on this line"))
 810     (unless (buffer-live-p (marker-buffer pos))
 811       (error "Buffer for this occurrence was killed"))
 812     pos))
 813
 814 (defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence)
 815 (defun occur-mode-goto-occurrence (&optional event)
 816   "Go to the occurrence the current line describes."
 817   (interactive (list last-nonmenu-event))
 818   (let ((pos
 819          (if (null event)
 820              ;; Actually `event-end' works correctly with a nil argument as
 821              ;; well, so we could dispense with this test, but let's not
 822              ;; rely on this undocumented behavior.
 823              (occur-mode-find-occurrence)
 824            (with-current-buffer (window-buffer (posn-window (event-end event)))
 825              (save-excursion
 826                (goto-char (posn-point (event-end event)))
 827                (occur-mode-find-occurrence)))))
 828         same-window-buffer-names
 829         same-window-regexps)
 830     (pop-to-buffer (marker-buffer pos))
 831     (goto-char pos)))
 832
 833 (defun occur-mode-goto-occurrence-other-window ()
 834   "Go to the occurrence the current line describes, in another window."
 835   (interactive)
 836   (let ((pos (occur-mode-find-occurrence)))
 837     (switch-to-buffer-other-window (marker-buffer pos))
 838     (goto-char pos)))
 839
 840 (defun occur-mode-display-occurrence ()
 841   "Display in another window the occurrence the current line describes."
 842   (interactive)
 843   (let ((pos (occur-mode-find-occurrence))
 844         window
 845         ;; Bind these to ensure `display-buffer' puts it in another window.
 846         same-window-buffer-names
 847         same-window-regexps)
 848     (setq window (display-buffer (marker-buffer pos)))
 849     ;; This is the way to set point in the proper window.
 850     (save-selected-window
 851       (select-window window)
 852       (goto-char pos))))
 853
 854 (defun occur-find-match (n search message)
 855   (if (not n) (setq n 1))
 856   (let ((r))
 857     (while (> n 0)
 858       (setq r (funcall search (point) 'occur-match))
 859       (and r
 860            (get-text-property r 'occur-match)
 861            (setq r (funcall search r 'occur-match)))
 862       (if r
 863           (goto-char r)
 864         (error message))
 865       (setq n (1- n)))))
 866
 867 (defun occur-next (&optional n)
 868   "Move to the Nth (default 1) next match in an Occur mode buffer."
 869   (interactive "p")
 870   (occur-find-match n #'next-single-property-change "No more matches"))
 871
 872 (defun occur-prev (&optional n)
 873   "Move to the Nth (default 1) previous match in an Occur mode buffer."
 874   (interactive "p")
 875   (occur-find-match n #'previous-single-property-change "No earlier matches"))
 876
 877 (defun occur-next-error (&optional argp reset)
 878   "Move to the Nth (default 1) next match in an Occur mode buffer.
 879 Compatibility function for \\[next-error] invocations."
 880   (interactive "p")
 881   ;; we need to run occur-find-match from within the Occur buffer
 882   (with-current-buffer
 883       ;; Choose the buffer and make it current.
 884       (if (next-error-buffer-p (current-buffer))
 885           (current-buffer)
 886         (next-error-find-buffer nil nil
 887                                 (lambda ()
 888                                   (eq major-mode 'occur-mode))))
 889
 890     (goto-char (cond (reset (point-min))
 891                      ((< argp 0) (line-beginning-position))
 892                      ((> argp 0) (line-end-position))
 893                      ((point))))
 894     (occur-find-match
 895      (abs argp)
 896      (if (> 0 argp)
 897          #'previous-single-property-change
 898        #'next-single-property-change)
 899      "No more matches")
 900     ;; In case the *Occur* buffer is visible in a nonselected window.
 901     (let ((win (get-buffer-window (current-buffer) t)))
 902       (if win (set-window-point win (point))))
 903     (occur-mode-goto-occurrence)))
 904 \f
 905 (defface match
 906   '((((class color) (min-colors 88) (background light))
 907      :background "yellow1")
 908     (((class color) (min-colors 88) (background dark))
 909      :background "RoyalBlue3")
 910     (((class color) (min-colors 8) (background light))
 911      :background "yellow" :foreground "black")
 912     (((class color) (min-colors 8) (background dark))
 913      :background "blue" :foreground "white")
 914     (((type tty) (class mono))
 915      :inverse-video t)
 916     (t :background "gray"))
 917   "Face used to highlight matches permanently."
 918   :group 'matching
 919   :version "22.1")
 920
 921 (defcustom list-matching-lines-default-context-lines 0
 922   "*Default number of context lines included around `list-matching-lines' matches.
 923 A negative number means to include that many lines before the match.
 924 A positive number means to include that many lines both before and after."
 925   :type 'integer
 926   :group 'matching)
 927
 928 (defalias 'list-matching-lines 'occur)
 929
 930 (defcustom list-matching-lines-face 'match
 931   "*Face used by \\[list-matching-lines] to show the text that matches.
 932 If the value is nil, don't highlight the matching portions specially."
 933   :type 'face
 934   :group 'matching)
 935
 936 (defcustom list-matching-lines-buffer-name-face 'underline
 937   "*Face used by \\[list-matching-lines] to show the names of buffers.
 938 If the value is nil, don't highlight the buffer names specially."
 939   :type 'face
 940   :group 'matching)
 941
 942 (defcustom occur-excluded-properties
 943   '(read-only invisible intangible field mouse-face help-echo local-map keymap
 944     yank-handler follow-link)
 945   "*Text properties to discard when copying lines to the *Occur* buffer.
 946 The value should be a list of text properties to discard or t,
 947 which means to discard all text properties."
 948   :type '(choice (const :tag "All" t) (repeat symbol))
 949   :group 'matching
 950   :version "22.1")
 951
 952 (defun occur-accumulate-lines (count &optional keep-props)
 953   (save-excursion
 954     (let ((forwardp (> count 0))
 955           result beg end)
 956       (while (not (or (zerop count)
 957                       (if forwardp
 958                           (eobp)
 959                         (bobp))))
 960         (setq count (+ count (if forwardp -1 1)))
 961         (setq beg (line-beginning-position)
 962               end (line-end-position))
 963         (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
 964                  (text-property-not-all beg end 'fontified t))
 965             (if (fboundp 'jit-lock-fontify-now)
 966                 (jit-lock-fontify-now beg end)))
 967         (push
 968          (if (and keep-props (not (eq occur-excluded-properties t)))
 969              (let ((str (buffer-substring beg end)))
 970                (remove-list-of-text-properties
 971                 0 (length str) occur-excluded-properties str)
 972                str)
 973            (buffer-substring-no-properties beg end))
 974          result)
 975         (forward-line (if forwardp 1 -1)))
 976       (nreverse result))))
 977
 978 (defun occur-read-primary-args ()
 979   (let* ((default
 980            (list (and transient-mark-mode mark-active
 981                       (regexp-quote
 982                        (buffer-substring-no-properties
 983                         (region-beginning) (region-end))))
 984                  (regexp-quote
 985                   (or (funcall
 986                        (or find-tag-default-function
 987                            (get major-mode 'find-tag-default-function)
 988                            'find-tag-default))
 989                       ""))
 990                  (car regexp-search-ring)
 991                  (regexp-quote (or (car search-ring) ""))
 992                  (car (symbol-value
 993                        query-replace-from-history-variable))))
 994          (default (delete-dups (delq nil (delete "" default))))
 995          (input
 996           (read-from-minibuffer
 997            "List lines matching regexp: "
 998            nil nil nil 'regexp-history default)))
 999     (list input
1000           (when current-prefix-arg
1001             (prefix-numeric-value current-prefix-arg)))))
1002
1003 (defun occur-rename-buffer (&optional unique-p interactive-p)
1004   "Rename the current *Occur* buffer to *Occur: original-buffer-name*.
1005 Here `original-buffer-name' is the buffer name were Occur was originally run.
1006 When given the prefix argument, or called non-interactively, the renaming
1007 will not clobber the existing buffer(s) of that name, but use
1008 `generate-new-buffer-name' instead.  You can add this to `occur-hook'
1009 if you always want a separate *Occur* buffer for each buffer where you
1010 invoke `occur'."
1011   (interactive "P\np")
1012   (with-current-buffer
1013       (if (eq major-mode 'occur-mode) (current-buffer) (get-buffer "*Occur*"))
1014     (rename-buffer (concat "*Occur: "
1015                            (mapconcat #'buffer-name
1016                                       (car (cddr occur-revert-arguments)) "/")
1017                            "*")
1018                    (or unique-p (not interactive-p)))))
1019
1020 (defun occur (regexp &optional nlines)
1021   "Show all lines in the current buffer containing a match for REGEXP.
1022 This function can not handle matches that span more than one line.
1023
1024 Each line is displayed with NLINES lines before and after, or -NLINES
1025 before if NLINES is negative.
1026 NLINES defaults to `list-matching-lines-default-context-lines'.
1027 Interactively it is the prefix arg.
1028
1029 The lines are shown in a buffer named `*Occur*'.
1030 It serves as a menu to find any of the occurrences in this buffer.
1031 \\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
1032
1033 If REGEXP contains upper case characters (excluding those preceded by `\\'),
1034 the matching is case-sensitive."
1035   (interactive (occur-read-primary-args))
1036   (occur-1 regexp nlines (list (current-buffer))))
1037
1038 (defun multi-occur (bufs regexp &optional nlines)
1039   "Show all lines in buffers BUFS containing a match for REGEXP.
1040 This function acts on multiple buffers; otherwise, it is exactly like
1041 `occur'.  When you invoke this command interactively, you must specify
1042 the buffer names that you want, one by one."
1043   (interactive
1044    (cons
1045     (let* ((bufs (list (read-buffer "First buffer to search: "
1046                                     (current-buffer) t)))
1047            (buf nil)
1048            (ido-ignore-item-temp-list bufs))
1049       (while (not (string-equal
1050                    (setq buf (read-buffer
1051                               (if (eq read-buffer-function 'ido-read-buffer)
1052                                   "Next buffer to search (C-j to end): "
1053                                 "Next buffer to search (RET to end): ")
1054                               nil t))
1055                    ""))
1056         (add-to-list 'bufs buf)
1057         (setq ido-ignore-item-temp-list bufs))
1058       (nreverse (mapcar #'get-buffer bufs)))
1059     (occur-read-primary-args)))
1060   (occur-1 regexp nlines bufs))
1061
1062 (defun multi-occur-in-matching-buffers (bufregexp regexp &optional allbufs)
1063   "Show all lines matching REGEXP in buffers specified by BUFREGEXP.
1064 Normally BUFREGEXP matches against each buffer's visited file name,
1065 but if you specify a prefix argument, it matches against the buffer name.
1066 See also `multi-occur'."
1067   (interactive
1068    (cons
1069     (let* ((default (car regexp-history))
1070            (input
1071             (read-from-minibuffer
1072              (if current-prefix-arg
1073                  "List lines in buffers whose names match regexp: "
1074                "List lines in buffers whose filenames match regexp: ")
1075              nil
1076              nil
1077              nil
1078              'regexp-history)))
1079       (if (equal input "")
1080           default
1081         input))
1082     (occur-read-primary-args)))
1083   (when bufregexp
1084     (occur-1 regexp nil
1085              (delq nil
1086                    (mapcar (lambda (buf)
1087                              (when (if allbufs
1088                                        (string-match bufregexp
1089                                                      (buffer-name buf))
1090                                      (and (buffer-file-name buf)
1091                                           (string-match bufregexp
1092                                                         (buffer-file-name buf))))
1093                                buf))
1094                            (buffer-list))))))
1095
1096 (defun occur-1 (regexp nlines bufs &optional buf-name)
1097   (unless buf-name
1098     (setq buf-name "*Occur*"))
1099   (let (occur-buf
1100         (active-bufs (delq nil (mapcar #'(lambda (buf)
1101                                            (when (buffer-live-p buf) buf))
1102                                        bufs))))
1103     ;; Handle the case where one of the buffers we're searching is the
1104     ;; output buffer.  Just rename it.
1105     (when (member buf-name (mapcar 'buffer-name active-bufs))
1106       (with-current-buffer (get-buffer buf-name)
1107         (rename-uniquely)))
1108
1109     ;; Now find or create the output buffer.
1110     ;; If we just renamed that buffer, we will make a new one here.
1111     (setq occur-buf (get-buffer-create buf-name))
1112
1113     (with-current-buffer occur-buf
1114       (occur-mode)
1115       (let ((inhibit-read-only t)
1116             ;; Don't generate undo entries for creation of the initial contents.
1117             (buffer-undo-list t))
1118         (erase-buffer)
1119         (let ((count (occur-engine
1120                       regexp active-bufs occur-buf
1121                       (or nlines list-matching-lines-default-context-lines)
1122                       (and case-fold-search
1123                            (isearch-no-upper-case-p regexp t))
1124                       list-matching-lines-buffer-name-face
1125                       nil list-matching-lines-face
1126                       (not (eq occur-excluded-properties t)))))
1127           (let* ((bufcount (length active-bufs))
1128                  (diff (- (length bufs) bufcount)))
1129             (message "Searched %d buffer%s%s; %s match%s for `%s'"
1130                      bufcount (if (= bufcount 1) "" "s")
1131                      (if (zerop diff) "" (format " (%d killed)" diff))
1132                      (if (zerop count) "no" (format "%d" count))
1133                      (if (= count 1) "" "es")
1134                      regexp))
1135           (setq occur-revert-arguments (list regexp nlines bufs))
1136           (if (= count 0)
1137               (kill-buffer occur-buf)
1138             (display-buffer occur-buf)
1139             (setq next-error-last-buffer occur-buf)
1140             (setq buffer-read-only t)
1141             (set-buffer-modified-p nil)
1142             (run-hooks 'occur-hook)))))))
1143
1144 (defun occur-engine-add-prefix (lines)
1145   (mapcar
1146    #'(lambda (line)
1147        (concat "       :" line "\n"))
1148    lines))
1149
1150 (defun occur-engine (regexp buffers out-buf nlines case-fold-search
1151                             title-face prefix-face match-face keep-props)
1152   (with-current-buffer out-buf
1153     (let ((globalcount 0)
1154           (coding nil))
1155       ;; Map over all the buffers
1156       (dolist (buf buffers)
1157         (when (buffer-live-p buf)
1158           (let ((matches 0)     ;; count of matched lines
1159                 (lines 1)       ;; line count
1160                 (matchbeg 0)
1161                 (origpt nil)
1162                 (begpt nil)
1163                 (endpt nil)
1164                 (marker nil)
1165                 (curstring "")
1166                 (inhibit-field-text-motion t)
1167                 (headerpt (with-current-buffer out-buf (point))))
1168             (with-current-buffer buf
1169               (or coding
1170                   ;; Set CODING only if the current buffer locally
1171                   ;; binds buffer-file-coding-system.
1172                   (not (local-variable-p 'buffer-file-coding-system))
1173                   (setq coding buffer-file-coding-system))
1174               (save-excursion
1175                 (goto-char (point-min)) ;; begin searching in the buffer
1176                 (while (not (eobp))
1177                   (setq origpt (point))
1178                   (when (setq endpt (re-search-forward regexp nil t))
1179                     (setq matches (1+ matches)) ;; increment match count
1180                     (setq matchbeg (match-beginning 0))
1181                     (setq lines (+ lines (1- (count-lines origpt endpt))))
1182                     (save-excursion
1183                       (goto-char matchbeg)
1184                       (setq begpt (line-beginning-position)
1185                             endpt (line-end-position)))
1186                     (setq marker (make-marker))
1187                     (set-marker marker matchbeg)
1188                     (if (and keep-props
1189                              (if (boundp 'jit-lock-mode) jit-lock-mode)
1190                              (text-property-not-all begpt endpt 'fontified t))
1191                         (if (fboundp 'jit-lock-fontify-now)
1192                             (jit-lock-fontify-now begpt endpt)))
1193                     (if (and keep-props (not (eq occur-excluded-properties t)))
1194                         (progn
1195                           (setq curstring (buffer-substring begpt endpt))
1196                           (remove-list-of-text-properties
1197                            0 (length curstring) occur-excluded-properties curstring))
1198                       (setq curstring (buffer-substring-no-properties begpt endpt)))
1199                     ;; Highlight the matches
1200                     (let ((len (length curstring))
1201                           (start 0))
1202                       (while (and (< start len)
1203                                   (string-match regexp curstring start))
1204                         (add-text-properties
1205                          (match-beginning 0) (match-end 0)
1206                          (append
1207                           `(occur-match t)
1208                           (when match-face
1209                             ;; Use `face' rather than `font-lock-face' here
1210                             ;; so as to override faces copied from the buffer.
1211                             `(face ,match-face)))
1212                          curstring)
1213                         (setq start (match-end 0))))
1214                     ;; Generate the string to insert for this match
1215                     (let* ((out-line
1216                             (concat
1217                              ;; Using 7 digits aligns tabs properly.
1218                              (apply #'propertize (format "%7d:" lines)
1219                                     (append
1220                                      (when prefix-face
1221                                        `(font-lock-face prefix-face))
1222                                      `(occur-prefix t mouse-face (highlight)
1223                                        occur-target ,marker follow-link t
1224                                        help-echo "mouse-2: go to this occurrence")))
1225                              ;; We don't put `mouse-face' on the newline,
1226                              ;; because that loses.  And don't put it
1227                              ;; on context lines to reduce flicker.
1228                              (propertize curstring 'mouse-face (list 'highlight)
1229                                          'occur-target marker
1230                                          'follow-link t
1231                                          'help-echo
1232                                          "mouse-2: go to this occurrence")
1233                              ;; Add marker at eol, but no mouse props.
1234                              (propertize "\n" 'occur-target marker)))
1235                            (data
1236                             (if (= nlines 0)
1237                                 ;; The simple display style
1238                                 out-line
1239                               ;; The complex multi-line display
1240                               ;; style.  Generate a list of lines,
1241                               ;; concatenate them all together.
1242                               (apply #'concat
1243                                      (nconc
1244                                       (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ (abs nlines))) keep-props))))
1245                                       (list out-line)
1246                                       (if (> nlines 0)
1247                                           (occur-engine-add-prefix
1248                                            (cdr (occur-accumulate-lines (1+ nlines) keep-props)))))))))
1249                       ;; Actually insert the match display data
1250                       (with-current-buffer out-buf
1251                         (let ((beg (point))
1252                               (end (progn (insert data) (point))))
1253                           (unless (= nlines 0)
1254                             (insert "-------\n")))))
1255                     (goto-char endpt))
1256                   (if endpt
1257                       (progn
1258                         (setq lines (1+ lines))
1259                         ;; On to the next match...
1260                         (forward-line 1))
1261                     (goto-char (point-max))))))
1262             (when (not (zerop matches)) ;; is the count zero?
1263               (setq globalcount (+ globalcount matches))
1264               (with-current-buffer out-buf
1265                 (goto-char headerpt)
1266                 (let ((beg (point))
1267                       end)
1268                   (insert (format "%d match%s for \"%s\" in buffer: %s\n"
1269                                   matches (if (= matches 1) "" "es")
1270                                   regexp (buffer-name buf)))
1271                   (setq end (point))
1272                   (add-text-properties beg end
1273                                        (append
1274                                         (when title-face
1275                                           `(font-lock-face ,title-face))
1276                                         `(occur-title ,buf))))
1277                 (goto-char (point-min)))))))
1278       (if coding
1279           ;; CODING is buffer-file-coding-system of the first buffer
1280           ;; that locally binds it.  Let's use it also for the output
1281           ;; buffer.
1282           (set-buffer-file-coding-system coding))
1283       ;; Return the number of matches
1284       globalcount)))
1285
1286 \f
1287 ;; It would be nice to use \\[...], but there is no reasonable way
1288 ;; to make that display both SPC and Y.
1289 (defconst query-replace-help
1290   "Type Space or `y' to replace one match, Delete or `n' to skip to next,
1291 RET or `q' to exit, Period to replace one match and exit,
1292 Comma to replace but not move point immediately,
1293 C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
1294 C-w to delete match and recursive edit,
1295 C-l to clear the screen, redisplay, and offer same replacement again,
1296 ! to replace all remaining matches with no more questions,
1297 ^ to move point back to previous match,
1298 E to edit the replacement string"
1299   "Help message while in `query-replace'.")
1300
1301 (defvar query-replace-map
1302   (let ((map (make-sparse-keymap)))
1303     (define-key map " " 'act)
1304     (define-key map "\d" 'skip)
1305     (define-key map [delete] 'skip)
1306     (define-key map [backspace] 'skip)
1307     (define-key map "y" 'act)
1308     (define-key map "n" 'skip)
1309     (define-key map "Y" 'act)
1310     (define-key map "N" 'skip)
1311     (define-key map "e" 'edit-replacement)
1312     (define-key map "E" 'edit-replacement)
1313     (define-key map "," 'act-and-show)
1314     (define-key map "q" 'exit)
1315     (define-key map "\r" 'exit)
1316     (define-key map [return] 'exit)
1317     (define-key map "." 'act-and-exit)
1318     (define-key map "\C-r" 'edit)
1319     (define-key map "\C-w" 'delete-and-edit)
1320     (define-key map "\C-l" 'recenter)
1321     (define-key map "!" 'automatic)
1322     (define-key map "^" 'backup)
1323     (define-key map "\C-h" 'help)
1324     (define-key map [f1] 'help)
1325     (define-key map [help] 'help)
1326     (define-key map "?" 'help)
1327     (define-key map "\C-g" 'quit)
1328     (define-key map "\C-]" 'quit)
1329     (define-key map "\e" 'exit-prefix)
1330     (define-key map [escape] 'exit-prefix)
1331     map)
1332   "Keymap that defines the responses to questions in `query-replace'.
1333 The \"bindings\" in this map are not commands; they are answers.
1334 The valid answers include `act', `skip', `act-and-show',
1335 `exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
1336 `automatic', `backup', `exit-prefix', and `help'.")
1337
1338 (defun replace-match-string-symbols (n)
1339   "Process a list (and any sub-lists), expanding certain symbols.
1340 Symbol  Expands To
1341 N     (match-string N)           (where N is a string of digits)
1342 #N    (string-to-number (match-string N))
1343 &     (match-string 0)
1344 #&    (string-to-number (match-string 0))
1345 #     replace-count
1346
1347 Note that these symbols must be preceeded by a backslash in order to
1348 type them using Lisp syntax."
1349   (while (consp n)
1350     (cond
1351      ((consp (car n))
1352       (replace-match-string-symbols (car n))) ;Process sub-list
1353      ((symbolp (car n))
1354       (let ((name (symbol-name (car n))))
1355         (cond
1356          ((string-match "^[0-9]+$" name)
1357           (setcar n (list 'match-string (string-to-number name))))
1358          ((string-match "^#[0-9]+$" name)
1359           (setcar n (list 'string-to-number
1360                           (list 'match-string
1361                                 (string-to-number (substring name 1))))))
1362          ((string= "&" name)
1363           (setcar n '(match-string 0)))
1364          ((string= "#&" name)
1365           (setcar n '(string-to-number (match-string 0))))
1366          ((string= "#" name)
1367           (setcar n 'replace-count))))))
1368     (setq n (cdr n))))
1369
1370 (defun replace-eval-replacement (expression replace-count)
1371   (let ((replacement (eval expression)))
1372     (if (stringp replacement)
1373         replacement
1374       (prin1-to-string replacement t))))
1375
1376 (defun replace-quote (replacement)
1377   "Quote a replacement string.
1378 This just doubles all backslashes in REPLACEMENT and
1379 returns the resulting string.  If REPLACEMENT is not
1380 a string, it is first passed through `prin1-to-string'
1381 with the `noescape' argument set.
1382
1383 `match-data' is preserved across the call."
1384   (save-match-data
1385     (replace-regexp-in-string "\\\\" "\\\\"
1386                               (if (stringp replacement)
1387                                   replacement
1388                                 (prin1-to-string replacement t))
1389                               t t)))
1390
1391 (defun replace-loop-through-replacements (data replace-count)
1392   ;; DATA is a vector contaning the following values:
1393   ;;   0 next-rotate-count
1394   ;;   1 repeat-count
1395   ;;   2 next-replacement
1396   ;;   3 replacements
1397   (if (= (aref data 0) replace-count)
1398       (progn
1399         (aset data 0 (+ replace-count (aref data 1)))
1400         (let ((next (cdr (aref data 2))))
1401           (aset data 2 (if (consp next) next (aref data 3))))))
1402   (car (aref data 2)))
1403
1404 (defun replace-match-data (integers reuse &optional new)
1405   "Like `match-data', but markers in REUSE get invalidated.
1406 If NEW is non-nil, it is set and returned instead of fresh data,
1407 but coerced to the correct value of INTEGERS."
1408   (or (and new
1409            (progn
1410              (set-match-data new)
1411              (and (eq new reuse)
1412                   (eq (null integers) (markerp (car reuse)))
1413                   new)))
1414       (match-data integers reuse t)))
1415
1416 (defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data)
1417   "Make a replacement with `replace-match', editing `\\?'.
1418 NEWTEXT, FIXEDCASE, LITERAL are just passed on.  If NOEDIT is true, no
1419 check for `\\?' is made to save time.  MATCH-DATA is used for the
1420 replacement.  In case editing is done, it is changed to use markers.
1421
1422 The return value is non-nil if there has been no `\\?' or NOEDIT was
1423 passed in.  If LITERAL is set, no checking is done, anyway."
1424   (unless (or literal noedit)
1425     (setq noedit t)
1426     (while (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\\\?\\)"
1427                          newtext)
1428       (setq newtext
1429             (read-string "Edit replacement string: "
1430                          (prog1
1431                              (cons
1432                               (replace-match "" t t newtext 3)
1433                               (1+ (match-beginning 3)))
1434                            (setq match-data
1435                                  (replace-match-data
1436                                   nil match-data match-data))))
1437             noedit nil)))
1438   (set-match-data match-data)
1439   (replace-match newtext fixedcase literal)
1440   noedit)
1441
1442 (defun perform-replace (from-string replacements
1443                         query-flag regexp-flag delimited-flag
1444                         &optional repeat-count map start end)
1445   "Subroutine of `query-replace'.  Its complexity handles interactive queries.
1446 Don't use this in your own program unless you want to query and set the mark
1447 just as `query-replace' does.  Instead, write a simple loop like this:
1448
1449   (while (re-search-forward \"foo[ \\t]+bar\" nil t)
1450     (replace-match \"foobar\" nil nil))
1451
1452 which will run faster and probably do exactly what you want.  Please
1453 see the documentation of `replace-match' to find out how to simulate
1454 `case-replace'.
1455
1456 This function returns nil if and only if there were no matches to
1457 make, or the user didn't cancel the call."
1458   (or map (setq map query-replace-map))
1459   (and query-flag minibuffer-auto-raise
1460        (raise-frame (window-frame (minibuffer-window))))
1461   (let* ((case-fold-search
1462           (and case-fold-search
1463                (isearch-no-upper-case-p from-string regexp-flag)))
1464          (nocasify (not (and case-replace case-fold-search)))
1465          (literal (or (not regexp-flag) (eq regexp-flag 'literal)))
1466          (search-function (if regexp-flag 're-search-forward 'search-forward))
1467          (search-string from-string)
1468          (real-match-data nil)       ; The match data for the current match.
1469          (next-replacement nil)
1470          ;; This is non-nil if we know there is nothing for the user
1471          ;; to edit in the replacement.
1472          (noedit nil)
1473          (keep-going t)
1474          (stack nil)
1475          (replace-count 0)
1476          (nonempty-match nil)
1477
1478          ;; If non-nil, it is marker saying where in the buffer to stop.
1479          (limit nil)
1480
1481          ;; Data for the next match.  If a cons, it has the same format as
1482          ;; (match-data); otherwise it is t if a match is possible at point.
1483          (match-again t)
1484
1485          (message
1486           (if query-flag
1487               (apply 'propertize
1488                      (substitute-command-keys
1489                       "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")
1490                      minibuffer-prompt-properties))))
1491
1492     ;; If region is active, in Transient Mark mode, operate on region.
1493     (when start
1494       (setq limit (copy-marker (max start end)))
1495       (goto-char (min start end))
1496       (deactivate-mark))
1497
1498     ;; REPLACEMENTS is either a string, a list of strings, or a cons cell
1499     ;; containing a function and its first argument.  The function is
1500     ;; called to generate each replacement like this:
1501     ;;   (funcall (car replacements) (cdr replacements) replace-count)
1502     ;; It must return a string.
1503     (cond
1504      ((stringp replacements)
1505       (setq next-replacement replacements
1506             replacements     nil))
1507      ((stringp (car replacements)) ; If it isn't a string, it must be a cons
1508       (or repeat-count (setq repeat-count 1))
1509       (setq replacements (cons 'replace-loop-through-replacements
1510                                (vector repeat-count repeat-count
1511                                        replacements replacements)))))
1512
1513     (if delimited-flag
1514         (setq search-function 're-search-forward
1515               search-string (concat "\\b"
1516                                     (if regexp-flag from-string
1517                                       (regexp-quote from-string))
1518                                     "\\b")))
1519     (when query-replace-lazy-highlight
1520       (setq isearch-lazy-highlight-last-string nil))
1521
1522     (push-mark)
1523     (undo-boundary)
1524     (unwind-protect
1525         ;; Loop finding occurrences that perhaps should be replaced.
1526         (while (and keep-going
1527                     (not (or (eobp) (and limit (>= (point) limit))))
1528                     ;; Use the next match if it is already known;
1529                     ;; otherwise, search for a match after moving forward
1530                     ;; one char if progress is required.
1531                     (setq real-match-data
1532                           (cond ((consp match-again)
1533                                  (goto-char (nth 1 match-again))
1534                                  (replace-match-data
1535                                   t real-match-data match-again))
1536                                 ;; MATCH-AGAIN non-nil means accept an
1537                                 ;; adjacent match.
1538                                 (match-again
1539                                  (and
1540                                   (funcall search-function search-string
1541                                            limit t)
1542                                   ;; For speed, use only integers and
1543                                   ;; reuse the list used last time.
1544                                   (replace-match-data t real-match-data)))
1545                                 ((and (< (1+ (point)) (point-max))
1546                                       (or (null limit)
1547                                           (< (1+ (point)) limit)))
1548                                  ;; If not accepting adjacent matches,
1549                                  ;; move one char to the right before
1550                                  ;; searching again.  Undo the motion
1551                                  ;; if the search fails.
1552                                  (let ((opoint (point)))
1553                                    (forward-char 1)
1554                                    (if (funcall
1555                                         search-function search-string
1556                                         limit t)
1557                                        (replace-match-data
1558                                         t real-match-data)
1559                                      (goto-char opoint)
1560                                      nil))))))
1561
1562           ;; Record whether the match is nonempty, to avoid an infinite loop
1563           ;; repeatedly matching the same empty string.
1564           (setq nonempty-match
1565                 (/= (nth 0 real-match-data) (nth 1 real-match-data)))
1566
1567           ;; If the match is empty, record that the next one can't be
1568           ;; adjacent.
1569
1570           ;; Otherwise, if matching a regular expression, do the next
1571           ;; match now, since the replacement for this match may
1572           ;; affect whether the next match is adjacent to this one.
1573           ;; If that match is empty, don't use it.
1574           (setq match-again
1575                 (and nonempty-match
1576                      (or (not regexp-flag)
1577                          (and (looking-at search-string)
1578                               (let ((match (match-data)))
1579                                 (and (/= (nth 0 match) (nth 1 match))
1580                                      match))))))
1581
1582           ;; Optionally ignore matches that have a read-only property.
1583           (unless (and query-replace-skip-read-only
1584                        (text-property-not-all
1585                         (nth 0 real-match-data) (nth 1 real-match-data)
1586                         'read-only nil))
1587
1588             ;; Calculate the replacement string, if necessary.
1589             (when replacements
1590               (set-match-data real-match-data)
1591               (setq next-replacement
1592                     (funcall (car replacements) (cdr replacements)
1593                              replace-count)))
1594             (if (not query-flag)
1595                 (let ((inhibit-read-only
1596                        query-replace-skip-read-only))
1597                   (unless (or literal noedit)
1598                     (replace-highlight
1599                      (nth 0 real-match-data) (nth 1 real-match-data)
1600                      start end search-string
1601                      (or delimited-flag regexp-flag) case-fold-search))
1602                   (setq noedit
1603                         (replace-match-maybe-edit
1604                          next-replacement nocasify literal
1605                          noedit real-match-data)
1606                         replace-count (1+ replace-count)))
1607               (undo-boundary)
1608               (let (done replaced key def)
1609                 ;; Loop reading commands until one of them sets done,
1610                 ;; which means it has finished handling this
1611                 ;; occurrence.  Any command that sets `done' should
1612                 ;; leave behind proper match data for the stack.
1613                 ;; Commands not setting `done' need to adjust
1614                 ;; `real-match-data'.
1615                 (while (not done)
1616                   (set-match-data real-match-data)
1617                   (replace-highlight
1618                    (match-beginning 0) (match-end 0)
1619                    start end search-string
1620                    (or delimited-flag regexp-flag) case-fold-search)
1621                   ;; Bind message-log-max so we don't fill up the message log
1622                   ;; with a bunch of identical messages.
1623                   (let ((message-log-max nil)
1624                         (replacement-presentation
1625                          (if query-replace-show-replacement
1626                              (save-match-data
1627                                (set-match-data real-match-data)
1628                                (match-substitute-replacement next-replacement
1629                                                              nocasify literal))
1630                            next-replacement)))
1631                     (message message
1632                              (query-replace-descr from-string)
1633                              (query-replace-descr replacement-presentation)))
1634                   (setq key (read-event))
1635                   ;; Necessary in case something happens during read-event
1636                   ;; that clobbers the match data.
1637                   (set-match-data real-match-data)
1638                   (setq key (vector key))
1639                   (setq def (lookup-key map key))
1640                   ;; Restore the match data while we process the command.
1641                   (cond ((eq def 'help)
1642                          (with-output-to-temp-buffer "*Help*"
1643                            (princ
1644                             (concat "Query replacing "
1645                                     (if regexp-flag "regexp " "")
1646                                     from-string " with "
1647                                     next-replacement ".\n\n"
1648                                     (substitute-command-keys
1649                                      query-replace-help)))
1650                            (with-current-buffer standard-output
1651                              (help-mode))))
1652                         ((eq def 'exit)
1653                          (setq keep-going nil)
1654                          (setq done t))
1655                         ((eq def 'backup)
1656                          (if stack
1657                              (let ((elt (pop stack)))
1658                                (goto-char (nth 0 elt))
1659                                (setq replaced (nth 1 elt)
1660                                      real-match-data
1661                                      (replace-match-data
1662                                       t real-match-data
1663                                       (nth 2 elt))))
1664                            (message "No previous match")
1665                            (ding 'no-terminate)
1666                            (sit-for 1)))
1667                         ((eq def 'act)
1668                          (or replaced
1669                              (setq noedit
1670                                    (replace-match-maybe-edit
1671                                     next-replacement nocasify literal
1672                                     noedit real-match-data)
1673                                    replace-count (1+ replace-count)))
1674                          (setq done t replaced t))
1675                         ((eq def 'act-and-exit)
1676                          (or replaced
1677                              (setq noedit
1678                                    (replace-match-maybe-edit
1679                                     next-replacement nocasify literal
1680                                     noedit real-match-data)
1681                                    replace-count (1+ replace-count)))
1682                          (setq keep-going nil)
1683                          (setq done t replaced t))
1684                         ((eq def 'act-and-show)
1685                          (if (not replaced)
1686                              (setq noedit
1687                                    (replace-match-maybe-edit
1688                                     next-replacement nocasify literal
1689                                     noedit real-match-data)
1690                                    replace-count (1+ replace-count)
1691                                    real-match-data (replace-match-data
1692                                                     t real-match-data)
1693                                    replaced t)))
1694                         ((eq def 'automatic)
1695                          (or replaced
1696                              (setq noedit
1697                                    (replace-match-maybe-edit
1698                                     next-replacement nocasify literal
1699                                     noedit real-match-data)
1700                                    replace-count (1+ replace-count)))
1701                          (setq done t query-flag nil replaced t))
1702                         ((eq def 'skip)
1703                          (setq done t))
1704                         ((eq def 'recenter)
1705                          (recenter nil))
1706                         ((eq def 'edit)
1707                          (let ((opos (point-marker)))
1708                            (setq real-match-data (replace-match-data
1709                                                   nil real-match-data
1710                                                   real-match-data))
1711                            (goto-char (match-beginning 0))
1712                            (save-excursion
1713                              (save-window-excursion
1714                                (recursive-edit)))
1715                            (goto-char opos)
1716                            (set-marker opos nil))
1717                          ;; Before we make the replacement,
1718                          ;; decide whether the search string
1719                          ;; can match again just after this match.
1720                          (if (and regexp-flag nonempty-match)
1721                              (setq match-again (and (looking-at search-string)
1722                                                     (match-data)))))
1723                         ;; Edit replacement.
1724                         ((eq def 'edit-replacement)
1725                          (setq real-match-data (replace-match-data
1726                                                 nil real-match-data
1727                                                 real-match-data)
1728                                next-replacement
1729                                (read-string "Edit replacement string: "
1730                                             next-replacement)
1731                                noedit nil)
1732                          (if replaced
1733                              (set-match-data real-match-data)
1734                            (setq noedit
1735                                  (replace-match-maybe-edit
1736                                   next-replacement nocasify literal noedit
1737                                   real-match-data)
1738                                  replaced t))
1739                          (setq done t))
1740
1741                         ((eq def 'delete-and-edit)
1742                          (replace-match "" t t)
1743                          (setq real-match-data (replace-match-data
1744                                                 nil real-match-data))
1745                          (replace-dehighlight)
1746                          (save-excursion (recursive-edit))
1747                          (setq replaced t))
1748                         ;; Note: we do not need to treat `exit-prefix'
1749                         ;; specially here, since we reread
1750                         ;; any unrecognized character.
1751                         (t
1752                          (setq this-command 'mode-exited)
1753                          (setq keep-going nil)
1754                          (setq unread-command-events
1755                                (append (listify-key-sequence key)
1756                                        unread-command-events))
1757                          (setq done t)))
1758                   (when query-replace-lazy-highlight
1759                     ;; Force lazy rehighlighting only after replacements
1760                     (if (not (memq def '(skip backup)))
1761                         (setq isearch-lazy-highlight-last-string nil))))
1762                 ;; Record previous position for ^ when we move on.
1763                 ;; Change markers to numbers in the match data
1764                 ;; since lots of markers slow down editing.
1765                 (push (list (point) replaced
1766 ;;;  If the replacement has already happened, all we need is the
1767 ;;;  current match start and end.  We could get this with a trivial
1768 ;;;  match like
1769 ;;;  (save-excursion (goto-char (match-beginning 0))
1770 ;;;                  (search-forward (match-string 0))
1771 ;;;                  (match-data t))
1772 ;;;  if we really wanted to avoid manually constructing match data.
1773 ;;;  Adding current-buffer is necessary so that match-data calls can
1774 ;;;  return markers which are appropriate for editing.
1775                             (if replaced
1776                                 (list
1777                                  (match-beginning 0)
1778                                  (match-end 0)
1779                                  (current-buffer))
1780                               (match-data t)))
1781                       stack)))))
1782
1783       (replace-dehighlight))
1784     (or unread-command-events
1785         (message "Replaced %d occurrence%s"
1786                  replace-count
1787                  (if (= replace-count 1) "" "s")))
1788     (and keep-going stack)))
1789
1790 (defvar replace-overlay nil)
1791
1792 (defun replace-highlight (match-beg match-end range-beg range-end
1793                           string regexp case-fold)
1794   (if query-replace-highlight
1795       (if replace-overlay
1796           (move-overlay replace-overlay match-beg match-end (current-buffer))
1797         (setq replace-overlay (make-overlay match-beg match-end))
1798         (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
1799         (overlay-put replace-overlay 'face 'query-replace)))
1800   (if query-replace-lazy-highlight
1801       (let ((isearch-string string)
1802             (isearch-regexp regexp)
1803             (search-whitespace-regexp nil)
1804             (isearch-case-fold-search case-fold))
1805         (isearch-lazy-highlight-new-loop range-beg range-end))))
1806
1807 (defun replace-dehighlight ()
1808   (when replace-overlay
1809     (delete-overlay replace-overlay))
1810   (when query-replace-lazy-highlight
1811     (lazy-highlight-cleanup lazy-highlight-cleanup)
1812     (setq isearch-lazy-highlight-last-string nil)))
1813
1814 ;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4
1815 ;;; replace.el ends here