Mercurial > hg > xemacs-beta

comparison lisp/next-error.el @ 3000:5df5ea55d3fc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-10-18 20:49:41 by malcolmp] Sync of occur mode with GNU Emacs 22.0.50.1 (CVS)
author malcolmp
date Tue, 18 Oct 2005 20:49:43 +0000
parents
children 1e7cc382eb16
comparison
equal deleted inserted replaced
2999:77dd8b943765 3000:5df5ea55d3fc
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.
273 (defun next-error-follow-mode-post-command-hook ()
274 (unless (equal next-error-follow-last-line (line-number-at-pos))
275 (setq next-error-follow-last-line (line-number-at-pos))
276 (condition-case nil
277 (let ((compilation-context-lines nil))
278 (setq compilation-current-error (point))
279 (next-error-no-select 0))
280 (error t))))
281
282 (provide 'next-error)