1;;; warnings.el --- log and display warnings
2
3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 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., 51 Franklin Street, Fifth Floor,
23;; Boston, MA 02110-1301, USA.
24
25;;; Commentary:
26
27;; This file implements the entry points `warn', `lwarn'
28;; and `display-warning'.
29
30;;; Code:
31
32(defgroup warnings nil
33  "Log and display warnings."
34  :version "22.1"
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'.
43Each element looks like (LEVEL STRING FUNCTION) and
44defines LEVEL as a severity level.  STRING specifies the
45description of this level.  STRING should use `%s' to
46specify where to put the warning type information,
47or it can omit the `%s' so as not to include that information.
48
49The optional FUNCTION, if non-nil, is a function to call
50with no arguments, to get the user's attention.
51
52The standard levels are :emergency, :error, :warning and :debug.
53See `display-warning' for documentation of their meanings.
54Level :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'.
69Each element looks like (ALIAS . LEVEL) and defines
70ALIAS as equivalent to LEVEL.  LEVEL must be defined in `warning-levels';
71it may not itself be an alias.")
72
73(defcustom warning-minimum-level :warning
74  "Minimum severity level for displaying the warning buffer.
75If a warning's severity level is lower than this,
76the warning is logged in the warnings buffer, but the buffer
77is not immediately displayed.  See also `warning-minimum-log-level'."
78  :group 'warnings
79  :type '(choice (const :emergency) (const :error)
80                 (const :warning) (const :debug))
81  :version "22.1")
82(defvaralias 'display-warning-minimum-level 'warning-minimum-level)
83
84(defcustom warning-minimum-log-level :warning
85  "Minimum severity level for logging a warning.
86If a warning severity level is lower than this,
87the warning is completely ignored.
88Value must be lower or equal than `warning-minimum-level',
89because warnings not logged aren't displayed either."
90  :group 'warnings
91  :type '(choice (const :emergency) (const :error)
92                 (const :warning) (const :debug))
93  :version "22.1")
94(defvaralias 'log-warning-minimum-level 'warning-minimum-log-level)
95
96(defcustom warning-suppress-log-types nil
97  "List of warning types that should not be logged.
98If any element of this list matches the TYPE argument to `display-warning',
99the warning is completely ignored.
100The element must match the first elements of TYPE.
101Thus, (foo bar) as an element matches (foo bar)
102or (foo bar ANYTHING...) as TYPE.
103If TYPE is a symbol FOO, that is equivalent to the list (FOO),
104so only the element (FOO) will match it."
105  :group 'warnings
106  :type '(repeat (repeat symbol))
107  :version "22.1")
108
109(defcustom warning-suppress-types nil
110  "List of warning types not to display immediately.
111If any element of this list matches the TYPE argument to `display-warning',
112the warning is logged nonetheless, but the warnings buffer is
113not immediately displayed.
114The element must match an initial segment of the list TYPE.
115Thus, (foo bar) as an element matches (foo bar)
116or (foo bar ANYTHING...) as TYPE.
117If TYPE is a symbol FOO, that is equivalent to the list (FOO),
118so only the element (FOO) will match it.
119See also `warning-suppress-log-types'."
120  :group 'warnings
121  :type '(repeat (repeat symbol))
122  :version "22.1")
123
124;;; The autoload cookie is so that programs can bind this variable
125;;; safely, testing the existing value, before they call one of the
126;;; warnings functions.
127;;;###autoload
128(defvar warning-prefix-function nil
129  "Function to generate warning prefixes.
130This function, if non-nil, is called with two arguments,
131the severity level and its entry in `warning-levels',
132and should return the entry that should actually be used.
133The warnings buffer is current when this function is called
134and the function can insert text in it.  This text becomes
135the beginning of the warning.")
136
137;;; The autoload cookie is so that programs can bind this variable
138;;; safely, testing the existing value, before they call one of the
139;;; warnings functions.
140;;;###autoload
141(defvar warning-series nil
142  "Non-nil means treat multiple `display-warning' calls as a series.
143A marker indicates a position in the warnings buffer
144which is the start of the current series; it means that
145additional warnings in the same buffer should not move point.
146t means the next warning begins a series (and stores a marker here).
147A symbol with a function definition is like t, except
148also call that function before the next warning.")
149(put 'warning-series 'risky-local-variable t)
150
151;;; The autoload cookie is so that programs can bind this variable
152;;; safely, testing the existing value, before they call one of the
153;;; warnings functions.
154;;;###autoload
155(defvar warning-fill-prefix nil
156  "Non-nil means fill each warning text using this string as `fill-prefix'.")
157
158;;; The autoload cookie is so that programs can bind this variable
159;;; safely, testing the existing value, before they call one of the
160;;; warnings functions.
161;;;###autoload
162(defvar warning-type-format " (%s)"
163  "Format for displaying the warning type in the warning message.
164The result of formatting the type this way gets included in the
165message under the control of the string in `warning-levels'.")
166
167(defun warning-numeric-level (level)
168  "Return a numeric measure of the warning severity level LEVEL."
169  (let* ((elt (assq level warning-levels))
170	 (link (memq elt warning-levels)))
171    (length link)))
172
173(defun warning-suppress-p (type suppress-list)
174  "Non-nil if a warning with type TYPE should be suppressed.
175SUPPRESS-LIST is the list of kinds of warnings to suppress."
176  (let (some-match)
177    (dolist (elt suppress-list)
178      (if (symbolp type)
179	  ;; If TYPE is a symbol, the ELT must be (TYPE).
180	  (if (and (consp elt)
181		   (eq (car elt) type)
182		   (null (cdr elt)))
183	      (setq some-match t))
184	;; If TYPE is a list, ELT must match it or some initial segment of it.
185	(let ((tem1 type)
186	      (tem2 elt)
187	      (match t))
188	  ;; Check elements of ELT until we run out of them.
189	  (while tem2
190	    (if (not (equal (car tem1) (car tem2)))
191		(setq match nil))
192	    (setq tem1 (cdr tem1)
193		  tem2 (cdr tem2)))
194	  ;; If ELT is an initial segment of TYPE, MATCH is t now.
195	  ;; So set SOME-MATCH.
196	  (if match
197	      (setq some-match t)))))
198    ;; If some element of SUPPRESS-LIST matched,
199    ;; we return t.
200    some-match))
201
202;;;###autoload
203(defun display-warning (type message &optional level buffer-name)
204  "Display a warning message, MESSAGE.
205TYPE is the warning type: either a custom group name (a symbol),
206or a list of symbols whose first element is a custom group name.
207\(The rest of the symbols represent subcategories, for warning purposes
208only, and you can use whatever symbols you like.)
209
210LEVEL should be either :debug, :warning, :error, or :emergency
211\(but see `warning-minimum-level' and `warning-minimum-log-level').
212Default is :warning.
213
214:emergency -- a problem that will seriously impair Emacs operation soon
215	      if you do not attend to it promptly.
216:error     -- data or circumstances that are inherently wrong.
217:warning   -- data or circumstances that are not inherently wrong,
218	      but raise suspicion of a possible problem.
219:debug     -- info for debugging only.
220
221BUFFER-NAME, if specified, is the name of the buffer for logging
222the warning.  By default, it is `*Warnings*'.  If this function
223has to create the buffer, it disables undo in the buffer.
224
225See the `warnings' custom group for user customization features.
226
227See also `warning-series', `warning-prefix-function' and
228`warning-fill-prefix' for additional programming features."
229  (unless level
230    (setq level :warning))
231  (unless buffer-name
232    (setq buffer-name "*Warnings*"))
233  (if (assq level warning-level-aliases)
234      (setq level (cdr (assq level warning-level-aliases))))
235  (or (< (warning-numeric-level level)
236         (warning-numeric-level warning-minimum-log-level))
237      (warning-suppress-p type warning-suppress-log-types)
238      (let* ((typename (if (consp type) (car type) type))
239             (old (get-buffer buffer-name))
240	     (buffer (get-buffer-create buffer-name))
241	     (level-info (assq level warning-levels))
242	     start end)
243	(with-current-buffer buffer
244          ;; If we created the buffer, disable undo.
245          (unless old
246            (setq buffer-undo-list t))
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)))))
253	  (unless (bolp)
254	    (newline))
255	  (setq start (point))
256	  (if warning-prefix-function
257	      (setq level-info (funcall warning-prefix-function
258					level level-info)))
259	  (insert (format (nth 1 level-info)
260                          (format warning-type-format typename))
261		  message)
262	  (newline)
263	  (when (and warning-fill-prefix (not (string-match "\n" message)))
264	    (let ((fill-prefix warning-fill-prefix)
265		  (fill-column 78))
266	      (fill-region start (point))))
267	  (setq end (point))
268	  (when (and (markerp warning-series)
269		     (eq (marker-buffer warning-series) buffer))
270	    (goto-char warning-series)))
271	(if (nth 2 level-info)
272	    (funcall (nth 2 level-info)))
273	(if noninteractive
274	    ;; Noninteractively, take the text we inserted
275	    ;; in the warnings buffer and print it.
276	    ;; Do this unconditionally, since there is no way
277	    ;; to view logged messages unless we output them.
278	    (with-current-buffer buffer
279	      (save-excursion
280		;; Don't include the final newline in the arg
281		;; to `message', because it adds a newline.
282		(goto-char end)
283		(if (bolp)
284		    (forward-char -1))
285		(message "%s" (buffer-substring start (point)))))
286	  ;; Interactively, decide whether the warning merits
287	  ;; immediate display.
288	  (or (< (warning-numeric-level level)
289		 (warning-numeric-level warning-minimum-level))
290	      (warning-suppress-p type warning-suppress-types)
291	      (let ((window (display-buffer buffer)))
292		(when (and (markerp warning-series)
293			   (eq (marker-buffer warning-series) buffer))
294		  (set-window-start window warning-series))
295		(sit-for 0)))))))
296
297;;;###autoload
298(defun lwarn (type level message &rest args)
299  "Display a warning message made from (format MESSAGE ARGS...).
300Aside from generating the message with `format',
301this is equivalent to `display-warning'.
302
303TYPE is the warning type: either a custom group name (a symbol),
304or a list of symbols whose first element is a custom group name.
305\(The rest of the symbols represent subcategories and
306can be whatever you like.)
307
308LEVEL should be either :debug, :warning, :error, or :emergency
309\(but see `warning-minimum-level' and `warning-minimum-log-level').
310
311:emergency -- a problem that will seriously impair Emacs operation soon
312	      if you do not attend to it promptly.
313:error     -- invalid data or circumstances.
314:warning   -- suspicious data or circumstances.
315:debug     -- info for debugging only."
316  (display-warning type (apply 'format message args) level))
317
318;;;###autoload
319(defun warn (message &rest args)
320  "Display a warning message made from (format MESSAGE ARGS...).
321Aside from generating the message with `format',
322this is equivalent to `display-warning', using
323`emacs' as the type and `:warning' as the level."
324  (display-warning 'emacs (apply 'format message args)))
325
326(provide 'warnings)
327
328;;; arch-tag: faaad1c8-7b2a-4161-af38-5ab4afde0496
329;;; warnings.el ends here
330