Mercurial > emacs
annotate lisp/emacs-lisp/warnings.el @ 59792:ff0bef9e820a
*** empty log message ***
author | Luc Teirlinck <teirllm@auburn.edu> |
---|---|
date | Sun, 30 Jan 2005 00:43:04 +0000 |
parents | 34a469490568 |
children | aac0a33f5772 |
rev | line source |
---|---|
51349 | 1 ;;; warnings.el --- log and display warnings |
2 | |
3 ;; Copyright (C) 2002 Free Software Foundation, Inc. | |
4 | |
5 ;; Maintainer: FSF | |
6 ;; Keywords: internal | |
7 | |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 ;; Boston, MA 02111-1307, USA. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;; This file implements the entry points `warn', `lwarn' | |
54486 | 28 ;; and `display-warning'. |
51349 | 29 |
30 ;;; Code: | |
31 | |
32 (defgroup warnings nil | |
33 "Log and display warnings." | |
34 :version "21.4" | |
35 :group 'lisp) | |
36 | |
37 (defvar warning-levels | |
38 '((:emergency "Emergency%s: " ding) | |
39 (:error "Error%s: ") | |
40 (:warning "Warning%s: ") | |
41 (:debug "Debug%s: ")) | |
42 "List of severity level definitions for `display-warning'. | |
43 Each element looks like (LEVEL STRING FUNCTION) and | |
44 defines LEVEL as a severity level. STRING specifies the | |
45 description of this level. STRING should use `%s' to | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
46 specify where to put the warning type information, |
51349 | 47 or it can omit the `%s' so as not to include that information. |
48 | |
49 The optional FUNCTION, if non-nil, is a function to call | |
50 with no arguments, to get the user's attention. | |
51 | |
52 The standard levels are :emergency, :error, :warning and :debug. | |
53 See `display-warning' for documentation of their meanings. | |
54 Level :debug is ignored by default (see `warning-minimum-level').") | |
55 (put 'warning-levels 'risky-local-variable t) | |
56 | |
57 ;; These are for compatibility with XEmacs. | |
58 ;; I don't think there is any chance of designing meaningful criteria | |
59 ;; to distinguish so many levels. | |
60 (defvar warning-level-aliases | |
61 '((emergency . :emergency) | |
62 (error . :error) | |
63 (warning . :warning) | |
64 (notice . :warning) | |
65 (info . :warning) | |
66 (critical . :emergency) | |
67 (alarm . :emergency)) | |
68 "Alist of aliases for severity levels for `display-warning'. | |
69 Each element looks like (ALIAS . LEVEL) and defines | |
70 ALIAS as equivalent to LEVEL. LEVEL must be defined in `warning-levels'; | |
71 it may not itself be an alias.") | |
72 | |
73 (defcustom warning-minimum-level :warning | |
74 "Minimum severity level for displaying the warning buffer. | |
75 If a warning's severity level is lower than this, | |
76 the warning is logged in the warnings buffer, but the buffer | |
77 is not immediately displayed. See also `warning-minimum-log-level'." | |
78 :group 'warnings | |
79 :type '(choice (const :emergency) (const :error) (const :warning)) | |
80 :version "21.4") | |
81 (defvaralias 'display-warning-minimum-level 'warning-minimum-level) | |
82 | |
83 (defcustom warning-minimum-log-level :warning | |
84 "Minimum severity level for logging a warning. | |
85 If a warning severity level is lower than this, | |
86 the warning is completely ignored." | |
87 :group 'warnings | |
88 :type '(choice (const :emergency) (const :error) (const :warning)) | |
89 :version "21.4") | |
90 (defvaralias 'log-warning-minimum-level 'warning-minimum-log-level) | |
91 | |
92 (defcustom warning-suppress-log-types nil | |
93 "List of warning types that should not be logged. | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
94 If any element of this list matches the TYPE argument to `display-warning', |
51349 | 95 the warning is completely ignored. |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
96 The element must match the first elements of TYPE. |
51349 | 97 Thus, (foo bar) as an element matches (foo bar) |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
98 or (foo bar ANYTHING...) as TYPE. |
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
99 If TYPE is a symbol FOO, that is equivalent to the list (FOO), |
51349 | 100 so only the element (FOO) will match it." |
101 :group 'warnings | |
102 :type '(repeat (repeat symbol)) | |
103 :version "21.4") | |
104 | |
105 (defcustom warning-suppress-types nil | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
106 "List of warning types not to display immediately. |
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
107 If any element of this list matches the TYPE argument to `display-warning', |
51349 | 108 the warning is logged nonetheless, but the warnings buffer is |
109 not immediately displayed. | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
110 The element must match an initial segment of the list TYPE. |
51349 | 111 Thus, (foo bar) as an element matches (foo bar) |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
112 or (foo bar ANYTHING...) as TYPE. |
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
113 If TYPE is a symbol FOO, that is equivalent to the list (FOO), |
51349 | 114 so only the element (FOO) will match it. |
115 See also `warning-suppress-log-types'." | |
116 :group 'warnings | |
117 :type '(repeat (repeat symbol)) | |
118 :version "21.4") | |
119 | |
120 ;;; The autoload cookie is so that programs can bind this variable | |
121 ;;; safely, testing the existing value, before they call one of the | |
122 ;;; warnings functions. | |
123 ;;;###autoload | |
124 (defvar warning-prefix-function nil | |
125 "Function to generate warning prefixes. | |
126 This function, if non-nil, is called with two arguments, | |
127 the severity level and its entry in `warning-levels', | |
128 and should return the entry that should actually be used. | |
129 The warnings buffer is current when this function is called | |
130 and the function can insert text in it. This text becomes | |
131 the beginning of the warning.") | |
132 | |
133 ;;; The autoload cookie is so that programs can bind this variable | |
134 ;;; safely, testing the existing value, before they call one of the | |
135 ;;; warnings functions. | |
136 ;;;###autoload | |
137 (defvar warning-series nil | |
138 "Non-nil means treat multiple `display-warning' calls as a series. | |
139 A marker indicates a position in the warnings buffer | |
140 which is the start of the current series; it means that | |
141 additional warnings in the same buffer should not move point. | |
142 t means the next warning begins a series (and stores a marker here). | |
143 A symbol with a function definition is like t, except | |
144 also call that function before the next warning.") | |
145 (put 'warning-series 'risky-local-variable t) | |
146 | |
147 ;;; The autoload cookie is so that programs can bind this variable | |
148 ;;; safely, testing the existing value, before they call one of the | |
149 ;;; warnings functions. | |
150 ;;;###autoload | |
151 (defvar warning-fill-prefix nil | |
152 "Non-nil means fill each warning text using this string as `fill-prefix'.") | |
153 | |
154 ;;; The autoload cookie is so that programs can bind this variable | |
155 ;;; safely, testing the existing value, before they call one of the | |
156 ;;; warnings functions. | |
157 ;;;###autoload | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
158 (defvar warning-type-format " (%s)" |
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
159 "Format for displaying the warning type in the warning message. |
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
160 The result of formatting the type this way gets included in the |
51349 | 161 message under the control of the string in `warning-levels'.") |
162 | |
163 (defun warning-numeric-level (level) | |
164 "Return a numeric measure of the warning severity level LEVEL." | |
165 (let* ((elt (assq level warning-levels)) | |
166 (link (memq elt warning-levels))) | |
167 (length link))) | |
168 | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
169 (defun warning-suppress-p (type suppress-list) |
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
170 "Non-nil if a warning with type TYPE should be suppressed. |
51349 | 171 SUPPRESS-LIST is the list of kinds of warnings to suppress." |
172 (let (some-match) | |
173 (dolist (elt suppress-list) | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
174 (if (symbolp type) |
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
175 ;; If TYPE is a symbol, the ELT must be (TYPE). |
51349 | 176 (if (and (consp elt) |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
177 (eq (car elt) type) |
51349 | 178 (null (cdr elt))) |
179 (setq some-match t)) | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
180 ;; If TYPE is a list, ELT must match it or some initial segment of it. |
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
181 (let ((tem1 type) |
51349 | 182 (tem2 elt) |
183 (match t)) | |
184 ;; Check elements of ELT until we run out of them. | |
185 (while tem2 | |
186 (if (not (equal (car tem1) (car tem2))) | |
187 (setq match nil)) | |
188 (setq tem1 (cdr tem1) | |
189 tem2 (cdr tem2))) | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
190 ;; If ELT is an initial segment of TYPE, MATCH is t now. |
51349 | 191 ;; So set SOME-MATCH. |
192 (if match | |
193 (setq some-match t))))) | |
194 ;; If some element of SUPPRESS-LIST matched, | |
195 ;; we return t. | |
196 some-match)) | |
197 | |
198 ;;;###autoload | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
199 (defun display-warning (type message &optional level buffer-name) |
51349 | 200 "Display a warning message, MESSAGE. |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
201 TYPE is the warning type: either a custom group name (a symbol), |
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
202 or a list of symbols whose first element is a custom group name. |
51349 | 203 \(The rest of the symbols represent subcategories, for warning purposes |
204 only, and you can use whatever symbols you like.) | |
205 | |
206 LEVEL should be either :warning, :error, or :emergency. | |
207 :emergency -- a problem that will seriously impair Emacs operation soon | |
208 if you do not attend to it promptly. | |
209 :error -- data or circumstances that are inherently wrong. | |
210 :warning -- data or circumstances that are not inherently wrong, | |
211 but raise suspicion of a possible problem. | |
212 :debug -- info for debugging only. | |
213 | |
214 BUFFER-NAME, if specified, is the name of the buffer for logging the | |
215 warning. By default, it is `*Warnings*'. | |
216 | |
217 See the `warnings' custom group for user customization features. | |
218 | |
219 See also `warning-series', `warning-prefix-function' and | |
220 `warning-fill-prefix' for additional programming features." | |
221 (unless level | |
222 (setq level :warning)) | |
223 (if (assq level warning-level-aliases) | |
224 (setq level (cdr (assq level warning-level-aliases)))) | |
225 (or (< (warning-numeric-level level) | |
226 (warning-numeric-level warning-minimum-log-level)) | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
227 (warning-suppress-p type warning-suppress-log-types) |
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
228 (let* ((typename (if (consp type) (car type) type)) |
51349 | 229 (buffer (get-buffer-create (or buffer-name "*Warnings*"))) |
230 (level-info (assq level warning-levels)) | |
231 start end) | |
232 (with-current-buffer buffer | |
233 (goto-char (point-max)) | |
234 (when (and warning-series (symbolp warning-series)) | |
235 (setq warning-series | |
236 (prog1 (point-marker) | |
237 (unless (eq warning-series t) | |
238 (funcall warning-series))))) | |
239 (unless (bolp) | |
240 (newline)) | |
241 (setq start (point)) | |
242 (if warning-prefix-function | |
243 (setq level-info (funcall warning-prefix-function | |
244 level level-info))) | |
245 (insert (format (nth 1 level-info) | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
246 (format warning-type-format typename)) |
51349 | 247 message) |
248 (newline) | |
249 (when (and warning-fill-prefix (not (string-match "\n" message))) | |
250 (let ((fill-prefix warning-fill-prefix) | |
251 (fill-column 78)) | |
252 (fill-region start (point)))) | |
253 (setq end (point)) | |
254 (when (and (markerp warning-series) | |
255 (eq (marker-buffer warning-series) buffer)) | |
256 (goto-char warning-series))) | |
257 (if (nth 2 level-info) | |
258 (funcall (nth 2 level-info))) | |
259 (if noninteractive | |
260 ;; Noninteractively, take the text we inserted | |
261 ;; in the warnings buffer and print it. | |
262 ;; Do this unconditionally, since there is no way | |
263 ;; to view logged messages unless we output them. | |
264 (with-current-buffer buffer | |
265 (save-excursion | |
266 ;; Don't include the final newline in the arg | |
267 ;; to `message', because it adds a newline. | |
268 (goto-char end) | |
269 (if (bolp) | |
270 (forward-char -1)) | |
271 (message "%s" (buffer-substring start (point))))) | |
272 ;; Interactively, decide whether the warning merits | |
273 ;; immediate display. | |
274 (or (< (warning-numeric-level level) | |
275 (warning-numeric-level warning-minimum-level)) | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
276 (warning-suppress-p type warning-suppress-types) |
51349 | 277 (let ((window (display-buffer buffer))) |
278 (when (and (markerp warning-series) | |
279 (eq (marker-buffer warning-series) buffer)) | |
280 (set-window-start window warning-series)) | |
281 (sit-for 0))))))) | |
282 | |
283 ;;;###autoload | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
284 (defun lwarn (type level message &rest args) |
51349 | 285 "Display a warning message made from (format MESSAGE ARGS...). |
286 Aside from generating the message with `format', | |
287 this is equivalent to `display-warning'. | |
288 | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
289 TYPE is the warning type: either a custom group name (a symbol). |
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
290 or a list of symbols whose first element is a custom group name. |
51349 | 291 \(The rest of the symbols represent subcategories and |
292 can be whatever you like.) | |
293 | |
294 LEVEL should be either :warning, :error, or :emergency. | |
295 :emergency -- a problem that will seriously impair Emacs operation soon | |
296 if you do not attend to it promptly. | |
297 :error -- invalid data or circumstances. | |
298 :warning -- suspicious data or circumstances." | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
299 (display-warning type (apply 'format message args) level)) |
51349 | 300 |
301 ;;;###autoload | |
302 (defun warn (message &rest args) | |
303 "Display a warning message made from (format MESSAGE ARGS...). | |
304 Aside from generating the message with `format', | |
305 this is equivalent to `display-warning', using | |
52134
d26709514a27
Doc fixes, args renamed.
Richard M. Stallman <rms@gnu.org>
parents:
51349
diff
changeset
|
306 `emacs' as the type and `:warning' as the level." |
51349 | 307 (display-warning 'emacs (apply 'format message args))) |
308 | |
309 (provide 'warnings) | |
310 | |
52401 | 311 ;;; arch-tag: faaad1c8-7b2a-4161-af38-5ab4afde0496 |
51349 | 312 ;;; warnings.el ends here |