Mercurial > hg > xemacs-beta
comparison lisp/prim/replace.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | ac2d302a0011 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; replace.el --- search and replace commands for XEmacs. | |
| 2 | |
| 3 ;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; This file is part of XEmacs. | |
| 6 | |
| 7 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 8 ;; under the terms of the GNU General Public License as published by | |
| 9 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 10 ;; any later version. | |
| 11 | |
| 12 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 15 ;; General Public License for more details. | |
| 16 | |
| 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 | |
| 19 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
| 20 | |
| 21 ;;; Synched up with: FSF 19.30. | |
| 22 | |
| 23 ;;; Commentary: | |
| 24 | |
| 25 ;; This package supplies the string and regular-expression replace functions | |
| 26 ;; documented in the XEmacs Reference Manual. | |
| 27 | |
| 28 ;;; Code: | |
| 29 | |
| 30 (defvar case-replace t "\ | |
| 31 *Non-nil means `query-replace' should preserve case in replacements. | |
| 32 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. | |
| 34 If this variable is nil, the replacement text will be inserted | |
| 35 exactly as it was specified by the user, irrespective of the case | |
| 36 of the text that was replaced. | |
| 37 | |
| 38 Note that this flag has no effect if `case-fold-search' is nil, | |
| 39 or if the replacement text has any uppercase letters in it.") | |
| 40 | |
| 41 (defvar query-replace-history nil) | |
| 42 | |
| 43 (defvar query-replace-interactive nil | |
| 44 "Non-nil means `query-replace' uses the last search string. | |
| 45 That becomes the \"string to replace\".") | |
| 46 | |
| 47 (defun query-replace-read-args (string regexp-flag) | |
| 48 (let (from to) | |
| 49 (if query-replace-interactive | |
| 50 (setq from (car (if regexp-flag regexp-search-ring search-ring))) | |
| 51 (setq from (read-from-minibuffer (format "%s: " (gettext string)) | |
| 52 nil nil nil | |
| 53 'query-replace-history))) | |
| 54 (setq to (read-from-minibuffer (format "%s %s with: " (gettext string) | |
| 55 from) | |
| 56 nil nil nil | |
| 57 'query-replace-history)) | |
| 58 (list from to current-prefix-arg))) | |
| 59 | |
| 60 (defun query-replace (from-string to-string &optional arg) | |
| 61 "Replace some occurrences of FROM-STRING with TO-STRING. | |
| 62 As each match is found, the user must type a character saying | |
| 63 what to do with it. For directions, type \\[help-command] at that time. | |
| 64 | |
| 65 If `query-replace-interactive' is non-nil, the last incremental search | |
| 66 string is used as FROM-STRING--you don't have to specify it with the | |
| 67 minibuffer. | |
| 68 | |
| 69 Preserves case in each replacement if `case-replace' and `case-fold-search' | |
| 70 are non-nil and FROM-STRING has no uppercase letters. | |
| 71 \(Preserving case means that if the string matched is all caps, or capitalized, | |
| 72 then its replacement is upcased or capitalized.) | |
| 73 | |
| 74 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace | |
| 75 only matches surrounded by word boundaries. | |
| 76 | |
| 77 To customize possible responses, change the \"bindings\" in `query-replace-map'." | |
| 78 (interactive (query-replace-read-args "Query replace" nil)) | |
| 79 (perform-replace from-string to-string t nil arg)) | |
| 80 | |
| 81 (defun query-replace-regexp (regexp to-string &optional arg) | |
| 82 "Replace some things after point matching REGEXP with TO-STRING. | |
| 83 As each match is found, the user must type a character saying | |
| 84 what to do with it. For directions, type \\[help-command] at that time. | |
| 85 | |
| 86 If `query-replace-interactive' is non-nil, the last incremental search | |
| 87 regexp is used as REGEXP--you don't have to specify it with the | |
| 88 minibuffer. | |
| 89 | |
| 90 Preserves case in each replacement if `case-replace' and `case-fold-search' | |
| 91 are non-nil and REGEXP has no uppercase letters. | |
| 92 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace | |
| 93 only matches surrounded by word boundaries. | |
| 94 In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, | |
| 95 and `\\=\\N' (where N is a digit) stands for | |
| 96 whatever what matched the Nth `\\(...\\)' in REGEXP." | |
| 97 (interactive (query-replace-read-args "Query replace regexp" t)) | |
| 98 (perform-replace regexp to-string t t arg)) | |
| 99 | |
| 100 ;;#### Not patently useful | |
| 101 (defun map-query-replace-regexp (regexp to-strings &optional arg) | |
| 102 "Replace some matches for REGEXP with various strings, in rotation. | |
| 103 The second argument TO-STRINGS contains the replacement strings, separated | |
| 104 by spaces. This command works like `query-replace-regexp' except | |
| 105 that each successive replacement uses the next successive replacement string, | |
| 106 wrapping around from the last such string to the first. | |
| 107 | |
| 108 Non-interactively, TO-STRINGS may be a list of replacement strings. | |
| 109 | |
| 110 If `query-replace-interactive' is non-nil, the last incremental search | |
| 111 regexp is used as REGEXP--you don't have to specify it with the minibuffer. | |
| 112 | |
| 113 A prefix argument N says to use each replacement string N times | |
| 114 before rotating to the next." | |
| 115 (interactive | |
| 116 (let (from to) | |
| 117 (setq from (if query-replace-interactive | |
| 118 (car regexp-search-ring) | |
| 119 (read-from-minibuffer "Map query replace (regexp): " | |
| 120 nil nil nil | |
| 121 'query-replace-history))) | |
| 122 (setq to (read-from-minibuffer | |
| 123 (format "Query replace %s with (space-separated strings): " | |
| 124 from) | |
| 125 nil nil nil | |
| 126 'query-replace-history)) | |
| 127 (list from to current-prefix-arg))) | |
| 128 (let (replacements) | |
| 129 (if (listp to-strings) | |
| 130 (setq replacements to-strings) | |
| 131 (while (/= (length to-strings) 0) | |
| 132 (if (string-match " " to-strings) | |
| 133 (setq replacements | |
| 134 (append replacements | |
| 135 (list (substring to-strings 0 | |
| 136 (string-match " " to-strings)))) | |
| 137 to-strings (substring to-strings | |
| 138 (1+ (string-match " " to-strings)))) | |
| 139 (setq replacements (append replacements (list to-strings)) | |
| 140 to-strings "")))) | |
| 141 (perform-replace regexp replacements t t nil arg))) | |
| 142 | |
| 143 (defun replace-string (from-string to-string &optional delimited) | |
| 144 "Replace occurrences of FROM-STRING with TO-STRING. | |
| 145 Preserve case in each match if `case-replace' and `case-fold-search' | |
| 146 are non-nil and FROM-STRING has no uppercase letters. | |
| 147 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace | |
| 148 only matches surrounded by word boundaries. | |
| 149 | |
| 150 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 | |
| 152 minibuffer. | |
| 153 | |
| 154 This function is usually the wrong thing to use in a Lisp program. | |
| 155 What you probably want is a loop like this: | |
| 156 (while (search-forward FROM-STRING nil t) | |
| 157 (replace-match TO-STRING nil t)) | |
| 158 which will run faster and will not set the mark or print anything." | |
| 159 (interactive (query-replace-read-args "Replace string" nil)) | |
| 160 (perform-replace from-string to-string nil nil delimited)) | |
| 161 | |
| 162 (defun replace-regexp (regexp to-string &optional delimited) | |
| 163 "Replace things after point matching REGEXP with TO-STRING. | |
| 164 Preserve case in each match if `case-replace' and `case-fold-search' | |
| 165 are non-nil and REGEXP has no uppercase letters. | |
| 166 \(Preserving case means that if the string matched is all caps, or capitalized, | |
| 167 then its replacement is upcased or capitalized.) | |
| 168 | |
| 169 Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace | |
| 170 only matches surrounded by word boundaries. | |
| 171 In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP, | |
| 172 and `\\=\\N' (where N is a digit) stands for | |
| 173 whatever what matched the Nth `\\(...\\)' in REGEXP. | |
| 174 | |
| 175 If `query-replace-interactive' is non-nil, the last incremental search | |
| 176 regexp is used as REGEXP--you don't have to specify it with the minibuffer. | |
| 177 | |
| 178 This function is usually the wrong thing to use in a Lisp program. | |
| 179 What you probably want is a loop like this: | |
| 180 (while (re-search-forward REGEXP nil t) | |
| 181 (replace-match TO-STRING nil nil)) | |
| 182 which will run faster and will not set the mark or print anything." | |
| 183 (interactive (query-replace-read-args "Replace regexp" t)) | |
| 184 (perform-replace regexp to-string nil t delimited)) | |
| 185 | |
| 186 | |
| 187 (defvar regexp-history nil | |
| 188 "History list for some commands that read regular expressions.") | |
| 189 | |
| 190 (define-function 'keep-lines 'delete-non-matching-lines) | |
| 191 (defun delete-non-matching-lines (regexp) | |
| 192 "Delete all lines except those containing matches for REGEXP. | |
| 193 A match split across lines preserves all the lines it lies in. | |
| 194 Applies to all lines after point." | |
| 195 (interactive (list (read-from-minibuffer | |
| 196 "Keep lines (containing match for regexp): " | |
| 197 nil nil nil 'regexp-history))) | |
| 198 (save-excursion | |
| 199 (or (bolp) (forward-line 1)) | |
| 200 (let ((start (point))) | |
| 201 (while (not (eobp)) | |
| 202 ;; Start is first char not preserved by previous match. | |
| 203 (if (not (re-search-forward regexp nil 'move)) | |
| 204 (delete-region start (point-max)) | |
| 205 (let ((end (save-excursion (goto-char (match-beginning 0)) | |
| 206 (beginning-of-line) | |
| 207 (point)))) | |
| 208 ;; Now end is first char preserved by the new match. | |
| 209 (if (< start end) | |
| 210 (delete-region start end)))) | |
| 211 (setq start (save-excursion (forward-line 1) | |
| 212 (point))) | |
| 213 ;; If the match was empty, avoid matching again at same place. | |
| 214 (and (not (eobp)) (= (match-beginning 0) (match-end 0)) | |
| 215 (forward-char 1)))))) | |
| 216 | |
| 217 (define-function 'flush-lines 'delete-matching-lines) | |
| 218 (defun delete-matching-lines (regexp) | |
| 219 "Delete lines containing matches for REGEXP. | |
| 220 If a match is split across lines, all the lines it lies in are deleted. | |
| 221 Applies to lines after point." | |
| 222 (interactive (list (read-from-minibuffer | |
| 223 "Flush lines (containing match for regexp): " | |
| 224 nil nil nil 'regexp-history))) | |
| 225 (save-excursion | |
| 226 (while (and (not (eobp)) | |
| 227 (re-search-forward regexp nil t)) | |
| 228 (delete-region (save-excursion (goto-char (match-beginning 0)) | |
| 229 (beginning-of-line) | |
| 230 (point)) | |
| 231 (progn (forward-line 1) (point)))))) | |
| 232 | |
| 233 (define-function 'how-many 'count-matches) | |
| 234 (defun count-matches (regexp) | |
| 235 "Print number of matches for REGEXP following point." | |
| 236 (interactive (list (read-from-minibuffer | |
| 237 "How many matches for (regexp): " | |
| 238 nil nil nil 'regexp-history))) | |
| 239 (let ((count 0) opoint) | |
| 240 (save-excursion | |
| 241 (while (and (not (eobp)) | |
| 242 (progn (setq opoint (point)) | |
| 243 (re-search-forward regexp nil t))) | |
| 244 (if (= opoint (point)) | |
| 245 (forward-char 1) | |
| 246 (setq count (1+ count)))) | |
| 247 (message "%d occurrences" count)))) | |
| 248 | |
| 249 | |
| 250 (defvar occur-mode-map ()) | |
| 251 (if occur-mode-map | |
| 252 () | |
| 253 (setq occur-mode-map (make-sparse-keymap)) | |
| 254 (set-keymap-name occur-mode-map 'occur-mode-map) | |
| 255 (define-key occur-mode-map 'button2 'occur-mode-mouse-goto) | |
| 256 (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)) | |
| 258 | |
| 259 (defvar occur-buffer nil) | |
| 260 (defvar occur-nlines nil) | |
| 261 (defvar occur-pos-list nil) | |
| 262 | |
| 263 (defun occur-mode () | |
| 264 "Major mode for output from \\[occur]. | |
| 265 \\<occur-mode-map>Move point to one of the items in this buffer, then use | |
| 266 \\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to. | |
| 267 Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. | |
| 268 | |
| 269 \\{occur-mode-map}" | |
| 270 (kill-all-local-variables) | |
| 271 (use-local-map occur-mode-map) | |
| 272 (setq major-mode 'occur-mode) | |
| 273 (setq mode-name (gettext "Occur")) | |
| 274 (make-local-variable 'occur-buffer) | |
| 275 (make-local-variable 'occur-nlines) | |
| 276 (make-local-variable 'occur-pos-list) | |
| 277 (require 'mode-motion) | |
| 278 (setq mode-motion-hook 'mode-motion-highlight-line) | |
| 279 (run-hooks 'occur-mode-hook)) | |
| 280 | |
| 281 (defun occur-mode-mouse-goto (e) | |
| 282 "go to occurence highlighted by mouse. This function is only reasonable when bound | |
| 283 to a mouse key in the occur buffer" | |
| 284 (interactive "e") | |
| 285 (let ((window-save (selected-window)) | |
| 286 (frame-save (selected-frame))) | |
| 287 ;; preserve the window/frame setup | |
| 288 (unwind-protect | |
| 289 (progn | |
| 290 (mouse-set-point e) | |
| 291 (occur-mode-goto-occurrence)) | |
| 292 (select-frame frame-save) | |
| 293 (select-window window-save)))) | |
| 294 | |
| 295 (defun occur-mode-goto-occurrence () | |
| 296 "Go to the occurrence the current line describes." | |
| 297 (interactive) | |
| 298 (if (or (null occur-buffer) | |
| 299 (null (buffer-name occur-buffer))) | |
| 300 (progn | |
| 301 (setq occur-buffer nil | |
| 302 occur-pos-list nil) | |
| 303 (error "Buffer in which occurrences were found is deleted"))) | |
| 304 (let* ((line-count | |
| 305 (count-lines (point-min) | |
| 306 (save-excursion | |
| 307 (beginning-of-line) | |
| 308 (point)))) | |
| 309 (occur-number (save-excursion | |
| 310 (beginning-of-line) | |
| 311 (/ (1- line-count) | |
| 312 (cond ((< occur-nlines 0) | |
| 313 (- 2 occur-nlines)) | |
| 314 ((> occur-nlines 0) | |
| 315 (+ 2 (* 2 occur-nlines))) | |
| 316 (t 1))))) | |
| 317 (pos (nth occur-number occur-pos-list)) | |
| 318 ;; removed t arg from Bob Weiner, 10/6/95 | |
| 319 (window (get-buffer-window occur-buffer)) | |
| 320 (occur-source-buffer occur-buffer)) | |
| 321 (if (< line-count 1) | |
| 322 (error "No occurrence on this line")) | |
| 323 (or pos | |
| 324 (error "No occurrence on this line")) | |
| 325 ;; don't raise window unless it isn't visible | |
| 326 ;; allow for the possibility that the occur buffer is on another frame | |
| 327 (or (and window | |
| 328 (window-live-p window) | |
| 329 (frame-visible-p (window-frame window)) | |
| 330 (set-buffer occur-source-buffer)) | |
| 331 (and (pop-to-buffer occur-source-buffer) | |
| 332 (setq window (get-buffer-window occur-source-buffer)))) | |
| 333 (goto-char pos) | |
| 334 (set-window-point window pos))) | |
| 335 | |
| 336 | |
| 337 (defvar list-matching-lines-default-context-lines 0 | |
| 338 "*Default number of context lines to include around a `list-matching-lines' | |
| 339 match. A negative number means to include that many lines before the match. | |
| 340 A positive number means to include that many lines both before and after.") | |
| 341 | |
| 342 ;; XEmacs addition | |
| 343 ;;; Damn you Jamie, this is utter trash. | |
| 344 (defvar list-matching-lines-whole-buffer t | |
| 345 "If t, occur operates on whole buffer, otherwise occur starts from point. | |
| 346 default is nil.") | |
| 347 | |
| 348 (define-function 'occur 'list-matching-lines) | |
| 349 (defun list-matching-lines (regexp &optional nlines) | |
| 350 "Show all lines in the current buffer containing a match for REGEXP. | |
| 351 | |
| 352 If a match spreads across multiple lines, all those lines are shown. | |
| 353 | |
| 354 If variable `list-matching-lines-whole-buffer' is non-nil, the entire buffer is | |
| 355 searched, otherwise search begins at point. | |
| 356 | |
| 357 Each line is displayed with NLINES lines before and after, | |
| 358 or -NLINES before if NLINES is negative. | |
| 359 NLINES defaults to `list-matching-lines-default-context-lines'. | |
| 360 Interactively it is the prefix arg. | |
| 361 | |
| 362 The lines are shown in a buffer named `*Occur*'. | |
| 363 It serves as a menu to find any of the occurrences in this buffer. | |
| 364 \\[describe-mode] in that buffer will explain how." | |
| 365 (interactive | |
| 366 (list (let* ((default (or (symbol-near-point) | |
| 367 (and regexp-history | |
| 368 (car regexp-history)))) | |
| 369 (minibuffer-history-minimum-string-length 0) | |
| 370 (input | |
| 371 (if default | |
| 372 ;; rewritten for I18N3 snarfing | |
| 373 (read-from-minibuffer | |
| 374 (format "List lines matching regexp (default `%s'): " | |
| 375 default) nil nil nil 'regexp-history) | |
| 376 (read-from-minibuffer | |
| 377 "List lines matching regexp: " | |
| 378 nil nil nil | |
| 379 'regexp-history)))) | |
| 380 (if (and (equal input "") default) | |
| 381 (progn | |
| 382 (setq input default) | |
| 383 (setcar regexp-history default))) | |
| 384 ;; clear extra entries | |
| 385 (setcdr regexp-history (delete (car regexp-history) | |
| 386 (cdr regexp-history))) | |
| 387 input) | |
| 388 current-prefix-arg)) | |
| 389 (if (equal regexp "") | |
| 390 (error "Must pass non-empty regexp to `list-matching-lines'")) | |
| 391 (setq nlines (if nlines (prefix-numeric-value nlines) | |
| 392 list-matching-lines-default-context-lines)) | |
| 393 (let ((first t) | |
| 394 (dir default-directory) | |
| 395 (buffer (current-buffer)) | |
| 396 (linenum 1) | |
| 397 (prevpos (point-min)) | |
| 398 (final-context-start (make-marker))) | |
| 399 (if (not list-matching-lines-whole-buffer) | |
| 400 (save-excursion | |
| 401 (beginning-of-line) | |
| 402 (setq linenum (1+ (count-lines (point-min) (point)))) | |
| 403 (setq prevpos (point)))) | |
| 404 (with-output-to-temp-buffer "*Occur*" | |
| 405 (save-excursion | |
| 406 (set-buffer standard-output) | |
| 407 (setq default-directory dir) | |
| 408 ;; We will insert the number of lines, and "lines", later. | |
| 409 ;; #### Needs fixing for I18N3 | |
| 410 (let ((print-escape-newlines t)) | |
| 411 (insert (format " matching %s in buffer %s.\n" | |
| 412 regexp (buffer-name buffer)))) | |
| 413 (occur-mode) | |
| 414 (setq occur-buffer buffer) | |
| 415 (setq occur-nlines nlines) | |
| 416 (setq occur-pos-list ())) | |
| 417 (if (eq buffer standard-output) | |
| 418 (goto-char (point-max))) | |
| 419 (save-excursion | |
| 420 (if list-matching-lines-whole-buffer | |
| 421 (beginning-of-buffer)) | |
| 422 (message (format "Searching for %s ..." regexp)) | |
| 423 ;; Find next match, but give up if prev match was at end of buffer. | |
| 424 (while (and (not (= prevpos (point-max))) | |
| 425 (re-search-forward regexp nil t)) | |
| 426 (goto-char (match-beginning 0)) | |
| 427 (beginning-of-line) | |
| 428 (save-match-data | |
| 429 (setq linenum (+ linenum (count-lines prevpos (point))))) | |
| 430 (setq prevpos (point)) | |
| 431 (goto-char (match-end 0)) | |
| 432 (let* ((start (save-excursion | |
| 433 (goto-char (match-beginning 0)) | |
| 434 (forward-line (if (< nlines 0) nlines (- nlines))) | |
| 435 (point))) | |
| 436 (end (save-excursion | |
| 437 (goto-char (match-end 0)) | |
| 438 (if (> nlines 0) | |
| 439 (forward-line (1+ nlines)) | |
| 440 (forward-line 1)) | |
| 441 (point))) | |
| 442 (tag (format "%5d" linenum)) | |
| 443 (empty (make-string (length tag) ?\ )) | |
| 444 tem) | |
| 445 (save-excursion | |
| 446 (setq tem (make-marker)) | |
| 447 (set-marker tem (point)) | |
| 448 (set-buffer standard-output) | |
| 449 (setq occur-pos-list (cons tem occur-pos-list)) | |
| 450 (or first (zerop nlines) | |
| 451 (insert "--------\n")) | |
| 452 (setq first nil) | |
| 453 (insert-buffer-substring buffer start end) | |
| 454 (set-marker final-context-start | |
| 455 (- (point) (- end (match-end 0)))) | |
| 456 (backward-char (- end start)) | |
| 457 (setq tem (if (< nlines 0) (- nlines) nlines)) | |
| 458 (while (> tem 0) | |
| 459 (insert empty ?:) | |
| 460 (forward-line 1) | |
| 461 (setq tem (1- tem))) | |
| 462 (let ((this-linenum linenum)) | |
| 463 (while (< (point) final-context-start) | |
| 464 (if (null tag) | |
| 465 (setq tag (format "%5d" this-linenum))) | |
| 466 (insert tag ?:) | |
| 467 ;; FSFmacs -- we handle this using mode-motion-highlight-line, above. | |
| 468 ; (put-text-property (save-excursion | |
| 469 ; (beginning-of-line) | |
| 470 ; (point)) | |
| 471 ; (save-excursion | |
| 472 ; (end-of-line) | |
| 473 ; (point)) | |
| 474 ; 'mouse-face 'highlight) | |
| 475 (forward-line 1) | |
| 476 (setq tag nil) | |
| 477 (setq this-linenum (1+ this-linenum))) | |
| 478 (while (<= (point) final-context-start) | |
| 479 (insert empty ?:) | |
| 480 (forward-line 1) | |
| 481 (setq this-linenum (1+ this-linenum)))) | |
| 482 (while (< tem nlines) | |
| 483 (insert empty ?:) | |
| 484 (forward-line 1) | |
| 485 (setq tem (1+ tem))) | |
| 486 (goto-char (point-max))) | |
| 487 (forward-line 1))) | |
| 488 (set-buffer standard-output) | |
| 489 ;; Put positions in increasing order to go with buffer. | |
| 490 (setq occur-pos-list (nreverse occur-pos-list)) | |
| 491 (goto-char (point-min)) | |
| 492 (if (= (length occur-pos-list) 1) | |
| 493 (insert "1 line") | |
| 494 (insert (format "%d lines" (length occur-pos-list)))) | |
| 495 (if (interactive-p) | |
| 496 (message "%d matching lines." (length occur-pos-list))))))) | |
| 497 | |
| 498 ;; It would be nice to use \\[...], but there is no reasonable way | |
| 499 ;; to make that display both SPC and Y. | |
| 500 (defvar query-replace-help (purecopy | |
| 501 "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, | |
| 503 Comma to replace but not move point immediately, | |
| 504 C-r to enter recursive edit (\\[exit-recursive-edit] to get out again), | |
| 505 C-w to delete match and recursive edit, | |
| 506 C-l to clear the frame, redisplay, and offer same replacement again, | |
| 507 ! to replace all remaining matches with no more questions, | |
| 508 ^ to move point back to previous match.") | |
| 509 "Help message while in query-replace") | |
| 510 | |
| 511 (defvar query-replace-map nil | |
| 512 "Keymap that defines the responses to questions in `query-replace'. | |
| 513 The \"bindings\" in this map are not commands; they are answers. | |
| 514 The valid answers include `act', `skip', `act-and-show', | |
| 515 `exit', `act-and-exit', `edit', `delete-and-edit', `recenter', | |
| 516 `automatic', `backup', `exit-prefix', and `help'.") | |
| 517 | |
| 518 (if query-replace-map | |
| 519 nil | |
| 520 (let ((map (make-sparse-keymap))) | |
| 521 (set-keymap-name map 'query-replace-map) | |
| 522 (define-key map " " 'act) | |
| 523 (define-key map "\d" 'skip) | |
| 524 (define-key map [delete] 'skip) | |
| 525 (define-key map [backspace] 'skip) | |
| 526 (define-key map "y" 'act) | |
| 527 (define-key map "n" 'skip) | |
| 528 (define-key map "Y" 'act) | |
| 529 (define-key map "N" 'skip) | |
| 530 (define-key map "," 'act-and-show) | |
| 531 (define-key map [escape] 'exit) | |
| 532 (define-key map "q" 'exit) | |
| 533 (define-key map [return] 'exit) | |
| 534 (define-key map "." 'act-and-exit) | |
| 535 (define-key map "\C-r" 'edit) | |
| 536 (define-key map "\C-w" 'delete-and-edit) | |
| 537 (define-key map "\C-l" 'recenter) | |
| 538 (define-key map "!" 'automatic) | |
| 539 (define-key map "^" 'backup) | |
| 540 (define-key map [(control h)] 'help) ;; XEmacs change | |
| 541 (define-key map [f1] 'help) | |
| 542 (define-key map [help] 'help) | |
| 543 (define-key map "?" 'help) | |
| 544 (define-key map "\C-g" 'quit) | |
| 545 (define-key map "\C-]" 'quit) | |
| 546 ;FSFmacs (define-key map "\e" 'exit-prefix) | |
| 547 (define-key map [escape] 'exit-prefix) | |
| 548 | |
| 549 (setq query-replace-map map))) | |
| 550 | |
| 551 | |
| 552 (autoload 'isearch-highlight "isearch") | |
| 553 | |
| 554 (defun perform-replace-next-event (event) | |
| 555 (if isearch-highlight | |
| 556 (let ((aborted t)) | |
| 557 (unwind-protect | |
| 558 (progn | |
| 559 (isearch-highlight (match-beginning 0) (match-end 0)) | |
| 560 (next-command-event event) | |
| 561 (setq aborted nil)) | |
| 562 (isearch-dehighlight aborted))) | |
| 563 (next-command-event event))) | |
| 564 | |
| 565 (defun perform-replace (from-string replacements | |
| 566 query-flag regexp-flag delimited-flag | |
| 567 &optional repeat-count map) | |
| 568 "Subroutine of `query-replace'. Its complexity handles interactive queries. | |
| 569 Don't use this in your own program unless you want to query and set the mark | |
| 570 just as `query-replace' does. Instead, write a simple loop like this: | |
| 571 (while (re-search-forward \"foo[ \t]+bar\" nil t) | |
| 572 (replace-match \"foobar\" nil nil)) | |
| 573 which will run faster and probably do exactly what you want." | |
| 574 (or map (setq map query-replace-map)) | |
| 575 (let* ((event (make-event)) | |
| 576 (nocasify (not (and case-fold-search case-replace | |
| 577 (string-equal from-string | |
| 578 (downcase from-string))))) | |
| 579 (literal (not regexp-flag)) | |
| 580 (search-function (if regexp-flag 're-search-forward 'search-forward)) | |
| 581 (search-string from-string) | |
| 582 (real-match-data nil) ; the match data for the current match | |
| 583 (next-replacement nil) | |
| 584 (replacement-index 0) | |
| 585 (keep-going t) | |
| 586 (stack nil) | |
| 587 (next-rotate-count 0) | |
| 588 (replace-count 0) | |
| 589 (lastrepl nil) ;Position after last match considered. | |
| 590 (match-again t) | |
| 591 ;; XEmacs addition | |
| 592 (qr-case-fold-search | |
| 593 (if (and case-fold-search search-caps-disable-folding) | |
| 594 (isearch-no-upper-case-p search-string) | |
| 595 case-fold-search)) | |
| 596 (message | |
| 597 (if query-flag | |
| 598 (substitute-command-keys | |
| 599 "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) ")))) | |
| 600 (if (stringp replacements) | |
| 601 (setq next-replacement replacements) | |
| 602 (or repeat-count (setq repeat-count 1))) | |
| 603 (if delimited-flag | |
| 604 (setq search-function 're-search-forward | |
| 605 search-string (concat "\\b" | |
| 606 (if regexp-flag from-string | |
| 607 (regexp-quote from-string)) | |
| 608 "\\b"))) | |
| 609 (push-mark) | |
| 610 (undo-boundary) | |
| 611 ;; Loop finding occurrences that perhaps should be replaced. | |
| 612 (while (and keep-going | |
| 613 (not (eobp)) | |
| 614 (let ((case-fold-search qr-case-fold-search)) | |
| 615 (funcall search-function search-string nil t)) | |
| 616 ;; If the search string matches immediately after | |
| 617 ;; the previous match, but it did not match there | |
| 618 ;; before the replacement was done, ignore the match. | |
| 619 (if (or (eq lastrepl (point)) | |
| 620 (and regexp-flag | |
| 621 (eq lastrepl (match-beginning 0)) | |
| 622 (not match-again))) | |
| 623 | |
| 624 (if (eobp) | |
| 625 nil | |
| 626 ;; Don't replace the null string | |
| 627 ;; right after end of previous replacement. | |
| 628 (forward-char 1) | |
| 629 (let ((case-fold-search qr-case-fold-search)) | |
| 630 (funcall search-function search-string nil t))) | |
| 631 t)) | |
| 632 ;; Save the data associated with the real match. | |
| 633 (setq real-match-data (match-data)) | |
| 634 | |
| 635 ;; Before we make the replacement, decide whether the search string | |
| 636 ;; can match again just after this match. | |
| 637 (if regexp-flag | |
| 638 (progn | |
| 639 (setq match-again (looking-at search-string)) | |
| 640 (store-match-data real-match-data))) | |
| 641 | |
| 642 ;; If time for a change, advance to next replacement string. | |
| 643 (if (and (listp replacements) | |
| 644 (= next-rotate-count replace-count)) | |
| 645 (progn | |
| 646 (setq next-rotate-count | |
| 647 (+ next-rotate-count repeat-count)) | |
| 648 (setq next-replacement (nth replacement-index replacements)) | |
| 649 (setq replacement-index (% (1+ replacement-index) (length replacements))))) | |
| 650 (if (not query-flag) | |
| 651 (progn | |
| 652 (store-match-data real-match-data) | |
| 653 (replace-match next-replacement nocasify literal) | |
| 654 (setq replace-count (1+ replace-count))) | |
| 655 (undo-boundary) | |
| 656 (let ((help-form | |
| 657 '(concat (format "Query replacing %s%s with %s.\n\n" | |
| 658 (if regexp-flag (gettext "regexp ") "") | |
| 659 from-string next-replacement) | |
| 660 (substitute-command-keys query-replace-help))) | |
| 661 (done nil) | |
| 662 (replaced nil) | |
| 663 def) | |
| 664 ;; Loop reading commands until one of them sets done, | |
| 665 ;; which means it has finished handling this occurrence. | |
| 666 (while (not done) | |
| 667 ;; Don't fill up the message log | |
| 668 ;; with a bunch of identical messages. | |
| 669 (display-message 'prompt | |
| 670 (format message from-string next-replacement)) | |
| 671 (perform-replace-next-event event) | |
| 672 (setq def (lookup-key map (vector event))) | |
| 673 ;; Restore the match data while we process the command. | |
| 674 (store-match-data real-match-data) | |
| 675 (cond ((eq def 'help) | |
| 676 (with-output-to-temp-buffer (gettext "*Help*") | |
| 677 (princ (concat | |
| 678 (format "Query replacing %s%s with %s.\n\n" | |
| 679 (if regexp-flag "regexp " "") | |
| 680 from-string next-replacement) | |
| 681 (substitute-command-keys | |
| 682 query-replace-help))) | |
| 683 (save-excursion | |
| 684 (set-buffer standard-output) | |
| 685 (help-mode)))) | |
| 686 ((eq def 'exit) | |
| 687 (setq keep-going nil) | |
| 688 (setq done t)) | |
| 689 ((eq def 'backup) | |
| 690 (if stack | |
| 691 (let ((elt (car stack))) | |
| 692 (goto-char (car elt)) | |
| 693 (setq replaced (eq t (cdr elt))) | |
| 694 (or replaced | |
| 695 (store-match-data (cdr elt))) | |
| 696 (setq stack (cdr stack))) | |
| 697 (progn | |
| 698 (message "No previous match") | |
| 699 (ding 'no-terminate) | |
| 700 (sit-for 1)))) | |
| 701 ((eq def 'act) | |
| 702 (or replaced | |
| 703 (replace-match next-replacement nocasify literal)) | |
| 704 (setq done t replaced t)) | |
| 705 ((eq def 'act-and-exit) | |
| 706 (or replaced | |
| 707 (replace-match next-replacement nocasify literal)) | |
| 708 (setq keep-going nil) | |
| 709 (setq done t replaced t)) | |
| 710 ((eq def 'act-and-show) | |
| 711 (if (not replaced) | |
| 712 (progn | |
| 713 (replace-match next-replacement nocasify literal) | |
| 714 (setq replaced t)))) | |
| 715 ((eq def 'automatic) | |
| 716 (or replaced | |
| 717 (replace-match next-replacement nocasify literal)) | |
| 718 (setq done t query-flag nil replaced t)) | |
| 719 ((eq def 'skip) | |
| 720 (setq done t)) | |
| 721 ((eq def 'recenter) | |
| 722 (recenter nil)) | |
| 723 ((eq def 'edit) | |
| 724 (store-match-data | |
| 725 (prog1 (match-data) | |
| 726 (save-excursion (recursive-edit)))) | |
| 727 ;; Before we make the replacement, | |
| 728 ;; decide whether the search string | |
| 729 ;; can match again just after this match. | |
| 730 (if regexp-flag | |
| 731 (setq match-again (looking-at search-string)))) | |
| 732 ((eq def 'delete-and-edit) | |
| 733 (delete-region (match-beginning 0) (match-end 0)) | |
| 734 (store-match-data (prog1 (match-data) | |
| 735 (save-excursion (recursive-edit)))) | |
| 736 (setq replaced t)) | |
| 737 ;; Note: we do not need to treat `exit-prefix' | |
| 738 ;; specially here, since we reread | |
| 739 ;; any unrecognized character. | |
| 740 (t | |
| 741 (setq this-command 'mode-exited) | |
| 742 (setq keep-going nil) | |
| 743 (setq unread-command-events | |
| 744 (cons event unread-command-events)) | |
| 745 (setq done t)))) | |
| 746 ;; Record previous position for ^ when we move on. | |
| 747 ;; Change markers to numbers in the match data | |
| 748 ;; since lots of markers slow down editing. | |
| 749 (setq stack | |
| 750 (cons (cons (point) | |
| 751 (or replaced | |
| 752 (mapcar | |
| 753 #'(lambda (elt) | |
| 754 (if (markerp elt) | |
| 755 (prog1 (marker-position elt) | |
| 756 (set-marker elt nil)) | |
| 757 elt)) | |
| 758 (match-data)))) | |
| 759 stack)) | |
| 760 (if replaced (setq replace-count (1+ replace-count))))) | |
| 761 (setq lastrepl (point))) | |
| 762 (or unread-command-events | |
| 763 (message "Replaced %d occurrence%s" | |
| 764 replace-count | |
| 765 (if (= replace-count 1) "" "s"))) | |
| 766 (and keep-going stack))) | |
| 767 | |
| 768 ; FSF 19.30 original: | |
| 769 ; (defun match-string (num &optional string) | |
| 770 ; "Return string of text matched by last search. | |
| 771 ; NUM specifies which parenthesized expression in the last regexp. | |
| 772 ; Value is nil if NUMth pair didn't match, or there were less than NUM pairs. | |
| 773 ; Zero means the entire text matched by the whole regexp or whole string. | |
| 774 ; STRING should be given if the last search was by `string-match' on STRING." | |
| 775 ; (if (match-beginning num) | |
| 776 ; (if string | |
| 777 ; (substring string (match-beginning num) (match-end num)) | |
| 778 ; (buffer-substring (match-beginning num) (match-end num))))) | |
| 779 | |
| 780 ;; #### - this could stand to be in C... | |
| 781 (defmacro match-string (n &optional string) | |
| 782 "Returns the Nth subexpression matched by the last regular expression | |
| 783 search. The second argument, STRING, must be specified if the last | |
| 784 regular expression search was done with `string-match'." | |
| 785 ;; #### - note that match-beginning is byte coded, so it's more efficient | |
| 786 ;; to just call it twice than it is to let-bind its return value... --Stig | |
| 787 `(and (match-beginning ,n) | |
| 788 ,(if string | |
| 789 `(substring ,string (match-beginning ,n) (match-end ,n)) | |
| 790 `(buffer-substring (match-beginning ,n) (match-end ,n))))) | |
| 791 | |
| 792 (defmacro save-match-data (&rest body) | |
| 793 "Execute BODY forms, restoring the global value of the match data." | |
| 794 (let ((original (make-symbol "match-data"))) | |
| 795 (list 'let (list (list original '(match-data))) | |
| 796 (list 'unwind-protect | |
| 797 (cons 'progn body) | |
| 798 (list 'store-match-data original))))) | |
| 799 | |
| 800 ;;; replace.el ends here |