Mercurial > emacs
comparison lisp/replace.el @ 44794:3b95c81de514
(toplevel): Require `cl' while compiling.
(occur-buffer, occur-nlines): Delete.
(occur-revert-properties): Rename to `occur-revert-properties'.
(occur-mode): Handle it. Set up font lock.
(occur-revert-function): Simply apply `occur-1'.
(occur-mode-find-occurence, occur-mode-mouse-goto)
(occur-mode-goto-occurrence-other-window)
(occur-mode-display-occurrence): Handle buffer property.
(list-matching-lines-face): Use defcustom.
(list-matching-lines-buffer-name-face): New variable.
(occur-accumulate-lines): Renamed from `ibuffer-accumulate-lines',
in ibuffer.el.
(occur-read-primary-args): Move out of `occur'.
(occur): Delete. Now simply call `occur-1'.
(multi-occur, multi-occur-by-filename-regexp): New functions.
(occur-1): New function.
(occur-engine): Renamed from `ibuffer-occur-engine' to replace the
previous implementation of `occur'; taken from ibuf-ext.el.
(occur-fontify-on-property): New function.
(occur-fontify-region-function, occur-unfontify-region-function):
New functions.
author | Colin Walters <walters@gnu.org> |
---|---|
date | Tue, 23 Apr 2002 20:34:58 +0000 |
parents | f1d7c706f7f7 |
children | d60f225edddc |
comparison
equal
deleted
inserted
replaced
44793:e3a600209db7 | 44794:3b95c81de514 |
---|---|
24 | 24 |
25 ;; This package supplies the string and regular-expression replace functions | 25 ;; This package supplies the string and regular-expression replace functions |
26 ;; documented in the Emacs user's manual. | 26 ;; documented in the Emacs user's manual. |
27 | 27 |
28 ;;; Code: | 28 ;;; Code: |
29 | |
30 (eval-when-compile | |
31 (require 'cl)) | |
29 | 32 |
30 (defcustom case-replace t | 33 (defcustom case-replace t |
31 "*Non-nil means `query-replace' should preserve case in replacements." | 34 "*Non-nil means `query-replace' should preserve case in replacements." |
32 :type 'boolean | 35 :type 'boolean |
33 :group 'matching) | 36 :group 'matching) |
444 (define-key map "\M-p" 'occur-prev) | 447 (define-key map "\M-p" 'occur-prev) |
445 (define-key map "g" 'revert-buffer) | 448 (define-key map "g" 'revert-buffer) |
446 map) | 449 map) |
447 "Keymap for `occur-mode'.") | 450 "Keymap for `occur-mode'.") |
448 | 451 |
449 | 452 (defvar occur-revert-properties nil) |
450 (defvar occur-buffer nil | |
451 "Name of buffer for last occur.") | |
452 | |
453 | |
454 (defvar occur-nlines nil | |
455 "Number of lines of context to show around matching line.") | |
456 | |
457 (defvar occur-command-arguments nil | |
458 "Arguments that were given to `occur' when it made this buffer.") | |
459 | 453 |
460 (put 'occur-mode 'mode-class 'special) | 454 (put 'occur-mode 'mode-class 'special) |
461 | |
462 (defun occur-mode () | 455 (defun occur-mode () |
463 "Major mode for output from \\[occur]. | 456 "Major mode for output from \\[occur]. |
464 \\<occur-mode-map>Move point to one of the items in this buffer, then use | 457 \\<occur-mode-map>Move point to one of the items in this buffer, then use |
465 \\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to. | 458 \\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to. |
466 Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. | 459 Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. |
469 (kill-all-local-variables) | 462 (kill-all-local-variables) |
470 (use-local-map occur-mode-map) | 463 (use-local-map occur-mode-map) |
471 (setq major-mode 'occur-mode) | 464 (setq major-mode 'occur-mode) |
472 (setq mode-name "Occur") | 465 (setq mode-name "Occur") |
473 (make-local-variable 'revert-buffer-function) | 466 (make-local-variable 'revert-buffer-function) |
467 (set (make-local-variable 'font-lock-defaults) | |
468 '(nil t nil nil nil | |
469 (font-lock-fontify-region-function . occur-fontify-region-function) | |
470 (font-lock-unfontify-region-function . occur-unfontify-region-function))) | |
474 (setq revert-buffer-function 'occur-revert-function) | 471 (setq revert-buffer-function 'occur-revert-function) |
475 (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) | 472 (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) |
476 (make-local-variable 'occur-buffer) | 473 (make-local-variable 'occur-revert-properties) |
477 (make-local-variable 'occur-nlines) | |
478 (make-local-variable 'occur-command-arguments) | |
479 (run-hooks 'occur-mode-hook)) | 474 (run-hooks 'occur-mode-hook)) |
480 | 475 |
481 (defun occur-revert-function (ignore1 ignore2) | 476 (defun occur-revert-function (ignore1 ignore2) |
482 "Handle `revert-buffer' for *Occur* buffers." | 477 "Handle `revert-buffer' for *Occur* buffers." |
483 (let ((args occur-command-arguments )) | 478 (apply 'occur-1 occur-revert-properties)) |
484 (save-excursion | |
485 (set-buffer occur-buffer) | |
486 (apply 'occur args)))) | |
487 | 479 |
488 (defun occur-mode-mouse-goto (event) | 480 (defun occur-mode-mouse-goto (event) |
489 "In Occur mode, go to the occurrence whose line you click on." | 481 "In Occur mode, go to the occurrence whose line you click on." |
490 (interactive "e") | 482 (interactive "e") |
491 (let (buffer pos) | 483 (let ((buffer nil) |
484 (pos nil)) | |
492 (save-excursion | 485 (save-excursion |
493 (set-buffer (window-buffer (posn-window (event-end event)))) | 486 (set-buffer (window-buffer (posn-window (event-end event)))) |
494 (save-excursion | 487 (save-excursion |
495 (goto-char (posn-point (event-end event))) | 488 (goto-char (posn-point (event-end event))) |
496 (setq pos (occur-mode-find-occurrence)) | 489 (let ((props (occur-mode-find-occurrence))) |
497 (setq buffer occur-buffer))) | 490 (setq buffer (car props)) |
491 (setq pos (cdr props))))) | |
498 (pop-to-buffer buffer) | 492 (pop-to-buffer buffer) |
499 (goto-char (marker-position pos)))) | 493 (goto-char (marker-position pos)))) |
500 | 494 |
501 (defun occur-mode-find-occurrence () | 495 (defun occur-mode-find-occurrence () |
502 (if (or (null occur-buffer) | 496 (let ((props (get-text-property (point) 'occur-target))) |
503 (null (buffer-name occur-buffer))) | 497 (unless props |
504 (progn | 498 (error "No occurrence on this line")) |
505 (setq occur-buffer nil) | 499 (unless (buffer-live-p (car props)) |
506 (error "Buffer in which occurrences were found is deleted"))) | 500 (error "Buffer in which occurrence was found is deleted")) |
507 (let ((pos (get-text-property (point) 'occur))) | 501 props)) |
508 (if (null pos) | |
509 (error "No occurrence on this line") | |
510 pos))) | |
511 | 502 |
512 (defun occur-mode-goto-occurrence () | 503 (defun occur-mode-goto-occurrence () |
513 "Go to the occurrence the current line describes." | 504 "Go to the occurrence the current line describes." |
514 (interactive) | 505 (interactive) |
515 (let ((pos (occur-mode-find-occurrence))) | 506 (let ((target (occur-mode-find-occurrence))) |
516 (pop-to-buffer occur-buffer) | 507 (pop-to-buffer (car target)) |
517 (goto-char (marker-position pos)))) | 508 (goto-char (marker-position (cdr target))))) |
518 | 509 |
519 (defun occur-mode-goto-occurrence-other-window () | 510 (defun occur-mode-goto-occurrence-other-window () |
520 "Go to the occurrence the current line describes, in another window." | 511 "Go to the occurrence the current line describes, in another window." |
521 (interactive) | 512 (interactive) |
522 (let ((pos (occur-mode-find-occurrence))) | 513 (let ((target (occur-mode-find-occurrence))) |
523 (switch-to-buffer-other-window occur-buffer) | 514 (switch-to-buffer-other-window (car target)) |
524 (goto-char (marker-position pos)))) | 515 (goto-char (marker-position (cdr target))))) |
525 | 516 |
526 (defun occur-mode-display-occurrence () | 517 (defun occur-mode-display-occurrence () |
527 "Display in another window the occurrence the current line describes." | 518 "Display in another window the occurrence the current line describes." |
528 (interactive) | 519 (interactive) |
529 (let ((pos (occur-mode-find-occurrence)) | 520 (let ((target (occur-mode-find-occurrence)) |
530 same-window-buffer-names | 521 same-window-buffer-names |
531 same-window-regexps | 522 same-window-regexps |
532 window) | 523 window) |
533 (setq window (display-buffer occur-buffer)) | 524 (setq window (display-buffer (car target))) |
534 ;; This is the way to set point in the proper window. | 525 ;; This is the way to set point in the proper window. |
535 (save-selected-window | 526 (save-selected-window |
536 (select-window window) | 527 (select-window window) |
537 (goto-char (marker-position pos))))) | 528 (goto-char (marker-position (cdr target)))))) |
538 | 529 |
539 (defun occur-next (&optional n) | 530 (defun occur-next (&optional n) |
540 "Move to the Nth (default 1) next match in the *Occur* buffer." | 531 "Move to the Nth (default 1) next match in the *Occur* buffer." |
541 (interactive "p") | 532 (interactive "p") |
542 (if (not n) (setq n 1)) | 533 (if (not n) (setq n 1)) |
547 (setq r (next-single-property-change (point) 'occur-point)) | 538 (setq r (next-single-property-change (point) 'occur-point)) |
548 (if r | 539 (if r |
549 (goto-char r) | 540 (goto-char r) |
550 (error "No more matches")) | 541 (error "No more matches")) |
551 (setq n (1- n))))) | 542 (setq n (1- n))))) |
552 | |
553 | |
554 | 543 |
555 (defun occur-prev (&optional n) | 544 (defun occur-prev (&optional n) |
556 "Move to the Nth (default 1) previous match in the *Occur* buffer." | 545 "Move to the Nth (default 1) previous match in the *Occur* buffer." |
557 (interactive "p") | 546 (interactive "p") |
558 (if (not n) (setq n 1)) | 547 (if (not n) (setq n 1)) |
576 :type 'integer | 565 :type 'integer |
577 :group 'matching) | 566 :group 'matching) |
578 | 567 |
579 (defalias 'list-matching-lines 'occur) | 568 (defalias 'list-matching-lines 'occur) |
580 | 569 |
581 (defvar list-matching-lines-face 'bold | 570 (defcustom list-matching-lines-face 'bold |
582 "*Face used by \\[list-matching-lines] to show the text that matches. | 571 "*Face used by \\[list-matching-lines] to show the text that matches. |
583 If the value is nil, don't highlight the matching portions specially.") | 572 If the value is nil, don't highlight the matching portions specially." |
573 :type 'face | |
574 :group 'matching) | |
575 | |
576 (defcustom list-matching-lines-buffer-name-face 'underline | |
577 "*Face used by \\[list-matching-lines] to show the names of buffers. | |
578 If the value is nil, don't highlight the buffer names specially." | |
579 :type 'face | |
580 :group 'matching) | |
581 | |
582 (defun occur-accumulate-lines (count) | |
583 (save-excursion | |
584 (let ((forwardp (> count 0)) | |
585 (result nil)) | |
586 (while (not (or (zerop count) | |
587 (if forwardp | |
588 (eobp) | |
589 (bobp)))) | |
590 (if forwardp | |
591 (decf count) | |
592 (incf count)) | |
593 (push | |
594 (buffer-substring | |
595 (line-beginning-position) | |
596 (line-end-position)) | |
597 result) | |
598 (forward-line (if forwardp 1 -1))) | |
599 (nreverse result)))) | |
600 | |
601 (defun occur-read-primary-args () | |
602 (list (let* ((default (car regexp-history)) | |
603 (input | |
604 (read-from-minibuffer | |
605 (if default | |
606 (format "List lines matching regexp (default `%s'): " | |
607 default) | |
608 "List lines matching regexp: ") | |
609 nil | |
610 nil | |
611 nil | |
612 'regexp-history))) | |
613 (if (equal input "") | |
614 default | |
615 input)) | |
616 current-prefix-arg)) | |
584 | 617 |
585 (defun occur (regexp &optional nlines) | 618 (defun occur (regexp &optional nlines) |
586 "Show all lines in the current buffer containing a match for REGEXP. | 619 "Show all lines in the current buffer containing a match for REGEXP. |
587 | 620 |
588 If a match spreads across multiple lines, all those lines are shown. | 621 If a match spreads across multiple lines, all those lines are shown. |
596 It serves as a menu to find any of the occurrences in this buffer. | 629 It serves as a menu to find any of the occurrences in this buffer. |
597 \\<occur-mode-map>\\[describe-mode] in that buffer will explain how. | 630 \\<occur-mode-map>\\[describe-mode] in that buffer will explain how. |
598 | 631 |
599 If REGEXP contains upper case characters (excluding those preceded by `\\'), | 632 If REGEXP contains upper case characters (excluding those preceded by `\\'), |
600 the matching is case-sensitive." | 633 the matching is case-sensitive." |
634 (interactive (occur-read-primary-args)) | |
635 (occur-1 regexp nlines (list (current-buffer)))) | |
636 | |
637 (defun multi-occur (bufs regexp &optional nlines) | |
638 "Show all lines in buffers BUFS containing a match for REGEXP. | |
639 This function acts on multiple buffers; otherwise, it is exactly like | |
640 `occur'." | |
601 (interactive | 641 (interactive |
602 (list (let* ((default (car regexp-history)) | 642 (cons |
603 (input | 643 (let ((bufs (list (read-buffer "First buffer to search: " |
604 (read-from-minibuffer | 644 (current-buffer) t))) |
605 (if default | 645 (buf nil)) |
606 (format "List lines matching regexp (default `%s'): " | 646 (while (not (string-equal |
607 default) | 647 (setq buf (read-buffer "Next buffer to search (RET to end): " |
608 "List lines matching regexp: ") | 648 nil t)) |
609 nil nil nil 'regexp-history default t))) | 649 "")) |
610 (and (equal input "") default | 650 (push buf bufs)) |
611 (setq input default)) | 651 (nreverse (mapcar #'get-buffer bufs))) |
612 input) | 652 (occur-read-primary-args))) |
613 current-prefix-arg)) | 653 (occur-1 regexp nlines bufs)) |
614 (let* ((nlines (if nlines | 654 |
615 (prefix-numeric-value nlines) | 655 (defun multi-occur-by-filename-regexp (bufregexp regexp &optional nlines) |
616 list-matching-lines-default-context-lines)) | 656 "Show all lines in buffers containing REGEXP, named by BUFREGEXP. |
617 (current-tab-width tab-width) | 657 See also `multi-occur'." |
618 (inhibit-read-only t) | 658 (interactive |
619 ;; Minimum width of line number plus trailing colon. | 659 (cons |
620 (min-line-number-width 6) | 660 (let* ((default (car regexp-history)) |
621 ;; Width of line number prefix without the colon. Choose a | 661 (input |
622 ;; width that's a multiple of `tab-width' in the original | 662 (read-from-minibuffer |
623 ;; buffer so that lines in *Occur* appear right. | 663 "List lines in buffers whose filename matches regexp: " |
624 (line-number-width (1- (* (/ (- (+ min-line-number-width | 664 nil |
625 tab-width) | 665 nil |
626 1) | 666 nil |
627 tab-width) | 667 'regexp-history))) |
628 tab-width))) | 668 (if (equal input "") |
629 ;; Format string for line numbers. | 669 default |
630 (line-number-format (format "%%%dd" line-number-width)) | 670 input)) |
631 (empty (make-string line-number-width ?\ )) | 671 (occur-read-primary-args))) |
632 (first t) | 672 (when bufregexp |
633 ;;flag to prevent printing separator for first match | 673 (occur-1 regexp nlines |
634 (occur-num-matches 0) | 674 (delq nil |
635 (buffer (current-buffer)) | 675 (mapcar (lambda (buf) |
636 (dir default-directory) | 676 (when (and (buffer-file-name buf) |
637 (linenum 1) | 677 (string-match bufregexp |
638 (prevpos | 678 (buffer-file-name buf))) |
639 ;;position of most recent match | 679 buf)) |
640 (point-min)) | 680 (buffer-list)))))) |
641 (case-fold-search (and case-fold-search | 681 |
642 (isearch-no-upper-case-p regexp t))) | 682 (defun occur-1 (regexp nlines bufs) |
643 (final-context-start | 683 (let ((occur-buf (get-buffer-create "*Occur*"))) |
644 ;; Marker to the start of context immediately following | 684 (with-current-buffer occur-buf |
645 ;; the matched text in *Occur*. | 685 (setq buffer-read-only nil) |
646 (make-marker))) | 686 (occur-mode) |
647 ;;; (save-excursion | 687 (erase-buffer) |
648 ;;; (beginning-of-line) | 688 (let ((count (occur-engine |
649 ;;; (setq linenum (1+ (count-lines (point-min) (point)))) | 689 regexp bufs occur-buf |
650 ;;; (setq prevpos (point))) | 690 (or nlines list-matching-lines-default-context-lines) |
691 (and case-fold-search | |
692 (isearch-no-upper-case-p regexp t)) | |
693 nil nil nil nil))) | |
694 (message "Searched %d buffers; %s matches for `%s'" (length bufs) | |
695 (if (zerop count) | |
696 "no" | |
697 (format "%d" count)) | |
698 regexp) | |
699 (if (> count 0) | |
700 (display-buffer occur-buf) | |
701 (kill-buffer occur-buf))) | |
702 (goto-char (point-min)) | |
703 (setq occur-revert-properties (list regexp nlines bufs) | |
704 buffer-read-only t)))) | |
705 | |
706 ;; Most of these are macros becuase if we used `flet', it wouldn't | |
707 ;; create a closure, so things would blow up at run time. Ugh. :( | |
708 (macrolet ((insert-get-point (obj) | |
709 `(progn | |
710 (insert ,obj) | |
711 (point))) | |
712 (add-prefix (lines) | |
713 `(mapcar | |
714 #'(lambda (line) | |
715 (concat " :" line "\n")) | |
716 ,lines))) | |
717 (defun occur-engine (regexp buffers out-buf nlines case-fold-search | |
718 title-face prefix-face match-face keep-props) | |
719 (with-current-buffer out-buf | |
720 (setq buffer-read-only nil) | |
721 (let ((globalcount 0)) | |
722 ;; Map over all the buffers | |
723 (dolist (buf buffers) | |
724 (when (buffer-live-p buf) | |
725 (let ((c 0) ;; count of matched lines | |
726 (l 1) ;; line count | |
727 (matchbeg 0) | |
728 (matchend 0) | |
729 (origpt nil) | |
730 (begpt nil) | |
731 (endpt nil) | |
732 (marker nil) | |
733 (curstring "") | |
734 (headerpt (with-current-buffer out-buf (point)))) | |
735 (save-excursion | |
736 (set-buffer buf) | |
737 (save-excursion | |
738 (goto-char (point-min)) ;; begin searching in the buffer | |
739 (while (not (eobp)) | |
740 (setq origpt (point)) | |
741 (when (setq endpt (re-search-forward regexp nil t)) | |
742 (incf c) ;; increment match count | |
743 (incf globalcount) | |
744 (setq matchbeg (match-beginning 0) | |
745 matchend (match-end 0)) | |
746 (setq begpt (save-excursion | |
747 (goto-char matchbeg) | |
748 (line-beginning-position))) | |
749 (incf l (1- (count-lines origpt endpt))) | |
750 (setq marker (make-marker)) | |
751 (set-marker marker matchbeg) | |
752 (setq curstring (buffer-substring begpt | |
753 (line-end-position))) | |
754 ;; Depropertize the string, and maybe | |
755 ;; highlight the matches | |
756 (let ((len (length curstring)) | |
757 (start 0)) | |
758 (unless keep-props | |
759 (set-text-properties 0 len nil curstring)) | |
760 (while (and (< start len) | |
761 (string-match regexp curstring start)) | |
762 (add-text-properties (match-beginning 0) | |
763 (match-end 0) | |
764 (append | |
765 '(occur-match t) | |
766 (when match-face | |
767 `(face ,match-face))) | |
768 curstring) | |
769 (setq start (match-end 0)))) | |
770 ;; Generate the string to insert for this match | |
771 (let* ((out-line | |
772 (concat | |
773 (apply #'propertize (format "%-6d:" l) | |
774 (append | |
775 (when prefix-face | |
776 `(face prefix-face)) | |
777 '(occur-prefix t))) | |
778 curstring | |
779 "\n")) | |
780 (data | |
781 (if (= nlines 1) | |
782 ;; The simple display style | |
783 out-line | |
784 ;; The complex multi-line display | |
785 ;; style. Generate a list of lines, | |
786 ;; concatenate them all together. | |
787 (apply #'concat | |
788 (nconc | |
789 (add-prefix (nreverse (cdr (occur-accumulate-lines (- nlines))))) | |
790 (list out-line) | |
791 (add-prefix (cdr (occur-accumulate-lines nlines)))))))) | |
792 ;; Actually insert the match display data | |
793 (with-current-buffer out-buf | |
794 (let ((beg (point)) | |
795 (end (insert-get-point data))) | |
796 (unless (= nlines 1) | |
797 (insert-get-point "-------\n")) | |
798 (add-text-properties | |
799 beg (1- end) | |
800 `(occur-target ,(cons buf marker) | |
801 mouse-face highlight help-echo | |
802 "mouse-2: go to this occurrence"))))) | |
803 (goto-char endpt)) | |
804 (incf l) | |
805 ;; On to the next match... | |
806 (forward-line 1)))) | |
807 (when (not (zerop c)) ;; is the count zero? | |
808 (with-current-buffer out-buf | |
809 (goto-char headerpt) | |
810 (let ((beg (point)) | |
811 (end (insert-get-point | |
812 (format "%d lines matching \"%s\" in buffer: %s\n" | |
813 c regexp (buffer-name buf))))) | |
814 (add-text-properties beg end | |
815 (append | |
816 (when title-face | |
817 `(face ,title-face)) | |
818 `(occur-title ,buf)))) | |
819 (goto-char (point-max))))))) | |
820 ;; Return the number of matches | |
821 globalcount)))) | |
822 | |
823 (defun occur-fontify-on-property (prop face beg end) | |
824 (let ((prop-beg (or (and (get-text-property (point) prop) (point)) | |
825 (next-single-property-change (point) prop nil end)))) | |
826 (when (and prop-beg (not (= prop-beg end))) | |
827 (let ((prop-end (next-single-property-change beg prop nil end))) | |
828 (when (and prop-end (not (= prop-end end))) | |
829 (put-text-property prop-beg prop-end 'face face) | |
830 prop-end))))) | |
831 | |
832 (defun occur-fontify-region-function (beg end &optional verbose) | |
833 (when verbose (message "Fontifying...")) | |
834 (let ((inhibit-read-only t)) | |
651 (save-excursion | 835 (save-excursion |
652 (goto-char (point-min)) | 836 (dolist (e `((occur-title . ,list-matching-lines-buffer-name-face) |
653 ;; Check first whether there are any matches at all. | 837 (occur-match . ,list-matching-lines-face))) |
654 (if (not (re-search-forward regexp nil t)) | 838 ; (occur-prefix . ,list-matching-lines-prefix-face))) |
655 (message "No matches for `%s'" regexp) | 839 (goto-char beg) |
656 ;; Back up, so the search loop below will find the first match. | 840 (let ((change-end nil)) |
657 (goto-char (match-beginning 0)) | 841 (while (setq change-end (occur-fontify-on-property (car e) |
658 (with-output-to-temp-buffer "*Occur*" | 842 (cdr e) |
659 (save-excursion | 843 (point) |
660 (set-buffer standard-output) | 844 end)) |
661 (setq default-directory dir) | 845 (goto-char change-end)))))) |
662 ;; We will insert the number of lines, and "lines", later. | 846 (when verbose (message "Fontifying...done"))) |
663 (insert " matching ") | 847 |
664 (let ((print-escape-newlines t)) | 848 (defun occur-unfontify-region-function (beg end) |
665 (prin1 regexp)) | 849 (let ((inhibit-read-only t)) |
666 (insert " in buffer " (buffer-name buffer) ?. ?\n) | 850 (remove-text-properties beg end '(face nil)))) |
667 (occur-mode) | 851 |
668 (setq occur-buffer buffer) | |
669 (setq occur-nlines nlines) | |
670 (setq occur-command-arguments | |
671 (list regexp nlines))) | |
672 (if (eq buffer standard-output) | |
673 (goto-char (point-max))) | |
674 (save-excursion | |
675 ;; Find next match, but give up if prev match was at end of buffer. | |
676 (while (and (not (eobp)) | |
677 (re-search-forward regexp nil t)) | |
678 (goto-char (match-beginning 0)) | |
679 (beginning-of-line) | |
680 (save-match-data | |
681 (setq linenum (+ linenum (count-lines prevpos (point))))) | |
682 (setq prevpos (point)) | |
683 (goto-char (match-end 0)) | |
684 (let* (;;start point of text in source buffer to be put | |
685 ;;into *Occur* | |
686 (start (save-excursion | |
687 (goto-char (match-beginning 0)) | |
688 (forward-line (if (< nlines 0) | |
689 nlines | |
690 (- nlines))) | |
691 (point))) | |
692 ;; end point of text in source buffer to be put | |
693 ;; into *Occur* | |
694 (end (save-excursion | |
695 (goto-char (match-end 0)) | |
696 (if (> nlines 0) | |
697 (forward-line (1+ nlines)) | |
698 (forward-line 1)) | |
699 (point))) | |
700 ;; Amount of context before matching text | |
701 (match-beg (- (match-beginning 0) start)) | |
702 ;; Length of matching text | |
703 (match-len (- (match-end 0) (match-beginning 0))) | |
704 (tag (format line-number-format linenum)) | |
705 tem | |
706 insertion-start | |
707 ;; Number of lines of context to show for current match. | |
708 occur-marker | |
709 ;; Marker pointing to end of match in source buffer. | |
710 (text-beg | |
711 ;; Marker pointing to start of text for one | |
712 ;; match in *Occur*. | |
713 (make-marker)) | |
714 (text-end | |
715 ;; Marker pointing to end of text for one match | |
716 ;; in *Occur*. | |
717 (make-marker))) | |
718 (save-excursion | |
719 (setq occur-marker (make-marker)) | |
720 (set-marker occur-marker (point)) | |
721 (set-buffer standard-output) | |
722 (setq occur-num-matches (1+ occur-num-matches)) | |
723 (or first (zerop nlines) | |
724 (insert "--------\n")) | |
725 (setq first nil) | |
726 (save-excursion | |
727 (set-buffer "*Occur*") | |
728 (setq tab-width current-tab-width)) | |
729 | |
730 ;; Insert matching text including context lines from | |
731 ;; source buffer into *Occur* | |
732 (set-marker text-beg (point)) | |
733 (setq insertion-start (point)) | |
734 (insert-buffer-substring buffer start end) | |
735 (or (and (/= (+ start match-beg) end) | |
736 (with-current-buffer buffer | |
737 (eq (char-before end) ?\n))) | |
738 (insert "\n")) | |
739 (set-marker final-context-start | |
740 (+ (- (point) (- end (match-end 0))) | |
741 (if (save-excursion | |
742 (set-buffer buffer) | |
743 (save-excursion | |
744 (goto-char (match-end 0)) | |
745 (end-of-line) | |
746 (bolp))) | |
747 1 0))) | |
748 (set-marker text-end (point)) | |
749 | |
750 ;; Highlight text that was matched. | |
751 (if list-matching-lines-face | |
752 (put-text-property | |
753 (+ (marker-position text-beg) match-beg) | |
754 (+ (marker-position text-beg) match-beg match-len) | |
755 'face list-matching-lines-face)) | |
756 | |
757 ;; `occur-point' property is used by occur-next and | |
758 ;; occur-prev to move between matching lines. | |
759 (put-text-property | |
760 (+ (marker-position text-beg) match-beg match-len) | |
761 (+ (marker-position text-beg) match-beg match-len 1) | |
762 'occur-point t) | |
763 | |
764 ;; Now go back to the start of the matching text | |
765 ;; adding the space and colon to the start of each line. | |
766 (goto-char insertion-start) | |
767 ;; Insert space and colon for lines of context before match. | |
768 (setq tem (if (< linenum nlines) | |
769 (- nlines linenum) | |
770 nlines)) | |
771 (while (> tem 0) | |
772 (insert empty ?:) | |
773 (forward-line 1) | |
774 (setq tem (1- tem))) | |
775 | |
776 ;; Insert line number and colon for the lines of | |
777 ;; matching text. | |
778 (let ((this-linenum linenum)) | |
779 (while (< (point) final-context-start) | |
780 (if (null tag) | |
781 (setq tag (format line-number-format this-linenum))) | |
782 (insert tag ?:) | |
783 (forward-line 1) | |
784 (setq tag nil) | |
785 (setq this-linenum (1+ this-linenum))) | |
786 (while (and (not (eobp)) (<= (point) final-context-start)) | |
787 (insert empty ?:) | |
788 (forward-line 1) | |
789 (setq this-linenum (1+ this-linenum)))) | |
790 | |
791 ;; Insert space and colon for lines of context after match. | |
792 (while (and (< (point) (point-max)) (< tem nlines)) | |
793 (insert empty ?:) | |
794 (forward-line 1) | |
795 (setq tem (1+ tem))) | |
796 | |
797 ;; Add text properties. The `occur' prop is used to | |
798 ;; store the marker of the matching text in the | |
799 ;; source buffer. | |
800 (add-text-properties | |
801 (marker-position text-beg) (- (marker-position text-end) 1) | |
802 '(mouse-face highlight | |
803 help-echo "mouse-2: go to this occurrence")) | |
804 (put-text-property (marker-position text-beg) | |
805 (marker-position text-end) | |
806 'occur occur-marker) | |
807 (goto-char (point-max))) | |
808 (forward-line 1))) | |
809 (set-buffer standard-output) | |
810 ;; Go back to top of *Occur* and finish off by printing the | |
811 ;; number of matching lines. | |
812 (goto-char (point-min)) | |
813 (let ((message-string | |
814 (if (= occur-num-matches 1) | |
815 "1 line" | |
816 (format "%d lines" occur-num-matches)))) | |
817 (insert message-string) | |
818 (if (interactive-p) | |
819 (message "%s matched" message-string))) | |
820 (setq buffer-read-only t))))))) | |
821 | 852 |
822 ;; It would be nice to use \\[...], but there is no reasonable way | 853 ;; It would be nice to use \\[...], but there is no reasonable way |
823 ;; to make that display both SPC and Y. | 854 ;; to make that display both SPC and Y. |
824 (defconst query-replace-help | 855 (defconst query-replace-help |
825 "Type Space or `y' to replace one match, Delete or `n' to skip to next, | 856 "Type Space or `y' to replace one match, Delete or `n' to skip to next, |