|
3000
|
1 ;;; occur.el --- Show all lines in the current buffer containing a match for REGEXP.
|
|
|
2
|
|
|
3 ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996, 1997, 2000, 2001,
|
|
|
4 ;; 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
|
|
|
5
|
|
|
6 ;; Maintainer: XEmacs Development Team
|
|
|
7 ;; Keywords: internal
|
|
|
8
|
|
|
9 ;; This file is part of XEmacs.
|
|
|
10
|
|
|
11 ;; XEmacs is free software; you can redistribute it and/or modify
|
|
|
12 ;; it under the terms of the GNU General Public License as published by
|
|
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
14 ;; any later version.
|
|
|
15
|
|
|
16 ;; XEmacs is distributed in the hope that it will be useful,
|
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
19 ;; GNU General Public License for more details.
|
|
|
20
|
|
|
21 ;; You should have received a copy of the GNU General Public License
|
|
|
22 ;; along with XEmacs; see the file COPYING. If not, write to the
|
|
|
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
|
24 ;; Boston, MA 02110-1301, USA.
|
|
|
25
|
|
|
26 ;;; Synched up with: FSF 22.0.50.1 (CVS)
|
|
|
27
|
|
|
28 (require 'next-error)
|
|
|
29 (defun query-replace-descr (string)
|
|
|
30 (mapconcat 'isearch-text-char-description string ""))
|
|
|
31
|
|
|
32 (defvar occur-mode-map ()
|
|
|
33 "Keymap for `occur-mode'.")
|
|
|
34 (if occur-mode-map
|
|
|
35 ()
|
|
|
36 (setq occur-mode-map (make-sparse-keymap))
|
|
|
37 (set-keymap-name occur-mode-map 'occur-mode-map) ; XEmacs
|
|
|
38 (define-key occur-mode-map 'button2 'occur-mode-mouse-goto) ; XEmacs
|
|
|
39 (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence)
|
|
|
40 (define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence)
|
|
|
41 (define-key occur-mode-map "o" 'occur-mode-goto-occurrence-other-window)
|
|
|
42 (define-key occur-mode-map "\C-o" 'occur-mode-display-occurrence)
|
|
|
43 (define-key occur-mode-map "\M-n" 'occur-next)
|
|
|
44 (define-key occur-mode-map "\M-p" 'occur-prev)
|
|
|
45 (define-key occur-mode-map "r" 'occur-rename-buffer)
|
|
|
46 (define-key occur-mode-map "c" 'clone-buffer)
|
|
|
47 (define-key occur-mode-map "g" 'revert-buffer)
|
|
|
48 (define-key occur-mode-map "q" 'quit-window)
|
|
|
49 (define-key occur-mode-map "z" 'kill-this-buffer)
|
|
|
50 (define-key occur-mode-map "\C-c\C-f" 'next-error-follow-minor-mode))
|
|
|
51
|
|
|
52 (defvar occur-revert-arguments nil
|
|
|
53 "Arguments to pass to `occur-1' to revert an Occur mode buffer.
|
|
|
54 See `occur-revert-function'.")
|
|
|
55
|
|
|
56 (defcustom occur-mode-hook nil ; XEmacs
|
|
|
57 "Hook run when entering Occur mode."
|
|
|
58 :type 'hook
|
|
|
59 :group 'matching)
|
|
|
60
|
|
|
61 (defcustom occur-hook nil
|
|
|
62 "Hook run by Occur when there are any matches."
|
|
|
63 :type 'hook
|
|
|
64 :group 'matching)
|
|
|
65
|
|
|
66 (put 'occur-mode 'mode-class 'special)
|
|
|
67 ;;;###autoload
|
|
|
68 (defun occur-mode ()
|
|
|
69 "Major mode for output from \\[occur].
|
|
|
70 \\<occur-mode-map>Move point to one of the items in this buffer, then use
|
|
|
71 \\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to.
|
|
|
72 Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
|
|
|
73
|
|
|
74 \\{occur-mode-map}"
|
|
|
75 (interactive)
|
|
|
76 (kill-all-local-variables)
|
|
|
77 (use-local-map occur-mode-map)
|
|
|
78 (setq major-mode 'occur-mode)
|
|
|
79 (setq mode-name (gettext "Occur")) ; XEmacs
|
|
|
80 (set (make-local-variable 'revert-buffer-function) 'occur-revert-function)
|
|
|
81 (make-local-variable 'occur-revert-arguments)
|
|
|
82 (add-hook 'change-major-mode-hook 'turn-off-font-lock t t)
|
|
|
83 (setq next-error-function 'occur-next-error)
|
|
|
84 (require 'mode-motion) ; XEmacs
|
|
|
85 (setq mode-motion-hook 'mode-motion-highlight-line) ; XEmacs
|
|
|
86 (run-mode-hooks 'occur-mode-hook))
|
|
|
87
|
|
|
88 (defun occur-revert-function (ignore1 ignore2)
|
|
|
89 "Handle `revert-buffer' for Occur mode buffers."
|
|
|
90 (apply 'occur-1 (append occur-revert-arguments (list (buffer-name)))))
|
|
|
91
|
|
|
92 ;; FSF Version of next function:
|
|
|
93 ; (defun occur-mode-mouse-goto (event)
|
|
|
94 ; "In Occur mode, go to the occurrence whose line you click on."
|
|
|
95 ; (interactive "e")
|
|
|
96 ; (let (pos)
|
|
|
97 ; (save-excursion
|
|
|
98 ; (set-buffer (window-buffer (posn-window (event-end event))))
|
|
|
99 ; (save-excursion
|
|
|
100 ; (goto-char (posn-point (event-end event)))
|
|
|
101 ; (setq pos (occur-mode-find-occurrence))))
|
|
|
102 ; (pop-to-buffer (marker-buffer pos))
|
|
|
103 ; (goto-char pos)))
|
|
|
104
|
|
|
105 (defun occur-mode-mouse-goto (event)
|
|
|
106 "Go to the occurrence highlighted by mouse.
|
|
|
107 This function should be bound to a mouse key in the `*Occur*' buffer."
|
|
|
108 (interactive "e")
|
|
|
109 (let ((window-save (selected-window))
|
|
|
110 (frame-save (selected-frame)))
|
|
|
111 ;; preserve the window/frame setup
|
|
|
112 (unwind-protect
|
|
|
113 (progn
|
|
|
114 (mouse-set-point event)
|
|
|
115 (occur-mode-goto-occurrence))
|
|
|
116 (select-frame frame-save)
|
|
|
117 (select-window window-save))))
|
|
|
118
|
|
|
119 (defun occur-mode-find-occurrence ()
|
|
|
120 (let ((pos (get-text-property (point) 'occur-target)))
|
|
|
121 (unless pos
|
|
|
122 (error "No occurrence on this line"))
|
|
|
123 (unless (buffer-live-p (marker-buffer pos))
|
|
|
124 (error "Buffer for this occurrence was killed"))
|
|
|
125 pos))
|
|
|
126
|
|
|
127 (defun occur-mode-goto-occurrence ()
|
|
|
128 "Go to the occurrence the current line describes."
|
|
|
129 (interactive)
|
|
|
130 (let ((pos (occur-mode-find-occurrence)))
|
|
|
131 (pop-to-buffer (marker-buffer pos))
|
|
|
132 (goto-char pos)))
|
|
|
133
|
|
|
134 (defun occur-mode-goto-occurrence-other-window ()
|
|
|
135 "Go to the occurrence the current line describes, in another window."
|
|
|
136 (interactive)
|
|
|
137 (let ((pos (occur-mode-find-occurrence)))
|
|
|
138 (switch-to-buffer-other-window (marker-buffer pos))
|
|
|
139 (goto-char pos)))
|
|
|
140
|
|
|
141 (defun occur-mode-display-occurrence ()
|
|
|
142 "Display in another window the occurrence the current line describes."
|
|
|
143 (interactive)
|
|
|
144 (let ((pos (occur-mode-find-occurrence))
|
|
|
145 window
|
|
|
146 ;; Bind these to ensure `display-buffer' puts it in another window.
|
|
|
147 same-window-buffer-names
|
|
|
148 same-window-regexps)
|
|
|
149 (setq window (display-buffer (marker-buffer pos)))
|
|
|
150 ;; This is the way to set point in the proper window.
|
|
|
151 (save-selected-window
|
|
|
152 (select-window window)
|
|
|
153 (goto-char pos))))
|
|
|
154
|
|
|
155 (defun occur-find-match (n search message)
|
|
|
156 (if (not n) (setq n 1))
|
|
|
157 (let ((r))
|
|
|
158 (while (> n 0)
|
|
|
159 (setq r (funcall search (point) 'occur-match))
|
|
|
160 (and r
|
|
|
161 (get-text-property r 'occur-match)
|
|
|
162 (setq r (funcall search r 'occur-match)))
|
|
|
163 (if r
|
|
|
164 (goto-char r)
|
|
|
165 (error message))
|
|
|
166 (setq n (1- n)))))
|
|
|
167
|
|
|
168 (defun occur-next (&optional n)
|
|
|
169 "Move to the Nth (default 1) next match in an Occur mode buffer."
|
|
|
170 (interactive "p")
|
|
|
171 (occur-find-match n #'next-single-property-change "No more matches"))
|
|
|
172
|
|
|
173 (defun occur-prev (&optional n)
|
|
|
174 "Move to the Nth (default 1) previous match in an Occur mode buffer."
|
|
|
175 (interactive "p")
|
|
|
176 (occur-find-match n #'previous-single-property-change "No earlier matches"))
|
|
|
177
|
|
|
178 (defun occur-next-error (&optional argp reset)
|
|
|
179 "Move to the Nth (default 1) next match in an Occur mode buffer.
|
|
|
180 Compatibility function for \\[next-error] invocations."
|
|
|
181 (interactive "p")
|
|
|
182 ;; we need to run occur-find-match from within the Occur buffer
|
|
|
183 (with-current-buffer
|
|
|
184 ;; Choose the buffer and make it current.
|
|
|
185 (if (next-error-buffer-p (current-buffer))
|
|
|
186 (current-buffer)
|
|
|
187 (next-error-find-buffer nil nil
|
|
|
188 (lambda ()
|
|
|
189 (eq major-mode 'occur-mode))))
|
|
|
190
|
|
|
191 (goto-char (cond (reset (point-min))
|
|
|
192 ((< argp 0) (line-beginning-position))
|
|
|
193 ((line-end-position))))
|
|
|
194 (occur-find-match
|
|
|
195 (abs argp)
|
|
|
196 (if (> 0 argp)
|
|
|
197 #'previous-single-property-change
|
|
|
198 #'next-single-property-change)
|
|
|
199 "No more matches")
|
|
|
200 ;; In case the *Occur* buffer is visible in a nonselected window.
|
|
|
201 (set-window-point (get-buffer-window (current-buffer)) (point))
|
|
|
202 (occur-mode-goto-occurrence)))
|
|
|
203
|
|
|
204 (defface match
|
|
|
205 '((((class color) (background light))
|
|
|
206 (:background "Tan"))
|
|
|
207 (((class color) (background dark))
|
|
|
208 (:background "RoyalBlue3"))
|
|
|
209 (((class color))
|
|
|
210 (:background "blue" :foreground "white"))
|
|
|
211 (((type tty) (class mono))
|
|
|
212 (:inverse-video t))
|
|
|
213 (t (:background "gray")))
|
|
|
214 "Face used to highlight matches permanently."
|
|
|
215 :group 'matching
|
|
|
216 :version "22.1")
|
|
|
217
|
|
|
218 (defcustom list-matching-lines-default-context-lines 0
|
|
|
219 "*Default number of context lines included around `list-matching-lines' matches.
|
|
|
220 A negative number means to include that many lines before the match.
|
|
|
221 A positive number means to include that many lines both before and after."
|
|
|
222 :type 'integer
|
|
|
223 :group 'matching)
|
|
|
224
|
|
|
225 (defalias 'list-matching-lines 'occur)
|
|
|
226
|
|
|
227 (defcustom list-matching-lines-face 'match
|
|
|
228 "*Face used by \\[list-matching-lines] to show the text that matches.
|
|
|
229 If the value is nil, don't highlight the matching portions specially."
|
|
|
230 :type 'face
|
|
|
231 :group 'matching)
|
|
|
232
|
|
|
233 (defcustom list-matching-lines-buffer-name-face 'underline
|
|
|
234 "*Face used by \\[list-matching-lines] to show the names of buffers.
|
|
|
235 If the value is nil, don't highlight the buffer names specially."
|
|
|
236 :type 'face
|
|
|
237 :group 'matching)
|
|
|
238
|
|
|
239 (defun occur-accumulate-lines (count &optional keep-props)
|
|
|
240 (save-excursion
|
|
|
241 (let ((forwardp (> count 0))
|
|
|
242 result beg end)
|
|
|
243 (while (not (or (zerop count)
|
|
|
244 (if forwardp
|
|
|
245 (eobp)
|
|
|
246 (bobp))))
|
|
|
247 (setq count (+ count (if forwardp -1 1)))
|
|
|
248 (setq beg (line-beginning-position)
|
|
|
249 end (line-end-position))
|
|
|
250 (if (and keep-props (if (boundp 'jit-lock-mode) jit-lock-mode)
|
|
|
251 (text-property-not-all beg end 'fontified t))
|
|
|
252 (if (fboundp 'jit-lock-fontify-now)
|
|
|
253 (jit-lock-fontify-now beg end)))
|
|
|
254 (push
|
|
|
255 (funcall (if keep-props
|
|
|
256 #'buffer-substring
|
|
|
257 #'buffer-substring-no-properties)
|
|
|
258 beg end)
|
|
|
259 result)
|
|
|
260 (forward-line (if forwardp 1 -1)))
|
|
|
261 (nreverse result))))
|
|
|
262
|
|
|
263 (defun occur-read-primary-args ()
|
|
|
264 (list (let* ((default (or (symbol-near-point)
|
|
|
265 (and regexp-history
|
|
|
266 (car regexp-history))))
|
|
|
267 (minibuffer-history-minimum-string-length 0)
|
|
|
268 (input
|
|
|
269 (if default
|
|
|
270 ;; XEmacs: rewritten for I18N3 snarfing
|
|
|
271 (read-from-minibuffer
|
|
|
272 (format "List lines matching regexp (default `%s'): "
|
|
|
273 default) nil nil nil 'regexp-history nil
|
|
|
274 default)
|
|
|
275 (read-from-minibuffer
|
|
|
276 "List lines matching regexp: "
|
|
|
277 nil nil nil
|
|
|
278 'regexp-history))))
|
|
|
279 (if (equal input "")
|
|
|
280 default
|
|
|
281 input))
|
|
|
282 (when current-prefix-arg
|
|
|
283 (prefix-numeric-value current-prefix-arg))))
|
|
|
284
|
|
|
285 ;;;###autoload
|
|
|
286 (defun occur-rename-buffer (&optional unique-p interactive-p)
|
|
|
287 "Rename the current *Occur* buffer to *Occur: original-buffer-name*.
|
|
|
288 Here `original-buffer-name' is the buffer name were Occur was originally run.
|
|
|
289 When given the prefix argument, or called non-interactively, the renaming
|
|
|
290 will not clobber the existing buffer(s) of that name, but use
|
|
|
291 `generate-new-buffer-name' instead. You can add this to `occur-hook'
|
|
|
292 if you always want a separate *Occur* buffer for each buffer where you
|
|
|
293 invoke `occur'."
|
|
|
294 (interactive "P\np")
|
|
|
295 (with-current-buffer
|
|
|
296 (if (eq major-mode 'occur-mode) (current-buffer) (get-buffer "*Occur*"))
|
|
|
297 (rename-buffer (concat "*Occur: "
|
|
|
298 (mapconcat #'buffer-name
|
|
|
299 (car (cddr occur-revert-arguments)) "/")
|
|
|
300 "*")
|
|
|
301 (or unique-p (not interactive-p)))))
|
|
|
302
|
|
|
303 ;;;###autoload
|
|
|
304 (defun occur (regexp &optional nlines)
|
|
|
305 "Show all lines in the current buffer containing a match for REGEXP.
|
|
|
306 This function can not handle matches that span more than one line.
|
|
|
307
|
|
|
308 Each line is displayed with NLINES lines before and after, or -NLINES
|
|
|
309 before if NLINES is negative.
|
|
|
310 NLINES defaults to `list-matching-lines-default-context-lines'.
|
|
|
311 Interactively it is the prefix arg.
|
|
|
312
|
|
|
313 The lines are shown in a buffer named `*Occur*'.
|
|
|
314 It serves as a menu to find any of the occurrences in this buffer.
|
|
|
315 \\<occur-mode-map>\\[describe-mode] in that buffer will explain how.
|
|
|
316
|
|
|
317 If REGEXP contains upper case characters (excluding those preceded by `\\'),
|
|
|
318 the matching is case-sensitive."
|
|
|
319 (interactive (occur-read-primary-args))
|
|
|
320 (occur-1 regexp nlines (list (current-buffer))))
|
|
|
321
|
|
|
322 ;;;###autoload
|
|
|
323 (defun multi-occur (bufs regexp &optional nlines)
|
|
|
324 "Show all lines in buffers BUFS containing a match for REGEXP.
|
|
|
325 This function acts on multiple buffers; otherwise, it is exactly like
|
|
|
326 `occur'."
|
|
|
327 (interactive
|
|
|
328 (cons
|
|
|
329 (let* ((bufs (list (read-buffer "First buffer to search: "
|
|
|
330 (current-buffer) t)))
|
|
|
331 (buf nil)
|
|
|
332 (ido-ignore-item-temp-list bufs))
|
|
|
333 (while (not (string-equal
|
|
|
334 (setq buf (read-buffer
|
|
|
335 (if (and-boundp 'read-buffer-function
|
|
|
336 '(eq read-buffer-function 'ido-read-buffer))
|
|
|
337 "Next buffer to search (C-j to end): "
|
|
|
338 "Next buffer to search (RET to end): ")
|
|
|
339 nil t))
|
|
|
340 ""))
|
|
|
341 (add-to-list 'bufs buf)
|
|
|
342 (setq ido-ignore-item-temp-list bufs))
|
|
|
343 (nreverse (mapcar #'get-buffer bufs)))
|
|
|
344 (occur-read-primary-args)))
|
|
|
345 (occur-1 regexp nlines bufs))
|
|
|
346
|
|
|
347 ;;;###autoload
|
|
|
348 (defun multi-occur-by-filename-regexp (bufregexp regexp &optional nlines)
|
|
|
349 "Show all lines matching REGEXP in buffers named by BUFREGEXP.
|
|
|
350 See also `multi-occur'."
|
|
|
351 (interactive
|
|
|
352 (cons
|
|
|
353 (let* ((default (car regexp-history))
|
|
|
354 (input
|
|
|
355 (read-from-minibuffer
|
|
|
356 "List lines in buffers whose filename matches regexp: "
|
|
|
357 nil
|
|
|
358 nil
|
|
|
359 nil
|
|
|
360 'regexp-history)))
|
|
|
361 (if (equal input "")
|
|
|
362 default
|
|
|
363 input))
|
|
|
364 (occur-read-primary-args)))
|
|
|
365 (when bufregexp
|
|
|
366 (occur-1 regexp nlines
|
|
|
367 (delq nil
|
|
|
368 (mapcar (lambda (buf)
|
|
|
369 (when (and (buffer-file-name buf)
|
|
|
370 (string-match bufregexp
|
|
|
371 (buffer-file-name buf)))
|
|
|
372 buf))
|
|
|
373 (buffer-list))))))
|
|
|
374
|
|
|
375 (defun occur-1 (regexp nlines bufs &optional buf-name)
|
|
|
376 (unless buf-name
|
|
|
377 (setq buf-name "*Occur*"))
|
|
|
378 (let (occur-buf
|
|
|
379 (active-bufs (delq nil (mapcar #'(lambda (buf)
|
|
|
380 (when (buffer-live-p buf) buf))
|
|
|
381 bufs))))
|
|
|
382 ;; Handle the case where one of the buffers we're searching is the
|
|
|
383 ;; output buffer. Just rename it.
|
|
|
384 (when (member buf-name (mapcar 'buffer-name active-bufs))
|
|
|
385 (with-current-buffer (get-buffer buf-name)
|
|
|
386 (rename-uniquely)))
|
|
|
387
|
|
|
388 ;; Now find or create the output buffer.
|
|
|
389 ;; If we just renamed that buffer, we will make a new one here.
|
|
|
390 (setq occur-buf (get-buffer-create buf-name))
|
|
|
391
|
|
|
392 (with-current-buffer occur-buf
|
|
|
393 (occur-mode)
|
|
|
394 (let ((inhibit-read-only t))
|
|
|
395 (erase-buffer)
|
|
|
396 (let ((count (occur-engine
|
|
|
397 regexp active-bufs occur-buf
|
|
|
398 (or nlines list-matching-lines-default-context-lines)
|
|
|
399 (and case-fold-search
|
|
|
400 (no-upper-case-p regexp t))
|
|
|
401 list-matching-lines-buffer-name-face
|
|
|
402 nil list-matching-lines-face t)))
|
|
|
403 (let* ((bufcount (length active-bufs))
|
|
|
404 (diff (- (length bufs) bufcount)))
|
|
|
405 (message "Searched %d buffer%s%s; %s match%s for `%s'"
|
|
|
406 bufcount (if (= bufcount 1) "" "s")
|
|
|
407 (if (zerop diff) "" (format " (%d killed)" diff))
|
|
|
408 (if (zerop count) "no" (format "%d" count))
|
|
|
409 (if (= count 1) "" "es")
|
|
|
410 regexp))
|
|
|
411 (setq occur-revert-arguments (list regexp nlines bufs))
|
|
|
412 (if (= count 0)
|
|
|
413 (kill-buffer occur-buf)
|
|
|
414 (display-buffer occur-buf)
|
|
|
415 (setq next-error-last-buffer occur-buf)
|
|
|
416 (setq buffer-read-only t)
|
|
|
417 (set-buffer-modified-p nil)
|
|
|
418 (run-hooks 'occur-hook)))))))
|
|
|
419
|
|
|
420 (defun occur-engine-add-prefix (lines)
|
|
|
421 (mapcar
|
|
|
422 #'(lambda (line)
|
|
|
423 (concat " :" line "\n"))
|
|
|
424 lines))
|
|
|
425
|
|
|
426 (defun occur-engine (regexp buffers out-buf nlines case-fold-search
|
|
|
427 title-face prefix-face match-face keep-props)
|
|
|
428 (with-current-buffer out-buf
|
|
|
429 (let ((globalcount 0)
|
|
|
430 ;; Don't generate undo entries for creation of the initial contents.
|
|
|
431 (buffer-undo-list t)
|
|
|
432 (coding nil))
|
|
|
433 ;; Map over all the buffers
|
|
|
434 (dolist (buf buffers)
|
|
|
435 (when (buffer-live-p buf)
|
|
|
436 (let ((matches 0) ;; count of matched lines
|
|
|
437 (lines 1) ;; line count
|
|
|
438 (matchbeg 0)
|
|
|
439 (origpt nil)
|
|
|
440 (begpt nil)
|
|
|
441 (endpt nil)
|
|
|
442 (marker nil)
|
|
|
443 (curstring "")
|
|
|
444 (headerpt (with-current-buffer out-buf (point))))
|
|
|
445 (save-excursion
|
|
|
446 (set-buffer buf)
|
|
|
447 (or coding
|
|
|
448 ;; Set CODING only if the current buffer locally
|
|
|
449 ;; binds buffer-file-coding-system.
|
|
|
450 (not (local-variable-p 'buffer-file-coding-system (current-buffer)))
|
|
|
451 (setq coding buffer-file-coding-system))
|
|
|
452 (save-excursion
|
|
|
453 (goto-char (point-min)) ;; begin searching in the buffer
|
|
|
454 (while (not (eobp))
|
|
|
455 (setq origpt (point))
|
|
|
456 (when (setq endpt (re-search-forward regexp nil t))
|
|
|
457 (setq matches (1+ matches)) ;; increment match count
|
|
|
458 (setq matchbeg (match-beginning 0))
|
|
|
459 (setq lines (+ lines (1- (count-lines origpt endpt))))
|
|
|
460 (save-excursion
|
|
|
461 (goto-char matchbeg)
|
|
|
462 (setq begpt (line-beginning-position)
|
|
|
463 endpt (line-end-position)))
|
|
|
464 (setq marker (make-marker))
|
|
|
465 (set-marker marker matchbeg)
|
|
|
466 (if (and keep-props
|
|
|
467 (if (boundp 'jit-lock-mode) jit-lock-mode)
|
|
|
468 (text-property-not-all begpt endpt 'fontified t))
|
|
|
469 (if (fboundp 'jit-lock-fontify-now)
|
|
|
470 (jit-lock-fontify-now begpt endpt)))
|
|
|
471 (setq curstring (buffer-substring begpt endpt))
|
|
|
472 ;; Depropertize the string, and maybe
|
|
|
473 ;; highlight the matches
|
|
|
474 (let ((len (length curstring))
|
|
|
475 (start 0))
|
|
|
476 (unless keep-props
|
|
|
477 (set-text-properties 0 len nil curstring))
|
|
|
478 (while (and (< start len)
|
|
|
479 (string-match regexp curstring start))
|
|
|
480 (add-text-properties
|
|
|
481 (match-beginning 0) (match-end 0)
|
|
|
482 (append
|
|
|
483 `(occur-match t)
|
|
|
484 (when match-face
|
|
|
485 ;; Use `face' rather than `font-lock-face' here
|
|
|
486 ;; so as to override faces copied from the buffer.
|
|
|
487 `(face ,match-face)))
|
|
|
488 curstring)
|
|
|
489 (setq start (match-end 0))))
|
|
|
490 ;; Generate the string to insert for this match
|
|
|
491 (let* ((out-line
|
|
|
492 (concat
|
|
|
493 ;; Using 7 digits aligns tabs properly.
|
|
|
494 (apply #'propertize (format "%7d:" lines)
|
|
|
495 (append
|
|
|
496 (when prefix-face
|
|
|
497 `(font-lock-face prefix-face))
|
|
|
498 '(occur-prefix t)))
|
|
|
499 ;; We don't put `mouse-face' on the newline,
|
|
|
500 ;; because that loses. And don't put it
|
|
|
501 ;; on context lines to reduce flicker.
|
|
|
502 (propertize curstring 'mouse-face 'highlight)
|
|
|
503 "\n"))
|
|
|
504 (data
|
|
|
505 (if (= nlines 0)
|
|
|
506 ;; The simple display style
|
|
|
507 out-line
|
|
|
508 ;; The complex multi-line display
|
|
|
509 ;; style. Generate a list of lines,
|
|
|
510 ;; concatenate them all together.
|
|
|
511 (apply #'concat
|
|
|
512 (nconc
|
|
|
513 (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ (abs nlines))) keep-props))))
|
|
|
514 (list out-line)
|
|
|
515 (if (> nlines 0)
|
|
|
516 (occur-engine-add-prefix
|
|
|
517 (cdr (occur-accumulate-lines (1+ nlines) keep-props)))))))))
|
|
|
518 ;; Actually insert the match display data
|
|
|
519 (with-current-buffer out-buf
|
|
|
520 (let ((beg (point))
|
|
|
521 (end (progn (insert data) (point))))
|
|
|
522 (unless (= nlines 0)
|
|
|
523 (insert "-------\n"))
|
|
|
524 (add-text-properties
|
|
|
525 beg end
|
|
|
526 `(occur-target ,marker help-echo "mouse-2: go to this occurrence")))))
|
|
|
527 (goto-char endpt))
|
|
|
528 (if endpt
|
|
|
529 (progn
|
|
|
530 (setq lines (1+ lines))
|
|
|
531 ;; On to the next match...
|
|
|
532 (forward-line 1))
|
|
|
533 (goto-char (point-max))))))
|
|
|
534 (when (not (zerop matches)) ;; is the count zero?
|
|
|
535 (setq globalcount (+ globalcount matches))
|
|
|
536 (with-current-buffer out-buf
|
|
|
537 (goto-char headerpt)
|
|
|
538 (let ((beg (point))
|
|
|
539 end)
|
|
|
540 (insert (format "%d match%s for \"%s\" in buffer: %s\n"
|
|
|
541 matches (if (= matches 1) "" "es")
|
|
|
542 regexp (buffer-name buf)))
|
|
|
543 (setq end (point))
|
|
|
544 (add-text-properties beg end
|
|
|
545 (append
|
|
|
546 (when title-face
|
|
|
547 `(font-lock-face ,title-face))
|
|
|
548 `(occur-title ,buf))))
|
|
|
549 (goto-char (point-min)))))))
|
|
|
550 (if coding
|
|
|
551 ;; CODING is buffer-file-coding-system of the first buffer
|
|
|
552 ;; that locally binds it. Let's use it also for the output
|
|
|
553 ;; buffer.
|
|
|
554 (set-buffer-file-coding-system coding))
|
|
|
555 ;; Return the number of matches
|
|
|
556 globalcount)))
|
|
|
557
|
|
|
558 (provide 'occur)
|
