;;; 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
-;; 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)
+(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
(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.)
+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.)
+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.
+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-from-history-variable
- 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))
\(Preserving case means that if the string matched is all caps, or capitalized,
then its replacement is upcased or capitalized.)
+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.
+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
+ ;; Regexp for tag at point.
+ (let* ((tagf (or find-tag-default-function
+ (get major-mode 'find-tag-default-function)
+ 'find-tag-default))
+ (tag (funcall tagf)))
+ (cond ((not tag) "")
+ ((eq tagf 'find-tag-default)
+ (format "\\_<%s\\_>" (regexp-quote tag)))
+ (t (regexp-quote tag))))
+ (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))
+
+\f
+;;; Occur Edit mode
-(defun occur-revert-function (ignore1 ignore2)
+(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)
: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))
- (push (occur-engine-line beg end keep-props) result)
- (forward-line (if forwardp 1 -1)))
- (nreverse result))))
-
(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")
+ (car regexp-history))))
+ (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'
\\<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
+ nil 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%s"
(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))
+ (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
+ (prev-after-lines nil) ;; context lines of prev match
+ (prev-lines nil) ;; line number of prev match endpt
(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
(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"))))
+ ;; 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
;; 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
+ lines prev-lines prev-after-lines))
+ ;; 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
(if (and (bolp) (eolp)) 1 0)))
;; On to the next match...
(forward-line 1))
- (goto-char (point-max))))))
+ (goto-char (point-max)))
+ (setq prev-lines (1- lines)))
+ ;; Flush remaining context after-lines.
+ (when prev-after-lines
+ (with-current-buffer out-buf
+ (insert (apply #'concat (occur-engine-add-prefix
+ prev-after-lines)))))))
(when (not (zerop matches)) ;; is the count zero?
(setq globalcount (+ globalcount matches))
(with-current-buffer out-buf
(goto-char headerpt)
(let ((beg (point))
end)
- (insert (format "%d match%s%s in buffer: %s\n"
- matches (if (= matches 1) "" "es")
- ;; Don't display regexp for multi-buffer.
- (if (> (length buffers) 1)
- "" (format " for \"%s\""
- (query-replace-descr regexp)))
- (buffer-name buf)))
+ (insert (propertize
+ (format "%d match%s%s in buffer: %s\n"
+ matches (if (= matches 1) "" "es")
+ ;; 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
str)
(buffer-substring-no-properties beg end)))
+(defun occur-engine-add-prefix (lines)
+ (mapcar
+ #'(lambda (line)
+ (concat " :" 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.
+;; LINES is line count of the current match,
+;; PREV-LINES 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
+ lines prev-lines prev-after-lines)
+ ;; 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-lines (length prev-after-lines))
+ (- lines (length before-lines)))
+ (setq prev-after-lines
+ (butlast prev-after-lines
+ (- (length prev-after-lines)
+ (- lines prev-lines (length before-lines) 1))))
+ ;; Separate non-overlapping context lines with a dashed line.
+ (setq separator "-------\n")))
+
+ (when prev-lines
+ ;; Don't overlap current before-lines with previous match line.
+ (if (<= (- lines (length before-lines))
+ prev-lines)
+ (setq before-lines
+ (nthcdr (- (length before-lines)
+ (- lines prev-lines 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
+ (and prev-after-lines
+ (occur-engine-add-prefix prev-after-lines))
+ (and separator (list separator))
+ (occur-engine-add-prefix before-lines)
+ (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)))
#& (string-to-number (match-string 0))
# replace-count
-Note that these symbols must be preceeded by a backslash in order to
+Note that these symbols must be preceded by a backslash in order to
type them using Lisp syntax."
(while (consp n)
(cond
(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'.
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)
(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))
;; Loop finding occurrences that perhaps should be replaced.
(while (and keep-going
(not (or (eobp) (and limit (>= (point) limit))))
- ;; Use the next match if it is already known;
- ;; otherwise, search for a match after moving forward
- ;; one char if progress is required.
- (setq real-match-data
- (cond ((consp match-again)
- (goto-char (nth 1 match-again))
- (replace-match-data
- t real-match-data match-again))
- ;; MATCH-AGAIN non-nil means accept an
- ;; adjacent match.
- (match-again
- (and
- (funcall search-function search-string
- limit t)
- ;; For speed, use only integers and
- ;; reuse the list used last time.
- (replace-match-data t real-match-data)))
- ((and (< (1+ (point)) (point-max))
- (or (null limit)
- (< (1+ (point)) limit)))
- ;; If not accepting adjacent matches,
- ;; move one char to the right before
- ;; searching again. Undo the motion
- ;; if the search fails.
- (let ((opoint (point)))
- (forward-char 1)
- (if (funcall
- search-function search-string
- limit t)
- (replace-match-data
- t real-match-data)
- (goto-char opoint)
- nil))))))
+ ;; 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 loop 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))))
+ ;; Use the next match if it is already known;
+ ;; otherwise, search for a match after moving forward
+ ;; one char if progress is required.
+ (setq real-match-data
+ (cond ((consp match-again)
+ (goto-char (nth 1 match-again))
+ (replace-match-data
+ t real-match-data match-again))
+ ;; MATCH-AGAIN non-nil means accept an
+ ;; adjacent match.
+ (match-again
+ (and
+ (funcall search-function search-string
+ limit t)
+ ;; For speed, use only integers and
+ ;; reuse the list used last time.
+ (replace-match-data t real-match-data)))
+ ((and (< (1+ (point)) (point-max))
+ (or (null limit)
+ (< (1+ (point)) limit)))
+ ;; If not accepting adjacent matches,
+ ;; move one char to the right before
+ ;; searching again. Undo the motion
+ ;; if the search fails.
+ (let ((opoint (point)))
+ (forward-char 1)
+ (if (funcall
+ search-function search-string
+ limit t)
+ (replace-match-data
+ t real-match-data)
+ (goto-char opoint)
+ nil)))))))
;; Record whether the match is nonempty, to avoid an infinite loop
;; repeatedly matching the same empty string.
(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)
(defvar replace-overlay nil)
(defun replace-highlight (match-beg match-end range-beg range-end
- string regexp case-fold)
+ 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))
(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))
+ (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 ()
(lazy-highlight-cleanup lazy-highlight-cleanup)
(setq isearch-lazy-highlight-last-string nil)))
-;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4
;;; replace.el ends here