Commit | Line | Data |
---|---|---|
5e046f6d JB |
1 | ;;; warnings.el --- log and display warnings |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2002-2014 Free Software Foundation, Inc. |
5e046f6d | 4 | |
34dc21db | 5 | ;; Maintainer: emacs-devel@gnu.org |
5e046f6d JB |
6 | ;; Keywords: internal |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
d6cba7ae | 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
5e046f6d | 11 | ;; it under the terms of the GNU General Public License as published by |
d6cba7ae GM |
12 | ;; the Free Software Foundation, either version 3 of the License, or |
13 | ;; (at your option) any later version. | |
5e046f6d JB |
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 | |
d6cba7ae | 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
5e046f6d JB |
22 | |
23 | ;;; Commentary: | |
24 | ||
25 | ;; This file implements the entry points `warn', `lwarn' | |
b49c969b | 26 | ;; and `display-warning'. |
5e046f6d JB |
27 | |
28 | ;;; Code: | |
29 | ||
30 | (defgroup warnings nil | |
31 | "Log and display warnings." | |
bf247b6e | 32 | :version "22.1" |
5e046f6d JB |
33 | :group 'lisp) |
34 | ||
35 | (defvar warning-levels | |
36 | '((:emergency "Emergency%s: " ding) | |
37 | (:error "Error%s: ") | |
38 | (:warning "Warning%s: ") | |
39 | (:debug "Debug%s: ")) | |
40 | "List of severity level definitions for `display-warning'. | |
41 | Each element looks like (LEVEL STRING FUNCTION) and | |
42 | defines LEVEL as a severity level. STRING specifies the | |
43 | description of this level. STRING should use `%s' to | |
10b6c932 | 44 | specify where to put the warning type information, |
5e046f6d JB |
45 | or it can omit the `%s' so as not to include that information. |
46 | ||
47 | The optional FUNCTION, if non-nil, is a function to call | |
48 | with no arguments, to get the user's attention. | |
49 | ||
50 | The standard levels are :emergency, :error, :warning and :debug. | |
51 | See `display-warning' for documentation of their meanings. | |
52 | Level :debug is ignored by default (see `warning-minimum-level').") | |
53 | (put 'warning-levels 'risky-local-variable t) | |
54 | ||
55 | ;; These are for compatibility with XEmacs. | |
56 | ;; I don't think there is any chance of designing meaningful criteria | |
57 | ;; to distinguish so many levels. | |
58 | (defvar warning-level-aliases | |
59 | '((emergency . :emergency) | |
60 | (error . :error) | |
61 | (warning . :warning) | |
62 | (notice . :warning) | |
63 | (info . :warning) | |
64 | (critical . :emergency) | |
65 | (alarm . :emergency)) | |
66 | "Alist of aliases for severity levels for `display-warning'. | |
455c834e JB |
67 | Each element looks like (ALIAS . LEVEL) and defines ALIAS as |
68 | equivalent to LEVEL. LEVEL must be defined in `warning-levels'; | |
5e046f6d JB |
69 | it may not itself be an alias.") |
70 | \f | |
71 | (defcustom warning-minimum-level :warning | |
72 | "Minimum severity level for displaying the warning buffer. | |
73 | If a warning's severity level is lower than this, | |
74 | the warning is logged in the warnings buffer, but the buffer | |
75 | is not immediately displayed. See also `warning-minimum-log-level'." | |
76 | :group 'warnings | |
53099cfc JB |
77 | :type '(choice (const :emergency) (const :error) |
78 | (const :warning) (const :debug)) | |
bf247b6e | 79 | :version "22.1") |
5e046f6d JB |
80 | (defvaralias 'display-warning-minimum-level 'warning-minimum-level) |
81 | ||
82 | (defcustom warning-minimum-log-level :warning | |
83 | "Minimum severity level for logging a warning. | |
84 | If a warning severity level is lower than this, | |
53099cfc JB |
85 | the warning is completely ignored. |
86 | Value must be lower or equal than `warning-minimum-level', | |
87 | because warnings not logged aren't displayed either." | |
5e046f6d | 88 | :group 'warnings |
53099cfc JB |
89 | :type '(choice (const :emergency) (const :error) |
90 | (const :warning) (const :debug)) | |
bf247b6e | 91 | :version "22.1") |
5e046f6d JB |
92 | (defvaralias 'log-warning-minimum-level 'warning-minimum-log-level) |
93 | ||
94 | (defcustom warning-suppress-log-types nil | |
95 | "List of warning types that should not be logged. | |
10b6c932 | 96 | If any element of this list matches the TYPE argument to `display-warning', |
5e046f6d | 97 | the warning is completely ignored. |
10b6c932 | 98 | The element must match the first elements of TYPE. |
5e046f6d | 99 | Thus, (foo bar) as an element matches (foo bar) |
10b6c932 RS |
100 | or (foo bar ANYTHING...) as TYPE. |
101 | If TYPE is a symbol FOO, that is equivalent to the list (FOO), | |
5e046f6d JB |
102 | so only the element (FOO) will match it." |
103 | :group 'warnings | |
104 | :type '(repeat (repeat symbol)) | |
bf247b6e | 105 | :version "22.1") |
5e046f6d JB |
106 | |
107 | (defcustom warning-suppress-types nil | |
10b6c932 RS |
108 | "List of warning types not to display immediately. |
109 | If any element of this list matches the TYPE argument to `display-warning', | |
5e046f6d JB |
110 | the warning is logged nonetheless, but the warnings buffer is |
111 | not immediately displayed. | |
10b6c932 | 112 | The element must match an initial segment of the list TYPE. |
5e046f6d | 113 | Thus, (foo bar) as an element matches (foo bar) |
10b6c932 RS |
114 | or (foo bar ANYTHING...) as TYPE. |
115 | If TYPE is a symbol FOO, that is equivalent to the list (FOO), | |
5e046f6d JB |
116 | so only the element (FOO) will match it. |
117 | See also `warning-suppress-log-types'." | |
118 | :group 'warnings | |
119 | :type '(repeat (repeat symbol)) | |
bf247b6e | 120 | :version "22.1") |
5e046f6d | 121 | \f |
cec01cd2 SM |
122 | ;; The autoload cookie is so that programs can bind this variable |
123 | ;; safely, testing the existing value, before they call one of the | |
124 | ;; warnings functions. | |
5e046f6d JB |
125 | ;;;###autoload |
126 | (defvar warning-prefix-function nil | |
127 | "Function to generate warning prefixes. | |
128 | This function, if non-nil, is called with two arguments, | |
129 | the severity level and its entry in `warning-levels', | |
130 | and should return the entry that should actually be used. | |
131 | The warnings buffer is current when this function is called | |
132 | and the function can insert text in it. This text becomes | |
133 | the beginning of the warning.") | |
134 | ||
cec01cd2 SM |
135 | ;; The autoload cookie is so that programs can bind this variable |
136 | ;; safely, testing the existing value, before they call one of the | |
137 | ;; warnings functions. | |
5e046f6d JB |
138 | ;;;###autoload |
139 | (defvar warning-series nil | |
140 | "Non-nil means treat multiple `display-warning' calls as a series. | |
141 | A marker indicates a position in the warnings buffer | |
142 | which is the start of the current series; it means that | |
143 | additional warnings in the same buffer should not move point. | |
455c834e | 144 | If t, the next warning begins a series (and stores a marker here). |
5e046f6d JB |
145 | A symbol with a function definition is like t, except |
146 | also call that function before the next warning.") | |
147 | (put 'warning-series 'risky-local-variable t) | |
148 | ||
cec01cd2 SM |
149 | ;; The autoload cookie is so that programs can bind this variable |
150 | ;; safely, testing the existing value, before they call one of the | |
151 | ;; warnings functions. | |
5e046f6d JB |
152 | ;;;###autoload |
153 | (defvar warning-fill-prefix nil | |
154 | "Non-nil means fill each warning text using this string as `fill-prefix'.") | |
155 | ||
cec01cd2 SM |
156 | ;; The autoload cookie is so that programs can bind this variable |
157 | ;; safely, testing the existing value, before they call one of the | |
158 | ;; warnings functions. | |
5e046f6d | 159 | ;;;###autoload |
1e8780b1 | 160 | (defvar warning-type-format (purecopy " (%s)") |
10b6c932 RS |
161 | "Format for displaying the warning type in the warning message. |
162 | The result of formatting the type this way gets included in the | |
5e046f6d JB |
163 | message under the control of the string in `warning-levels'.") |
164 | \f | |
165 | (defun warning-numeric-level (level) | |
166 | "Return a numeric measure of the warning severity level LEVEL." | |
167 | (let* ((elt (assq level warning-levels)) | |
168 | (link (memq elt warning-levels))) | |
169 | (length link))) | |
170 | ||
10b6c932 RS |
171 | (defun warning-suppress-p (type suppress-list) |
172 | "Non-nil if a warning with type TYPE should be suppressed. | |
5e046f6d JB |
173 | SUPPRESS-LIST is the list of kinds of warnings to suppress." |
174 | (let (some-match) | |
175 | (dolist (elt suppress-list) | |
10b6c932 RS |
176 | (if (symbolp type) |
177 | ;; If TYPE is a symbol, the ELT must be (TYPE). | |
5e046f6d | 178 | (if (and (consp elt) |
10b6c932 | 179 | (eq (car elt) type) |
5e046f6d JB |
180 | (null (cdr elt))) |
181 | (setq some-match t)) | |
10b6c932 RS |
182 | ;; If TYPE is a list, ELT must match it or some initial segment of it. |
183 | (let ((tem1 type) | |
5e046f6d JB |
184 | (tem2 elt) |
185 | (match t)) | |
186 | ;; Check elements of ELT until we run out of them. | |
187 | (while tem2 | |
188 | (if (not (equal (car tem1) (car tem2))) | |
189 | (setq match nil)) | |
190 | (setq tem1 (cdr tem1) | |
191 | tem2 (cdr tem2))) | |
10b6c932 | 192 | ;; If ELT is an initial segment of TYPE, MATCH is t now. |
5e046f6d JB |
193 | ;; So set SOME-MATCH. |
194 | (if match | |
195 | (setq some-match t))))) | |
196 | ;; If some element of SUPPRESS-LIST matched, | |
197 | ;; we return t. | |
198 | some-match)) | |
199 | \f | |
200 | ;;;###autoload | |
10b6c932 | 201 | (defun display-warning (type message &optional level buffer-name) |
5e046f6d | 202 | "Display a warning message, MESSAGE. |
10b6c932 RS |
203 | TYPE is the warning type: either a custom group name (a symbol), |
204 | or a list of symbols whose first element is a custom group name. | |
5e046f6d JB |
205 | \(The rest of the symbols represent subcategories, for warning purposes |
206 | only, and you can use whatever symbols you like.) | |
207 | ||
53099cfc JB |
208 | LEVEL should be either :debug, :warning, :error, or :emergency |
209 | \(but see `warning-minimum-level' and `warning-minimum-log-level'). | |
78d4839b | 210 | Default is :warning. |
53099cfc | 211 | |
5e046f6d JB |
212 | :emergency -- a problem that will seriously impair Emacs operation soon |
213 | if you do not attend to it promptly. | |
214 | :error -- data or circumstances that are inherently wrong. | |
215 | :warning -- data or circumstances that are not inherently wrong, | |
216 | but raise suspicion of a possible problem. | |
217 | :debug -- info for debugging only. | |
218 | ||
0eae9f3b GM |
219 | BUFFER-NAME, if specified, is the name of the buffer for logging |
220 | the warning. By default, it is `*Warnings*'. If this function | |
221 | has to create the buffer, it disables undo in the buffer. | |
5e046f6d JB |
222 | |
223 | See the `warnings' custom group for user customization features. | |
224 | ||
225 | See also `warning-series', `warning-prefix-function' and | |
226 | `warning-fill-prefix' for additional programming features." | |
227 | (unless level | |
228 | (setq level :warning)) | |
0eae9f3b GM |
229 | (unless buffer-name |
230 | (setq buffer-name "*Warnings*")) | |
5e046f6d JB |
231 | (if (assq level warning-level-aliases) |
232 | (setq level (cdr (assq level warning-level-aliases)))) | |
233 | (or (< (warning-numeric-level level) | |
53099cfc | 234 | (warning-numeric-level warning-minimum-log-level)) |
10b6c932 RS |
235 | (warning-suppress-p type warning-suppress-log-types) |
236 | (let* ((typename (if (consp type) (car type) type)) | |
0eae9f3b | 237 | (old (get-buffer buffer-name)) |
455c834e | 238 | (buffer (or old (get-buffer-create buffer-name))) |
5e046f6d JB |
239 | (level-info (assq level warning-levels)) |
240 | start end) | |
241 | (with-current-buffer buffer | |
0eae9f3b GM |
242 | ;; If we created the buffer, disable undo. |
243 | (unless old | |
cec01cd2 SM |
244 | (special-mode) |
245 | (setq buffer-read-only t) | |
0eae9f3b | 246 | (setq buffer-undo-list t)) |
5e046f6d JB |
247 | (goto-char (point-max)) |
248 | (when (and warning-series (symbolp warning-series)) | |
249 | (setq warning-series | |
250 | (prog1 (point-marker) | |
251 | (unless (eq warning-series t) | |
252 | (funcall warning-series))))) | |
cec01cd2 | 253 | (let ((inhibit-read-only t)) |
455c834e JB |
254 | (unless (bolp) |
255 | (newline)) | |
256 | (setq start (point)) | |
257 | (if warning-prefix-function | |
258 | (setq level-info (funcall warning-prefix-function | |
259 | level level-info))) | |
260 | (insert (format (nth 1 level-info) | |
261 | (format warning-type-format typename)) | |
262 | message) | |
263 | (newline) | |
264 | (when (and warning-fill-prefix (not (string-match "\n" message))) | |
265 | (let ((fill-prefix warning-fill-prefix) | |
266 | (fill-column 78)) | |
267 | (fill-region start (point)))) | |
268 | (setq end (point))) | |
5e046f6d JB |
269 | (when (and (markerp warning-series) |
270 | (eq (marker-buffer warning-series) buffer)) | |
271 | (goto-char warning-series))) | |
272 | (if (nth 2 level-info) | |
273 | (funcall (nth 2 level-info))) | |
455c834e JB |
274 | (cond (noninteractive |
275 | ;; Noninteractively, take the text we inserted | |
276 | ;; in the warnings buffer and print it. | |
277 | ;; Do this unconditionally, since there is no way | |
278 | ;; to view logged messages unless we output them. | |
279 | (with-current-buffer buffer | |
280 | (save-excursion | |
281 | ;; Don't include the final newline in the arg | |
282 | ;; to `message', because it adds a newline. | |
283 | (goto-char end) | |
284 | (if (bolp) | |
285 | (forward-char -1)) | |
286 | (message "%s" (buffer-substring start (point)))))) | |
287 | ((and (daemonp) (null after-init-time)) | |
288 | ;; Warnings assigned during daemon initialization go into | |
289 | ;; the messages buffer. | |
290 | (message "%s" | |
291 | (with-current-buffer buffer | |
292 | (save-excursion | |
293 | (goto-char end) | |
294 | (if (bolp) | |
295 | (forward-char -1)) | |
296 | (buffer-substring start (point)))))) | |
297 | (t | |
298 | ;; Interactively, decide whether the warning merits | |
299 | ;; immediate display. | |
300 | (or (< (warning-numeric-level level) | |
301 | (warning-numeric-level warning-minimum-level)) | |
302 | (warning-suppress-p type warning-suppress-types) | |
303 | (let ((window (display-buffer buffer))) | |
304 | (when (and (markerp warning-series) | |
305 | (eq (marker-buffer warning-series) buffer)) | |
306 | (set-window-start window warning-series)) | |
307 | (sit-for 0)))))))) | |
5e046f6d | 308 | \f |
2abd71e5 GM |
309 | ;; Use \\<special-mode-map> so that help-enable-auto-load can do its thing. |
310 | ;; Any keymap that is defined will do. | |
5e046f6d | 311 | ;;;###autoload |
10b6c932 | 312 | (defun lwarn (type level message &rest args) |
5e046f6d | 313 | "Display a warning message made from (format MESSAGE ARGS...). |
2abd71e5 | 314 | \\<special-mode-map> |
5e046f6d JB |
315 | Aside from generating the message with `format', |
316 | this is equivalent to `display-warning'. | |
317 | ||
78d4839b | 318 | TYPE is the warning type: either a custom group name (a symbol), |
10b6c932 | 319 | or a list of symbols whose first element is a custom group name. |
5e046f6d JB |
320 | \(The rest of the symbols represent subcategories and |
321 | can be whatever you like.) | |
322 | ||
53099cfc JB |
323 | LEVEL should be either :debug, :warning, :error, or :emergency |
324 | \(but see `warning-minimum-level' and `warning-minimum-log-level'). | |
325 | ||
5e046f6d JB |
326 | :emergency -- a problem that will seriously impair Emacs operation soon |
327 | if you do not attend to it promptly. | |
328 | :error -- invalid data or circumstances. | |
53099cfc JB |
329 | :warning -- suspicious data or circumstances. |
330 | :debug -- info for debugging only." | |
10b6c932 | 331 | (display-warning type (apply 'format message args) level)) |
5e046f6d JB |
332 | |
333 | ;;;###autoload | |
334 | (defun warn (message &rest args) | |
335 | "Display a warning message made from (format MESSAGE ARGS...). | |
336 | Aside from generating the message with `format', | |
337 | this is equivalent to `display-warning', using | |
10b6c932 | 338 | `emacs' as the type and `:warning' as the level." |
5e046f6d JB |
339 | (display-warning 'emacs (apply 'format message args))) |
340 | ||
341 | (provide 'warnings) | |
342 | ||
343 | ;;; warnings.el ends here |