Mercurial > hg > xemacs-beta

comparison lisp/prim/replace.el @ 4:b82b59fe008d r19-15b3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b3
author cvs
date Mon, 13 Aug 2007 08:46:56 +0200
parents ac2d302a0011
children bcdc7deadc19
comparison
equal deleted inserted replaced
3:30df88044ec6 4:b82b59fe008d
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 ;; General Public License for more details. 15 ;; General Public License for more details.
16 16
17 ;; You should have received a copy of the GNU General Public License 17 ;; You should have received a copy of the GNU General Public License
18 ;; along with XEmacs; see the file COPYING. If not, write to the Free 18 ;; along with XEmacs; see the file COPYING. If not, write to the Free
19 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 19 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
20 20 ;; 02111-1307, USA.
21 ;;; Synched up with: FSF 19.30. 21
22 ;;; Synched up with: FSF 19.34 [Partially].
22 23
23 ;;; Commentary: 24 ;;; Commentary:
24 25
25 ;; This package supplies the string and regular-expression replace functions 26 ;; This package supplies the string and regular-expression replace functions
26 ;; documented in the XEmacs Reference Manual. 27 ;; documented in the XEmacs Reference Manual.
27 28
29 ;; All the gettext calls are for XEmacs I18N3 message catalog support.
30
28 ;;; Code: 31 ;;; Code:
29 32
30 (defvar case-replace t "\ 33 (defconst case-replace t "\
31 *Non-nil means `query-replace' should preserve case in replacements. 34 *Non-nil means `query-replace' should preserve case in replacements.
32 What this means is that `query-replace' will change the case of the 35 What this means is that `query-replace' will change the case of the
33 replacement text so that it matches the text that was replaced. 36 replacement text so that it matches the text that was replaced.
34 If this variable is nil, the replacement text will be inserted 37 If this variable is nil, the replacement text will be inserted
35 exactly as it was specified by the user, irrespective of the case 38 exactly as it was specified by the user, irrespective of the case
142 145
143 (defun replace-string (from-string to-string &optional delimited) 146 (defun replace-string (from-string to-string &optional delimited)
144 "Replace occurrences of FROM-STRING with TO-STRING. 147 "Replace occurrences of FROM-STRING with TO-STRING.
145 Preserve case in each match if `case-replace' and `case-fold-search' 148 Preserve case in each match if `case-replace' and `case-fold-search'
146 are non-nil and FROM-STRING has no uppercase letters. 149 are non-nil and FROM-STRING has no uppercase letters.
150 \(Preserving case means that if the string matched is all caps, or capitalized,
151 then its replacement is upcased or capitalized.)
152
147 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace 153 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
148 only matches surrounded by word boundaries. 154 only matches surrounded by word boundaries.
149 155
150 If `query-replace-interactive' is non-nil, the last incremental search 156 If `query-replace-interactive' is non-nil, the last incremental search
151 string is used as FROM-STRING--you don't have to specify it with the 157 string is used as FROM-STRING--you don't have to specify it with the
249 255
250 (defvar occur-mode-map ()) 256 (defvar occur-mode-map ())
251 (if occur-mode-map 257 (if occur-mode-map
252 () 258 ()
253 (setq occur-mode-map (make-sparse-keymap)) 259 (setq occur-mode-map (make-sparse-keymap))
254 (set-keymap-name occur-mode-map 'occur-mode-map) 260 (set-keymap-name occur-mode-map 'occur-mode-map) ; XEmacs
255 (define-key occur-mode-map 'button2 'occur-mode-mouse-goto) 261 (define-key occur-mode-map [mouse-2] 'occur-mode-mouse-goto)
256 (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence) 262 (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence)
257 (define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence)) 263 (define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence))
258 264
259 (defvar occur-buffer nil) 265 (defvar occur-buffer nil)
260 (defvar occur-nlines nil) 266 (defvar occur-nlines nil)
268 274
269 \\{occur-mode-map}" 275 \\{occur-mode-map}"
270 (kill-all-local-variables) 276 (kill-all-local-variables)
271 (use-local-map occur-mode-map) 277 (use-local-map occur-mode-map)
272 (setq major-mode 'occur-mode) 278 (setq major-mode 'occur-mode)
273 (setq mode-name (gettext "Occur")) 279 (setq mode-name (gettext "Occur")) ; XEmacs
274 (make-local-variable 'occur-buffer) 280 (make-local-variable 'occur-buffer)
275 (make-local-variable 'occur-nlines) 281 (make-local-variable 'occur-nlines)
276 (make-local-variable 'occur-pos-list) 282 (make-local-variable 'occur-pos-list)
277 (require 'mode-motion) 283 (require 'mode-motion) ; XEmacs
278 (setq mode-motion-hook 'mode-motion-highlight-line) 284 (setq mode-motion-hook 'mode-motion-highlight-line) ; XEmacs
279 (run-hooks 'occur-mode-hook)) 285 (run-hooks 'occur-mode-hook))
280 286
281 (defun occur-mode-mouse-goto (e) 287 ;; FSF Version of next function:
288 ; (let (buffer pos)
289 ; (save-excursion
290 ; (set-buffer (window-buffer (posn-window (event-end event))))
291 ; (save-excursion
292 ; (goto-char (posn-point (event-end event)))
293 ; (setq pos (occur-mode-find-occurrence))
294 ; (setq buffer occur-buffer)))
295 ; (pop-to-buffer buffer)
296 ; (goto-char (marker-position pos))))
297
298 (defun occur-mode-mouse-goto (event)
282 "Go to the occurrence highlighted by mouse. 299 "Go to the occurrence highlighted by mouse.
283 This function is only reasonable when bound to a mouse key in the occur buffer" 300 This function is only reasonable when bound to a mouse key in the occur buffer"
284 (interactive "e") 301 (interactive "e")
285 (let ((window-save (selected-window)) 302 (let ((window-save (selected-window))
286 (frame-save (selected-frame))) 303 (frame-save (selected-frame)))
290 (mouse-set-point e) 307 (mouse-set-point e)
291 (occur-mode-goto-occurrence)) 308 (occur-mode-goto-occurrence))
292 (select-frame frame-save) 309 (select-frame frame-save)
293 (select-window window-save)))) 310 (select-window window-save))))
294 311
312 ;; Called occur-mode-find-occurrence in FSF
295 (defun occur-mode-goto-occurrence () 313 (defun occur-mode-goto-occurrence ()
296 "Go to the occurrence the current line describes." 314 "Go to the occurrence the current line describes."
297 (interactive) 315 (interactive)
298 (if (or (null occur-buffer) 316 (if (or (null occur-buffer)
299 (null (buffer-name occur-buffer))) 317 (null (buffer-name occur-buffer)))
320 (occur-source-buffer occur-buffer)) 338 (occur-source-buffer occur-buffer))
321 (if (< line-count 1) 339 (if (< line-count 1)
322 (error "No occurrence on this line")) 340 (error "No occurrence on this line"))
323 (or pos 341 (or pos
324 (error "No occurrence on this line")) 342 (error "No occurrence on this line"))
325 ;; don't raise window unless it isn't visible 343 ;; XEmacs: don't raise window unless it isn't visible
326 ;; allow for the possibility that the occur buffer is on another frame 344 ;; allow for the possibility that the occur buffer is on another frame
327 (or (and window 345 (or (and window
328 (window-live-p window) 346 (window-live-p window)
329 (frame-visible-p (window-frame window)) 347 (frame-visible-p (window-frame window))
330 (set-buffer occur-source-buffer)) 348 (set-buffer occur-source-buffer))
341 359
342 ;; XEmacs addition 360 ;; XEmacs addition
343 ;;; Damn you Jamie, this is utter trash. 361 ;;; Damn you Jamie, this is utter trash.
344 (defvar list-matching-lines-whole-buffer t 362 (defvar list-matching-lines-whole-buffer t
345 "If t, occur operates on whole buffer, otherwise occur starts from point. 363 "If t, occur operates on whole buffer, otherwise occur starts from point.
346 default is nil.") 364 default is t.")
347 365
348 (define-function 'occur 'list-matching-lines) 366 (define-function 'occur 'list-matching-lines)
349 (defun list-matching-lines (regexp &optional nlines) 367 (defun list-matching-lines (regexp &optional nlines)
350 "Show all lines in the current buffer containing a match for REGEXP. 368 "Show all lines in the current buffer containing a match for REGEXP.
351 369
352 If a match spreads across multiple lines, all those lines are shown. 370 If a match spreads across multiple lines, all those lines are shown.
353 371
354 If variable `list-matching-lines-whole-buffer' is non-nil, the entire buffer is 372 If variable `list-matching-lines-whole-buffer' is non-nil, the entire buffer is
355 searched, otherwise search begins at point. 373 searched, otherwise search begins at point.
356 374
357 Each line is displayed with NLINES lines before and after, 375 Each line is displayed with NLINES lines before and after, or -NLINES
358 or -NLINES before if NLINES is negative. 376 before if NLINES is negative.
359 NLINES defaults to `list-matching-lines-default-context-lines'. 377 NLINES defaults to `list-matching-lines-default-context-lines'.
360 Interactively it is the prefix arg. 378 Interactively it is the prefix arg.
361 379
362 The lines are shown in a buffer named `*Occur*'. 380 The lines are shown in a buffer named `*Occur*'.
363 It serves as a menu to find any of the occurrences in this buffer. 381 It serves as a menu to find any of the occurrences in this buffer.
364 \\[describe-mode] in that buffer will explain how." 382 \\[describe-mode] in that buffer will explain how."
365 (interactive 383 (interactive
384 ;; XEmacs change
366 (list (let* ((default (or (symbol-near-point) 385 (list (let* ((default (or (symbol-near-point)
367 (and regexp-history 386 (and regexp-history
368 (car regexp-history)))) 387 (car regexp-history))))
369 (minibuffer-history-minimum-string-length 0) 388 (minibuffer-history-minimum-string-length 0)
370 (input 389 (input
393 (let ((first t) 412 (let ((first t)
394 (dir default-directory) 413 (dir default-directory)
395 (buffer (current-buffer)) 414 (buffer (current-buffer))
396 (linenum 1) 415 (linenum 1)
397 (prevpos (point-min)) 416 (prevpos (point-min))
417 ;; The rest of this function is very different from FSF.
418 ;; Presumably that's due to Jamie's misfeature
398 (final-context-start (make-marker))) 419 (final-context-start (make-marker)))
399 (if (not list-matching-lines-whole-buffer) 420 (if (not list-matching-lines-whole-buffer)
400 (save-excursion 421 (save-excursion
401 (beginning-of-line) 422 (beginning-of-line)
402 (setq linenum (1+ (count-lines (point-min) (point)))) 423 (setq linenum (1+ (count-lines (point-min) (point))))
495 (if (interactive-p) 516 (if (interactive-p)
496 (message "%d matching lines." (length occur-pos-list))))))) 517 (message "%d matching lines." (length occur-pos-list)))))))
497 518
498 ;; It would be nice to use \\[...], but there is no reasonable way 519 ;; It would be nice to use \\[...], but there is no reasonable way
499 ;; to make that display both SPC and Y. 520 ;; to make that display both SPC and Y.
500 (defvar query-replace-help (purecopy 521 (defconst query-replace-help
501 "Type Space or `y' to replace one match, Delete or `n' to skip to next, 522 (purecopy
523 "Type Space or `y' to replace one match, Delete or `n' to skip to next,
502 RET or `q' to exit, Period to replace one match and exit, 524 RET or `q' to exit, Period to replace one match and exit,
503 Comma to replace but not move point immediately, 525 Comma to replace but not move point immediately,
504 C-r to enter recursive edit (\\[exit-recursive-edit] to get out again), 526 C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
505 C-w to delete match and recursive edit, 527 C-w to delete match and recursive edit,
506 C-l to clear the frame, redisplay, and offer same replacement again, 528 C-l to clear the frame, redisplay, and offer same replacement again,
507 ! to replace all remaining matches with no more questions, 529 ! to replace all remaining matches with no more questions,
508 ^ to move point back to previous match.") 530 ^ to move point back to previous match."
531 )
509 "Help message while in query-replace") 532 "Help message while in query-replace")
510 533
511 (defvar query-replace-map nil 534 (defvar query-replace-map nil
512 "Keymap that defines the responses to questions in `query-replace'. 535 "Keymap that defines the responses to questions in `query-replace'.
513 The \"bindings\" in this map are not commands; they are answers. 536 The \"bindings\" in this map are not commands; they are answers.
514 The valid answers include `act', `skip', `act-and-show', 537 The valid answers include `act', `skip', `act-and-show',
515 `exit', `act-and-exit', `edit', `delete-and-edit', `recenter', 538 `exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
516 `automatic', `backup', `exit-prefix', and `help'.") 539 `automatic', `backup', `exit-prefix', and `help'.")
517 540
541 ;; Why does it seem that ever file has a different method of doing this?
518 (if query-replace-map 542 (if query-replace-map
519 nil 543 nil
520 (let ((map (make-sparse-keymap))) 544 (let ((map (make-sparse-keymap)))
521 (set-keymap-name map 'query-replace-map) 545 (set-keymap-name map 'query-replace-map)
522 (define-key map " " 'act) 546 (define-key map " " 'act)
549 (setq query-replace-map map))) 573 (setq query-replace-map map)))
550 574
551 575
552 (autoload 'isearch-highlight "isearch") 576 (autoload 'isearch-highlight "isearch")
553 577
578 ;; XEmacs
554 (defun perform-replace-next-event (event) 579 (defun perform-replace-next-event (event)
555 (if isearch-highlight 580 (if isearch-highlight
556 (let ((aborted t)) 581 (let ((aborted t))
557 (unwind-protect 582 (unwind-protect
558 (progn 583 (progn
572 (replace-match \"foobar\" nil nil)) 597 (replace-match \"foobar\" nil nil))
573 which will run faster and probably do exactly what you want." 598 which will run faster and probably do exactly what you want."
574 (or map (setq map query-replace-map)) 599 (or map (setq map query-replace-map))
575 (let* ((event (make-event)) 600 (let* ((event (make-event))
576 (nocasify (not (and case-fold-search case-replace 601 (nocasify (not (and case-fold-search case-replace
577 (string-equal from-string 602 (string-equal from-string
578 (downcase from-string))))) 603 (downcase from-string)))))
579 (literal (not regexp-flag)) 604 (literal (not regexp-flag))
580 (search-function (if regexp-flag 're-search-forward 'search-forward)) 605 (search-function (if regexp-flag 're-search-forward 'search-forward))
581 (search-string from-string) 606 (search-string from-string)
582 (real-match-data nil) ; the match data for the current match 607 (real-match-data nil) ; the match data for the current match
583 (next-replacement nil) 608 (next-replacement nil)
606 (if regexp-flag from-string 631 (if regexp-flag from-string
607 (regexp-quote from-string)) 632 (regexp-quote from-string))
608 "\\b"))) 633 "\\b")))
609 (push-mark) 634 (push-mark)
610 (undo-boundary) 635 (undo-boundary)
611 ;; Loop finding occurrences that perhaps should be replaced. 636 (unwind-protect
612 (while (and keep-going 637 ;; Loop finding occurrences that perhaps should be replaced.
613 (not (eobp)) 638 (while (and keep-going
614 (let ((case-fold-search qr-case-fold-search)) 639 (not (eobp))
615 (funcall search-function search-string nil t)) 640 (let ((case-fold-search qr-case-fold-search))
616 ;; If the search string matches immediately after 641 (funcall search-function search-string nil t))
617 ;; the previous match, but it did not match there 642 ;; If the search string matches immediately after
618 ;; before the replacement was done, ignore the match. 643 ;; the previous match, but it did not match there
619 (if (or (eq lastrepl (point)) 644 ;; before the replacement was done, ignore the match.
620 (and regexp-flag 645 (if (or (eq lastrepl (point))
621 (eq lastrepl (match-beginning 0)) 646 (and regexp-flag
622 (not match-again))) 647 (eq lastrepl (match-beginning 0))
623 648 (not match-again)))
624 (if (eobp) 649 (if (eobp)
625 nil 650 nil
626 ;; Don't replace the null string 651 ;; Don't replace the null string
627 ;; right after end of previous replacement. 652 ;; right after end of previous replacement.
628 (forward-char 1) 653 (forward-char 1)
629 (let ((case-fold-search qr-case-fold-search)) 654 (let ((case-fold-search qr-case-fold-search))
630 (funcall search-function search-string nil t))) 655 (funcall search-function search-string nil t)))
631 t)) 656 t))
632 ;; Save the data associated with the real match. 657
633 (setq real-match-data (match-data)) 658 ;; Save the data associated with the real match.
634 659 (setq real-match-data (match-data))
635 ;; Before we make the replacement, decide whether the search string 660
636 ;; can match again just after this match. 661 ;; Before we make the replacement, decide whether the search string
637 (if regexp-flag 662 ;; can match again just after this match.
638 (progn 663 (if regexp-flag
639 (setq match-again (looking-at search-string)) 664 (progn
640 (store-match-data real-match-data))) 665 (setq match-again (looking-at search-string))
641 666 ;; XEmacs addition
642 ;; If time for a change, advance to next replacement string. 667 (store-match-data real-match-data)))
643 (if (and (listp replacements) 668 ;; If time for a change, advance to next replacement string.
644 (= next-rotate-count replace-count)) 669 (if (and (listp replacements)
645 (progn 670 (= next-rotate-count replace-count))
646 (setq next-rotate-count 671 (progn
647 (+ next-rotate-count repeat-count)) 672 (setq next-rotate-count
648 (setq next-replacement (nth replacement-index replacements)) 673 (+ next-rotate-count repeat-count))
649 (setq replacement-index (% (1+ replacement-index) (length replacements))))) 674 (setq next-replacement (nth replacement-index replacements))
650 (if (not query-flag) 675 (setq replacement-index (% (1+ replacement-index) (length replacements)))))
651 (progn 676 (if (not query-flag)
652 (store-match-data real-match-data) 677 (progn
653 (replace-match next-replacement nocasify literal) 678 (store-match-data real-match-data)
654 (setq replace-count (1+ replace-count))) 679 (replace-match next-replacement nocasify literal)
655 (undo-boundary) 680 (setq replace-count (1+ replace-count)))
656 (let ((help-form 681 (undo-boundary)
657 '(concat (format "Query replacing %s%s with %s.\n\n" 682 (let ((help-form
658 (if regexp-flag (gettext "regexp ") "") 683 '(concat (format "Query replacing %s%s with %s.\n\n"
659 from-string next-replacement) 684 (if regexp-flag (gettext "regexp ") "")
660 (substitute-command-keys query-replace-help))) 685 from-string next-replacement)
661 (done nil) 686 (substitute-command-keys query-replace-help)))
662 (replaced nil) 687 done replaced def)
663 def) 688 ;; Loop reading commands until one of them sets done,
664 ;; Loop reading commands until one of them sets done, 689 ;; which means it has finished handling this occurrence.
665 ;; which means it has finished handling this occurrence. 690 (while (not done)
666 (while (not done) 691 ;; Don't fill up the message log
667 ;; Don't fill up the message log 692 ;; with a bunch of identical messages.
668 ;; with a bunch of identical messages. 693 ;; XEmacs change
669 (display-message 'prompt 694 (display-message 'prompt
670 (format message from-string next-replacement)) 695 (format message from-string next-replacement))
671 (perform-replace-next-event event) 696 (perform-replace-next-event event)
672 (setq def (lookup-key map (vector event))) 697 (setq def (lookup-key map (vector event)))
673 ;; Restore the match data while we process the command. 698 ;; Restore the match data while we process the command.
674 (store-match-data real-match-data) 699 (store-match-data real-match-data)
675 (cond ((eq def 'help) 700 (cond ((eq def 'help)
676 (with-output-to-temp-buffer (gettext "*Help*") 701 (with-output-to-temp-buffer (gettext "*Help*")
677 (princ (concat 702 (princ (concat
678 (format "Query replacing %s%s with %s.\n\n" 703 (format "Query replacing %s%s with %s.\n\n"
679 (if regexp-flag "regexp " "") 704 (if regexp-flag "regexp " "")
680 from-string next-replacement) 705 from-string next-replacement)
681 (substitute-command-keys 706 (substitute-command-keys
682 query-replace-help))) 707 query-replace-help)))
683 (save-excursion 708 (save-excursion
684 (set-buffer standard-output) 709 (set-buffer standard-output)
685 (help-mode)))) 710 (help-mode))))
686 ((eq def 'exit) 711 ((eq def 'exit)
687 (setq keep-going nil) 712 (setq keep-going nil)
688 (setq done t)) 713 (setq done t))
689 ((eq def 'backup) 714 ((eq def 'backup)
690 (if stack 715 (if stack
691 (let ((elt (car stack))) 716 (let ((elt (car stack)))
692 (goto-char (car elt)) 717 (goto-char (car elt))
693 (setq replaced (eq t (cdr elt))) 718 (setq replaced (eq t (cdr elt)))
694 (or replaced 719 (or replaced
695 (store-match-data (cdr elt))) 720 (store-match-data (cdr elt)))
696 (setq stack (cdr stack))) 721 (setq stack (cdr stack)))
697 (progn
698 (message "No previous match") 722 (message "No previous match")
699 (ding 'no-terminate) 723 (ding 'no-terminate)
700 (sit-for 1)))) 724 (sit-for 1)))
701 ((eq def 'act) 725 ((eq def 'act)
702 (or replaced 726 (or replaced
703 (replace-match next-replacement nocasify literal)) 727 (replace-match next-replacement nocasify literal))
704 (setq done t replaced t)) 728 (setq done t replaced t))
705 ((eq def 'act-and-exit) 729 ((eq def 'act-and-exit)
706 (or replaced 730 (or replaced
707 (replace-match next-replacement nocasify literal)) 731 (replace-match next-replacement nocasify literal))
708 (setq keep-going nil) 732 (setq keep-going nil)
709 (setq done t replaced t)) 733 (setq done t replaced t))
710 ((eq def 'act-and-show) 734 ((eq def 'act-and-show)
711 (if (not replaced) 735 (if (not replaced)
712 (progn 736 (progn
713 (replace-match next-replacement nocasify literal) 737 (replace-match next-replacement nocasify literal)
714 (setq replaced t)))) 738 (setq replaced t))))
715 ((eq def 'automatic) 739 ((eq def 'automatic)
716 (or replaced 740 (or replaced
717 (replace-match next-replacement nocasify literal)) 741 (replace-match next-replacement nocasify literal))
718 (setq done t query-flag nil replaced t)) 742 (setq done t query-flag nil replaced t))
719 ((eq def 'skip) 743 ((eq def 'skip)
720 (setq done t)) 744 (setq done t))
721 ((eq def 'recenter) 745 ((eq def 'recenter)
722 (recenter nil)) 746 (recenter nil))
723 ((eq def 'edit) 747 ((eq def 'edit)
724 (store-match-data 748 (store-match-data
725 (prog1 (match-data) 749 (prog1 (match-data)
726 (save-excursion (recursive-edit)))) 750 (save-excursion (recursive-edit))))
727 ;; Before we make the replacement, 751 ;; Before we make the replacement,
728 ;; decide whether the search string 752 ;; decide whether the search string
729 ;; can match again just after this match. 753 ;; can match again just after this match.
730 (if regexp-flag 754 (if regexp-flag
731 (setq match-again (looking-at search-string)))) 755 (setq match-again (looking-at search-string))))
732 ((eq def 'delete-and-edit) 756 ((eq def 'delete-and-edit)
733 (delete-region (match-beginning 0) (match-end 0)) 757 (delete-region (match-beginning 0) (match-end 0))
734 (store-match-data (prog1 (match-data) 758 (store-match-data (prog1 (match-data)
735 (save-excursion (recursive-edit)))) 759 (save-excursion (recursive-edit))))
736 (setq replaced t)) 760 (setq replaced t))
737 ;; Note: we do not need to treat `exit-prefix' 761 ;; Note: we do not need to treat `exit-prefix'
738 ;; specially here, since we reread 762 ;; specially here, since we reread
739 ;; any unrecognized character. 763 ;; any unrecognized character.
740 (t 764 (t
741 (setq this-command 'mode-exited) 765 (setq this-command 'mode-exited)
742 (setq keep-going nil) 766 (setq keep-going nil)
743 (setq unread-command-events 767 (setq unread-command-events
744 (cons event unread-command-events)) 768 (cons event unread-command-events))
745 (setq done t)))) 769 (setq done t))))
746 ;; Record previous position for ^ when we move on. 770 ;; Record previous position for ^ when we move on.
747 ;; Change markers to numbers in the match data 771 ;; Change markers to numbers in the match data
748 ;; since lots of markers slow down editing. 772 ;; since lots of markers slow down editing.
749 (setq stack 773 (setq stack
750 (cons (cons (point) 774 (cons (cons (point)
751 (or replaced 775 (or replaced
752 (mapcar 776 (mapcar
753 #'(lambda (elt) 777 #'(lambda (elt)
754 (if (markerp elt) 778 (if (markerp elt)
755 (prog1 (marker-position elt) 779 (prog1 (marker-position elt)
756 (set-marker elt nil)) 780 (set-marker elt nil))
757 elt)) 781 elt))
758 (match-data)))) 782 (match-data))))
759 stack)) 783 stack))
760 (if replaced (setq replace-count (1+ replace-count))))) 784 (if replaced (setq replace-count (1+ replace-count)))))
761 (setq lastrepl (point))) 785 (setq lastrepl (point)))
786 (replace-dehighlight))
762 (or unread-command-events 787 (or unread-command-events
763 (message "Replaced %d occurrence%s" 788 (message "Replaced %d occurrence%s"
764 replace-count 789 replace-count
765 (if (= replace-count 1) "" "s"))) 790 (if (= replace-count 1) "" "s")))
766 (and keep-going stack))) 791 (and keep-going stack)))
767 792
768 ; FSF 19.30 original: 793 (defvar query-replace-highlight nil
769 ; (defun match-string (num &optional string) 794 "*Non-nil means to highlight words during query replacement.")
770 ; "Return string of text matched by last search. 795
771 ; NUM specifies which parenthesized expression in the last regexp. 796 (defvar replace-overlay nil)
772 ; Value is nil if NUMth pair didn't match, or there were less than NUM pairs. 797
773 ; Zero means the entire text matched by the whole regexp or whole string. 798 (defun replace-dehighlight ()
774 ; STRING should be given if the last search was by `string-match' on STRING." 799 (and replace-overlay
775 ; (if (match-beginning num) 800 (progn
776 ; (if string 801 (delete-overlay replace-overlay)
777 ; (substring string (match-beginning num) (match-end num)) 802 (setq replace-overlay nil))))
778 ; (buffer-substring (match-beginning num) (match-end num))))) 803
779 804 (defun replace-highlight (start end)
780 ;; #### - this could stand to be in C... 805 (and query-replace-highlight
781 (defmacro match-string (n &optional string) 806 (progn
782 "Returns the Nth subexpression matched by the last regular expression 807 (or replace-overlay
783 search. The second argument, STRING, must be specified if the last 808 (progn
784 regular expression search was done with `string-match'." 809 (setq replace-overlay (make-overlay start end))
785 ;; #### - note that match-beginning is byte coded, so it's more efficient 810 (overlay-put replace-overlay 'face
786 ;; to just call it twice than it is to let-bind its return value... --Stig 811 (if (internal-find-face 'query-replace)
787 `(and (match-beginning ,n) 812 'query-replace 'region))))
788 ,(if string 813 (move-overlay replace-overlay start end (current-buffer)))))
789 `(substring ,string (match-beginning ,n) (match-end ,n)) 814
790 `(buffer-substring (match-beginning ,n) (match-end ,n))))) 815 (defun match-string (num &optional string)
816 "Return string of text matched by last search.
817 NUM specifies which parenthesized expression in the last regexp.
818 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
819 Zero means the entire text matched by the whole regexp or whole string.
820 STRING should be given if the last search was by `string-match' on STRING."
821 (if (match-beginning num)
822 (if string
823 (substring string (match-beginning num) (match-end num))
824 (buffer-substring (match-beginning num) (match-end num)))))
791 825
792 (defmacro save-match-data (&rest body) 826 (defmacro save-match-data (&rest body)
793 "Execute BODY forms, restoring the global value of the match data." 827 "Execute BODY forms, restoring the global value of the match data."
794 (let ((original (make-symbol "match-data"))) 828 (let ((original (make-symbol "match-data")))
795 (list 'let (list (list original '(match-data))) 829 (list 'let (list (list original '(match-data)))