Mercurial > emacs

comparison lisp/replace.el @ 83171:09bbf2fc80da

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merged in changes from CVS trunk. Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-439 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-440 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-441 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-442 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-443 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-444 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-445 Tweak permissions * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-446 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-211
author Karoly Lorentey <lorentey@elte.hu>
date Sat, 10 Jul 2004 14:37:36 +0000
parents a9b695d281d4
children 84df5471b01e 029a652ac817
comparison
equal deleted inserted replaced
83170:952f7cc8274d 83171:09bbf2fc80da
1 ;;; replace.el --- replace commands for Emacs 1 ;;; replace.el --- replace commands for Emacs
2 2
3 ;; Copyright (C) 1985, 86, 87, 92, 94, 96, 1997, 2000, 2001, 2002, 3 ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001, 2002,
4 ;; 2003, 2004 Free Software Foundation, Inc. 4 ;; 2003, 2004 Free Software Foundation, Inc.
5 5
6 ;; Maintainer: FSF 6 ;; Maintainer: FSF
7 7
8 ;; This file is part of GNU Emacs. 8 ;; This file is part of GNU Emacs.
9 9
34 :type 'boolean 34 :type 'boolean
35 :group 'matching) 35 :group 'matching)
36 36
37 (defvar query-replace-history nil) 37 (defvar query-replace-history nil)
38 38
39 (defcustom query-replace-interactive nil 39 (defvar query-replace-interactive nil
40 "Non-nil means `query-replace' uses the last search string. 40 "Non-nil means `query-replace' uses the last search string.
41 That becomes the \"string to replace\". 41 That becomes the \"string to replace\".")
42 If value is `initial', the last search string is inserted into
43 the minibuffer as an initial value for \"string to replace\"."
44 :type '(choice (const :tag "Off" nil)
45 (const :tag "Initial content" initial)
46 (other :tag "Use default value" t))
47 :group 'matching)
48 42
49 (defcustom query-replace-from-history-variable 'query-replace-history 43 (defcustom query-replace-from-history-variable 'query-replace-history
50 "History list to use for the FROM argument of `query-replace' commands. 44 "History list to use for the FROM argument of `query-replace' commands.
51 The value of this variable should be a symbol; that symbol 45 The value of this variable should be a symbol; that symbol
52 is used as a variable to hold a history list for the strings 46 is used as a variable to hold a history list for the strings
68 "*Non-nil means `query-replace' and friends ignore read-only matches." 62 "*Non-nil means `query-replace' and friends ignore read-only matches."
69 :type 'boolean 63 :type 'boolean
70 :group 'matching 64 :group 'matching
71 :version "21.4") 65 :version "21.4")
72 66
73 (defun query-replace-read-args (string regexp-flag &optional noerror) 67 (defun query-replace-descr (string)
74 (unless noerror 68 (mapconcat 'isearch-text-char-description string ""))
75 (barf-if-buffer-read-only)) 69
76 (let (from to) 70 (defun query-replace-read-from (string regexp-flag)
77 (if (and query-replace-interactive 71 "Query and return the `from' argument of a query-replace operation.
78 (not (eq query-replace-interactive 'initial))) 72 The return value can also be a pair (FROM . TO) indicating that the user
79 (setq from (car (if regexp-flag regexp-search-ring search-ring))) 73 wants to replace FROM with TO."
80 ;; The save-excursion here is in case the user marks and copies 74 (if query-replace-interactive
81 ;; a region in order to specify the minibuffer input. 75 (car (if regexp-flag regexp-search-ring search-ring))
82 ;; That should not clobber the region for the query-replace itself. 76 (let* ((lastfrom (car (symbol-value query-replace-from-history-variable)))
83 (save-excursion 77 (lastto (car (symbol-value query-replace-to-history-variable)))
84 (setq from (read-from-minibuffer 78 (from
85 (format "%s: " string) 79 ;; The save-excursion here is in case the user marks and copies
86 (if (eq query-replace-interactive 'initial) 80 ;; a region in order to specify the minibuffer input.
87 (car (if regexp-flag regexp-search-ring search-ring))) 81 ;; That should not clobber the region for the query-replace itself.
88 nil nil 82 (save-excursion
89 query-replace-from-history-variable 83 (when (equal lastfrom lastto)
90 nil t))) 84 ;; Typically, this is because the two histlists are shared.
91 ;; Warn if user types \n or \t, but don't reject the input. 85 (setq lastfrom (cadr (symbol-value
92 (and regexp-flag 86 query-replace-from-history-variable))))
93 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from) 87 (read-from-minibuffer
94 (let ((match (match-string 3 from))) 88 (if (and lastto lastfrom)
95 (cond 89 (format "%s (default %s -> %s): " string
96 ((string= match "\\n") 90 (query-replace-descr lastfrom)
97 (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead")) 91 (query-replace-descr lastto))
98 ((string= match "\\t") 92 (format "%s: " string))
99 (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB"))) 93 nil nil nil
100 (sit-for 2)))) 94 query-replace-from-history-variable
101 95 nil t))))
102 (save-excursion 96 (if (and (zerop (length from)) lastto lastfrom)
103 (setq to (read-from-minibuffer 97 (cons lastfrom lastto)
104 (format "%s %s with: " string from) 98 ;; Warn if user types \n or \t, but don't reject the input.
105 nil nil nil 99 (and regexp-flag
106 query-replace-to-history-variable from t))) 100 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
101 (let ((match (match-string 3 from)))
102 (cond
103 ((string= match "\\n")
104 (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
105 ((string= match "\\t")
106 (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
107 (sit-for 2)))
108 from))))
109
110 (defun query-replace-read-to (from string regexp-flag)
111 "Query and return the `from' argument of a query-replace operation."
112 (let ((to (save-excursion
113 (read-from-minibuffer
114 (format "%s %s with: " string (query-replace-descr from))
115 nil nil nil
116 query-replace-to-history-variable from t))))
107 (when (and regexp-flag 117 (when (and regexp-flag
108 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)) 118 (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))
109 (let (pos list char) 119 (let (pos list char)
110 (while 120 (while
111 (progn 121 (progn
136 (replace-match-string-symbols to) 146 (replace-match-string-symbols to)
137 (setq to (cons 'replace-eval-replacement 147 (setq to (cons 'replace-eval-replacement
138 (if (> (length to) 1) 148 (if (> (length to) 1)
139 (cons 'concat to) 149 (cons 'concat to)
140 (car to))))) 150 (car to)))))
151 to))
152
153 (defun query-replace-read-args (string regexp-flag &optional noerror)
154 (unless noerror
155 (barf-if-buffer-read-only))
156 (let* ((from (query-replace-read-from string regexp-flag))
157 (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
158 (query-replace-read-to from string regexp-flag))))
141 (list from to current-prefix-arg))) 159 (list from to current-prefix-arg)))
142 160
143 (defun query-replace (from-string to-string &optional delimited start end) 161 (defun query-replace (from-string to-string &optional delimited start end)
144 "Replace some occurrences of FROM-STRING with TO-STRING. 162 "Replace some occurrences of FROM-STRING with TO-STRING.
145 As each match is found, the user must type a character saying 163 As each match is found, the user must type a character saying
267 285
268 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace 286 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
269 only matches that are surrounded by word boundaries. 287 only matches that are surrounded by word boundaries.
270 Fourth and fifth arg START and END specify the region to operate on." 288 Fourth and fifth arg START and END specify the region to operate on."
271 (interactive 289 (interactive
272 (let (from to) 290 (progn
273 (if query-replace-interactive 291 (barf-if-buffer-read-only)
274 (setq from (car regexp-search-ring)) 292 (let* ((from
275 (setq from (read-from-minibuffer "Query replace regexp: " 293 ;; Let-bind the history var to disable the "foo -> bar" default.
276 nil nil nil 294 ;; Maybe we shouldn't disable this default, but for now I'll
277 query-replace-from-history-variable 295 ;; leave it off. --Stef
278 nil t))) 296 (let ((query-replace-to-history-variable nil))
279 (setq to (list (read-from-minibuffer 297 (query-replace-read-from "Query replace regexp" t)))
280 (format "Query replace regexp %s with eval: " from) 298 (to (list (read-from-minibuffer
281 nil nil t query-replace-to-history-variable from t))) 299 (format "Query replace regexp %s with eval: "
300 (query-replace-descr from))
301 nil nil t query-replace-to-history-variable from t))))
282 ;; We make TO a list because replace-match-string-symbols requires one, 302 ;; We make TO a list because replace-match-string-symbols requires one,
283 ;; and the user might enter a single token. 303 ;; and the user might enter a single token.
284 (replace-match-string-symbols to) 304 (replace-match-string-symbols to)
285 (list from (car to) current-prefix-arg 305 (list from (car to) current-prefix-arg
286 (if (and transient-mark-mode mark-active) 306 (if (and transient-mark-mode mark-active)
287 (region-beginning)) 307 (region-beginning))
288 (if (and transient-mark-mode mark-active) 308 (if (and transient-mark-mode mark-active)
289 (region-end))))) 309 (region-end))))))
290 (perform-replace regexp (cons 'replace-eval-replacement to-expr) 310 (perform-replace regexp (cons 'replace-eval-replacement to-expr)
291 t 'literal delimited nil nil start end)) 311 t 'literal delimited nil nil start end))
292 312
293 (defun map-query-replace-regexp (regexp to-strings &optional n start end) 313 (defun map-query-replace-regexp (regexp to-strings &optional n start end)
294 "Replace some matches for REGEXP with various strings, in rotation. 314 "Replace some matches for REGEXP with various strings, in rotation.
309 329
310 A prefix argument N says to use each replacement string N times 330 A prefix argument N says to use each replacement string N times
311 before rotating to the next. 331 before rotating to the next.
312 Fourth and fifth arg START and END specify the region to operate on." 332 Fourth and fifth arg START and END specify the region to operate on."
313 (interactive 333 (interactive
314 (let (from to) 334 (let* ((from (if query-replace-interactive
315 (setq from (if query-replace-interactive
316 (car regexp-search-ring) 335 (car regexp-search-ring)
317 (read-from-minibuffer "Map query replace (regexp): " 336 (read-from-minibuffer "Map query replace (regexp): "
318 nil nil nil 337 nil nil nil
319 'query-replace-history nil t))) 338 'query-replace-history nil t)))
320 (setq to (read-from-minibuffer 339 (to (read-from-minibuffer
321 (format "Query replace %s with (space-separated strings): " 340 (format "Query replace %s with (space-separated strings): "
322 from) 341 (query-replace-descr from))
323 nil nil nil 342 nil nil nil
324 'query-replace-history from t)) 343 'query-replace-history from t)))
325 (list from to 344 (list from to
326 (and current-prefix-arg 345 (and current-prefix-arg
327 (prefix-numeric-value current-prefix-arg)) 346 (prefix-numeric-value current-prefix-arg))
328 (if (and transient-mark-mode mark-active) 347 (if (and transient-mark-mode mark-active)
329 (region-beginning)) 348 (region-beginning))
760 (list (let* ((default (car regexp-history)) 779 (list (let* ((default (car regexp-history))
761 (input 780 (input
762 (read-from-minibuffer 781 (read-from-minibuffer
763 (if default 782 (if default
764 (format "List lines matching regexp (default `%s'): " 783 (format "List lines matching regexp (default `%s'): "
765 default) 784 (query-replace-descr default))
766 "List lines matching regexp: ") 785 "List lines matching regexp: ")
767 nil 786 nil
768 nil 787 nil
769 nil 788 nil
770 'regexp-history))) 789 'regexp-history)))
923 (dolist (buf buffers) 942 (dolist (buf buffers)
924 (when (buffer-live-p buf) 943 (when (buffer-live-p buf)
925 (let ((matches 0) ;; count of matched lines 944 (let ((matches 0) ;; count of matched lines
926 (lines 1) ;; line count 945 (lines 1) ;; line count
927 (matchbeg 0) 946 (matchbeg 0)
928 (matchend 0)
929 (origpt nil) 947 (origpt nil)
930 (begpt nil) 948 (begpt nil)
931 (endpt nil) 949 (endpt nil)
932 (marker nil) 950 (marker nil)
933 (curstring "") 951 (curstring "")
943 (goto-char (point-min)) ;; begin searching in the buffer 961 (goto-char (point-min)) ;; begin searching in the buffer
944 (while (not (eobp)) 962 (while (not (eobp))
945 (setq origpt (point)) 963 (setq origpt (point))
946 (when (setq endpt (re-search-forward regexp nil t)) 964 (when (setq endpt (re-search-forward regexp nil t))
947 (setq matches (1+ matches)) ;; increment match count 965 (setq matches (1+ matches)) ;; increment match count
948 (setq matchbeg (match-beginning 0) 966 (setq matchbeg (match-beginning 0))
949 matchend (match-end 0))
950 (setq begpt (save-excursion 967 (setq begpt (save-excursion
951 (goto-char matchbeg) 968 (goto-char matchbeg)
952 (line-beginning-position))) 969 (line-beginning-position)))
953 (setq lines (+ lines (1- (count-lines origpt endpt)))) 970 (setq lines (+ lines (1- (count-lines origpt endpt))))
954 (setq marker (make-marker)) 971 (setq marker (make-marker))
1540 (setq replace-overlay (make-overlay start end)) 1557 (setq replace-overlay (make-overlay start end))
1541 (overlay-put replace-overlay 'face 1558 (overlay-put replace-overlay 'face
1542 (if (facep 'query-replace) 1559 (if (facep 'query-replace)
1543 'query-replace 'region))))) 1560 'query-replace 'region)))))
1544 1561
1545 ;;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4 1562 ;; arch-tag: 16b4cd61-fd40-497b-b86f-b667c4cf88e4
1546 ;;; replace.el ends here 1563 ;;; replace.el ends here