;;; replace.el --- replace commands for Emacs
-;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001,
-;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985-1987, 1992, 1994, 1996-1997, 2000-2013 Free
+;; Software Foundation, Inc.
;; Maintainer: FSF
+;; Package: emacs
;; This file is part of GNU Emacs.
:type 'boolean
:group 'matching)
-(defvar query-replace-history nil)
+(defcustom replace-lax-whitespace nil
+ "Non-nil means `query-replace' matches a sequence of whitespace chars.
+When you enter a space or spaces in the strings to be replaced,
+it will match any sequence matched by the regexp `search-whitespace-regexp'."
+ :type 'boolean
+ :group 'matching
+ :version "24.3")
+
+(defcustom replace-regexp-lax-whitespace nil
+ "Non-nil means `query-replace-regexp' matches a sequence of whitespace chars.
+When you enter a space or spaces in the regexps to be replaced,
+it will match any sequence matched by the regexp `search-whitespace-regexp'."
+ :type 'boolean
+ :group 'matching
+ :version "24.3")
+
+(defvar query-replace-history nil
+ "Default history list for query-replace commands.
+See `query-replace-from-history-variable' and
+`query-replace-to-history-variable'.")
(defvar query-replace-defaults nil
"Default values of FROM-STRING and TO-STRING for `query-replace'.
(defvar query-replace-interactive nil
"Non-nil means `query-replace' uses the last search string.
That becomes the \"string to replace\".")
+(make-obsolete-variable 'query-replace-interactive
+ "use `M-n' to pull the last incremental search string
+to the minibuffer that reads the string to replace, or invoke replacements
+from Isearch by using a key sequence like `C-s C-s M-%'." "24.3")
(defcustom query-replace-from-history-variable 'query-replace-history
"History list to use for the FROM argument of `query-replace' commands.
:group 'matching
:version "22.1")
+(defvar replace-count 0
+ "Number of replacements done so far.
+See `replace-regexp' and `query-replace-regexp-eval'.")
+
(defun query-replace-descr (string)
(mapconcat 'isearch-text-char-description string ""))
(if query-replace-interactive
(car (if regexp-flag regexp-search-ring search-ring))
(let* ((history-add-new-input nil)
+ (prompt
+ (if query-replace-defaults
+ (format "%s (default %s -> %s): " prompt
+ (query-replace-descr (car query-replace-defaults))
+ (query-replace-descr (cdr query-replace-defaults)))
+ (format "%s: " prompt)))
(from
;; The save-excursion here is in case the user marks and copies
;; a region in order to specify the minibuffer input.
;; That should not clobber the region for the query-replace itself.
(save-excursion
- (read-from-minibuffer
- (if query-replace-defaults
- (format "%s (default %s -> %s): " prompt
- (query-replace-descr (car query-replace-defaults))
- (query-replace-descr (cdr query-replace-defaults)))
- (format "%s: " prompt))
- nil nil nil
- query-replace-from-history-variable
- nil t))))
+ (if regexp-flag
+ (read-regexp prompt nil query-replace-from-history-variable)
+ (read-from-minibuffer
+ prompt nil nil nil query-replace-from-history-variable
+ (car (if regexp-flag regexp-search-ring search-ring)) t)))))
(if (and (zerop (length from)) query-replace-defaults)
(cons (car query-replace-defaults)
(query-replace-compile-replacement
In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
-If `query-replace-interactive' is non-nil, the last incremental search
-string is used as FROM-STRING--you don't have to specify it with the
-minibuffer.
+Use \\<minibuffer-local-map>\\[next-history-element] \
+to pull the last incremental search string to the minibuffer
+that reads FROM-STRING, or invoke replacements from
+incremental search with a key sequence like `C-s C-s M-%'
+to use its current search string as the string to replace.
Matching is independent of case if `case-fold-search' is non-nil and
FROM-STRING has no uppercase letters. Replacement transfers the case
matched is all caps, or capitalized, then its replacement is upcased
or capitalized.)
+Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
+ignore hidden matches if `search-invisible' is nil, and ignore more
+matches using a non-nil `isearch-filter-predicates'.
+
+If `replace-lax-whitespace' is non-nil, a space or spaces in the string
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on.
In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
-If `query-replace-interactive' is non-nil, the last incremental search
-regexp is used as REGEXP--you don't have to specify it with the
-minibuffer.
+Use \\<minibuffer-local-map>\\[next-history-element] \
+to pull the last incremental search regexp to the minibuffer
+that reads REGEXP, or invoke replacements from
+incremental search with a key sequence like `C-M-s C-M-s C-M-%'
+to use its current search regexp as the regexp to replace.
Matching is independent of case if `case-fold-search' is non-nil and
REGEXP has no uppercase letters. Replacement transfers the case
all caps, or capitalized, then its replacement is upcased or
capitalized.)
+Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
+ignore hidden matches if `search-invisible' is nil, and ignore more
+matches using a non-nil `isearch-filter-predicates'.
+
+If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on.
In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
-If `query-replace-interactive' is non-nil, the last incremental search
-regexp is used as REGEXP--you don't have to specify it with the
-minibuffer.
+Use \\<minibuffer-local-map>\\[next-history-element] \
+to pull the last incremental search regexp to the minibuffer
+that reads REGEXP.
Preserves case in each replacement if `case-replace' and `case-fold-search'
are non-nil and REGEXP has no uppercase letters.
+Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
+ignore hidden matches if `search-invisible' is nil, and ignore more
+matches using a non-nil `isearch-filter-predicates'.
+
+If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
only matches that are surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on."
+ (declare (obsolete "use the `\\,' feature of `query-replace-regexp'
+for interactive calls, and `search-forward-regexp'/`replace-match'
+for Lisp calls." "22.1"))
(interactive
(progn
- (barf-if-buffer-read-only)
- (let* ((from
- ;; Let-bind the history var to disable the "foo -> bar" default.
- ;; Maybe we shouldn't disable this default, but for now I'll
- ;; leave it off. --Stef
- (let ((query-replace-to-history-variable nil))
- (query-replace-read-from "Query replace regexp" t)))
- (to (list (read-from-minibuffer
- (format "Query replace regexp %s with eval: "
- (query-replace-descr from))
- nil nil t query-replace-to-history-variable from t))))
- ;; We make TO a list because replace-match-string-symbols requires one,
- ;; and the user might enter a single token.
- (replace-match-string-symbols to)
- (list from (car to) current-prefix-arg
- (if (and transient-mark-mode mark-active)
- (region-beginning))
- (if (and transient-mark-mode mark-active)
- (region-end))))))
+ (barf-if-buffer-read-only)
+ (let* ((from
+ ;; Let-bind the history var to disable the "foo -> bar"
+ ;; default. Maybe we shouldn't disable this default, but
+ ;; for now I'll leave it off. --Stef
+ (let ((query-replace-to-history-variable nil))
+ (query-replace-read-from "Query replace regexp" t)))
+ (to (list (read-from-minibuffer
+ (format "Query replace regexp %s with eval: "
+ (query-replace-descr from))
+ nil nil t query-replace-to-history-variable from t))))
+ ;; We make TO a list because replace-match-string-symbols requires one,
+ ;; and the user might enter a single token.
+ (replace-match-string-symbols to)
+ (list from (car to) current-prefix-arg
+ (if (and transient-mark-mode mark-active)
+ (region-beginning))
+ (if (and transient-mark-mode mark-active)
+ (region-end))))))
(perform-replace regexp (cons 'replace-eval-replacement to-expr)
t 'literal delimited nil nil start end))
-(make-obsolete 'query-replace-regexp-eval
- "for interactive use, use the special `\\,' feature of
-`query-replace-regexp' instead. Non-interactively, a loop
-using `search-forward-regexp' and `replace-match' is preferred." "22.1")
-
(defun map-query-replace-regexp (regexp to-strings &optional n start end)
"Replace some matches for REGEXP with various strings, in rotation.
The second argument TO-STRINGS contains the replacement strings, separated
Non-interactively, TO-STRINGS may be a list of replacement strings.
-If `query-replace-interactive' is non-nil, the last incremental search
-regexp is used as REGEXP--you don't have to specify it with the minibuffer.
+Use \\<minibuffer-local-map>\\[next-history-element] \
+to pull the last incremental search regexp to the minibuffer
+that reads REGEXP.
A prefix argument N says to use each replacement string N times
before rotating to the next.
Fourth and fifth arg START and END specify the region to operate on."
(interactive
- (let* ((from (if query-replace-interactive
- (car regexp-search-ring)
- (read-from-minibuffer "Map query replace (regexp): "
- nil nil nil
- 'query-replace-history nil t)))
+ (let* ((from (read-regexp "Map query replace (regexp): " nil
+ query-replace-from-history-variable))
(to (read-from-minibuffer
(format "Query replace %s with (space-separated strings): "
(query-replace-descr from))
nil nil nil
- 'query-replace-history from t)))
+ query-replace-to-history-variable from t)))
(list from to
(and current-prefix-arg
(prefix-numeric-value current-prefix-arg))
\(Preserving case means that if the string matched is all caps, or capitalized,
then its replacement is upcased or capitalized.)
+Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
+ignore hidden matches if `search-invisible' is nil, and ignore more
+matches using a non-nil `isearch-filter-predicates'.
+
+If `replace-lax-whitespace' is non-nil, a space or spaces in the string
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
only matches surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on.
-If `query-replace-interactive' is non-nil, the last incremental search
-string is used as FROM-STRING--you don't have to specify it with the
-minibuffer.
+Use \\<minibuffer-local-map>\\[next-history-element] \
+to pull the last incremental search string to the minibuffer
+that reads FROM-STRING.
This function is usually the wrong thing to use in a Lisp program.
What you probably want is a loop like this:
Preserve case in each match if `case-replace' and `case-fold-search'
are non-nil and REGEXP has no uppercase letters.
+Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
+ignore hidden matches if `search-invisible' is nil, and ignore more
+matches using a non-nil `isearch-filter-predicates'.
+
+If `replace-regexp-lax-whitespace' is non-nil, a space or spaces in the regexp
+to be replaced will match a sequence of whitespace chars defined by the
+regexp in `search-whitespace-regexp'.
+
In Transient Mark mode, if the mark is active, operate on the contents
of the region. Otherwise, operate from point to the end of the buffer.
text, TO-STRING is actually made a list instead of a string.
Use \\[repeat-complex-command] after this command for details.
-If `query-replace-interactive' is non-nil, the last incremental search
-regexp is used as REGEXP--you don't have to specify it with the minibuffer.
+Use \\<minibuffer-local-map>\\[next-history-element] \
+to pull the last incremental search regexp to the minibuffer
+that reads REGEXP.
This function is usually the wrong thing to use in a Lisp program.
What you probably want is a loop like this:
Maximum length of the history list is determined by the value
of `history-length', which see.")
-(defun read-regexp (prompt &optional default-value)
- "Read regexp as a string using the regexp history and some useful defaults.
-Prompt for a regular expression with PROMPT (without a colon and
-space) in the minibuffer. The optional argument DEFAULT-VALUE
-provides the value to display in the minibuffer prompt that is
-returned if the user just types RET.
-Values available via M-n are the string at point, the last isearch
-regexp, the last isearch string, and the last replacement regexp."
- (let* ((defaults
- (list (regexp-quote
- (or (funcall (or find-tag-default-function
- (get major-mode 'find-tag-default-function)
- 'find-tag-default))
- ""))
- (car regexp-search-ring)
- (regexp-quote (or (car search-ring) ""))
- (car (symbol-value
- query-replace-from-history-variable))))
- (defaults (delete-dups (delq nil (delete "" defaults))))
- ;; Don't add automatically the car of defaults for empty input
+(defvar occur-collect-regexp-history '("\\1")
+ "History of regexp for occur's collect operation")
+
+(defun read-regexp (prompt &optional defaults history)
+ "Read and return a regular expression as a string.
+When PROMPT doesn't end with a colon and space, it adds a final \": \".
+If the first element of DEFAULTS is non-nil, it's added to the prompt.
+
+Optional arg DEFAULTS has the form (DEFAULT . SUGGESTIONS)
+or simply DEFAULT where DEFAULT, if non-nil, should be a string that
+is returned as the default value when the user enters empty input.
+SUGGESTIONS is a list of strings that can be inserted into
+the minibuffer using \\<minibuffer-local-map>\\[next-history-element]. \
+The values supplied in SUGGESTIONS
+are prepended to the list of standard suggestions that include
+the tag at point, the last isearch regexp, the last isearch string,
+and the last replacement regexp.
+
+Optional arg HISTORY is a symbol to use for the history list.
+If HISTORY is nil, `regexp-history' is used."
+ (let* ((default (if (consp defaults) (car defaults) defaults))
+ (suggestions (if (listp defaults) defaults (list defaults)))
+ (suggestions
+ (append
+ suggestions
+ (list
+ (find-tag-default-as-regexp)
+ (car regexp-search-ring)
+ (regexp-quote (or (car search-ring) ""))
+ (car (symbol-value query-replace-from-history-variable)))))
+ (suggestions (delete-dups (delq nil (delete "" suggestions))))
+ ;; Do not automatically add default to the history for empty input.
(history-add-new-input nil)
- (input
- (read-from-minibuffer
- (if default-value
- (format "%s (default %s): " prompt
- (query-replace-descr default-value))
- (format "%s: " prompt))
- nil nil nil 'regexp-history defaults t)))
+ (input (read-from-minibuffer
+ (cond ((string-match-p ":[ \t]*\\'" prompt)
+ prompt)
+ (default
+ (format "%s (default %s): " prompt
+ (query-replace-descr default)))
+ (t
+ (format "%s: " prompt)))
+ nil nil nil (or history 'regexp-history) suggestions t)))
(if (equal input "")
- (or default-value input)
+ ;; Return the default value when the user enters empty input.
+ (or default input)
+ ;; Otherwise, add non-empty input to the history and return input.
(prog1 input
- (add-to-history 'regexp-history input)))))
+ (add-to-history (or history 'regexp-history) input)))))
(defalias 'delete-non-matching-lines 'keep-lines)
count)))
\f
+(defvar occur-menu-map
+ (let ((map (make-sparse-keymap)))
+ (bindings--define-key map [next-error-follow-minor-mode]
+ '(menu-item "Auto Occurrence Display"
+ next-error-follow-minor-mode
+ :help "Display another occurrence when moving the cursor"
+ :button (:toggle . (and (boundp 'next-error-follow-minor-mode)
+ next-error-follow-minor-mode))))
+ (bindings--define-key map [separator-1] menu-bar-separator)
+ (bindings--define-key map [kill-this-buffer]
+ '(menu-item "Kill Occur Buffer" kill-this-buffer
+ :help "Kill the current *Occur* buffer"))
+ (bindings--define-key map [quit-window]
+ '(menu-item "Quit Occur Window" quit-window
+ :help "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame"))
+ (bindings--define-key map [revert-buffer]
+ '(menu-item "Revert Occur Buffer" revert-buffer
+ :help "Replace the text in the *Occur* buffer with the results of rerunning occur"))
+ (bindings--define-key map [clone-buffer]
+ '(menu-item "Clone Occur Buffer" clone-buffer
+ :help "Create and return a twin copy of the current *Occur* buffer"))
+ (bindings--define-key map [occur-rename-buffer]
+ '(menu-item "Rename Occur Buffer" occur-rename-buffer
+ :help "Rename the current *Occur* buffer to *Occur: original-buffer-name*."))
+ (bindings--define-key map [occur-edit-buffer]
+ '(menu-item "Edit Occur Buffer" occur-edit-mode
+ :help "Edit the *Occur* buffer and apply changes to the original buffers."))
+ (bindings--define-key map [separator-2] menu-bar-separator)
+ (bindings--define-key map [occur-mode-goto-occurrence-other-window]
+ '(menu-item "Go To Occurrence Other Window" occur-mode-goto-occurrence-other-window
+ :help "Go to the occurrence the current line describes, in another window"))
+ (bindings--define-key map [occur-mode-goto-occurrence]
+ '(menu-item "Go To Occurrence" occur-mode-goto-occurrence
+ :help "Go to the occurrence the current line describes"))
+ (bindings--define-key map [occur-mode-display-occurrence]
+ '(menu-item "Display Occurrence" occur-mode-display-occurrence
+ :help "Display in another window the occurrence the current line describes"))
+ (bindings--define-key map [occur-next]
+ '(menu-item "Move to Next Match" occur-next
+ :help "Move to the Nth (default 1) next match in an Occur mode buffer"))
+ (bindings--define-key map [occur-prev]
+ '(menu-item "Move to Previous Match" occur-prev
+ :help "Move to the Nth (default 1) previous match in an Occur mode buffer"))
+ map)
+ "Menu keymap for `occur-mode'.")
+
(defvar occur-mode-map
(let ((map (make-sparse-keymap)))
;; We use this alternative name, so we can use \\[occur-mode-mouse-goto].
(define-key map [mouse-2] 'occur-mode-mouse-goto)
(define-key map "\C-c\C-c" 'occur-mode-goto-occurrence)
+ (define-key map "e" 'occur-edit-mode)
(define-key map "\C-m" 'occur-mode-goto-occurrence)
(define-key map "o" 'occur-mode-goto-occurrence-other-window)
(define-key map "\C-o" 'occur-mode-display-occurrence)
(define-key map "\M-p" 'occur-prev)
(define-key map "r" 'occur-rename-buffer)
(define-key map "c" 'clone-buffer)
- (define-key map "g" 'revert-buffer)
- (define-key map "q" 'quit-window)
- (define-key map "z" 'kill-this-buffer)
(define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
- (define-key map [menu-bar] (make-sparse-keymap))
- (define-key map [menu-bar occur]
- `(cons ,(purecopy "Occur") map))
- (define-key map [next-error-follow-minor-mode]
- (menu-bar-make-mm-toggle next-error-follow-minor-mode
- "Auto Occurrence Display"
- "Display another occurrence when moving the cursor"))
- (define-key map [separator-1] menu-bar-separator)
- (define-key map [kill-this-buffer]
- `(menu-item ,(purecopy "Kill occur buffer") kill-this-buffer
- :help ,(purecopy "Kill the current *Occur* buffer")))
- (define-key map [quit-window]
- `(menu-item ,(purecopy "Quit occur window") quit-window
- :help ,(purecopy "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame")))
- (define-key map [revert-buffer]
- `(menu-item ,(purecopy "Revert occur buffer") revert-buffer
- :help ,(purecopy "Replace the text in the *Occur* buffer with the results of rerunning occur")))
- (define-key map [clone-buffer]
- `(menu-item ,(purecopy "Clone occur buffer") clone-buffer
- :help ,(purecopy "Create and return a twin copy of the current *Occur* buffer")))
- (define-key map [occur-rename-buffer]
- `(menu-item ,(purecopy "Rename occur buffer") occur-rename-buffer
- :help ,(purecopy "Rename the current *Occur* buffer to *Occur: original-buffer-name*.")))
- (define-key map [separator-2] menu-bar-separator)
- (define-key map [occur-mode-goto-occurrence-other-window]
- `(menu-item ,(purecopy "Go To Occurrence Other Window") occur-mode-goto-occurrence-other-window
- :help ,(purecopy "Go to the occurrence the current line describes, in another window")))
- (define-key map [occur-mode-goto-occurrence]
- `(menu-item ,(purecopy "Go To Occurrence") occur-mode-goto-occurrence
- :help ,(purecopy "Go to the occurrence the current line describes")))
- (define-key map [occur-mode-display-occurrence]
- `(menu-item ,(purecopy "Display Occurrence") occur-mode-display-occurrence
- :help ,(purecopy "Display in another window the occurrence the current line describes")))
- (define-key map [occur-next]
- `(menu-item ,(purecopy "Move to next match") occur-next
- :help ,(purecopy "Move to the Nth (default 1) next match in an Occur mode buffer")))
- (define-key map [occur-prev]
- `(menu-item ,(purecopy "Move to previous match") occur-prev
- :help ,(purecopy "Move to the Nth (default 1) previous match in an Occur mode buffer")))
+ (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map))
map)
"Keymap for `occur-mode'.")
(defvar occur-revert-arguments nil
"Arguments to pass to `occur-1' to revert an Occur mode buffer.
See `occur-revert-function'.")
+(make-variable-buffer-local 'occur-revert-arguments)
+(put 'occur-revert-arguments 'permanent-local t)
(defcustom occur-mode-hook '(turn-on-font-lock)
"Hook run when entering Occur mode."
:group 'matching)
(put 'occur-mode 'mode-class 'special)
-(defun occur-mode ()
+(define-derived-mode occur-mode special-mode "Occur"
"Major mode for output from \\[occur].
\\<occur-mode-map>Move point to one of the items in this buffer, then use
\\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to.
Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
\\{occur-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map occur-mode-map)
- (setq major-mode 'occur-mode)
- (setq mode-name "Occur")
(set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
- (make-local-variable 'occur-revert-arguments)
- (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
- (setq next-error-function 'occur-next-error)
- (run-mode-hooks 'occur-mode-hook))
+ (setq next-error-function 'occur-next-error))
-(defun occur-revert-function (ignore1 ignore2)
+\f
+;;; Occur Edit mode
+
+(defvar occur-edit-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map text-mode-map)
+ (define-key map [mouse-2] 'occur-mode-mouse-goto)
+ (define-key map "\C-c\C-c" 'occur-cease-edit)
+ (define-key map "\C-o" 'occur-mode-display-occurrence)
+ (define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
+ (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map))
+ map)
+ "Keymap for `occur-edit-mode'.")
+
+(define-derived-mode occur-edit-mode occur-mode "Occur-Edit"
+ "Major mode for editing *Occur* buffers.
+In this mode, changes to the *Occur* buffer are also applied to
+the originating buffer.
+
+To return to ordinary Occur mode, use \\[occur-cease-edit]."
+ (setq buffer-read-only nil)
+ (add-hook 'after-change-functions 'occur-after-change-function nil t)
+ (message (substitute-command-keys
+ "Editing: Type \\[occur-cease-edit] to return to Occur mode.")))
+
+(defun occur-cease-edit ()
+ "Switch from Occur Edit mode to Occur mode."
+ (interactive)
+ (when (derived-mode-p 'occur-edit-mode)
+ (occur-mode)
+ (message "Switching to Occur mode.")))
+
+(defun occur-after-change-function (beg end length)
+ (save-excursion
+ (goto-char beg)
+ (let* ((line-beg (line-beginning-position))
+ (m (get-text-property line-beg 'occur-target))
+ (buf (marker-buffer m))
+ col)
+ (when (and (get-text-property line-beg 'occur-prefix)
+ (not (get-text-property end 'occur-prefix)))
+ (when (= length 0)
+ ;; Apply occur-target property to inserted (e.g. yanked) text.
+ (put-text-property beg end 'occur-target m)
+ ;; Did we insert a newline? Occur Edit mode can't create new
+ ;; Occur entries; just discard everything after the newline.
+ (save-excursion
+ (and (search-forward "\n" end t)
+ (delete-region (1- (point)) end))))
+ (let* ((line (- (line-number-at-pos)
+ (line-number-at-pos (window-start))))
+ (readonly (with-current-buffer buf buffer-read-only))
+ (win (or (get-buffer-window buf)
+ (display-buffer buf
+ '(nil (inhibit-same-window . t)
+ (inhibit-switch-frame . t)))))
+ (line-end (line-end-position))
+ (text (save-excursion
+ (goto-char (next-single-property-change
+ line-beg 'occur-prefix nil
+ line-end))
+ (setq col (- (point) line-beg))
+ (buffer-substring-no-properties (point) line-end))))
+ (with-selected-window win
+ (goto-char m)
+ (recenter line)
+ (if readonly
+ (message "Buffer `%s' is read only." buf)
+ (delete-region (line-beginning-position) (line-end-position))
+ (insert text))
+ (move-to-column col)))))))
+
+\f
+(defun occur-revert-function (_ignore1 _ignore2)
"Handle `revert-buffer' for Occur mode buffers."
(apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))
(defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence)
(defun occur-mode-goto-occurrence (&optional event)
- "Go to the occurrence the current line describes."
+ "Go to the occurrence on the current line."
(interactive (list last-nonmenu-event))
(let ((pos
(if (null event)
(with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion
(goto-char (posn-point (event-end event)))
- (occur-mode-find-occurrence)))))
- same-window-buffer-names
- same-window-regexps)
+ (occur-mode-find-occurrence))))))
(pop-to-buffer (marker-buffer pos))
(goto-char pos)
(run-hooks 'occur-mode-find-occurrence-hook)))
"Display in another window the occurrence the current line describes."
(interactive)
(let ((pos (occur-mode-find-occurrence))
- window
- ;; Bind these to ensure `display-buffer' puts it in another window.
- same-window-buffer-names
- same-window-regexps)
- (setq window (display-buffer (marker-buffer pos)))
+ window)
+ (setq window (display-buffer (marker-buffer pos) t))
;; This is the way to set point in the proper window.
(save-selected-window
(select-window window)
:type 'face
:group 'matching)
+(defcustom list-matching-lines-prefix-face 'shadow
+ "Face used by \\[list-matching-lines] to show the prefix column.
+If the face doesn't differ from the default face,
+don't highlight the prefix with line numbers specially."
+ :type 'face
+ :group 'matching
+ :version "24.4")
+
(defcustom occur-excluded-properties
'(read-only invisible intangible field mouse-face help-echo local-map keymap
yank-handler follow-link)
:group 'matching
:version "22.1")
-(defun occur-accumulate-lines (count &optional keep-props)
- (save-excursion
- (let ((forwardp (> count 0))
- result beg end)
- (while (not (or (zerop count)
- (if forwardp
- (eobp)
- (bobp))))
- (setq count (+ count (if forwardp -1 1)))
- (setq beg (line-beginning-position)
- end (line-end-position))
- (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
- (text-property-not-all beg end 'fontified t))
- (if (fboundp 'jit-lock-fontify-now)
- (jit-lock-fontify-now beg end)))
- (push
- (if (and keep-props (not (eq occur-excluded-properties t)))
- (let ((str (buffer-substring beg end)))
- (remove-list-of-text-properties
- 0 (length str) occur-excluded-properties str)
- str)
- (buffer-substring-no-properties beg end))
- result)
- (forward-line (if forwardp 1 -1)))
- (nreverse result))))
+(defvar occur-read-regexp-defaults-function
+ 'occur-read-regexp-defaults
+ "Function that provides default regexp(s) for occur commands.
+This function should take no arguments and return one of nil, a
+regexp or a list of regexps for use with occur commands -
+`occur', `multi-occur' and `multi-occur-in-matching-buffers'.
+The return value of this function is used as DEFAULTS param of
+`read-regexp' while executing the occur command. This function
+is called only during interactive use.
+
+For example, to check for occurrence of symbol at point use
+
+ \(setq occur-read-regexp-defaults-function
+ 'find-tag-default-as-regexp\).")
+
+(defun occur-read-regexp-defaults ()
+ "Return the latest regexp from `regexp-history'.
+See `occur-read-regexp-defaults-function' for details."
+ (car regexp-history))
(defun occur-read-primary-args ()
- (list (read-regexp "List lines matching regexp"
- (car regexp-history))
- (when current-prefix-arg
- (prefix-numeric-value current-prefix-arg))))
+ (let* ((perform-collect (consp current-prefix-arg))
+ (regexp (read-regexp (if perform-collect
+ "Collect strings matching regexp"
+ "List lines matching regexp")
+ (funcall occur-read-regexp-defaults-function))))
+ (list regexp
+ (if perform-collect
+ ;; Perform collect operation
+ (if (zerop (regexp-opt-depth regexp))
+ ;; No subexpression so collect the entire match.
+ "\\&"
+ ;; Get the regexp for collection pattern.
+ (let ((default (car occur-collect-regexp-history)))
+ (read-regexp
+ (format "Regexp to collect (default %s): " default)
+ default 'occur-collect-regexp-history)))
+ ;; Otherwise normal occur takes numerical prefix argument.
+ (when current-prefix-arg
+ (prefix-numeric-value current-prefix-arg))))))
(defun occur-rename-buffer (&optional unique-p interactive-p)
"Rename the current *Occur* buffer to *Occur: original-buffer-name*.
-Here `original-buffer-name' is the buffer name were Occur was originally run.
+Here `original-buffer-name' is the buffer name where Occur was originally run.
When given the prefix argument, or called non-interactively, the renaming
will not clobber the existing buffer(s) of that name, but use
`generate-new-buffer-name' instead. You can add this to `occur-hook'
(defun occur (regexp &optional nlines)
"Show all lines in the current buffer containing a match for REGEXP.
-This function can not handle matches that span more than one line.
+If a match spreads across multiple lines, all those lines are shown.
Each line is displayed with NLINES lines before and after, or -NLINES
before if NLINES is negative.
\\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
If REGEXP contains upper case characters (excluding those preceded by `\\')
-and `search-upper-case' is non-nil, the matching is case-sensitive."
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
+When NLINES is a string or when the function is called
+interactively with prefix argument without a number (`C-u' alone
+as prefix) the matching strings are collected into the `*Occur*'
+buffer by using NLINES as a replacement regexp. NLINES may
+contain \\& and \\N which convention follows `replace-match'.
+For example, providing \"defun\\s +\\(\\S +\\)\" for REGEXP and
+\"\\1\" for NLINES collects all the function names in a lisp
+program. When there is no parenthesized subexpressions in REGEXP
+the entire match is collected. In any case the searched buffer
+is not modified."
(interactive (occur-read-primary-args))
(occur-1 regexp nlines (list (current-buffer))))
+(defvar ido-ignore-item-temp-list)
+
(defun multi-occur (bufs regexp &optional nlines)
"Show all lines in buffers BUFS containing a match for REGEXP.
This function acts on multiple buffers; otherwise, it is exactly like
`occur'. When you invoke this command interactively, you must specify
-the buffer names that you want, one by one."
+the buffer names that you want, one by one.
+See also `multi-occur-in-matching-buffers'."
(interactive
(cons
(let* ((bufs (list (read-buffer "First buffer to search: "
(cons
(let* ((default (car regexp-history))
(input
- (read-from-minibuffer
+ (read-regexp
(if current-prefix-arg
"List lines in buffers whose names match regexp: "
- "List lines in buffers whose filenames match regexp: ")
- nil
- nil
- nil
- 'regexp-history)))
+ "List lines in buffers whose filenames match regexp: "))))
(if (equal input "")
default
input))
(setq occur-buf (get-buffer-create buf-name))
(with-current-buffer occur-buf
- (occur-mode)
+ (if (stringp nlines)
+ (fundamental-mode) ;; This is for collect operation.
+ (occur-mode))
(let ((inhibit-read-only t)
;; Don't generate undo entries for creation of the initial contents.
(buffer-undo-list t))
(erase-buffer)
- (let ((count (occur-engine
- regexp active-bufs occur-buf
- (or nlines list-matching-lines-default-context-lines)
- (if (and case-fold-search search-upper-case)
- (isearch-no-upper-case-p regexp t)
- case-fold-search)
- list-matching-lines-buffer-name-face
- nil list-matching-lines-face
- (not (eq occur-excluded-properties t)))))
+ (let ((count
+ (if (stringp nlines)
+ ;; Treat nlines as a regexp to collect.
+ (let ((bufs active-bufs)
+ (count 0))
+ (while bufs
+ (with-current-buffer (car bufs)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ ;; Insert the replacement regexp.
+ (let ((str (match-substitute-replacement nlines)))
+ (if str
+ (with-current-buffer occur-buf
+ (insert str)
+ (setq count (1+ count))
+ (or (zerop (current-column))
+ (insert "\n"))))))))
+ (setq bufs (cdr bufs)))
+ count)
+ ;; Perform normal occur.
+ (occur-engine
+ regexp active-bufs occur-buf
+ (or nlines list-matching-lines-default-context-lines)
+ (if (and case-fold-search search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ case-fold-search)
+ list-matching-lines-buffer-name-face
+ (if (face-differs-from-default-p list-matching-lines-prefix-face)
+ list-matching-lines-prefix-face)
+ list-matching-lines-face
+ (not (eq occur-excluded-properties t))))))
(let* ((bufcount (length active-bufs))
(diff (- (length bufs) bufcount)))
- (message "Searched %d buffer%s%s; %s match%s for `%s'"
+ (message "Searched %d buffer%s%s; %s match%s%s"
bufcount (if (= bufcount 1) "" "s")
(if (zerop diff) "" (format " (%d killed)" diff))
(if (zerop count) "no" (format "%d" count))
(if (= count 1) "" "es")
- regexp))
+ ;; Don't display regexp if with remaining text
+ ;; it is longer than window-width.
+ (if (> (+ (length regexp) 42) (window-width))
+ "" (format " for `%s'" (query-replace-descr regexp)))))
(setq occur-revert-arguments (list regexp nlines bufs))
(if (= count 0)
(kill-buffer occur-buf)
(set-buffer-modified-p nil)
(run-hooks 'occur-hook)))))))
-(defun occur-engine-add-prefix (lines)
- (mapcar
- #'(lambda (line)
- (concat " :" line "\n"))
- lines))
-
-(defun occur-engine (regexp buffers out-buf nlines case-fold-search
+(defun occur-engine (regexp buffers out-buf nlines case-fold
title-face prefix-face match-face keep-props)
(with-current-buffer out-buf
- (let ((globalcount 0)
- (coding nil))
+ (let ((global-lines 0) ;; total count of matching lines
+ (global-matches 0) ;; total count of matches
+ (coding nil)
+ (case-fold-search case-fold))
;; Map over all the buffers
(dolist (buf buffers)
(when (buffer-live-p buf)
- (let ((matches 0) ;; count of matched lines
- (lines 1) ;; line count
+ (let ((lines 0) ;; count of matching lines
+ (matches 0) ;; count of matches
+ (curr-line 1) ;; line count
+ (prev-line nil) ;; line number of prev match endpt
+ (prev-after-lines nil) ;; context lines of prev match
(matchbeg 0)
(origpt nil)
(begpt nil)
(endpt nil)
(marker nil)
(curstring "")
+ (ret nil)
(inhibit-field-text-motion t)
(headerpt (with-current-buffer out-buf (point))))
(with-current-buffer buf
(while (not (eobp))
(setq origpt (point))
(when (setq endpt (re-search-forward regexp nil t))
- (setq matches (1+ matches)) ;; increment match count
+ (setq lines (1+ lines)) ;; increment matching lines count
(setq matchbeg (match-beginning 0))
- (setq lines (+ lines (1- (count-lines origpt endpt))))
+ ;; Get beginning of first match line and end of the last.
(save-excursion
(goto-char matchbeg)
- (setq begpt (line-beginning-position)
- endpt (line-end-position)))
+ (setq begpt (line-beginning-position))
+ (goto-char endpt)
+ (setq endpt (line-end-position)))
+ ;; Sum line numbers up to the first match line.
+ (setq curr-line (+ curr-line (count-lines origpt begpt)))
(setq marker (make-marker))
(set-marker marker matchbeg)
- (if (and keep-props
- (if (boundp 'jit-lock-mode) jit-lock-mode)
- (text-property-not-all begpt endpt 'fontified t))
- (if (fboundp 'jit-lock-fontify-now)
- (jit-lock-fontify-now begpt endpt)))
- (if (and keep-props (not (eq occur-excluded-properties t)))
- (progn
- (setq curstring (buffer-substring begpt endpt))
- (remove-list-of-text-properties
- 0 (length curstring) occur-excluded-properties curstring))
- (setq curstring (buffer-substring-no-properties begpt endpt)))
+ (setq curstring (occur-engine-line begpt endpt keep-props))
;; Highlight the matches
(let ((len (length curstring))
(start 0))
(while (and (< start len)
(string-match regexp curstring start))
+ (setq matches (1+ matches))
(add-text-properties
(match-beginning 0) (match-end 0)
(append
curstring)
(setq start (match-end 0))))
;; Generate the string to insert for this match
- (let* ((out-line
+ (let* ((match-prefix
+ ;; Using 7 digits aligns tabs properly.
+ (apply #'propertize (format "%7d:" curr-line)
+ (append
+ (when prefix-face
+ `(font-lock-face ,prefix-face))
+ `(occur-prefix t mouse-face (highlight)
+ ;; Allow insertion of text at
+ ;; the end of the prefix (for
+ ;; Occur Edit mode).
+ front-sticky t rear-nonsticky t
+ occur-target ,marker follow-link t
+ help-echo "mouse-2: go to this occurrence"))))
+ (match-str
+ ;; We don't put `mouse-face' on the newline,
+ ;; because that loses. And don't put it
+ ;; on context lines to reduce flicker.
+ (propertize curstring 'mouse-face (list 'highlight)
+ 'occur-target marker
+ 'follow-link t
+ 'help-echo
+ "mouse-2: go to this occurrence"))
+ (out-line
(concat
- ;; Using 7 digits aligns tabs properly.
- (apply #'propertize (format "%7d:" lines)
- (append
- (when prefix-face
- `(font-lock-face prefix-face))
- `(occur-prefix t mouse-face (highlight)
- occur-target ,marker follow-link t
- help-echo "mouse-2: go to this occurrence")))
- ;; We don't put `mouse-face' on the newline,
- ;; because that loses. And don't put it
- ;; on context lines to reduce flicker.
- (propertize curstring 'mouse-face (list 'highlight)
- 'occur-target marker
- 'follow-link t
- 'help-echo
- "mouse-2: go to this occurrence")
+ match-prefix
+ ;; Add non-numeric prefix to all non-first lines
+ ;; of multi-line matches.
+ (replace-regexp-in-string
+ "\n"
+ (if prefix-face
+ (propertize "\n :" 'font-lock-face prefix-face)
+ "\n :")
+ match-str)
;; Add marker at eol, but no mouse props.
(propertize "\n" 'occur-target marker)))
(data
;; The simple display style
out-line
;; The complex multi-line display style.
- (occur-context-lines out-line nlines keep-props)
- )))
+ (setq ret (occur-context-lines
+ out-line nlines keep-props begpt endpt
+ curr-line prev-line prev-after-lines
+ prefix-face))
+ ;; Set first elem of the returned list to `data',
+ ;; and the second elem to `prev-after-lines'.
+ (setq prev-after-lines (nth 1 ret))
+ (nth 0 ret))))
;; Actually insert the match display data
(with-current-buffer out-buf
- (let ((beg (point))
- (end (progn (insert data) (point))))
- (unless (= nlines 0)
- (insert "-------\n")))))
+ (insert data)))
(goto-char endpt))
(if endpt
(progn
- (setq lines (1+ lines))
+ ;; Sum line numbers between first and last match lines.
+ (setq curr-line (+ curr-line (count-lines begpt endpt)
+ ;; Add 1 for empty last match line since
+ ;; count-lines returns 1 line less.
+ (if (and (bolp) (eolp)) 1 0)))
;; On to the next match...
(forward-line 1))
- (goto-char (point-max))))))
- (when (not (zerop matches)) ;; is the count zero?
- (setq globalcount (+ globalcount matches))
+ (goto-char (point-max)))
+ (setq prev-line (1- curr-line)))
+ ;; Flush remaining context after-lines.
+ (when prev-after-lines
+ (with-current-buffer out-buf
+ (insert (apply #'concat (occur-engine-add-prefix
+ prev-after-lines prefix-face)))))))
+ (when (not (zerop lines)) ;; is the count zero?
+ (setq global-lines (+ global-lines lines)
+ global-matches (+ global-matches matches))
(with-current-buffer out-buf
(goto-char headerpt)
(let ((beg (point))
end)
- (insert (format "%d match%s for \"%s\" in buffer: %s\n"
- matches (if (= matches 1) "" "es")
- regexp (buffer-name buf)))
+ (insert (propertize
+ (format "%d match%s%s%s in buffer: %s\n"
+ matches (if (= matches 1) "" "es")
+ ;; Don't display the same number of lines
+ ;; and matches in case of 1 match per line.
+ (if (= lines matches)
+ "" (format " in %d line%s"
+ lines (if (= lines 1) "" "s")))
+ ;; Don't display regexp for multi-buffer.
+ (if (> (length buffers) 1)
+ "" (format " for \"%s\""
+ (query-replace-descr regexp)))
+ (buffer-name buf))
+ 'read-only t))
(setq end (point))
(add-text-properties beg end
(append
`(font-lock-face ,title-face))
`(occur-title ,buf))))
(goto-char (point-min)))))))
+ ;; Display total match count and regexp for multi-buffer.
+ (when (and (not (zerop global-lines)) (> (length buffers) 1))
+ (goto-char (point-min))
+ (let ((beg (point))
+ end)
+ (insert (format "%d match%s%s total for \"%s\":\n"
+ global-matches (if (= global-matches 1) "" "es")
+ ;; Don't display the same number of lines
+ ;; and matches in case of 1 match per line.
+ (if (= global-lines global-matches)
+ "" (format " in %d line%s"
+ global-lines (if (= global-lines 1) "" "s")))
+ (query-replace-descr regexp)))
+ (setq end (point))
+ (add-text-properties beg end (when title-face
+ `(font-lock-face ,title-face))))
+ (goto-char (point-min)))
(if coding
;; CODING is buffer-file-coding-system of the first buffer
;; that locally binds it. Let's use it also for the output
;; buffer.
(set-buffer-file-coding-system coding))
;; Return the number of matches
- globalcount)))
+ global-matches)))
+
+(defun occur-engine-line (beg end &optional keep-props)
+ (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
+ (text-property-not-all beg end 'fontified t))
+ (if (fboundp 'jit-lock-fontify-now)
+ (jit-lock-fontify-now beg end)))
+ (if (and keep-props (not (eq occur-excluded-properties t)))
+ (let ((str (buffer-substring beg end)))
+ (remove-list-of-text-properties
+ 0 (length str) occur-excluded-properties str)
+ str)
+ (buffer-substring-no-properties beg end)))
+
+(defun occur-engine-add-prefix (lines &optional prefix-face)
+ (mapcar
+ #'(lambda (line)
+ (concat (if prefix-face
+ (propertize " :" 'font-lock-face prefix-face)
+ " :")
+ line "\n"))
+ lines))
+
+(defun occur-accumulate-lines (count &optional keep-props pt)
+ (save-excursion
+ (when pt
+ (goto-char pt))
+ (let ((forwardp (> count 0))
+ result beg end moved)
+ (while (not (or (zerop count)
+ (if forwardp
+ (eobp)
+ (and (bobp) (not moved)))))
+ (setq count (+ count (if forwardp -1 1)))
+ (setq beg (line-beginning-position)
+ end (line-end-position))
+ (push (occur-engine-line beg end keep-props) result)
+ (setq moved (= 0 (forward-line (if forwardp 1 -1)))))
+ (nreverse result))))
;; Generate context display for occur.
;; OUT-LINE is the line where the match is.
;; NLINES and KEEP-PROPS are args to occur-engine.
+;; CURR-LINE is line count of the current match,
+;; PREV-LINE is line count of the previous match,
+;; PREV-AFTER-LINES is a list of after-context lines of the previous match.
;; Generate a list of lines, add prefixes to all but OUT-LINE,
;; then concatenate them all together.
-(defun occur-context-lines (out-line nlines keep-props)
- (apply #'concat
- (nconc
- (occur-engine-add-prefix
- (nreverse (cdr (occur-accumulate-lines
- (- (1+ (abs nlines))) keep-props))))
- (list out-line)
- (if (> nlines 0)
- (occur-engine-add-prefix
- (cdr (occur-accumulate-lines (1+ nlines) keep-props)))))))
+(defun occur-context-lines (out-line nlines keep-props begpt endpt
+ curr-line prev-line prev-after-lines
+ &optional prefix-face)
+ ;; Find after- and before-context lines of the current match.
+ (let ((before-lines
+ (nreverse (cdr (occur-accumulate-lines
+ (- (1+ (abs nlines))) keep-props begpt))))
+ (after-lines
+ (cdr (occur-accumulate-lines
+ (1+ nlines) keep-props endpt)))
+ separator)
+
+ ;; Combine after-lines of the previous match
+ ;; with before-lines of the current match.
+
+ (when prev-after-lines
+ ;; Don't overlap prev after-lines with current before-lines.
+ (if (>= (+ prev-line (length prev-after-lines))
+ (- curr-line (length before-lines)))
+ (setq prev-after-lines
+ (butlast prev-after-lines
+ (- (length prev-after-lines)
+ (- curr-line prev-line (length before-lines) 1))))
+ ;; Separate non-overlapping context lines with a dashed line.
+ (setq separator "-------\n")))
+
+ (when prev-line
+ ;; Don't overlap current before-lines with previous match line.
+ (if (<= (- curr-line (length before-lines))
+ prev-line)
+ (setq before-lines
+ (nthcdr (- (length before-lines)
+ (- curr-line prev-line 1))
+ before-lines))
+ ;; Separate non-overlapping before-context lines.
+ (unless (> nlines 0)
+ (setq separator "-------\n"))))
+
+ (list
+ ;; Return a list where the first element is the output line.
+ (apply #'concat
+ (append
+ (if prev-after-lines
+ (occur-engine-add-prefix prev-after-lines prefix-face))
+ (if separator
+ (list (if prefix-face
+ (propertize separator 'font-lock-face prefix-face)
+ separator)))
+ (occur-engine-add-prefix before-lines prefix-face)
+ (list out-line)))
+ ;; And the second element is the list of context after-lines.
+ (if (> nlines 0) after-lines))))
+
\f
;; It would be nice to use \\[...], but there is no reasonable way
;; to make that display both SPC and Y.
C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
C-w to delete match and recursive edit,
C-l to clear the screen, redisplay, and offer same replacement again,
-! to replace all remaining matches with no more questions,
+! to replace all remaining matches in this buffer with no more questions,
^ to move point back to previous match,
-E to edit the replacement string"
+E to edit the replacement string.
+In multi-buffer replacements type `Y' to replace all remaining
+matches in all remaining buffers with no more questions,
+`N' to skip to the next buffer without replacing remaining matches
+in the current buffer."
"Help message while in `query-replace'.")
(defvar query-replace-map
(define-key map "?" 'help)
(define-key map "\C-g" 'quit)
(define-key map "\C-]" 'quit)
- (define-key map "\e" 'exit-prefix)
+ (define-key map "\C-v" 'scroll-up)
+ (define-key map "\M-v" 'scroll-down)
+ (define-key map [next] 'scroll-up)
+ (define-key map [prior] 'scroll-down)
+ (define-key map [?\C-\M-v] 'scroll-other-window)
+ (define-key map [M-next] 'scroll-other-window)
+ (define-key map [?\C-\M-\S-v] 'scroll-other-window-down)
+ (define-key map [M-prior] 'scroll-other-window-down)
+ ;; Binding ESC would prohibit the M-v binding. Instead, callers
+ ;; should check for ESC specially.
+ ;; (define-key map "\e" 'exit-prefix)
(define-key map [escape] 'exit-prefix)
map)
- "Keymap that defines the responses to questions in `query-replace'.
+ "Keymap of responses to questions posed by commands like `query-replace'.
The \"bindings\" in this map are not commands; they are answers.
The valid answers include `act', `skip', `act-and-show',
-`exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
-`automatic', `backup', `exit-prefix', and `help'.")
+`act-and-exit', `exit', `exit-prefix', `recenter', `scroll-up',
+`scroll-down', `scroll-other-window', `scroll-other-window-down',
+`edit', `edit-replacement', `delete-and-edit', `automatic',
+`backup', `quit', and `help'.
+
+This keymap is used by `y-or-n-p' as well as `query-replace'.")
(defvar multi-query-replace-map
(let ((map (make-sparse-keymap)))
(setcar n 'replace-count))))))
(setq n (cdr n))))
-(defun replace-eval-replacement (expression replace-count)
- (let ((replacement (eval expression)))
+(defun replace-eval-replacement (expression count)
+ (let* ((replace-count count)
+ (replacement (eval expression)))
(if (stringp replacement)
replacement
(prin1-to-string replacement t))))
(prin1-to-string replacement t))
t t)))
-(defun replace-loop-through-replacements (data replace-count)
- ;; DATA is a vector contaning the following values:
+(defun replace-loop-through-replacements (data count)
+ ;; DATA is a vector containing the following values:
;; 0 next-rotate-count
;; 1 repeat-count
;; 2 next-replacement
;; 3 replacements
- (if (= (aref data 0) replace-count)
+ (if (= (aref data 0) count)
(progn
- (aset data 0 (+ replace-count (aref data 1)))
+ (aset data 0 (+ count (aref data 1)))
(let ((next (cdr (aref data 2))))
(aset data 2 (if (consp next) next (aref data 3))))))
(car (aref data 2)))
(replace-match newtext fixedcase literal)
noedit)
-(defvar replace-search-function 'search-forward
+(defvar replace-search-function nil
"Function to use when searching for strings to replace.
It is used by `query-replace' and `replace-string', and is called
with three arguments, as if it were `search-forward'.")
-(defvar replace-re-search-function 're-search-forward
+(defvar replace-re-search-function nil
"Function to use when searching for regexps to replace.
It is used by `query-replace-regexp', `replace-regexp',
`query-replace-regexp-eval', and `map-query-replace-regexp'.
It is called with three arguments, as if it were
`re-search-forward'.")
+(defun replace-search (search-string limit regexp-flag delimited-flag
+ case-fold-search)
+ "Search for the next occurence of SEARCH-STRING to replace."
+ ;; Let-bind global isearch-* variables to values used
+ ;; to search the next replacement. These let-bindings
+ ;; should be effective both at the time of calling
+ ;; `isearch-search-fun-default' and also at the
+ ;; time of funcalling `search-function'.
+ ;; These isearch-* bindings can't be placed higher
+ ;; outside of this function because then another I-search
+ ;; used after `recursive-edit' might override them.
+ (let* ((isearch-regexp regexp-flag)
+ (isearch-word delimited-flag)
+ (isearch-lax-whitespace
+ replace-lax-whitespace)
+ (isearch-regexp-lax-whitespace
+ replace-regexp-lax-whitespace)
+ (isearch-case-fold-search case-fold-search)
+ (isearch-adjusted nil)
+ (isearch-nonincremental t) ; don't use lax word mode
+ (isearch-forward t)
+ (search-function
+ (or (if regexp-flag
+ replace-re-search-function
+ replace-search-function)
+ (isearch-search-fun-default))))
+ (funcall search-function search-string limit t)))
+
+(defvar replace-overlay nil)
+
+(defun replace-highlight (match-beg match-end range-beg range-end
+ search-string regexp-flag delimited-flag
+ case-fold-search)
+ (if query-replace-highlight
+ (if replace-overlay
+ (move-overlay replace-overlay match-beg match-end (current-buffer))
+ (setq replace-overlay (make-overlay match-beg match-end))
+ (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
+ (overlay-put replace-overlay 'face 'query-replace)))
+ (if query-replace-lazy-highlight
+ (let ((isearch-string search-string)
+ (isearch-regexp regexp-flag)
+ (isearch-word delimited-flag)
+ (isearch-lax-whitespace
+ replace-lax-whitespace)
+ (isearch-regexp-lax-whitespace
+ replace-regexp-lax-whitespace)
+ (isearch-case-fold-search case-fold-search)
+ (isearch-forward t)
+ (isearch-other-end match-beg)
+ (isearch-error nil))
+ (isearch-lazy-highlight-new-loop range-beg range-end))))
+
+(defun replace-dehighlight ()
+ (when replace-overlay
+ (delete-overlay replace-overlay))
+ (when query-replace-lazy-highlight
+ (lazy-highlight-cleanup lazy-highlight-cleanup)
+ (setq isearch-lazy-highlight-last-string nil))
+ ;; Close overlays opened by `isearch-range-invisible' in `perform-replace'.
+ (isearch-clean-overlays))
+
(defun perform-replace (from-string replacements
query-flag regexp-flag delimited-flag
&optional repeat-count map start end)
case-fold-search))
(nocasify (not (and case-replace case-fold-search)))
(literal (or (not regexp-flag) (eq regexp-flag 'literal)))
- (search-function
- (if regexp-flag
- replace-re-search-function
- replace-search-function))
(search-string from-string)
(real-match-data nil) ; The match data for the current match.
(next-replacement nil)
(keep-going t)
(stack nil)
(replace-count 0)
+ (skip-read-only-count 0)
+ (skip-filtered-count 0)
+ (skip-invisible-count 0)
(nonempty-match nil)
(multi-buffer nil)
(recenter-last-op nil) ; Start cycling order with initial position.
(vector repeat-count repeat-count
replacements replacements)))))
- (if delimited-flag
- (setq search-function 're-search-forward
- search-string (concat "\\b"
- (if regexp-flag from-string
- (regexp-quote from-string))
- "\\b")))
(when query-replace-lazy-highlight
(setq isearch-lazy-highlight-last-string nil))
;; adjacent match.
(match-again
(and
- (funcall search-function search-string
- limit t)
+ (replace-search search-string limit
+ regexp-flag delimited-flag
+ case-fold-search)
;; For speed, use only integers and
;; reuse the list used last time.
(replace-match-data t real-match-data)))
;; if the search fails.
(let ((opoint (point)))
(forward-char 1)
- (if (funcall
- search-function search-string
- limit t)
+ (if (replace-search search-string limit
+ regexp-flag delimited-flag
+ case-fold-search)
(replace-match-data
t real-match-data)
(goto-char opoint)
(and (/= (nth 0 match) (nth 1 match))
match))))))
- ;; Optionally ignore matches that have a read-only property.
- (unless (and query-replace-skip-read-only
- (text-property-not-all
- (nth 0 real-match-data) (nth 1 real-match-data)
- 'read-only nil))
-
+ (cond
+ ;; Optionally ignore matches that have a read-only property.
+ ((not (or (not query-replace-skip-read-only)
+ (not (text-property-not-all
+ (nth 0 real-match-data) (nth 1 real-match-data)
+ 'read-only nil))))
+ (setq skip-read-only-count (1+ skip-read-only-count)))
+ ;; Optionally filter out matches.
+ ((not (run-hook-with-args-until-failure
+ 'isearch-filter-predicates
+ (nth 0 real-match-data) (nth 1 real-match-data)))
+ (setq skip-filtered-count (1+ skip-filtered-count)))
+ ;; Optionally ignore invisible matches.
+ ((not (or (eq search-invisible t)
+ ;; Don't open overlays for automatic replacements.
+ (and (not query-flag) search-invisible)
+ ;; Open hidden overlays for interactive replacements.
+ (not (isearch-range-invisible
+ (nth 0 real-match-data) (nth 1 real-match-data)))))
+ (setq skip-invisible-count (1+ skip-invisible-count)))
+ (t
;; Calculate the replacement string, if necessary.
(when replacements
(set-match-data real-match-data)
(replace-highlight
(nth 0 real-match-data) (nth 1 real-match-data)
start end search-string
- (or delimited-flag regexp-flag) case-fold-search))
+ regexp-flag delimited-flag case-fold-search))
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal
(replace-highlight
(match-beginning 0) (match-end 0)
start end search-string
- (or delimited-flag regexp-flag) case-fold-search)
+ regexp-flag delimited-flag case-fold-search)
;; Bind message-log-max so we don't fill up the message log
;; with a bunch of identical messages.
(let ((message-log-max nil)
(match-end 0)
(current-buffer))
(match-data t)))
- stack)))))
+ stack))))))
(replace-dehighlight))
(or unread-command-events
- (message "Replaced %d occurrence%s"
+ (message "Replaced %d occurrence%s%s"
replace-count
- (if (= replace-count 1) "" "s")))
+ (if (= replace-count 1) "" "s")
+ (if (> (+ skip-read-only-count
+ skip-filtered-count
+ skip-invisible-count) 0)
+ (format " (skipped %s)"
+ (mapconcat
+ 'identity
+ (delq nil (list
+ (if (> skip-read-only-count 0)
+ (format "%s read-only"
+ skip-read-only-count))
+ (if (> skip-invisible-count 0)
+ (format "%s invisible"
+ skip-invisible-count))
+ (if (> skip-filtered-count 0)
+ (format "%s filtered out"
+ skip-filtered-count))))
+ ", "))
+ "")))
(or (and keep-going stack) multi-buffer)))
-(defvar replace-overlay nil)
-
-(defun replace-highlight (match-beg match-end range-beg range-end
- string regexp case-fold)
- (if query-replace-highlight
- (if replace-overlay
- (move-overlay replace-overlay match-beg match-end (current-buffer))
- (setq replace-overlay (make-overlay match-beg match-end))
- (overlay-put replace-overlay 'priority 1001) ;higher than lazy overlays
- (overlay-put replace-overlay 'face 'query-replace)))
- (if query-replace-lazy-highlight
- (let ((isearch-string string)
- (isearch-regexp regexp)
- (search-whitespace-regexp nil)
- (isearch-case-fold-search case-fold)
- (isearch-forward t)
- (isearch-error nil))
- (isearch-lazy-highlight-new-loop range-beg range-end))))
-
-(defun replace-dehighlight ()
- (when replace-overlay
- (delete-overlay replace-overlay))
- (when query-replace-lazy-highlight
- (lazy-highlight-cleanup lazy-highlight-cleanup)
- (setq isearch-lazy-highlight-last-string nil)))
-
-;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4
;;; replace.el ends here