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,