Mercurial > hg > xemacs-beta

comparison lisp/replace.el @ 282:c42ec1d1cded r21-0b39

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b39
author cvs
date Mon, 13 Aug 2007 10:33:18 +0200
parents 85a06df23a9a
children 182f72e8cd0d
comparison
equal deleted inserted replaced
281:090b52736db2 282:c42ec1d1cded
66 'query-replace-history)) 66 'query-replace-history))
67 (list from to current-prefix-arg))) 67 (list from to current-prefix-arg)))
68 68
69 ;; As per suggestion from Per Abrahamsen, limit replacement to the region 69 ;; As per suggestion from Per Abrahamsen, limit replacement to the region
70 ;; if the region is active. 70 ;; if the region is active.
71 (defun query-replace (from-string to-string &optional arg) 71 (defun query-replace (from-string to-string &optional delimited)
72 "Replace some occurrences of FROM-STRING with TO-STRING. 72 "Replace some occurrences of FROM-STRING with TO-STRING.
73 As each match is found, the user must type a character saying 73 As each match is found, the user must type a character saying
74 what to do with it. For directions, type \\[help-command] at that time. 74 what to do with it. For directions, type \\[help-command] at that time.
75 75
76 If `query-replace-interactive' is non-nil, the last incremental search 76 If `query-replace-interactive' is non-nil, the last incremental search
85 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace 85 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
86 only matches surrounded by word boundaries. 86 only matches surrounded by word boundaries.
87 87
88 To customize possible responses, change the \"bindings\" in `query-replace-map'." 88 To customize possible responses, change the \"bindings\" in `query-replace-map'."
89 (interactive (query-replace-read-args "Query replace" nil)) 89 (interactive (query-replace-read-args "Query replace" nil))
90 (if (or (and (boundp 'zmacs-region-active-p) zmacs-region-active-p) 90 (perform-replace from-string to-string t nil delimited))
91 (and (boundp 'transient-mark-mode) transient-mark-mode mark-active)) 91
92 (save-restriction 92 (defun query-replace-regexp (regexp to-string &optional delimited)
93 (save-excursion
94 (narrow-to-region (point) (mark))
95 (goto-char (point-min))
96 (perform-replace from-string to-string t nil arg)))
97 (perform-replace from-string to-string t nil arg)))
98
99 (defun query-replace-regexp (regexp to-string &optional arg)
100 "Replace some things after point matching REGEXP with TO-STRING. 93 "Replace some things after point matching REGEXP with TO-STRING.
101 As each match is found, the user must type a character saying 94 As each match is found, the user must type a character saying
102 what to do with it. For directions, type \\[help-command] at that time. 95 what to do with it. For directions, type \\[help-command] at that time.
103 96
104 If `query-replace-interactive' is non-nil, the last incremental search 97 If `query-replace-interactive' is non-nil, the last incremental search
111 only matches surrounded by word boundaries. 104 only matches surrounded by word boundaries.
112 In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, 105 In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
113 and `\\=\\N' (where N is a digit) stands for 106 and `\\=\\N' (where N is a digit) stands for
114 whatever what matched the Nth `\\(...\\)' in REGEXP." 107 whatever what matched the Nth `\\(...\\)' in REGEXP."
115 (interactive (query-replace-read-args "Query replace regexp" t)) 108 (interactive (query-replace-read-args "Query replace regexp" t))
116 (if (or (and (boundp 'zmacs-region-active-p) zmacs-region-active-p) 109 (perform-replace regexp to-string t t delimited))
117 (and (boundp 'transient-mark-mode) transient-mark-mode mark-active))
118 (save-restriction
119 (save-excursion
120 (narrow-to-region (point) (mark))
121 (goto-char (point-min))
122 (perform-replace regexp to-string t t arg)))
123 (perform-replace regexp to-string t t arg)))
124 110
125 ;;#### Not patently useful 111 ;;#### Not patently useful
126 (defun map-query-replace-regexp (regexp to-strings &optional arg) 112 (defun map-query-replace-regexp (regexp to-strings &optional arg)
127 "Replace some matches for REGEXP with various strings, in rotation. 113 "Replace some matches for REGEXP with various strings, in rotation.
128 The second argument TO-STRINGS contains the replacement strings, separated 114 The second argument TO-STRINGS contains the replacement strings, separated
592 ;FSFmacs (define-key map "\e" 'exit-prefix) 578 ;FSFmacs (define-key map "\e" 'exit-prefix)
593 (define-key map [escape] 'exit-prefix) 579 (define-key map [escape] 'exit-prefix)
594 580
595 (setq query-replace-map map))) 581 (setq query-replace-map map)))
596 582
597 583 ;; isearch-mode is dumped, so don't autoload.
598 (autoload 'isearch-highlight "isearch") 584 ;(autoload 'isearch-highlight "isearch")
599 585
600 ;; XEmacs 586 ;; XEmacs
601 (defun perform-replace-next-event (event) 587 (defun perform-replace-next-event (event)
602 (if isearch-highlight 588 (if isearch-highlight
603 (let ((aborted t)) 589 (let ((aborted t))
633 (keep-going t) 619 (keep-going t)
634 (stack nil) 620 (stack nil)
635 (next-rotate-count 0) 621 (next-rotate-count 0)
636 (replace-count 0) 622 (replace-count 0)
637 (lastrepl nil) ;Position after last match considered. 623 (lastrepl nil) ;Position after last match considered.
624 ;; If non-nil, it is marker saying where in the buffer to
625 ;; stop.
626 (limit nil)
638 (match-again t) 627 (match-again t)
639 ;; XEmacs addition 628 ;; XEmacs addition
640 (qr-case-fold-search 629 (qr-case-fold-search
641 (if (and case-fold-search search-caps-disable-folding) 630 (if (and case-fold-search search-caps-disable-folding)
642 (isearch-no-upper-case-p search-string) 631 (isearch-no-upper-case-p search-string)
643 case-fold-search)) 632 case-fold-search))
644 (message 633 (message
645 (if query-flag 634 (if query-flag
646 (substitute-command-keys 635 (substitute-command-keys
647 "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")))) 636 "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) "))))
637 ;; If the region is active, operate on region.
638 (when (region-active-p)
639 ;; Original Per Abrahamsen's code simply narrowed the region,
640 ;; thus providing a visual indication of the search boundary.
641 ;; Stallman, on the other hand, handles it like this.
642 (setq limit (copy-marker (region-end)))
643 (goto-char (region-beginning))
644 (zmacs-deactivate-region))
648 (if (stringp replacements) 645 (if (stringp replacements)
649 (setq next-replacement replacements) 646 (setq next-replacement replacements)
650 (or repeat-count (setq repeat-count 1))) 647 (or repeat-count (setq repeat-count 1)))
651 (if delimited-flag 648 (if delimited-flag
652 (setq search-function 're-search-forward 649 (setq search-function 're-search-forward
659 (unwind-protect 656 (unwind-protect
660 ;; Loop finding occurrences that perhaps should be replaced. 657 ;; Loop finding occurrences that perhaps should be replaced.
661 (while (and keep-going 658 (while (and keep-going
662 (not (eobp)) 659 (not (eobp))
663 (let ((case-fold-search qr-case-fold-search)) 660 (let ((case-fold-search qr-case-fold-search))
664 (funcall search-function search-string nil t)) 661 (funcall search-function search-string limit t))
665 ;; If the search string matches immediately after 662 ;; If the search string matches immediately after
666 ;; the previous match, but it did not match there 663 ;; the previous match, but it did not match there
667 ;; before the replacement was done, ignore the match. 664 ;; before the replacement was done, ignore the match.
668 (if (or (eq lastrepl (point)) 665 (if (or (eq lastrepl (point))
669 (and regexp-flag 666 (and regexp-flag
673 nil 670 nil
674 ;; Don't replace the null string 671 ;; Don't replace the null string
675 ;; right after end of previous replacement. 672 ;; right after end of previous replacement.
676 (forward-char 1) 673 (forward-char 1)
677 (let ((case-fold-search qr-case-fold-search)) 674 (let ((case-fold-search qr-case-fold-search))
678 (funcall search-function search-string nil t))) 675 (funcall search-function search-string limit t)))
679 t)) 676 t))
680 677
681 ;; Save the data associated with the real match. 678 ;; Save the data associated with the real match.
682 (setq real-match-data (match-data)) 679 (setq real-match-data (match-data))
683 680
795 ;; Change markers to numbers in the match data 792 ;; Change markers to numbers in the match data
796 ;; since lots of markers slow down editing. 793 ;; since lots of markers slow down editing.
797 (setq stack 794 (setq stack
798 (cons (cons (point) 795 (cons (cons (point)
799 (or replaced 796 (or replaced
800 (mapcar 797 (match-data t)))
801 #'(lambda (elt)
802 (if (markerp elt)
803 (prog1 (marker-position elt)
804 (set-marker elt nil))
805 elt))
806 (match-data))))
807 stack)) 798 stack))
808 (if replaced (setq replace-count (1+ replace-count))))) 799 (if replaced (setq replace-count (1+ replace-count)))))
809 (setq lastrepl (point))) 800 (setq lastrepl (point)))
810 (replace-dehighlight)) 801 ;; Useless in XEmacs. We handle (de)highlighting through
802 ;; perform-replace-next-event.
803 ;(replace-dehighlight)
804 )
811 (or unread-command-events 805 (or unread-command-events
812 (message "Replaced %d occurrence%s" 806 (message "Replaced %d occurrence%s"
813 replace-count 807 replace-count
814 (if (= replace-count 1) "" "s"))) 808 (if (= replace-count 1) "" "s")))
815 (and keep-going stack))) 809 (and keep-going stack)))
816 810
817 (defvar query-replace-highlight nil 811 ;; FSFmacs code: someone should port it.
818 "*Non-nil means to highlight words during query replacement.") 812
819 813 ;(defvar query-replace-highlight nil
820 (defvar replace-overlay nil) 814 ; "*Non-nil means to highlight words during query replacement.")
821 815
822 (defun replace-dehighlight () 816 ;(defvar replace-overlay nil)
823 (and replace-overlay 817
824 (progn 818 ;(defun replace-dehighlight ()
825 (delete-overlay replace-overlay) 819 ; (and replace-overlay
826 (setq replace-overlay nil)))) 820 ; (progn
827 821 ; (delete-overlay replace-overlay)
828 (defun replace-highlight (start end) 822 ; (setq replace-overlay nil))))
829 (and query-replace-highlight 823
830 (progn 824 ;(defun replace-highlight (start end)
831 (or replace-overlay 825 ; (and query-replace-highlight
832 (progn 826 ; (progn
833 (setq replace-overlay (make-overlay start end)) 827 ; (or replace-overlay
834 (overlay-put replace-overlay 'face 828 ; (progn
835 (if (internal-find-face 'query-replace) 829 ; (setq replace-overlay (make-overlay start end))
836 'query-replace 'region)))) 830 ; (overlay-put replace-overlay 'face
837 (move-overlay replace-overlay start end (current-buffer))))) 831 ; (if (internal-find-face 'query-replace)
832 ; 'query-replace 'region))))
833 ; (move-overlay replace-overlay start end (current-buffer)))))
838 834
839 (defun match-string (num &optional string) 835 (defun match-string (num &optional string)
840 "Return string of text matched by last search. 836 "Return string of text matched by last search.
841 NUM specifies which parenthesized expression in the last regexp. 837 NUM specifies which parenthesized expression in the last regexp.
842 Value is nil if NUMth pair didn't match, or there were less than NUM pairs. 838 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.