*** empty log message ***
[emacs.git] / lisp / warnings.el
blob4d0354236a806bc71000aaa43877259c8aef7a90
1 ;;; warnings.el --- log and display warnings
3 ;; Copyright (C) 2002 Free Software Foundation, Inc.
5 ;; Maintainer: FSF
6 ;; Keywords: internal
8 ;; This file is part of GNU Emacs.
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.
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.
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.
25 ;;; Commentary:
27 ;; This file implements the entry points `warn', `lwarn'
28 ;; and `display-warnings'.
30 ;;; Code:
32 (defgroup warnings nil
33 "Log and display warnings."
34 :version "21.4"
35 :group 'lisp)
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
46 specify where to put the warning group information,
47 or it can omit the `%s' so as not to include that information.
49 The optional FUNCTION, if non-nil, is a function to call
50 with no arguments, to get the user's attention.
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)
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.")
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)
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)
92 (defcustom warning-suppress-log-types nil
93 "List of warning types that should not be logged.
94 If any element of this list matches the GROUP argument to `display-warning',
95 the warning is completely ignored.
96 The element must match the first elements of GROUP.
97 Thus, (foo bar) as an element matches (foo bar)
98 or (foo bar ANYTHING...) as GROUP.
99 If GROUP is a symbol FOO, that is equivalent to the list (FOO),
100 so only the element (FOO) will match it."
101 :group 'warnings
102 :type '(repeat (repeat symbol))
103 :version "21.4")
105 (defcustom warning-suppress-types nil
106 "Custom groups for warnings not to display immediately.
107 If any element of this list matches the GROUP argument to `display-warning',
108 the warning is logged nonetheless, but the warnings buffer is
109 not immediately displayed.
110 The element must match an initial segment of the list GROUP.
111 Thus, (foo bar) as an element matches (foo bar)
112 or (foo bar ANYTHING...) as GROUP.
113 If GROUP is a symbol FOO, that is equivalent to the list (FOO),
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")
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.")
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)
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'.")
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
158 (defvar warning-group-format " (%s)"
159 "Format for displaying the warning group in the warning message.
160 The result of formatting the group this way gets included in the
161 message under the control of the string in `warning-levels'.")
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)))
169 (defun warning-suppress-p (group suppress-list)
170 "Non-nil if a warning with group GROUP should be suppressed.
171 SUPPRESS-LIST is the list of kinds of warnings to suppress."
172 (let (some-match)
173 (dolist (elt suppress-list)
174 (if (symbolp group)
175 ;; If GROUP is a symbol, the ELT must be (GROUP).
176 (if (and (consp elt)
177 (eq (car elt) group)
178 (null (cdr elt)))
179 (setq some-match t))
180 ;; If GROUP is a list, ELT must match it or some initial segment of it.
181 (let ((tem1 group)
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)))
190 ;; If ELT is an initial segment of GROUP, MATCH is t now.
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))
198 ;;;###autoload
199 (defun display-warning (group message &optional level buffer-name)
200 "Display a warning message, MESSAGE.
201 GROUP should be a custom group name (a symbol),
202 or else a list of symbols whose first element is a custom group name.
203 \(The rest of the symbols represent subcategories, for warning purposes
204 only, and you can use whatever symbols you like.)
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.
214 BUFFER-NAME, if specified, is the name of the buffer for logging the
215 warning. By default, it is `*Warnings*'.
217 See the `warnings' custom group for user customization features.
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))
227 (warning-suppress-p group warning-suppress-log-types)
228 (let* ((groupname (if (consp group) (car group) group))
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)
246 (format warning-group-format groupname))
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))
276 (warning-suppress-p group warning-suppress-types)
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)))))))
283 ;;;###autoload
284 (defun lwarn (group level message &rest args)
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'.
289 GROUP should be a custom group name (a symbol).
290 or else a list of symbols whose first element is a custom group name.
291 \(The rest of the symbols represent subcategories and
292 can be whatever you like.)
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."
299 (display-warning group (apply 'format message args) level))
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
306 `emacs' as the group and `:warning' as the level."
307 (display-warning 'emacs (apply 'format message args)))
309 (provide 'warnings)
311 ;;; warnings.el ends here