|
3000
|
1 ;;; next-error.el --- Next error support framework
|
|
|
2
|
|
|
3 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
|
|
|
4 ;; 2000, 2001, 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 (defgroup next-error nil
|
|
|
29 "`next-error' support framework."
|
|
|
30 :group 'compilation
|
|
|
31 :version "22.1")
|
|
|
32
|
|
|
33 (defface next-error
|
|
|
34 '((t (:inherit region)))
|
|
|
35 "Face used to highlight next error locus."
|
|
|
36 :group 'next-error
|
|
|
37 :version "22.1")
|
|
|
38
|
|
|
39 (defcustom next-error-highlight 0.1
|
|
|
40 "*Highlighting of locations in selected source buffers.
|
|
|
41 If number, highlight the locus in `next-error' face for given time in seconds.
|
|
|
42 If t, use persistent overlays fontified in `next-error' face.
|
|
|
43 If nil, don't highlight the locus in the source buffer.
|
|
|
44 If `fringe-arrow', indicate the locus by the fringe arrow."
|
|
|
45 :type '(choice (number :tag "Delay")
|
|
|
46 (const :tag "Persistent overlay" t)
|
|
|
47 (const :tag "No highlighting" nil)
|
|
|
48 (const :tag "Fringe arrow" 'fringe-arrow))
|
|
|
49 :group 'next-error
|
|
|
50 :version "22.1")
|
|
|
51
|
|
|
52 (defcustom next-error-highlight-no-select 0.1
|
|
|
53 "*Highlighting of locations in non-selected source buffers.
|
|
|
54 If number, highlight the locus in `next-error' face for given time in seconds.
|
|
|
55 If t, use persistent overlays fontified in `next-error' face.
|
|
|
56 If nil, don't highlight the locus in the source buffer.
|
|
|
57 If `fringe-arrow', indicate the locus by the fringe arrow."
|
|
|
58 :type '(choice (number :tag "Delay")
|
|
|
59 (const :tag "Persistent overlay" t)
|
|
|
60 (const :tag "No highlighting" nil)
|
|
|
61 (const :tag "Fringe arrow" 'fringe-arrow))
|
|
|
62 :group 'next-error
|
|
|
63 :version "22.1")
|
|
|
64
|
|
|
65 (defcustom next-error-hook nil
|
|
|
66 "*List of hook functions run by `next-error' after visiting source file."
|
|
|
67 :type 'hook
|
|
|
68 :group 'next-error)
|
|
|
69
|
|
|
70 (defvar next-error-highlight-timer nil)
|
|
|
71
|
|
|
72 ;(defvar next-error-overlay-arrow-position nil)
|
|
|
73 ;(put 'next-error-overlay-arrow-position 'overlay-arrow-string "=>")
|
|
|
74 ;(add-to-list 'overlay-arrow-variable-list 'next-error-overlay-arrow-position)
|
|
|
75
|
|
|
76 (defvar next-error-last-buffer nil
|
|
|
77 "The most recent `next-error' buffer.
|
|
|
78 A buffer becomes most recent when its compilation, grep, or
|
|
|
79 similar mode is started, or when it is used with \\[next-error]
|
|
|
80 or \\[compile-goto-error].")
|
|
|
81
|
|
|
82 (defvar next-error-function nil
|
|
|
83 "Function to use to find the next error in the current buffer.
|
|
|
84 The function is called with 2 parameters:
|
|
|
85 ARG is an integer specifying by how many errors to move.
|
|
|
86 RESET is a boolean which, if non-nil, says to go back to the beginning
|
|
|
87 of the errors before moving.
|
|
|
88 Major modes providing compile-like functionality should set this variable
|
|
|
89 to indicate to `next-error' that this is a candidate buffer and how
|
|
|
90 to navigate in it.")
|
|
|
91
|
|
|
92 (make-variable-buffer-local 'next-error-function)
|
|
|
93
|
|
|
94 (defsubst next-error-buffer-p (buffer
|
|
|
95 &optional avoid-current
|
|
|
96 extra-test-inclusive
|
|
|
97 extra-test-exclusive)
|
|
|
98 "Test if BUFFER is a `next-error' capable buffer.
|
|
|
99
|
|
|
100 If AVOID-CURRENT is non-nil, treat the current buffer
|
|
|
101 as an absolute last resort only.
|
|
|
102
|
|
|
103 The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
|
|
|
104 that normally would not qualify. If it returns t, the buffer
|
|
|
105 in question is treated as usable.
|
|
|
106
|
|
|
107 The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer
|
|
|
108 that would normally be considered usable. If it returns nil,
|
|
|
109 that buffer is rejected."
|
|
|
110 (and (buffer-name buffer) ;First make sure it's live.
|
|
|
111 (not (and avoid-current (eq buffer (current-buffer))))
|
|
|
112 (with-current-buffer buffer
|
|
|
113 (if next-error-function ; This is the normal test.
|
|
|
114 ;; Optionally reject some buffers.
|
|
|
115 (if extra-test-exclusive
|
|
|
116 (funcall extra-test-exclusive)
|
|
|
117 t)
|
|
|
118 ;; Optionally accept some other buffers.
|
|
|
119 (and extra-test-inclusive
|
|
|
120 (funcall extra-test-inclusive))))))
|
|
|
121
|
|
|
122 (defun next-error-find-buffer (&optional avoid-current
|
|
|
123 extra-test-inclusive
|
|
|
124 extra-test-exclusive)
|
|
|
125 "Return a `next-error' capable buffer.
|
|
|
126 If AVOID-CURRENT is non-nil, treat the current buffer
|
|
|
127 as an absolute last resort only.
|
|
|
128
|
|
|
129 The function EXTRA-TEST-INCLUSIVE, if non-nil, is called in each buffer
|
|
|
130 that normally would not qualify. If it returns t, the buffer
|
|
|
131 in question is treated as usable.
|
|
|
132
|
|
|
133 The function EXTRA-TEST-EXCLUSIVE, if non-nil is called in each buffer
|
|
|
134 that would normally be considered usable. If it returns nil,
|
|
|
135 that buffer is rejected."
|
|
|
136 (or
|
|
|
137 ;; 1. If one window on the selected frame displays such buffer, return it.
|
|
|
138 (let ((window-buffers
|
|
|
139 (delete-dups
|
|
|
140 (delq nil (mapcar (lambda (w)
|
|
|
141 (if (next-error-buffer-p
|
|
|
142 (window-buffer w)
|
|
|
143 avoid-current
|
|
|
144 extra-test-inclusive extra-test-exclusive)
|
|
|
145 (window-buffer w)))
|
|
|
146 (window-list))))))
|
|
|
147 (if (eq (length window-buffers) 1)
|
|
|
148 (car window-buffers)))
|
|
|
149 ;; 2. If next-error-last-buffer is an acceptable buffer, use that.
|
|
|
150 (if (and next-error-last-buffer
|
|
|
151 (next-error-buffer-p next-error-last-buffer avoid-current
|
|
|
152 extra-test-inclusive extra-test-exclusive))
|
|
|
153 next-error-last-buffer)
|
|
|
154 ;; 3. If the current buffer is acceptable, choose it.
|
|
|
155 (if (next-error-buffer-p (current-buffer) avoid-current
|
|
|
156 extra-test-inclusive extra-test-exclusive)
|
|
|
157 (current-buffer))
|
|
|
158 ;; 4. Look for any acceptable buffer.
|
|
|
159 (let ((buffers (buffer-list)))
|
|
|
160 (while (and buffers
|
|
|
161 (not (next-error-buffer-p
|
|
|
162 (car buffers) avoid-current
|
|
|
163 extra-test-inclusive extra-test-exclusive)))
|
|
|
164 (setq buffers (cdr buffers)))
|
|
|
165 (car buffers))
|
|
|
166 ;; 5. Use the current buffer as a last resort if it qualifies,
|
|
|
167 ;; even despite AVOID-CURRENT.
|
|
|
168 (and avoid-current
|
|
|
169 (next-error-buffer-p (current-buffer) nil
|
|
|
170 extra-test-inclusive extra-test-exclusive)
|
|
|
171 (progn
|
|
|
172 (message "This is the only next-error capable buffer")
|
|
|
173 (current-buffer)))
|
|
|
174 ;; 6. Give up.
|
|
|
175 (error "No next-error capable buffer found")))
|
|
|
176
|
|
|
177 ;;;###autoload
|
|
|
178 (defun next-error (&optional arg reset)
|
|
|
179 "Visit next `next-error' message and corresponding source code.
|
|
|
180
|
|
|
181 If all the error messages parsed so far have been processed already,
|
|
|
182 the message buffer is checked for new ones.
|
|
|
183
|
|
|
184 A prefix ARG specifies how many error messages to move;
|
|
|
185 negative means move back to previous error messages.
|
|
|
186 Just \\[universal-argument] as a prefix means reparse the error message buffer
|
|
|
187 and start at the first error.
|
|
|
188
|
|
|
189 The RESET argument specifies that we should restart from the beginning.
|
|
|
190
|
|
|
191 \\[next-error] normally uses the most recently started
|
|
|
192 compilation, grep, or occur buffer. It can also operate on any
|
|
|
193 buffer with output from the \\[compile], \\[grep] commands, or,
|
|
|
194 more generally, on any buffer in Compilation mode or with
|
|
|
195 Compilation Minor mode enabled, or any buffer in which
|
|
|
196 `next-error-function' is bound to an appropriate function.
|
|
|
197 To specify use of a particular buffer for error messages, type
|
|
|
198 \\[next-error] in that buffer when it is the only one displayed
|
|
|
199 in the current frame.
|
|
|
200
|
|
|
201 Once \\[next-error] has chosen the buffer for error messages, it
|
|
|
202 runs `next-error-hook' with `run-hooks', and stays with that buffer
|
|
|
203 until you use it in some other buffer which uses Compilation mode
|
|
|
204 or Compilation Minor mode.
|
|
|
205
|
|
|
206 See variables `compilation-parse-errors-function' and
|
|
|
207 \`compilation-error-regexp-alist' for customization ideas."
|
|
|
208 (interactive "P")
|
|
|
209 (if (consp arg) (setq reset t arg nil))
|
|
|
210 (when (setq next-error-last-buffer (next-error-find-buffer))
|
|
|
211 ;; we know here that next-error-function is a valid symbol we can funcall
|
|
|
212 (with-current-buffer next-error-last-buffer
|
|
|
213 (funcall next-error-function (prefix-numeric-value arg) reset)
|
|
|
214 (run-hooks 'next-error-hook))))
|
|
|
215
|
|
|
216 (defalias 'goto-next-locus 'next-error)
|
|
|
217 (defalias 'next-match 'next-error)
|
|
|
218
|
|
|
219 (defun previous-error (&optional n)
|
|
|
220 "Visit previous `next-error' message and corresponding source code.
|
|
|
221
|
|
|
222 Prefix arg N says how many error messages to move backwards (or
|
|
|
223 forwards, if negative).
|
|
|
224
|
|
|
225 This operates on the output from the \\[compile] and \\[grep] commands."
|
|
|
226 (interactive "p")
|
|
|
227 (next-error (- (or n 1))))
|
|
|
228
|
|
|
229 (defun first-error (&optional n)
|
|
|
230 "Restart at the first error.
|
|
|
231 Visit corresponding source code.
|
|
|
232 With prefix arg N, visit the source code of the Nth error.
|
|
|
233 This operates on the output from the \\[compile] command, for instance."
|
|
|
234 (interactive "p")
|
|
|
235 (next-error n t))
|
|
|
236
|
|
|
237 (defun next-error-no-select (&optional n)
|
|
|
238 "Move point to the next error in the `next-error' buffer and highlight match.
|
|
|
239 Prefix arg N says how many error messages to move forwards (or
|
|
|
240 backwards, if negative).
|
|
|
241 Finds and highlights the source line like \\[next-error], but does not
|
|
|
242 select the source buffer."
|
|
|
243 (interactive "p")
|
|
|
244 (let ((next-error-highlight next-error-highlight-no-select))
|
|
|
245 (next-error n))
|
|
|
246 (pop-to-buffer next-error-last-buffer))
|
|
|
247
|
|
|
248 (defun previous-error-no-select (&optional n)
|
|
|
249 "Move point to the previous error in the `next-error' buffer and highlight match.
|
|
|
250 Prefix arg N says how many error messages to move backwards (or
|
|
|
251 forwards, if negative).
|
|
|
252 Finds and highlights the source line like \\[previous-error], but does not
|
|
|
253 select the source buffer."
|
|
|
254 (interactive "p")
|
|
|
255 (next-error-no-select (- (or n 1))))
|
|
|
256
|
|
|
257 ;;; Internal variable for `next-error-follow-mode-post-command-hook'.
|
|
|
258 (defvar next-error-follow-last-line nil)
|
|
|
259
|
|
|
260 (define-minor-mode next-error-follow-minor-mode
|
|
|
261 "Minor mode for compilation, occur and diff modes.
|
|
|
262 When turned on, cursor motion in the compilation, grep, occur or diff
|
|
|
263 buffer causes automatic display of the corresponding source code
|
|
|
264 location."
|
|
|
265 :group 'next-error :init-value nil :lighter " Fol"
|
|
|
266 (if (not next-error-follow-minor-mode)
|
|
|
267 (remove-hook 'post-command-hook 'next-error-follow-mode-post-command-hook t)
|
|
|
268 (add-hook 'post-command-hook 'next-error-follow-mode-post-command-hook nil t)
|
|
|
269 (make-local-variable 'next-error-follow-last-line)))
|
|
|
270
|
|
|
271 ;;; Used as a `post-command-hook' by `next-error-follow-mode'
|
|
|
272 ;;; for the *Compilation* *grep* and *Occur* buffers.
|
|
3017
|
273 (defvar compilation-current-error)
|
|
|
274 (defvar compilation-context-lines)
|
|
3000
|
275 (defun next-error-follow-mode-post-command-hook ()
|
|
|
276 (unless (equal next-error-follow-last-line (line-number-at-pos))
|
|
|
277 (setq next-error-follow-last-line (line-number-at-pos))
|
|
|
278 (condition-case nil
|
|
|
279 (let ((compilation-context-lines nil))
|
|
|
280 (setq compilation-current-error (point))
|
|
|
281 (next-error-no-select 0))
|
|
|
282 (error t))))
|
|
|
283
|
|
|
284 (provide 'next-error)
|
