27 |
|
|
28 |
;;; Code: |
;;; Code: |
29 |
|
|
30 |
|
(eval-when-compile |
31 |
|
(require 'cl)) |
32 |
|
|
33 |
(defcustom case-replace t |
(defcustom case-replace t |
34 |
"*Non-nil means `query-replace' should preserve case in replacements." |
"*Non-nil means `query-replace' should preserve case in replacements." |
35 |
:type 'boolean |
:type 'boolean |
449 |
map) |
map) |
450 |
"Keymap for `occur-mode'.") |
"Keymap for `occur-mode'.") |
451 |
|
|
452 |
|
(defvar occur-revert-properties nil) |
|
(defvar occur-buffer nil |
|
|
"Name of buffer for last occur.") |
|
|
|
|
|
|
|
|
(defvar occur-nlines nil |
|
|
"Number of lines of context to show around matching line.") |
|
|
|
|
|
(defvar occur-command-arguments nil |
|
|
"Arguments that were given to `occur' when it made this buffer.") |
|
453 |
|
|
454 |
(put 'occur-mode 'mode-class 'special) |
(put 'occur-mode 'mode-class 'special) |
|
|
|
455 |
(defun occur-mode () |
(defun occur-mode () |
456 |
"Major mode for output from \\[occur]. |
"Major mode for output from \\[occur]. |
457 |
\\<occur-mode-map>Move point to one of the items in this buffer, then use |
\\<occur-mode-map>Move point to one of the items in this buffer, then use |
464 |
(setq major-mode 'occur-mode) |
(setq major-mode 'occur-mode) |
465 |
(setq mode-name "Occur") |
(setq mode-name "Occur") |
466 |
(make-local-variable 'revert-buffer-function) |
(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))) |
471 |
(setq revert-buffer-function 'occur-revert-function) |
(setq revert-buffer-function 'occur-revert-function) |
472 |
(set (make-local-variable 'revert-buffer-function) 'occur-revert-function) |
(set (make-local-variable 'revert-buffer-function) 'occur-revert-function) |
473 |
(make-local-variable 'occur-buffer) |
(make-local-variable 'occur-revert-properties) |
|
(make-local-variable 'occur-nlines) |
|
|
(make-local-variable 'occur-command-arguments) |
|
474 |
(run-hooks 'occur-mode-hook)) |
(run-hooks 'occur-mode-hook)) |
475 |
|
|
476 |
(defun occur-revert-function (ignore1 ignore2) |
(defun occur-revert-function (ignore1 ignore2) |
477 |
"Handle `revert-buffer' for *Occur* buffers." |
"Handle `revert-buffer' for *Occur* buffers." |
478 |
(let ((args occur-command-arguments )) |
(apply 'occur-1 occur-revert-properties)) |
|
(save-excursion |
|
|
(set-buffer occur-buffer) |
|
|
(apply 'occur args)))) |
|
479 |
|
|
480 |
(defun occur-mode-mouse-goto (event) |
(defun occur-mode-mouse-goto (event) |
481 |
"In Occur mode, go to the occurrence whose line you click on." |
"In Occur mode, go to the occurrence whose line you click on." |
482 |
(interactive "e") |
(interactive "e") |
483 |
(let (buffer pos) |
(let ((buffer nil) |
484 |
|
(pos nil)) |
485 |
(save-excursion |
(save-excursion |
486 |
(set-buffer (window-buffer (posn-window (event-end event)))) |
(set-buffer (window-buffer (posn-window (event-end event)))) |
487 |
(save-excursion |
(save-excursion |
488 |
(goto-char (posn-point (event-end event))) |
(goto-char (posn-point (event-end event))) |
489 |
(setq pos (occur-mode-find-occurrence)) |
(let ((props (occur-mode-find-occurrence))) |
490 |
(setq buffer occur-buffer))) |
(setq buffer (car props)) |
491 |
|
(setq pos (cdr props))))) |
492 |
(pop-to-buffer buffer) |
(pop-to-buffer buffer) |
493 |
(goto-char (marker-position pos)))) |
(goto-char (marker-position pos)))) |
494 |
|
|
495 |
(defun occur-mode-find-occurrence () |
(defun occur-mode-find-occurrence () |
496 |
(if (or (null occur-buffer) |
(let ((props (get-text-property (point) 'occur-target))) |
497 |
(null (buffer-name occur-buffer))) |
(unless props |
498 |
(progn |
(error "No occurrence on this line")) |
499 |
(setq occur-buffer nil) |
(unless (buffer-live-p (car props)) |
500 |
(error "Buffer in which occurrences were found is deleted"))) |
(error "Buffer in which occurrence was found is deleted")) |
501 |
(let ((pos (get-text-property (point) 'occur))) |
props)) |
|
(if (null pos) |
|
|
(error "No occurrence on this line") |
|
|
pos))) |
|
502 |
|
|
503 |
(defun occur-mode-goto-occurrence () |
(defun occur-mode-goto-occurrence () |
504 |
"Go to the occurrence the current line describes." |
"Go to the occurrence the current line describes." |
505 |
(interactive) |
(interactive) |
506 |
(let ((pos (occur-mode-find-occurrence))) |
(let ((target (occur-mode-find-occurrence))) |
507 |
(pop-to-buffer occur-buffer) |
(pop-to-buffer (car target)) |
508 |
(goto-char (marker-position pos)))) |
(goto-char (marker-position (cdr target))))) |
509 |
|
|
510 |
(defun occur-mode-goto-occurrence-other-window () |
(defun occur-mode-goto-occurrence-other-window () |
511 |
"Go to the occurrence the current line describes, in another window." |
"Go to the occurrence the current line describes, in another window." |
512 |
(interactive) |
(interactive) |
513 |
(let ((pos (occur-mode-find-occurrence))) |
(let ((target (occur-mode-find-occurrence))) |
514 |
(switch-to-buffer-other-window occur-buffer) |
(switch-to-buffer-other-window (car target)) |
515 |
(goto-char (marker-position pos)))) |
(goto-char (marker-position (cdr target))))) |
516 |
|
|
517 |
(defun occur-mode-display-occurrence () |
(defun occur-mode-display-occurrence () |
518 |
"Display in another window the occurrence the current line describes." |
"Display in another window the occurrence the current line describes." |
519 |
(interactive) |
(interactive) |
520 |
(let ((pos (occur-mode-find-occurrence)) |
(let ((target (occur-mode-find-occurrence)) |
521 |
same-window-buffer-names |
same-window-buffer-names |
522 |
same-window-regexps |
same-window-regexps |
523 |
window) |
window) |
524 |
(setq window (display-buffer occur-buffer)) |
(setq window (display-buffer (car target))) |
525 |
;; This is the way to set point in the proper window. |
;; This is the way to set point in the proper window. |
526 |
(save-selected-window |
(save-selected-window |
527 |
(select-window window) |
(select-window window) |
528 |
(goto-char (marker-position pos))))) |
(goto-char (marker-position (cdr target)))))) |
529 |
|
|
530 |
(defun occur-next (&optional n) |
(defun occur-next (&optional n) |
531 |
"Move to the Nth (default 1) next match in the *Occur* buffer." |
"Move to the Nth (default 1) next match in the *Occur* buffer." |
541 |
(error "No more matches")) |
(error "No more matches")) |
542 |
(setq n (1- n))))) |
(setq n (1- n))))) |
543 |
|
|
|
|
|
|
|
|
544 |
(defun occur-prev (&optional n) |
(defun occur-prev (&optional n) |
545 |
"Move to the Nth (default 1) previous match in the *Occur* buffer." |
"Move to the Nth (default 1) previous match in the *Occur* buffer." |
546 |
(interactive "p") |
(interactive "p") |
567 |
|
|
568 |
(defalias 'list-matching-lines 'occur) |
(defalias 'list-matching-lines 'occur) |
569 |
|
|
570 |
(defvar list-matching-lines-face 'bold |
(defcustom list-matching-lines-face 'bold |
571 |
"*Face used by \\[list-matching-lines] to show the text that matches. |
"*Face used by \\[list-matching-lines] to show the text that matches. |
572 |
If the value is nil, don't highlight the matching portions specially.") |
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)) |
617 |
|
|
618 |
(defun occur (regexp &optional nlines) |
(defun occur (regexp &optional nlines) |
619 |
"Show all lines in the current buffer containing a match for REGEXP. |
"Show all lines in the current buffer containing a match for REGEXP. |
631 |
|
|
632 |
If REGEXP contains upper case characters (excluding those preceded by `\\'), |
If REGEXP contains upper case characters (excluding those preceded by `\\'), |
633 |
the matching is case-sensitive." |
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'." |
641 |
(interactive |
(interactive |
642 |
(list (let* ((default (car regexp-history)) |
(cons |
643 |
(input |
(let ((bufs (list (read-buffer "First buffer to search: " |
644 |
(read-from-minibuffer |
(current-buffer) t))) |
645 |
(if default |
(buf nil)) |
646 |
(format "List lines matching regexp (default `%s'): " |
(while (not (string-equal |
647 |
default) |
(setq buf (read-buffer "Next buffer to search (RET to end): " |
648 |
"List lines matching regexp: ") |
nil t)) |
649 |
nil nil nil 'regexp-history default t))) |
"")) |
650 |
(and (equal input "") default |
(push buf bufs)) |
651 |
(setq input default)) |
(nreverse (mapcar #'get-buffer bufs))) |
652 |
input) |
(occur-read-primary-args))) |
653 |
current-prefix-arg)) |
(occur-1 regexp nlines bufs)) |
654 |
(let* ((nlines (if nlines |
|
655 |
(prefix-numeric-value nlines) |
(defun multi-occur-by-filename-regexp (bufregexp regexp &optional nlines) |
656 |
list-matching-lines-default-context-lines)) |
"Show all lines in buffers containing REGEXP, named by BUFREGEXP. |
657 |
(current-tab-width tab-width) |
See also `multi-occur'." |
658 |
(inhibit-read-only t) |
(interactive |
659 |
;; Minimum width of line number plus trailing colon. |
(cons |
660 |
(min-line-number-width 6) |
(let* ((default (car regexp-history)) |
661 |
;; Width of line number prefix without the colon. Choose a |
(input |
662 |
;; width that's a multiple of `tab-width' in the original |
(read-from-minibuffer |
663 |
;; buffer so that lines in *Occur* appear right. |
"List lines in buffers whose filename matches regexp: " |
664 |
(line-number-width (1- (* (/ (- (+ min-line-number-width |
nil |
665 |
tab-width) |
nil |
666 |
1) |
nil |
667 |
tab-width) |
'regexp-history))) |
668 |
tab-width))) |
(if (equal input "") |
669 |
;; Format string for line numbers. |
default |
670 |
(line-number-format (format "%%%dd" line-number-width)) |
input)) |
671 |
(empty (make-string line-number-width ?\ )) |
(occur-read-primary-args))) |
672 |
(first t) |
(when bufregexp |
673 |
;;flag to prevent printing separator for first match |
(occur-1 regexp nlines |
674 |
(occur-num-matches 0) |
(delq nil |
675 |
(buffer (current-buffer)) |
(mapcar (lambda (buf) |
676 |
(dir default-directory) |
(when (and (buffer-file-name buf) |
677 |
(linenum 1) |
(string-match bufregexp |
678 |
(prevpos |
(buffer-file-name buf))) |
679 |
;;position of most recent match |
buf)) |
680 |
(point-min)) |
(buffer-list)))))) |
681 |
(case-fold-search (and case-fold-search |
|
682 |
(isearch-no-upper-case-p regexp t))) |
(defun occur-1 (regexp nlines bufs) |
683 |
(final-context-start |
(let ((occur-buf (get-buffer-create "*Occur*"))) |
684 |
;; Marker to the start of context immediately following |
(with-current-buffer occur-buf |
685 |
;; the matched text in *Occur*. |
(setq buffer-read-only nil) |
686 |
(make-marker))) |
(occur-mode) |
687 |
;;; (save-excursion |
(erase-buffer) |
688 |
;;; (beginning-of-line) |
(let ((count (occur-engine |
689 |
;;; (setq linenum (1+ (count-lines (point-min) (point)))) |
regexp bufs occur-buf |
690 |
;;; (setq prevpos (point))) |
(or nlines list-matching-lines-default-context-lines) |
691 |
(save-excursion |
(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)) |
(goto-char (point-min)) |
703 |
;; Check first whether there are any matches at all. |
(setq occur-revert-properties (list regexp nlines bufs) |
704 |
(if (not (re-search-forward regexp nil t)) |
buffer-read-only t)))) |
705 |
(message "No matches for `%s'" regexp) |
|
706 |
;; Back up, so the search loop below will find the first match. |
;; Most of these are macros becuase if we used `flet', it wouldn't |
707 |
(goto-char (match-beginning 0)) |
;; create a closure, so things would blow up at run time. Ugh. :( |
708 |
(with-output-to-temp-buffer "*Occur*" |
(macrolet ((insert-get-point (obj) |
709 |
(save-excursion |
`(progn |
710 |
(set-buffer standard-output) |
(insert ,obj) |
711 |
(setq default-directory dir) |
(point))) |
712 |
;; We will insert the number of lines, and "lines", later. |
(add-prefix (lines) |
713 |
(insert " matching ") |
`(mapcar |
714 |
(let ((print-escape-newlines t)) |
#'(lambda (line) |
715 |
(prin1 regexp)) |
(concat " :" line "\n")) |
716 |
(insert " in buffer " (buffer-name buffer) ?. ?\n) |
,lines))) |
717 |
(occur-mode) |
(defun occur-engine (regexp buffers out-buf nlines case-fold-search |
718 |
(setq occur-buffer buffer) |
title-face prefix-face match-face keep-props) |
719 |
(setq occur-nlines nlines) |
(with-current-buffer out-buf |
720 |
(setq occur-command-arguments |
(setq buffer-read-only nil) |
721 |
(list regexp nlines))) |
(let ((globalcount 0)) |
722 |
(if (eq buffer standard-output) |
;; Map over all the buffers |
723 |
(goto-char (point-max))) |
(dolist (buf buffers) |
724 |
(save-excursion |
(when (buffer-live-p buf) |
725 |
;; Find next match, but give up if prev match was at end of buffer. |
(let ((c 0) ;; count of matched lines |
726 |
(while (and (not (eobp)) |
(l 1) ;; line count |
727 |
(re-search-forward regexp nil t)) |
(matchbeg 0) |
728 |
(goto-char (match-beginning 0)) |
(matchend 0) |
729 |
(beginning-of-line) |
(origpt nil) |
730 |
(save-match-data |
(begpt nil) |
731 |
(setq linenum (+ linenum (count-lines prevpos (point))))) |
(endpt nil) |
732 |
(setq prevpos (point)) |
(marker nil) |
733 |
(goto-char (match-end 0)) |
(curstring "") |
734 |
(let* (;;start point of text in source buffer to be put |
(headerpt (with-current-buffer out-buf (point)))) |
735 |
;;into *Occur* |
(save-excursion |
736 |
(start (save-excursion |
(set-buffer buf) |
|
(goto-char (match-beginning 0)) |
|
|
(forward-line (if (< nlines 0) |
|
|
nlines |
|
|
(- nlines))) |
|
|
(point))) |
|
|
;; end point of text in source buffer to be put |
|
|
;; into *Occur* |
|
|
(end (save-excursion |
|
|
(goto-char (match-end 0)) |
|
|
(if (> nlines 0) |
|
|
(forward-line (1+ nlines)) |
|
|
(forward-line 1)) |
|
|
(point))) |
|
|
;; Amount of context before matching text |
|
|
(match-beg (- (match-beginning 0) start)) |
|
|
;; Length of matching text |
|
|
(match-len (- (match-end 0) (match-beginning 0))) |
|
|
(tag (format line-number-format linenum)) |
|
|
tem |
|
|
insertion-start |
|
|
;; Number of lines of context to show for current match. |
|
|
occur-marker |
|
|
;; Marker pointing to end of match in source buffer. |
|
|
(text-beg |
|
|
;; Marker pointing to start of text for one |
|
|
;; match in *Occur*. |
|
|
(make-marker)) |
|
|
(text-end |
|
|
;; Marker pointing to end of text for one match |
|
|
;; in *Occur*. |
|
|
(make-marker))) |
|
737 |
(save-excursion |
(save-excursion |
738 |
(setq occur-marker (make-marker)) |
(goto-char (point-min)) ;; begin searching in the buffer |
739 |
(set-marker occur-marker (point)) |
(while (not (eobp)) |
740 |
(set-buffer standard-output) |
(setq origpt (point)) |
741 |
(setq occur-num-matches (1+ occur-num-matches)) |
(when (setq endpt (re-search-forward regexp nil t)) |
742 |
(or first (zerop nlines) |
(incf c) ;; increment match count |
743 |
(insert "--------\n")) |
(incf globalcount) |
744 |
(setq first nil) |
(setq matchbeg (match-beginning 0) |
745 |
(save-excursion |
matchend (match-end 0)) |
746 |
(set-buffer "*Occur*") |
(setq begpt (save-excursion |
747 |
(setq tab-width current-tab-width)) |
(goto-char matchbeg) |
748 |
|
(line-beginning-position))) |
749 |
;; Insert matching text including context lines from |
(incf l (1- (count-lines origpt endpt))) |
750 |
;; source buffer into *Occur* |
(setq marker (make-marker)) |
751 |
(set-marker text-beg (point)) |
(set-marker marker matchbeg) |
752 |
(setq insertion-start (point)) |
(setq curstring (buffer-substring begpt |
753 |
(insert-buffer-substring buffer start end) |
(line-end-position))) |
754 |
(or (and (/= (+ start match-beg) end) |
;; Depropertize the string, and maybe |
755 |
(with-current-buffer buffer |
;; highlight the matches |
756 |
(eq (char-before end) ?\n))) |
(let ((len (length curstring)) |
757 |
(insert "\n")) |
(start 0)) |
758 |
(set-marker final-context-start |
(unless keep-props |
759 |
(+ (- (point) (- end (match-end 0))) |
(set-text-properties 0 len nil curstring)) |
760 |
(if (save-excursion |
(while (and (< start len) |
761 |
(set-buffer buffer) |
(string-match regexp curstring start)) |
762 |
(save-excursion |
(add-text-properties (match-beginning 0) |
763 |
(goto-char (match-end 0)) |
(match-end 0) |
764 |
(end-of-line) |
(append |
765 |
(bolp))) |
'(occur-match t) |
766 |
1 0))) |
(when match-face |
767 |
(set-marker text-end (point)) |
`(face ,match-face))) |
768 |
|
curstring) |
769 |
;; Highlight text that was matched. |
(setq start (match-end 0)))) |
770 |
(if list-matching-lines-face |
;; Generate the string to insert for this match |
771 |
(put-text-property |
(let* ((out-line |
772 |
(+ (marker-position text-beg) match-beg) |
(concat |
773 |
(+ (marker-position text-beg) match-beg match-len) |
(apply #'propertize (format "%-6d:" l) |
774 |
'face list-matching-lines-face)) |
(append |
775 |
|
(when prefix-face |
776 |
;; `occur-point' property is used by occur-next and |
`(face prefix-face)) |
777 |
;; occur-prev to move between matching lines. |
'(occur-prefix t))) |
778 |
(put-text-property |
curstring |
779 |
(+ (marker-position text-beg) match-beg match-len) |
"\n")) |
780 |
(+ (marker-position text-beg) match-beg match-len 1) |
(data |
781 |
'occur-point t) |
(if (= nlines 1) |
782 |
|
;; The simple display style |
783 |
;; Now go back to the start of the matching text |
out-line |
784 |
;; adding the space and colon to the start of each line. |
;; The complex multi-line display |
785 |
(goto-char insertion-start) |
;; style. Generate a list of lines, |
786 |
;; Insert space and colon for lines of context before match. |
;; concatenate them all together. |
787 |
(setq tem (if (< linenum nlines) |
(apply #'concat |
788 |
(- nlines linenum) |
(nconc |
789 |
nlines)) |
(add-prefix (nreverse (cdr (occur-accumulate-lines (- nlines))))) |
790 |
(while (> tem 0) |
(list out-line) |
791 |
(insert empty ?:) |
(add-prefix (cdr (occur-accumulate-lines nlines)))))))) |
792 |
(forward-line 1) |
;; Actually insert the match display data |
793 |
(setq tem (1- tem))) |
(with-current-buffer out-buf |
794 |
|
(let ((beg (point)) |
795 |
;; Insert line number and colon for the lines of |
(end (insert-get-point data))) |
796 |
;; matching text. |
(unless (= nlines 1) |
797 |
(let ((this-linenum linenum)) |
(insert-get-point "-------\n")) |
798 |
(while (< (point) final-context-start) |
(add-text-properties |
799 |
(if (null tag) |
beg (1- end) |
800 |
(setq tag (format line-number-format this-linenum))) |
`(occur-target ,(cons buf marker) |
801 |
(insert tag ?:) |
mouse-face highlight help-echo |
802 |
(forward-line 1) |
"mouse-2: go to this occurrence"))))) |
803 |
(setq tag nil) |
(goto-char endpt)) |
804 |
(setq this-linenum (1+ this-linenum))) |
(incf l) |
805 |
(while (and (not (eobp)) (<= (point) final-context-start)) |
;; On to the next match... |
806 |
(insert empty ?:) |
(forward-line 1)))) |
807 |
(forward-line 1) |
(when (not (zerop c)) ;; is the count zero? |
808 |
(setq this-linenum (1+ this-linenum)))) |
(with-current-buffer out-buf |
809 |
|
(goto-char headerpt) |
810 |
;; Insert space and colon for lines of context after match. |
(let ((beg (point)) |
811 |
(while (and (< (point) (point-max)) (< tem nlines)) |
(end (insert-get-point |
812 |
(insert empty ?:) |
(format "%d lines matching \"%s\" in buffer: %s\n" |
813 |
(forward-line 1) |
c regexp (buffer-name buf))))) |
814 |
(setq tem (1+ tem))) |
(add-text-properties beg end |
815 |
|
(append |
816 |
;; Add text properties. The `occur' prop is used to |
(when title-face |
817 |
;; store the marker of the matching text in the |
`(face ,title-face)) |
818 |
;; source buffer. |
`(occur-title ,buf)))) |
819 |
(add-text-properties |
(goto-char (point-max))))))) |
820 |
(marker-position text-beg) (- (marker-position text-end) 1) |
;; Return the number of matches |
821 |
'(mouse-face highlight |
globalcount)))) |
822 |
help-echo "mouse-2: go to this occurrence")) |
|
823 |
(put-text-property (marker-position text-beg) |
(defun occur-fontify-on-property (prop face beg end) |
824 |
(marker-position text-end) |
(let ((prop-beg (or (and (get-text-property (point) prop) (point)) |
825 |
'occur occur-marker) |
(next-single-property-change (point) prop nil end)))) |
826 |
(goto-char (point-max))) |
(when (and prop-beg (not (= prop-beg end))) |
827 |
(forward-line 1))) |
(let ((prop-end (next-single-property-change beg prop nil end))) |
828 |
(set-buffer standard-output) |
(when (and prop-end (not (= prop-end end))) |
829 |
;; Go back to top of *Occur* and finish off by printing the |
(put-text-property prop-beg prop-end 'face face) |
830 |
;; number of matching lines. |
prop-end))))) |
831 |
(goto-char (point-min)) |
|
832 |
(let ((message-string |
(defun occur-fontify-region-function (beg end &optional verbose) |
833 |
(if (= occur-num-matches 1) |
(when verbose (message "Fontifying...")) |
834 |
"1 line" |
(let ((inhibit-read-only t)) |
835 |
(format "%d lines" occur-num-matches)))) |
(save-excursion |
836 |
(insert message-string) |
(dolist (e `((occur-title . ,list-matching-lines-buffer-name-face) |
837 |
(if (interactive-p) |
(occur-match . ,list-matching-lines-face))) |
838 |
(message "%s matched" message-string))) |
; (occur-prefix . ,list-matching-lines-prefix-face))) |
839 |
(setq buffer-read-only t))))))) |
(goto-char beg) |
840 |
|
(let ((change-end nil)) |
841 |
|
(while (setq change-end (occur-fontify-on-property (car e) |
842 |
|
(cdr e) |
843 |
|
(point) |
844 |
|
end)) |
845 |
|
(goto-char change-end)))))) |
846 |
|
(when verbose (message "Fontifying...done"))) |
847 |
|
|
848 |
|
(defun occur-unfontify-region-function (beg end) |
849 |
|
(let ((inhibit-read-only t)) |
850 |
|
(remove-text-properties beg end '(face nil)))) |
851 |
|
|
852 |
|
|
853 |
;; It would be nice to use \\[...], but there is no reasonable way |
;; It would be nice to use \\[...], but there is no reasonable way |
854 |
;; to make that display both SPC and Y. |
;; to make that display both SPC and Y. |