;;; replace.el --- replace commands for Emacs
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001, 2002,
-;; 2003, 2004 Free Software Foundation, Inc.
+;; 2003, 2004, 2005 Free Software Foundation, Inc.
;; Maintainer: FSF
"*Non-nil means `query-replace' and friends ignore read-only matches."
:type 'boolean
:group 'matching
- :version "21.4")
+ :version "22.1")
+
+(defcustom query-replace-highlight t
+ "*Non-nil means to highlight matches during query replacement."
+ :type 'boolean
+ :group 'matching)
+
+(defcustom query-replace-lazy-highlight t
+ "*Controls the lazy-highlighting during query replacements.
+When non-nil, all text in the buffer matching the current match
+is highlighted lazily using isearch lazy highlighting (see
+`lazy-highlight-initial-delay' and `lazy-highlight-interval')."
+ :type 'boolean
+ :group 'lazy-highlight
+ :group 'matching
+ :version "22.1")
+
+(defface query-replace
+ '((t (:inherit isearch)))
+ "Face for highlighting query replacement matches."
+ :group 'matching
+ :version "22.1")
(defun query-replace-descr (string)
(mapconcat 'isearch-text-char-description string ""))
query-replace-from-history-variable
nil t t))))
(if (and (zerop (length from)) lastto lastfrom)
- (cons lastfrom
- (query-replace-compile-replacement lastto regexp-flag))
+ (progn
+ (set query-replace-from-history-variable
+ (cdr (symbol-value query-replace-from-history-variable)))
+ (cons lastfrom
+ (query-replace-compile-replacement lastto regexp-flag)))
;; Warn if user types \n or \t, but don't reject the input.
(and regexp-flag
(string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
To customize possible responses, change the \"bindings\" in `query-replace-map'."
(interactive (let ((common
- (query-replace-read-args "Query replace" nil)))
+ (query-replace-read-args
+ (if (and transient-mark-mode mark-active)
+ "Query replace in region"
+ "Query replace")
+ nil)))
(list (nth 0 common) (nth 1 common) (nth 2 common)
;; These are done separately here
;; so that command-history will record these expressions
Use \\[repeat-complex-command] after this command for details."
(interactive
(let ((common
- (query-replace-read-args "Query replace regexp" t)))
+ (query-replace-read-args
+ (if (and transient-mark-mode mark-active)
+ "Query replace regexp in region"
+ "Query replace regexp")
+ t)))
(list (nth 0 common) (nth 1 common) (nth 2 common)
;; These are done separately here
;; so that command-history will record these expressions
and TO-STRING is also null.)"
(interactive
(let ((common
- (query-replace-read-args "Replace string" nil)))
+ (query-replace-read-args
+ (if (and transient-mark-mode mark-active)
+ "Replace string in region"
+ "Replace string")
+ nil)))
(list (nth 0 common) (nth 1 common) (nth 2 common)
(if (and transient-mark-mode mark-active)
(region-beginning))
which will run faster and will not set the mark or print anything."
(interactive
(let ((common
- (query-replace-read-args "Replace regexp" t)))
+ (query-replace-read-args
+ (if (and transient-mark-mode mark-active)
+ "Replace regexp in region"
+ "Replace regexp")
+ t)))
(list (nth 0 common) (nth 1 common) (nth 2 common)
(if (and transient-mark-mode mark-active)
(region-beginning))
(interactive "p")
;; we need to run occur-find-match from within the Occur buffer
(with-current-buffer
+ ;; Choose the buffer and make it current.
(if (next-error-buffer-p (current-buffer))
(current-buffer)
- (next-error-find-buffer nil nil (lambda() (eq major-mode 'occur-mode))))
+ (next-error-find-buffer nil nil
+ (lambda ()
+ (eq major-mode 'occur-mode))))
(goto-char (cond (reset (point-min))
((< argp 0) (line-beginning-position))
(t :background "gray"))
"Face used to highlight matches permanently."
:group 'matching
- :version "21.4")
+ :version "22.1")
(defcustom list-matching-lines-default-context-lines 0
"*Default number of context lines included around `list-matching-lines' matches.
(setq count (+ count (if forwardp -1 1)))
(setq beg (line-beginning-position)
end (line-end-position))
- (if (and keep-props font-lock-mode
+ (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
(text-property-not-all beg end 'fontified t))
- (font-lock-fontify-region beg end))
+ (if (fboundp 'jit-lock-fontify-now)
+ (jit-lock-fontify-now beg end)))
(push
(funcall (if keep-props
#'buffer-substring
(defun occur-1 (regexp nlines bufs &optional buf-name)
(unless buf-name
(setq buf-name "*Occur*"))
- (let ((occur-buf (get-buffer-create buf-name))
- (made-temp-buf nil)
+ (let (occur-buf
(active-bufs (delq nil (mapcar #'(lambda (buf)
(when (buffer-live-p buf) buf))
bufs))))
;; Handle the case where one of the buffers we're searching is the
- ;; *Occur* buffer itself.
- (when (memq occur-buf bufs)
- (setq occur-buf (with-current-buffer occur-buf
- (clone-buffer "*Occur-temp*"))
- made-temp-buf t))
+ ;; output buffer. Just rename it.
+ (when (member buf-name (mapcar 'buffer-name active-bufs))
+ (with-current-buffer (get-buffer buf-name)
+ (rename-uniquely)))
+
+ ;; Now find or create the output buffer.
+ ;; If we just renamed that buffer, we will make a new one here.
+ (setq occur-buf (get-buffer-create buf-name))
+
(with-current-buffer occur-buf
- (setq buffer-read-only nil)
(occur-mode)
- (erase-buffer)
- (let ((count (occur-engine
- regexp active-bufs occur-buf
- (or nlines list-matching-lines-default-context-lines)
- (and case-fold-search
- (isearch-no-upper-case-p regexp t))
- list-matching-lines-buffer-name-face
- nil list-matching-lines-face t)))
- (let* ((bufcount (length active-bufs))
- (diff (- (length bufs) bufcount)))
- (message "Searched %d buffer%s%s; %s match%s for `%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))
- ;; If we had to make a temporary buffer, make it the *Occur*
- ;; buffer now.
- (when made-temp-buf
- (with-current-buffer (get-buffer buf-name)
- (kill-buffer (current-buffer)))
- (rename-buffer buf-name))
- (setq occur-revert-arguments (list regexp nlines bufs)
- buffer-read-only t)
- (if (> count 0)
- (progn
- (display-buffer occur-buf)
- (setq next-error-last-buffer occur-buf))
- (kill-buffer occur-buf)))
- (run-hooks 'occur-hook))))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (let ((count (occur-engine
+ regexp active-bufs occur-buf
+ (or nlines list-matching-lines-default-context-lines)
+ (and case-fold-search
+ (isearch-no-upper-case-p regexp t))
+ list-matching-lines-buffer-name-face
+ nil list-matching-lines-face t)))
+ (let* ((bufcount (length active-bufs))
+ (diff (- (length bufs) bufcount)))
+ (message "Searched %d buffer%s%s; %s match%s for `%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))
+ (setq occur-revert-arguments (list regexp nlines bufs))
+ (if (> count 0)
+ (progn
+ (display-buffer occur-buf)
+ (setq next-error-last-buffer occur-buf))
+ (kill-buffer occur-buf)))
+ (run-hooks 'occur-hook))
+ (setq buffer-read-only t)
+ (set-buffer-modified-p nil))))
(defun occur-engine-add-prefix (lines)
(mapcar
(defun occur-engine (regexp buffers out-buf nlines case-fold-search
title-face prefix-face match-face keep-props)
(with-current-buffer out-buf
- (setq buffer-read-only nil)
(let ((globalcount 0)
(coding nil))
;; Map over all the buffers
endpt (line-end-position)))
(setq marker (make-marker))
(set-marker marker matchbeg)
- (if (and keep-props font-lock-mode
+ (if (and keep-props
+ (if (boundp 'jit-lock-mode) jit-lock-mode)
(text-property-not-all begpt endpt 'fontified t))
- (font-lock-fontify-region begpt endpt))
+ (if (fboundp 'jit-lock-fontify-now)
+ (jit-lock-fontify-now begpt endpt)))
(setq curstring (buffer-substring begpt endpt))
;; Depropertize the string, and maybe
;; highlight the matches
(while (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\\\?\\)"
newtext)
(setq newtext
- (read-input "Edit replacement string: "
- (prog1
- (cons
- (replace-match "" t t newtext 3)
- (1+ (match-beginning 3)))
- (setq match-data
- (replace-match-data
- nil match-data match-data))))
+ (read-string "Edit replacement string: "
+ (prog1
+ (cons
+ (replace-match "" t t newtext 3)
+ (1+ (match-beginning 3)))
+ (setq match-data
+ (replace-match-data
+ nil match-data match-data))))
noedit nil)))
(set-match-data match-data)
(replace-match newtext fixedcase literal)
;; (match-data); otherwise it is t if a match is possible at point.
(match-again t)
- (isearch-string isearch-string)
- (isearch-regexp isearch-regexp)
- (isearch-case-fold-search isearch-case-fold-search)
(message
(if query-flag
(substitute-command-keys
(regexp-quote from-string))
"\\b")))
(when query-replace-lazy-highlight
- (setq isearch-string search-string
- isearch-regexp (or delimited-flag regexp-flag)
- isearch-case-fold-search case-fold-search
- isearch-lazy-highlight-last-string nil))
+ (setq isearch-lazy-highlight-last-string nil))
(push-mark)
(undo-boundary)
(let ((inhibit-read-only
query-replace-skip-read-only))
(unless (or literal noedit)
- (replace-highlight (nth 0 real-match-data)
- (nth 1 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))
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal
;; `real-match-data'.
(while (not done)
(set-match-data real-match-data)
- (replace-highlight (match-beginning 0) (match-end 0))
+ (replace-highlight
+ (match-beginning 0) (match-end 0)
+ start end search-string
+ (or delimited-flag regexp-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))
nil real-match-data
real-match-data)
next-replacement
- (read-input "Edit replacement string: "
- next-replacement)
+ (read-string "Edit replacement string: "
+ next-replacement)
noedit nil)
(if replaced
(set-match-data real-match-data)
unread-command-events))
(setq done t)))
(when query-replace-lazy-highlight
- ;; Restore isearch data for lazy highlighting
- ;; in case of isearching during recursive edit
- (setq isearch-string search-string
- isearch-regexp (or delimited-flag regexp-flag)
- isearch-case-fold-search case-fold-search)
;; Force lazy rehighlighting only after replacements
(if (not (memq def '(skip backup)))
(setq isearch-lazy-highlight-last-string nil))))
(if (= replace-count 1) "" "s")))
(and keep-going stack)))
-(defcustom query-replace-highlight t
- "*Non-nil means to highlight matches during query replacement."
- :type 'boolean
- :group 'matching)
-
-(defcustom query-replace-lazy-highlight t
- "*Controls the lazy-highlighting during query replacements.
-When non-nil, all text in the buffer matching the current match
-is highlighted lazily using isearch lazy highlighting (see
-`isearch-lazy-highlight-initial-delay' and
-`isearch-lazy-highlight-interval')."
- :type 'boolean
- :group 'matching
- :version "21.4")
-
-(defface query-replace
- '((t (:inherit isearch)))
- "Face for highlighting query replacement matches."
- :group 'matching
- :version "21.4")
-
(defvar replace-overlay nil)
-(defun replace-highlight (beg end)
+(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 beg end (current-buffer))
- (setq replace-overlay (make-overlay beg end))
+ (move-overlay replace-overlay match-beg match-end (current-buffer))
+ (setq replace-overlay (make-overlay match-beg match-end))
(overlay-put replace-overlay 'priority 1) ;higher than lazy overlays
(overlay-put replace-overlay 'face 'query-replace)))
(if query-replace-lazy-highlight
- (isearch-lazy-highlight-new-loop)))
+ (let ((isearch-string string)
+ (isearch-regexp regexp)
+ (isearch-case-fold-search case-fold))
+ (isearch-lazy-highlight-new-loop range-beg range-end))))
(defun replace-dehighlight ()
(when replace-overlay
(delete-overlay replace-overlay))
(when query-replace-lazy-highlight
- (isearch-lazy-highlight-cleanup isearch-lazy-highlight-cleanup)
+ (lazy-highlight-cleanup lazy-highlight-cleanup)
(setq isearch-lazy-highlight-last-string nil)))
;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4