735 |
Compatibility function for \\[next-error] invocations." |
Compatibility function for \\[next-error] invocations." |
736 |
(interactive "p") |
(interactive "p") |
737 |
;; we need to run occur-find-match from within the Occur buffer |
;; we need to run occur-find-match from within the Occur buffer |
738 |
(with-current-buffer |
(with-current-buffer |
739 |
(if (next-error-buffer-p (current-buffer)) |
(if (next-error-buffer-p (current-buffer)) |
740 |
(current-buffer) |
(current-buffer) |
741 |
(next-error-find-buffer nil nil (lambda() (eq major-mode 'occur-mode)))) |
(next-error-find-buffer nil nil (lambda() (eq major-mode 'occur-mode)))) |
742 |
|
|
743 |
(when reset |
(goto-char (cond (reset (point-min)) |
744 |
(goto-char (point-min))) |
((< argp 0) (line-beginning-position)) |
745 |
|
((line-end-position)))) |
746 |
(occur-find-match |
(occur-find-match |
747 |
(abs (prefix-numeric-value argp)) |
(abs argp) |
748 |
(if (> 0 (prefix-numeric-value argp)) |
(if (> 0 argp) |
749 |
#'previous-single-property-change |
#'previous-single-property-change |
750 |
#'next-single-property-change) |
#'next-single-property-change) |
751 |
"No more matches") |
"No more matches") |
791 |
(defun occur-accumulate-lines (count &optional keep-props) |
(defun occur-accumulate-lines (count &optional keep-props) |
792 |
(save-excursion |
(save-excursion |
793 |
(let ((forwardp (> count 0)) |
(let ((forwardp (> count 0)) |
794 |
(result nil)) |
result beg end) |
795 |
(while (not (or (zerop count) |
(while (not (or (zerop count) |
796 |
(if forwardp |
(if forwardp |
797 |
(eobp) |
(eobp) |
798 |
(bobp)))) |
(bobp)))) |
799 |
(setq count (+ count (if forwardp -1 1))) |
(setq count (+ count (if forwardp -1 1))) |
800 |
|
(setq beg (line-beginning-position) |
801 |
|
end (line-end-position)) |
802 |
|
(if (and keep-props font-lock-mode |
803 |
|
(text-property-not-all beg end 'fontified t)) |
804 |
|
(font-lock-fontify-region beg end)) |
805 |
(push |
(push |
806 |
(funcall (if keep-props |
(funcall (if keep-props |
807 |
#'buffer-substring |
#'buffer-substring |
808 |
#'buffer-substring-no-properties) |
#'buffer-substring-no-properties) |
809 |
(line-beginning-position) |
beg end) |
|
(line-end-position)) |
|
810 |
result) |
result) |
811 |
(forward-line (if forwardp 1 -1))) |
(forward-line (if forwardp 1 -1))) |
812 |
(nreverse result)))) |
(nreverse result)))) |
1001 |
(when (setq endpt (re-search-forward regexp nil t)) |
(when (setq endpt (re-search-forward regexp nil t)) |
1002 |
(setq matches (1+ matches)) ;; increment match count |
(setq matches (1+ matches)) ;; increment match count |
1003 |
(setq matchbeg (match-beginning 0)) |
(setq matchbeg (match-beginning 0)) |
|
(setq begpt (save-excursion |
|
|
(goto-char matchbeg) |
|
|
(line-beginning-position))) |
|
1004 |
(setq lines (+ lines (1- (count-lines origpt endpt)))) |
(setq lines (+ lines (1- (count-lines origpt endpt)))) |
1005 |
|
(save-excursion |
1006 |
|
(goto-char matchbeg) |
1007 |
|
(setq begpt (line-beginning-position) |
1008 |
|
endpt (line-end-position))) |
1009 |
(setq marker (make-marker)) |
(setq marker (make-marker)) |
1010 |
(set-marker marker matchbeg) |
(set-marker marker matchbeg) |
1011 |
(setq curstring (buffer-substring begpt |
(if (and keep-props font-lock-mode |
1012 |
(line-end-position))) |
(text-property-not-all begpt endpt 'fontified t)) |
1013 |
|
(font-lock-fontify-region begpt endpt)) |
1014 |
|
(setq curstring (buffer-substring begpt endpt)) |
1015 |
;; Depropertize the string, and maybe |
;; Depropertize the string, and maybe |
1016 |
;; highlight the matches |
;; highlight the matches |
1017 |
(let ((len (length curstring)) |
(let ((len (length curstring)) |
1020 |
(set-text-properties 0 len nil curstring)) |
(set-text-properties 0 len nil curstring)) |
1021 |
(while (and (< start len) |
(while (and (< start len) |
1022 |
(string-match regexp curstring start)) |
(string-match regexp curstring start)) |
1023 |
(add-text-properties (match-beginning 0) |
(add-text-properties |
1024 |
(match-end 0) |
(match-beginning 0) (match-end 0) |
1025 |
(append |
(append |
1026 |
`(occur-match t) |
`(occur-match t) |
1027 |
(when match-face |
(when match-face |
1028 |
;; Use `face' rather than |
;; Use `face' rather than `font-lock-face' here |
1029 |
;; `font-lock-face' here |
;; so as to override faces copied from the buffer. |
1030 |
;; so as to override faces |
`(face ,match-face))) |
1031 |
;; copied from the buffer. |
curstring) |
|
`(face ,match-face))) |
|
|
curstring) |
|
1032 |
(setq start (match-end 0)))) |
(setq start (match-end 0)))) |
1033 |
;; Generate the string to insert for this match |
;; Generate the string to insert for this match |
1034 |
(let* ((out-line |
(let* ((out-line |
1039 |
(when prefix-face |
(when prefix-face |
1040 |
`(font-lock-face prefix-face)) |
`(font-lock-face prefix-face)) |
1041 |
'(occur-prefix t))) |
'(occur-prefix t))) |
1042 |
curstring |
;; We don't put `mouse-face' on the newline, |
1043 |
|
;; because that loses. And don't put it |
1044 |
|
;; on context lines to reduce flicker. |
1045 |
|
(propertize curstring 'mouse-face 'highlight) |
1046 |
"\n")) |
"\n")) |
1047 |
(data |
(data |
1048 |
(if (= nlines 0) |
(if (= nlines 0) |
1066 |
(insert "-------\n")) |
(insert "-------\n")) |
1067 |
(add-text-properties |
(add-text-properties |
1068 |
beg end |
beg end |
1069 |
`(occur-target ,marker help-echo "mouse-2: go to this occurrence")) |
`(occur-target ,marker help-echo "mouse-2: go to this occurrence"))))) |
|
;; We don't put `mouse-face' on the newline, |
|
|
;; because that loses. |
|
|
(add-text-properties beg (1- end) '(mouse-face highlight))))) |
|
1070 |
(goto-char endpt)) |
(goto-char endpt)) |
1071 |
(if endpt |
(if endpt |
1072 |
(progn |
(progn |