;;; replace.el --- replace commands for Emacs
-;; Copyright (C) 1985, 86, 87, 92, 94, 96, 1997, 2000, 2001, 2002,
-;; 2003, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001, 2002,
+;; 2003, 2004, 2005 Free Software Foundation, Inc.
;; Maintainer: FSF
(defvar query-replace-history nil)
-(defcustom query-replace-interactive nil
+(defvar query-replace-interactive nil
"Non-nil means `query-replace' uses the last search string.
-That becomes the \"string to replace\".
-If value is `initial', the last search string is inserted into
-the minibuffer as an initial value for \"string to replace\"."
- :type '(choice (const :tag "Off" nil)
- (const :tag "Initial content" initial)
- (other :tag "Use default value" t))
- :group 'matching)
+That becomes the \"string to replace\".")
(defcustom query-replace-from-history-variable 'query-replace-history
"History list to use for the FROM argument of `query-replace' commands.
"*Non-nil means `query-replace' and friends ignore read-only matches."
:type 'boolean
:group 'matching
- :version "21.4")
+ :version "22.1")
-(defun query-replace-read-args (string regexp-flag &optional noerror)
- (unless noerror
- (barf-if-buffer-read-only))
- (let (from to)
- (if (and query-replace-interactive
- (not (eq query-replace-interactive 'initial)))
- (setq from (car (if regexp-flag regexp-search-ring search-ring)))
- ;; 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
- (setq from (read-from-minibuffer
- (format "%s: " string)
- (if (eq query-replace-interactive 'initial)
- (car (if regexp-flag regexp-search-ring search-ring)))
- nil nil
- query-replace-from-history-variable
- nil t)))
- ;; Warn if user types \n or \t, but don't reject the input.
- (and regexp-flag
- (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
- (let ((match (match-string 3 from)))
- (cond
- ((string= match "\\n")
- (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
- ((string= match "\\t")
- (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
- (sit-for 2))))
+(defcustom query-replace-highlight t
+ "*Non-nil means to highlight matches during query replacement."
+ :type 'boolean
+ :group 'matching)
- (save-excursion
- (setq to (read-from-minibuffer
- (format "%s %s with: " string from)
- nil nil nil
- query-replace-to-history-variable from t)))
- (when (and regexp-flag
- (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))
+(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 ""))
+
+(defun query-replace-read-from (string regexp-flag)
+ "Query and return the `from' argument of a query-replace operation.
+The return value can also be a pair (FROM . TO) indicating that the user
+wants to replace FROM with TO."
+ (if query-replace-interactive
+ (car (if regexp-flag regexp-search-ring search-ring))
+ (let* ((lastfrom (car (symbol-value query-replace-from-history-variable)))
+ (lastto (car (symbol-value query-replace-to-history-variable)))
+ (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
+ (when (equal lastfrom lastto)
+ ;; Typically, this is because the two histlists are shared.
+ (setq lastfrom (cadr (symbol-value
+ query-replace-from-history-variable))))
+ (read-from-minibuffer
+ (if (and lastto lastfrom)
+ (format "%s (default %s -> %s): " string
+ (query-replace-descr lastfrom)
+ (query-replace-descr lastto))
+ (format "%s: " string))
+ nil nil nil
+ query-replace-from-history-variable
+ nil t t))))
+ (if (and (zerop (length from)) lastto lastfrom)
+ (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)
+ (let ((match (match-string 3 from)))
+ (cond
+ ((string= match "\\n")
+ (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
+ ((string= match "\\t")
+ (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
+ (sit-for 2)))
+ from))))
+
+(defun query-replace-compile-replacement (to regexp-flag)
+ "Maybe convert a regexp replacement TO to Lisp.
+Returns a list suitable for `perform-replace' if necessary,
+the original string if not."
+ (if (and regexp-flag
+ (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))
(let (pos list char)
(while
(progn
(cdr pos))))
(setq to (substring to end)))))
(string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)))
- (setq to (nreverse (delete "" (cons to list)))))
- (replace-match-string-symbols to)
- (setq to (cons 'replace-eval-replacement
- (if (> (length to) 1)
- (cons 'concat to)
- (car to)))))
+ (setq to (nreverse (delete "" (cons to list))))
+ (replace-match-string-symbols to)
+ (cons 'replace-eval-replacement
+ (if (cdr to)
+ (cons 'concat to)
+ (car to))))
+ to))
+
+
+(defun query-replace-read-to (from string regexp-flag)
+ "Query and return the `to' argument of a query-replace operation."
+ (query-replace-compile-replacement
+ (save-excursion
+ (read-from-minibuffer
+ (format "%s %s with: " string (query-replace-descr from))
+ nil nil nil
+ query-replace-to-history-variable from t t))
+ regexp-flag))
+
+(defun query-replace-read-args (string regexp-flag &optional noerror)
+ (unless noerror
+ (barf-if-buffer-read-only))
+ (let* ((from (query-replace-read-from string regexp-flag))
+ (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
+ (query-replace-read-to from string regexp-flag))))
(list from to current-prefix-arg)))
(defun query-replace (from-string to-string &optional delimited start end)
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
only matches that are surrounded by word boundaries.
Fourth and fifth arg START and END specify the region to operate on."
(interactive
- (let (from to)
- (if query-replace-interactive
- (setq from (car regexp-search-ring))
- (setq from (read-from-minibuffer "Query replace regexp: "
- nil nil nil
- query-replace-from-history-variable
- nil t)))
- (setq to (list (read-from-minibuffer
- (format "Query replace regexp %s with eval: " from)
- nil nil t query-replace-to-history-variable from t)))
+ (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)
(if (and transient-mark-mode mark-active)
(region-beginning))
(if (and transient-mark-mode mark-active)
- (region-end)))))
+ (region-end))))))
(perform-replace regexp (cons 'replace-eval-replacement to-expr)
t 'literal delimited nil nil start end))
before rotating to the next.
Fourth and fifth arg START and END specify the region to operate on."
(interactive
- (let (from to)
- (setq from (if query-replace-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)))
- (setq to (read-from-minibuffer
+ (to (read-from-minibuffer
(format "Query replace %s with (space-separated strings): "
- from)
+ (query-replace-descr from))
nil nil nil
- 'query-replace-history from t))
+ 'query-replace-history from t)))
(list from to
(and current-prefix-arg
(prefix-numeric-value current-prefix-arg))
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))
(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)
map)
"Keymap for `occur-mode'.")
"Move to the Nth (default 1) next match in an Occur mode buffer.
Compatibility function for \\[next-error] invocations."
(interactive "p")
- (when reset
- (occur-find-match 0 #'next-single-property-change "No first match"))
- (occur-find-match
- (prefix-numeric-value argp)
- (if (> 0 (prefix-numeric-value argp))
- #'previous-single-property-change
- #'next-single-property-change)
- "No more matches")
- (occur-mode-goto-occurrence))
-
+ ;; 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))))
+
+ (goto-char (cond (reset (point-min))
+ ((< argp 0) (line-beginning-position))
+ ((line-end-position))))
+ (occur-find-match
+ (abs argp)
+ (if (> 0 argp)
+ #'previous-single-property-change
+ #'next-single-property-change)
+ "No more matches")
+ ;; In case the *Occur* buffer is visible in a nonselected window.
+ (set-window-point (get-buffer-window (current-buffer)) (point))
+ (occur-mode-goto-occurrence)))
\f
+(defface match
+ '((((class color) (min-colors 88) (background light))
+ :background "Tan")
+ (((class color) (min-colors 88) (background dark))
+ :background "RoyalBlue4")
+ (((class color) (min-colors 8))
+ :background "blue" :foreground "white")
+ (((type tty) (class mono))
+ :inverse-video t)
+ (t :background "gray"))
+ "Face used to highlight matches permanently."
+ :group 'matching
+ :version "22.1")
+
(defcustom list-matching-lines-default-context-lines 0
"*Default number of context lines included around `list-matching-lines' matches.
A negative number means to include that many lines before the match.
(defalias 'list-matching-lines 'occur)
-(defcustom list-matching-lines-face 'bold
+(defcustom list-matching-lines-face 'match
"*Face used by \\[list-matching-lines] to show the text that matches.
If the value is nil, don't highlight the matching portions specially."
:type 'face
:type 'face
:group 'matching)
-(defun occur-accumulate-lines (count &optional no-props)
+(defun occur-accumulate-lines (count &optional keep-props)
(save-excursion
(let ((forwardp (> count 0))
- (result nil))
+ 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
- (funcall (if no-props
- #'buffer-substring-no-properties
- #'buffer-substring)
- (line-beginning-position)
- (line-end-position))
+ (funcall (if keep-props
+ #'buffer-substring
+ #'buffer-substring-no-properties)
+ beg end)
result)
(forward-line (if forwardp 1 -1)))
(nreverse result))))
(read-from-minibuffer
(if default
(format "List lines matching regexp (default `%s'): "
- default)
+ (query-replace-descr default))
"List lines matching regexp: ")
nil
nil
nil
- 'regexp-history)))
+ 'regexp-history
+ default)))
(if (equal input "")
default
input))
(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)
(and case-fold-search
(isearch-no-upper-case-p regexp t))
list-matching-lines-buffer-name-face
- nil list-matching-lines-face nil)))
+ 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'"
(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)
(let ((matches 0) ;; count of matched lines
(lines 1) ;; line count
(matchbeg 0)
- (matchend 0)
(origpt nil)
(begpt nil)
(endpt nil)
(setq origpt (point))
(when (setq endpt (re-search-forward regexp nil t))
(setq matches (1+ matches)) ;; increment match count
- (setq matchbeg (match-beginning 0)
- matchend (match-end 0))
- (setq begpt (save-excursion
- (goto-char matchbeg)
- (line-beginning-position)))
+ (setq matchbeg (match-beginning 0))
(setq lines (+ lines (1- (count-lines origpt endpt))))
+ (save-excursion
+ (goto-char matchbeg)
+ (setq begpt (line-beginning-position)
+ endpt (line-end-position)))
(setq marker (make-marker))
(set-marker marker matchbeg)
- (setq curstring (buffer-substring begpt
- (line-end-position)))
+ (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)))
+ (setq curstring (buffer-substring begpt endpt))
;; Depropertize the string, and maybe
;; highlight the matches
(let ((len (length curstring))
(set-text-properties 0 len nil curstring))
(while (and (< start len)
(string-match regexp curstring start))
- (add-text-properties (match-beginning 0)
- (match-end 0)
- (append
- `(occur-match t)
- (when match-face
- `(font-lock-face ,match-face)))
- curstring)
+ (add-text-properties
+ (match-beginning 0) (match-end 0)
+ (append
+ `(occur-match t)
+ (when match-face
+ ;; Use `face' rather than `font-lock-face' here
+ ;; so as to override faces copied from the buffer.
+ `(face ,match-face)))
+ curstring)
(setq start (match-end 0))))
;; Generate the string to insert for this match
(let* ((out-line
(when prefix-face
`(font-lock-face prefix-face))
'(occur-prefix t)))
- curstring
+ ;; 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 'highlight)
"\n"))
(data
(if (= nlines 0)
;; concatenate them all together.
(apply #'concat
(nconc
- (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ nlines)) keep-props))))
+ (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ (abs nlines))) keep-props))))
(list out-line)
- (occur-engine-add-prefix (cdr (occur-accumulate-lines (1+ nlines) keep-props))))))))
+ (if (> nlines 0)
+ (occur-engine-add-prefix
+ (cdr (occur-accumulate-lines (1+ nlines) keep-props)))))))))
;; Actually insert the match display data
(with-current-buffer out-buf
(let ((beg (point))
(insert "-------\n"))
(add-text-properties
beg end
- `(occur-target ,marker help-echo "mouse-2: go to this occurrence"))
- ;; We don't put `mouse-face' on the newline,
- ;; because that loses.
- (add-text-properties beg (1- end) '(mouse-face highlight)))))
+ `(occur-target ,marker help-echo "mouse-2: go to this occurrence")))))
(goto-char endpt))
(if endpt
(progn
(defun replace-match-maybe-edit (newtext fixedcase literal noedit match-data)
"Make a replacement with `replace-match', editing `\\?'.
-NEXTEXT, FIXEDCASE, LITERAL are just passed on. If NOEDIT is true, no
+NEWTEXT, FIXEDCASE, LITERAL are just passed on. If NOEDIT is true, no
check for `\\?' is made to save time. MATCH-DATA is used for the
replacement. In case editing is done, it is changed to use markers.
(if regexp-flag from-string
(regexp-quote from-string))
"\\b")))
+ (when query-replace-lazy-highlight
+ (setq isearch-lazy-highlight-last-string nil))
+
(push-mark)
(undo-boundary)
(unwind-protect
(if (not query-flag)
(let ((inhibit-read-only
query-replace-skip-read-only))
- (unless noedit
- (replace-highlight (nth 0 real-match-data)
- (nth 1 real-match-data)))
+ (unless (or literal noedit)
+ (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))
- (message message from-string next-replacement))
+ (message message
+ (query-replace-descr from-string)
+ (query-replace-descr next-replacement)))
(setq key (read-event))
;; Necessary in case something happens during read-event
;; that clobbers the match data.
(setq unread-command-events
(append (listify-key-sequence key)
unread-command-events))
- (setq done t))))
+ (setq done t)))
+ (when query-replace-lazy-highlight
+ ;; Force lazy rehighlighting only after replacements
+ (if (not (memq def '(skip backup)))
+ (setq isearch-lazy-highlight-last-string nil))))
;; Record previous position for ^ when we move on.
;; Change markers to numbers in the match data
;; since lots of markers slow down editing.
(if (= replace-count 1) "" "s")))
(and keep-going stack)))
-(defcustom query-replace-highlight t
- "*Non-nil means to highlight words during query replacement."
- :type 'boolean
- :group 'matching)
-
(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 1) ;higher than lazy overlays
+ (overlay-put replace-overlay 'face 'query-replace)))
+ (if query-replace-lazy-highlight
+ (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 ()
- (and replace-overlay
- (progn
- (delete-overlay replace-overlay)
- (setq replace-overlay nil))))
-
-(defun replace-highlight (start end)
- (and query-replace-highlight
- (if replace-overlay
- (move-overlay replace-overlay start end (current-buffer))
- (setq replace-overlay (make-overlay start end))
- (overlay-put replace-overlay 'face
- (if (facep 'query-replace)
- 'query-replace 'region)))))
-
-;;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4
+ (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