LCOV - code coverage report
Current view: top level - lisp - replace.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 4 1298 0.3 %
Date: 2017-08-30 10:12:24 Functions: 1 63 1.6 %

          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

Generated by: LCOV version 1.12