Mercurial > hg > xemacs-beta

comparison lisp/replace.el @ 388:aabb7f5b1c81 r21-2-9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-9
author cvs
date Mon, 13 Aug 2007 11:09:42 +0200
parents a300bb07d72d
children 74fd4e045ea6
comparison
equal deleted inserted replaced
387:f892a9d0bb8d 388:aabb7f5b1c81
50 (defvar query-replace-history nil) 50 (defvar query-replace-history nil)
51 51
52 (defvar query-replace-interactive nil 52 (defvar query-replace-interactive nil
53 "Non-nil means `query-replace' uses the last search string. 53 "Non-nil means `query-replace' uses the last search string.
54 That becomes the \"string to replace\".") 54 That becomes the \"string to replace\".")
55
56 (defvar replace-search-function
57 (lambda (str limit)
58 (search-forward str limit t))
59 "Function used by perform-replace to search forward for a string. It will be
60 called with two arguments: the string to search for and a limit bounding the
61 search.")
62
63 (defvar replace-re-search-function
64 (lambda (regexp limit)
65 (re-search-forward regexp limit t))
66 "Function used by perform-replace to search forward for a regular
67 expression. It will be called with two arguments: the regexp to search for and
68 a limit bounding the search.")
55 69
56 (defun query-replace-read-args (string regexp-flag) 70 (defun query-replace-read-args (string regexp-flag)
57 (let (from to) 71 (let (from to)
58 (if query-replace-interactive 72 (if query-replace-interactive
59 (setq from (car (if regexp-flag regexp-search-ring search-ring))) 73 (setq from (car (if regexp-flag regexp-search-ring search-ring)))
207 A match split across lines preserves all the lines it lies in. 221 A match split across lines preserves all the lines it lies in.
208 Applies to all lines after point." 222 Applies to all lines after point."
209 (interactive (list (read-from-minibuffer 223 (interactive (list (read-from-minibuffer
210 "Keep lines (containing match for regexp): " 224 "Keep lines (containing match for regexp): "
211 nil nil nil 'regexp-history))) 225 nil nil nil 'regexp-history)))
212 (save-excursion 226 (with-interactive-search-caps-disable-folding regexp t
213 (or (bolp) (forward-line 1)) 227 (save-excursion
214 (let ((start (point))) 228 (or (bolp) (forward-line 1))
215 (while (not (eobp)) 229 (let ((start (point)))
216 ;; Start is first char not preserved by previous match. 230 (while (not (eobp))
217 (if (not (re-search-forward regexp nil 'move)) 231 ;; Start is first char not preserved by previous match.
218 (delete-region start (point-max)) 232 (if (not (re-search-forward regexp nil 'move))
219 (let ((end (save-excursion (goto-char (match-beginning 0)) 233 (delete-region start (point-max))
220 (beginning-of-line) 234 (let ((end (save-excursion (goto-char (match-beginning 0))
221 (point)))) 235 (beginning-of-line)
222 ;; Now end is first char preserved by the new match. 236 (point))))
223 (if (< start end) 237 ;; Now end is first char preserved by the new match.
224 (delete-region start end)))) 238 (if (< start end)
225 (setq start (save-excursion (forward-line 1) 239 (delete-region start end))))
226 (point))) 240 (setq start (save-excursion (forward-line 1)
227 ;; If the match was empty, avoid matching again at same place. 241 (point)))
228 (and (not (eobp)) (= (match-beginning 0) (match-end 0)) 242 ;; If the match was empty, avoid matching again at same place.
229 (forward-char 1)))))) 243 (and (not (eobp)) (= (match-beginning 0) (match-end 0))
244 (forward-char 1)))))))
230 245
231 (define-function 'flush-lines 'delete-matching-lines) 246 (define-function 'flush-lines 'delete-matching-lines)
232 (defun delete-matching-lines (regexp) 247 (defun delete-matching-lines (regexp)
233 "Delete lines containing matches for REGEXP. 248 "Delete lines containing matches for REGEXP.
234 If a match is split across lines, all the lines it lies in are deleted. 249 If a match is split across lines, all the lines it lies in are deleted.
235 Applies to lines after point." 250 Applies to lines after point."
236 (interactive (list (read-from-minibuffer 251 (interactive (list (read-from-minibuffer
237 "Flush lines (containing match for regexp): " 252 "Flush lines (containing match for regexp): "
238 nil nil nil 'regexp-history))) 253 nil nil nil 'regexp-history)))
239 (save-excursion 254 (with-interactive-search-caps-disable-folding regexp t
240 (while (and (not (eobp)) 255 (save-excursion
241 (re-search-forward regexp nil t)) 256 (while (and (not (eobp))
242 (delete-region (save-excursion (goto-char (match-beginning 0)) 257 (re-search-forward regexp nil t))
243 (beginning-of-line) 258 (delete-region (save-excursion (goto-char (match-beginning 0))
244 (point)) 259 (beginning-of-line)
245 (progn (forward-line 1) (point)))))) 260 (point))
261 (progn (forward-line 1) (point)))))))
246 262
247 (define-function 'how-many 'count-matches) 263 (define-function 'how-many 'count-matches)
248 (defun count-matches (regexp) 264 (defun count-matches (regexp)
249 "Print number of matches for REGEXP following point." 265 "Print number of matches for REGEXP following point."
250 (interactive (list (read-from-minibuffer 266 (interactive (list (read-from-minibuffer
251 "How many matches for (regexp): " 267 "How many matches for (regexp): "
252 nil nil nil 'regexp-history))) 268 nil nil nil 'regexp-history)))
253 (let ((count 0) opoint) 269 (with-interactive-search-caps-disable-folding regexp t
254 (save-excursion 270 (let ((count 0) opoint)
255 (while (and (not (eobp)) 271 (save-excursion
256 (progn (setq opoint (point)) 272 (while (and (not (eobp))
257 (re-search-forward regexp nil t))) 273 (progn (setq opoint (point))
258 (if (= opoint (point)) 274 (re-search-forward regexp nil t)))
259 (forward-char 1) 275 (if (= opoint (point))
260 (setq count (1+ count)))) 276 (forward-char 1)
261 (message "%d occurrences" count)))) 277 (setq count (1+ count))))
278 (message "%d occurrences" count)))))
262 279
263 280
264 (defvar occur-mode-map ()) 281 (defvar occur-mode-map ())
265 (if occur-mode-map 282 (if occur-mode-map
266 () 283 ()
443 (setq occur-buffer buffer) 460 (setq occur-buffer buffer)
444 (setq occur-nlines nlines) 461 (setq occur-nlines nlines)
445 (setq occur-pos-list ())) 462 (setq occur-pos-list ()))
446 (if (eq buffer standard-output) 463 (if (eq buffer standard-output)
447 (goto-char (point-max))) 464 (goto-char (point-max)))
448 (save-excursion 465 (with-interactive-search-caps-disable-folding regexp t
449 (if list-matching-lines-whole-buffer 466 (save-excursion
450 (beginning-of-buffer)) 467 (if list-matching-lines-whole-buffer
451 (message "Searching for %s ..." regexp) 468 (beginning-of-buffer))
452 ;; Find next match, but give up if prev match was at end of buffer. 469 (message "Searching for %s ..." regexp)
453 (while (and (not (= prevpos (point-max))) 470 ;; Find next match, but give up if prev match was at end of buffer.
454 (re-search-forward regexp nil t)) 471 (while (and (not (= prevpos (point-max)))
455 (goto-char (match-beginning 0)) 472 (re-search-forward regexp nil t))
456 (beginning-of-line) 473 (goto-char (match-beginning 0))
457 (save-match-data 474 (beginning-of-line)
458 (setq linenum (+ linenum (count-lines prevpos (point))))) 475 (save-match-data
459 (setq prevpos (point)) 476 (setq linenum (+ linenum (count-lines prevpos (point)))))
460 (goto-char (match-end 0)) 477 (setq prevpos (point))
461 (let* ((start (save-excursion 478 (goto-char (match-end 0))
462 (goto-char (match-beginning 0)) 479 (let* ((start (save-excursion
463 (forward-line (if (< nlines 0) nlines (- nlines))) 480 (goto-char (match-beginning 0))
481 (forward-line (if (< nlines 0) nlines (- nlines)))
482 (point)))
483 (end (save-excursion
484 (goto-char (match-end 0))
485 (if (> nlines 0)
486 (forward-line (1+ nlines))
487 (forward-line 1))
464 (point))) 488 (point)))
465 (end (save-excursion 489 (tag (format "%5d" linenum))
466 (goto-char (match-end 0)) 490 (empty (make-string (length tag) ?\ ))
467 (if (> nlines 0) 491 tem)
468 (forward-line (1+ nlines)) 492 (save-excursion
469 (forward-line 1)) 493 (setq tem (make-marker))
470 (point))) 494 (set-marker tem (point))
471 (tag (format "%5d" linenum)) 495 (set-buffer standard-output)
472 (empty (make-string (length tag) ?\ )) 496 (setq occur-pos-list (cons tem occur-pos-list))
473 tem) 497 (or first (zerop nlines)
474 (save-excursion 498 (insert "--------\n"))
475 (setq tem (make-marker)) 499 (setq first nil)
476 (set-marker tem (point)) 500 (insert-buffer-substring buffer start end)
477 (set-buffer standard-output) 501 (set-marker final-context-start
478 (setq occur-pos-list (cons tem occur-pos-list)) 502 (- (point) (- end (match-end 0))))
479 (or first (zerop nlines) 503 (backward-char (- end start))
480 (insert "--------\n")) 504 (setq tem (if (< nlines 0) (- nlines) nlines))
481 (setq first nil) 505 (while (> tem 0)
482 (insert-buffer-substring buffer start end)
483 (set-marker final-context-start
484 (- (point) (- end (match-end 0))))
485 (backward-char (- end start))
486 (setq tem (if (< nlines 0) (- nlines) nlines))
487 (while (> tem 0)
488 (insert empty ?:)
489 (forward-line 1)
490 (setq tem (1- tem)))
491 (let ((this-linenum linenum))
492 (while (< (point) final-context-start)
493 (if (null tag)
494 (setq tag (format "%5d" this-linenum)))
495 (insert tag ?:)
496 ;; FSFmacs -- we handle this using mode-motion-highlight-line, above.
497 ; (put-text-property (save-excursion
498 ; (beginning-of-line)
499 ; (point))
500 ; (save-excursion
501 ; (end-of-line)
502 ; (point))
503 ; 'mouse-face 'highlight)
504 (forward-line 1)
505 (setq tag nil)
506 (setq this-linenum (1+ this-linenum)))
507 (while (<= (point) final-context-start)
508 (insert empty ?:) 506 (insert empty ?:)
509 (forward-line 1) 507 (forward-line 1)
510 (setq this-linenum (1+ this-linenum)))) 508 (setq tem (1- tem)))
511 (while (< tem nlines) 509 (let ((this-linenum linenum))
512 (insert empty ?:) 510 (while (< (point) final-context-start)
513 (forward-line 1) 511 (if (null tag)
514 (setq tem (1+ tem))) 512 (setq tag (format "%5d" this-linenum)))
515 (goto-char (point-max))) 513 (insert tag ?:)
516 (forward-line 1))) 514 ;; FSFmacs --
517 (set-buffer standard-output) 515 ;; we handle this using mode-motion-highlight-line, above.
518 ;; Put positions in increasing order to go with buffer. 516 ;; (put-text-property (save-excursion
519 (setq occur-pos-list (nreverse occur-pos-list)) 517 ;; (beginning-of-line)
520 (goto-char (point-min)) 518 ;; (point))
521 (if (= (length occur-pos-list) 1) 519 ;; (save-excursion
522 (insert "1 line") 520 ;; (end-of-line)
523 (insert (format "%d lines" (length occur-pos-list)))) 521 ;; (point))
524 (if (interactive-p) 522 ;; 'mouse-face 'highlight)
525 (message "%d matching lines." (length occur-pos-list))))))) 523 (forward-line 1)
524 (setq tag nil)
525 (setq this-linenum (1+ this-linenum)))
526 (while (<= (point) final-context-start)
527 (insert empty ?:)
528 (forward-line 1)
529 (setq this-linenum (1+ this-linenum))))
530 (while (< tem nlines)
531 (insert empty ?:)
532 (forward-line 1)
533 (setq tem (1+ tem)))
534 (goto-char (point-max)))
535 (forward-line 1)))
536 (set-buffer standard-output)
537 ;; Put positions in increasing order to go with buffer.
538 (setq occur-pos-list (nreverse occur-pos-list))
539 (goto-char (point-min))
540 (if (= (length occur-pos-list) 1)
541 (insert "1 line")
542 (insert (format "%d lines" (length occur-pos-list))))
543 (if (interactive-p)
544 (message "%d matching lines." (length occur-pos-list))))))))
526 545
527 ;; It would be nice to use \\[...], but there is no reasonable way 546 ;; It would be nice to use \\[...], but there is no reasonable way
528 ;; to make that display both SPC and Y. 547 ;; to make that display both SPC and Y.
529 (defconst query-replace-help 548 (defconst query-replace-help
530 (purecopy 549 (purecopy
602 "Subroutine of `query-replace'. Its complexity handles interactive queries. 621 "Subroutine of `query-replace'. Its complexity handles interactive queries.
603 Don't use this in your own program unless you want to query and set the mark 622 Don't use this in your own program unless you want to query and set the mark
604 just as `query-replace' does. Instead, write a simple loop like this: 623 just as `query-replace' does. Instead, write a simple loop like this:
605 (while (re-search-forward \"foo[ \t]+bar\" nil t) 624 (while (re-search-forward \"foo[ \t]+bar\" nil t)
606 (replace-match \"foobar\" nil nil)) 625 (replace-match \"foobar\" nil nil))
607 which will run faster and probably do exactly what you want." 626 which will run faster and probably do exactly what you want.
627 When searching for a match, this function use `replace-search-function' and `replace-re-search-function'"
608 (or map (setq map query-replace-map)) 628 (or map (setq map query-replace-map))
609 (let* ((event (make-event)) 629 (let* ((event (make-event))
610 (nocasify (not (and case-fold-search case-replace 630 (nocasify (not (and case-fold-search case-replace
611 (string-equal from-string 631 (string-equal from-string
612 (downcase from-string))))) 632 (downcase from-string)))))
613 (literal (not regexp-flag)) 633 (literal (not regexp-flag))
614 (search-function (if regexp-flag 're-search-forward 'search-forward)) 634 (search-function (if regexp-flag
635 replace-re-search-function
636 replace-search-function))
615 (search-string from-string) 637 (search-string from-string)
616 (real-match-data nil) ; the match data for the current match 638 (real-match-data nil) ; the match data for the current match
617 (next-replacement nil) 639 (next-replacement nil)
618 (replacement-index 0) 640 (replacement-index 0)
619 (keep-going t) 641 (keep-going t)
644 (zmacs-deactivate-region)) 666 (zmacs-deactivate-region))
645 (if (stringp replacements) 667 (if (stringp replacements)
646 (setq next-replacement replacements) 668 (setq next-replacement replacements)
647 (or repeat-count (setq repeat-count 1))) 669 (or repeat-count (setq repeat-count 1)))
648 (if delimited-flag 670 (if delimited-flag
649 (setq search-function 're-search-forward 671 (setq search-function replace-re-search-function
650 search-string (concat "\\b" 672 search-string (concat "\\b"
651 (if regexp-flag from-string 673 (if regexp-flag from-string
652 (regexp-quote from-string)) 674 (regexp-quote from-string))
653 "\\b"))) 675 "\\b")))
654 (push-mark) 676 (push-mark)
656 (unwind-protect 678 (unwind-protect
657 ;; Loop finding occurrences that perhaps should be replaced. 679 ;; Loop finding occurrences that perhaps should be replaced.
658 (while (and keep-going 680 (while (and keep-going
659 (not (eobp)) 681 (not (eobp))
660 (let ((case-fold-search qr-case-fold-search)) 682 (let ((case-fold-search qr-case-fold-search))
661 (funcall search-function search-string limit t)) 683 (funcall search-function search-string limit))
662 ;; If the search string matches immediately after 684 ;; If the search string matches immediately after
663 ;; the previous match, but it did not match there 685 ;; the previous match, but it did not match there
664 ;; before the replacement was done, ignore the match. 686 ;; before the replacement was done, ignore the match.
665 (if (or (eq lastrepl (point)) 687 (if (or (eq lastrepl (point))
666 (and regexp-flag 688 (and regexp-flag
670 nil 692 nil
671 ;; Don't replace the null string 693 ;; Don't replace the null string
672 ;; right after end of previous replacement. 694 ;; right after end of previous replacement.
673 (forward-char 1) 695 (forward-char 1)
674 (let ((case-fold-search qr-case-fold-search)) 696 (let ((case-fold-search qr-case-fold-search))
675 (funcall search-function search-string limit t))) 697 (funcall search-function search-string limit)))
676 t)) 698 t))
677 699
678 ;; Save the data associated with the real match. 700 ;; Save the data associated with the real match.
679 (setq real-match-data (match-data)) 701 (setq real-match-data (match-data))
680 702