Mercurial > hg > xemacs-beta

comparison lisp/prim/replace.el @ 70:131b0175ea99 r20-0b30

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