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