Mercurial > emacs
comparison lisp/warnings.el @ 46575:30fda32839de
New file.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 20 Jul 2002 21:54:53 +0000 |
parents | |
children | e07579b3efcc |
comparison
equal
deleted
inserted
replaced
46574:2f83f3473b40 | 46575:30fda32839de |
---|---|
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' | |
28 ;; and `display-warnings'. | |
29 | |
30 ;;; Code: | |
31 | |
32 (defvar warning-levels | |
33 '((:emergency "Emergency: " ding) | |
34 (:error "Error: ") | |
35 (:warning "Warning: ") | |
36 (:debug "Debug: ")) | |
37 "List of severity level definitions for `define-warnings'. | |
38 Each element looks like (LEVEL STRING FUNCTION) and | |
39 defines LEVEL as a severity level. STRING is the description | |
40 to use in the buffer, and FUNCTION (which may be omitted) | |
41 if non-nil is a function to call with no arguments | |
42 to get the user's attention. | |
43 | |
44 :debug level is ignored by default (see `warning-minimum-level').") | |
45 (put 'warning-levels 'risky-local-variable t) | |
46 | |
47 ;; These are for compatibility with XEmacs. | |
48 ;; I don't think there is any chance of finding meaningful distinctions | |
49 ;; to distinguish so many levels. | |
50 (defvar warning-level-aliases | |
51 '((emergency . :emergency) | |
52 (error . :error) | |
53 (warning . :warning) | |
54 (notice . :warning) | |
55 (info . :warning) | |
56 (critical . :emergency) | |
57 (alarm . :emergency)) | |
58 "Alist of aliases for severity levels for `display-warning'. | |
59 Each element looks like (ALIAS . LEVEL) and defines | |
60 ALIAS as equivalent to LEVEL.") | |
61 | |
62 (defcustom warning-minimum-level :warning | |
63 "Minimum severity level for displaying the warning buffer. | |
64 If a warning's severity level is lower than this, | |
65 the warning is logged in the warnings buffer, but the buffer | |
66 is not immediately displayed. See also `warning-minimum-log-level'." | |
67 :group 'warnings | |
68 :type '(choice (const :emergency) (const :error) (const :warning)) | |
69 :version "21.4") | |
70 (defvaralias 'display-warning-minimum-level 'warning-minimum-level) | |
71 | |
72 (defcustom warning-minimum-log-level :warning | |
73 "Minimum severity level for logging a warning. | |
74 If a warning severity level is lower than this, | |
75 the warning is completely ignored." | |
76 :group 'warnings | |
77 :type '(choice (const :emergency) (const :error) (const :warning)) | |
78 :version "21.4") | |
79 (defvaralias 'log-warning-minimum-level 'warning-minimum-log-level) | |
80 | |
81 (defcustom warning-suppress-log nil | |
82 "List of warning types that should not be logged. | |
83 If any element of this list matches the GROUP argument to `display-warning', | |
84 the warning is completely ignored. | |
85 The element must match the first elements of GROUP. | |
86 Thus, (foo bar) as an element matches (foo bar) | |
87 or (foo bar ANYTHING...) as GROUP. | |
88 If GROUP is a symbol FOO, that is equivalent to the list (FOO) | |
89 so only the element (FOO) will match it." | |
90 :group 'warnings | |
91 :type '(repeat (repeat symbol)) | |
92 :version "21.4") | |
93 | |
94 (defcustom warning-suppress nil | |
95 "Custom groups for warnings not to display immediately. | |
96 If any element of this list matches the GROUP argument to `display-warning', | |
97 the warning is logged nonetheless, but the warnings buffer is | |
98 not immediately displayed. | |
99 The element must match an initial segment of the list GROUP. | |
100 Thus, (foo bar) as an element matches (foo bar) | |
101 or (foo bar ANYTHING...) as GROUP. | |
102 If GROUP is a symbol FOO, that is equivalent to the list (FOO), | |
103 so only the element (FOO) will match it. | |
104 See also `warning-suppress-log'." | |
105 :group 'warnings | |
106 :type '(repeat (repeat symbol)) | |
107 :version "21.4") | |
108 | |
109 (defvar warning-prefix-function nil | |
110 "Function to generate warning prefixes. | |
111 This function, if non-nil, is called with two arguments, | |
112 the severity level and its entry in `warning-levels', | |
113 and should return the entry that should actually be used. | |
114 The warnings buffer is current when this function is called | |
115 and the function can insert text in it. This text becomes | |
116 the beginning of the warning.") | |
117 | |
118 (defun warning-numeric-level (level) | |
119 "Return a numeric measure of the warning severity level LEVEL." | |
120 (let* ((elt (assq level warning-levels)) | |
121 (link (memq elt warning-levels))) | |
122 (length link))) | |
123 | |
124 (defvar warning-series nil | |
125 "Non-nil means treat multiple `display-warning' calls as a series. | |
126 An integer is a position in the warnings buffer | |
127 which is the start of the current series. | |
128 t means the next warning begins a series (and stores an integer here). | |
129 A symbol with a function definition is like t, except | |
130 also call that function before the next warning.") | |
131 (put 'warning-series 'risky-local-variable t) | |
132 | |
133 (defvar warning-fill-prefix nil | |
134 "Non-nil means fill each warning text using this string as `fill-prefix'.") | |
135 | |
136 (defun warning-suppress-p (group suppress-list) | |
137 "Non-nil if a warning with group GROUP should be suppressed. | |
138 SUPPRESS-LIST is the list of kinds of warnings to suppress." | |
139 (let (some-match) | |
140 (dolist (elt suppress-list) | |
141 (if (symbolp group) | |
142 ;; If GROUP is a symbol, the ELT must be (GROUP). | |
143 (if (and (consp elt) | |
144 (eq (car elt) group) | |
145 (null (cdr elt))) | |
146 (setq some-match t)) | |
147 ;; If GROUP is a list, ELT must match it or some initial segment of it. | |
148 (let ((tem1 group) | |
149 (tem2 elt) | |
150 (match t)) | |
151 ;; Check elements of ELT until we run out of them. | |
152 (while tem2 | |
153 (if (not (equal (car tem1) (car tem2))) | |
154 (setq match nil)) | |
155 (setq tem1 (cdr tem1) | |
156 tem2 (cdr tem2))) | |
157 ;; If ELT is an initial segment of GROUP, MATCH is t now. | |
158 ;; So set SOME-MATCH. | |
159 (if match | |
160 (setq some-match t))))) | |
161 ;; If some element of SUPPRESS-LIST matched, | |
162 ;; we return t. | |
163 some-match)) | |
164 | |
165 (defun display-warning (group message &optional level buffer-name) | |
166 "Display a warning message, MESSAGE. | |
167 GROUP should be a custom group name (a symbol). | |
168 or else a list of symbols whose first element is a custom group name. | |
169 \(The rest of the symbols represent subcategories, for warning purposes | |
170 only, and you can use whatever symbols you like.) | |
171 | |
172 LEVEL should be either :warning, :error, or :emergency. | |
173 :emergency -- a problem that will seriously impair Emacs operation soon | |
174 if you do not attend to it promptly. | |
175 :error -- data or circumstances that are inherently wrong. | |
176 :warning -- data or circumstances that are not inherently wrong, | |
177 but raise suspicion of a possible problem. | |
178 :debug -- info for debugging only. | |
179 | |
180 BUFFER-NAME, if specified, is the name of the buffer for logging the | |
181 warning. By default, it is `*Warnings*'. | |
182 | |
183 See the `warnings' custom group for user customization features. | |
184 | |
185 See also `warning-series', `warning-prefix-function' and | |
186 `warning-fill-prefix' for additional programming features." | |
187 (unless level | |
188 (setq level :warning)) | |
189 (if (assq level warning-level-aliases) | |
190 (setq level (cdr (assq level warning-level-aliases)))) | |
191 (or (< (warning-numeric-level level) | |
192 (warning-numeric-level warning-minimum-log-level)) | |
193 (warning-suppress-p group warning-suppress-log) | |
194 (let* ((groupname (if (consp group) (car group) group)) | |
195 (buffer (get-buffer-create (or buffer-name "*Warnings*"))) | |
196 (level-info (assq level warning-levels)) | |
197 start end) | |
198 (with-current-buffer buffer | |
199 (goto-char (point-max)) | |
200 (when (and warning-series (symbolp warning-series)) | |
201 (setq warning-series | |
202 (prog1 (point) | |
203 (unless (eq warning-series t) | |
204 (funcall warning-series))))) | |
205 (unless (bolp) | |
206 (newline)) | |
207 (setq start (point)) | |
208 (if warning-prefix-function | |
209 (setq level-info (funcall warning-prefix-function | |
210 level level-info))) | |
211 (insert (nth 1 level-info) message) | |
212 (newline) | |
213 (when (and warning-fill-prefix (not (string-match "\n" message))) | |
214 (let ((fill-prefix warning-fill-prefix) | |
215 (fill-column 78)) | |
216 (fill-region start (point)))) | |
217 (setq end (point)) | |
218 (when warning-series | |
219 (goto-char warning-series))) | |
220 (if (nth 2 level-info) | |
221 (funcall (nth 2 level-info))) | |
222 (if noninteractive | |
223 ;; Noninteractively, take the text we inserted | |
224 ;; in the warnings buffer and print it. | |
225 ;; Do this unconditionally, since there is no way | |
226 ;; to view logged messages unless we output them. | |
227 (with-current-buffer buffer | |
228 (message "%s" (buffer-substring start end))) | |
229 ;; Interactively, decide whether the warning merits | |
230 ;; immediate display. | |
231 (or (< (warning-numeric-level level) | |
232 (warning-numeric-level warning-minimum-level)) | |
233 (warning-suppress-p group warning-suppress) | |
234 (let ((window (display-buffer buffer))) | |
235 (when warning-series | |
236 (set-window-start window warning-series)) | |
237 (sit-for 0))))))) | |
238 | |
239 (defun lwarn (group level message &rest args) | |
240 "Display a warning message made from (format MESSAGE ARGS...). | |
241 Aside from generating the message with `format', | |
242 this is equivalent to `display-message'. | |
243 | |
244 GROUP should be a custom group name (a symbol). | |
245 or else a list of symbols whose first element is a custom group name. | |
246 \(The rest of the symbols represent subcategories and | |
247 can be whatever you like.) | |
248 | |
249 LEVEL should be either :warning, :error, or :emergency. | |
250 :emergency -- a problem that will seriously impair Emacs operation soon | |
251 if you do not attend to it promptly. | |
252 :error -- invalid data or circumstances. | |
253 :warning -- suspicious data or circumstances." | |
254 (display-warning group (apply 'format message args) level)) | |
255 | |
256 (defun warn (message &rest args) | |
257 "Display a warning message made from (format MESSAGE ARGS...). | |
258 Aside from generating the message with `format', | |
259 this is equivalent to `display-message', using | |
260 `emacs' as the group and `:warning' as the level." | |
261 (display-warning 'emacs (apply 'format message args))) | |
262 | |
263 ;;; warnings.el ends here |