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