code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/warnings.el

   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'.
  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 type information,
  47 or it can omit the `%s' so as not to include that information.
  48
  49 The optional FUNCTION, if non-nil, is a function to call
  50 with no arguments, to get the user's attention.
  51
  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)
  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'.
  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.")
  72 \f
  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)
  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.
  86 If a warning severity level is lower than this,
  87 the warning is completely ignored.
  88 Value must be lower or equal than `warning-minimum-level',
  89 because 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.
  98 If any element of this list matches the TYPE argument to `display-warning',
  99 the warning is completely ignored.
 100 The element must match the first elements of TYPE.
 101 Thus, (foo bar) as an element matches (foo bar)
 102 or (foo bar ANYTHING...) as TYPE.
 103 If TYPE is a symbol FOO, that is equivalent to the list (FOO),
 104 so 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.
 111 If any element of this list matches the TYPE argument to `display-warning',
 112 the warning is logged nonetheless, but the warnings buffer is
 113 not immediately displayed.
 114 The element must match an initial segment of the list TYPE.
 115 Thus, (foo bar) as an element matches (foo bar)
 116 or (foo bar ANYTHING...) as TYPE.
 117 If TYPE is a symbol FOO, that is equivalent to the list (FOO),
 118 so only the element (FOO) will match it.
 119 See also `warning-suppress-log-types'."
 120   :group 'warnings
 121   :type '(repeat (repeat symbol))
 122   :version "22.1")
 123 \f
 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.
 130 This function, if non-nil, is called with two arguments,
 131 the severity level and its entry in `warning-levels',
 132 and should return the entry that should actually be used.
 133 The warnings buffer is current when this function is called
 134 and the function can insert text in it.  This text becomes
 135 the 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.
 143 A marker indicates a position in the warnings buffer
 144 which is the start of the current series; it means that
 145 additional warnings in the same buffer should not move point.
 146 t means the next warning begins a series (and stores a marker here).
 147 A symbol with a function definition is like t, except
 148 also 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.
 164 The result of formatting the type this way gets included in the
 165 message under the control of the string in `warning-levels'.")
 166 \f
 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.
 175 SUPPRESS-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 \f
 202 ;;;###autoload
 203 (defun display-warning (type message &optional level buffer-name)
 204   "Display a warning message, MESSAGE.
 205 TYPE is the warning type: either a custom group name (a symbol),
 206 or a list of symbols whose first element is a custom group name.
 207 \(The rest of the symbols represent subcategories, for warning purposes
 208 only, and you can use whatever symbols you like.)
 209
 210 LEVEL should be either :debug, :warning, :error, or :emergency
 211 \(but see `warning-minimum-level' and `warning-minimum-log-level').
 212 Default 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
 221 BUFFER-NAME, if specified, is the name of the buffer for logging the
 222 warning.  By default, it is `*Warnings*'.
 223
 224 See the `warnings' custom group for user customization features.
 225
 226 See also `warning-series', `warning-prefix-function' and
 227 `warning-fill-prefix' for additional programming features."
 228   (unless level
 229     (setq level :warning))
 230   (if (assq level warning-level-aliases)
 231       (setq level (cdr (assq level warning-level-aliases))))
 232   (or (< (warning-numeric-level level)
 233          (warning-numeric-level warning-minimum-log-level))
 234       (warning-suppress-p type warning-suppress-log-types)
 235       (let* ((typename (if (consp type) (car type) type))
 236              (buffer (get-buffer-create (or buffer-name "*Warnings*")))
 237              (level-info (assq level warning-levels))
 238              start end)
 239         (with-current-buffer buffer
 240           (goto-char (point-max))
 241           (when (and warning-series (symbolp warning-series))
 242             (setq warning-series
 243                   (prog1 (point-marker)
 244                     (unless (eq warning-series t)
 245                       (funcall warning-series)))))
 246           (unless (bolp)
 247             (newline))
 248           (setq start (point))
 249           (if warning-prefix-function
 250               (setq level-info (funcall warning-prefix-function
 251                                         level level-info)))
 252           (insert (format (nth 1 level-info)
 253                           (format warning-type-format typename))
 254                   message)
 255           (newline)
 256           (when (and warning-fill-prefix (not (string-match "\n" message)))
 257             (let ((fill-prefix warning-fill-prefix)
 258                   (fill-column 78))
 259               (fill-region start (point))))
 260           (setq end (point))
 261           (when (and (markerp warning-series)
 262                      (eq (marker-buffer warning-series) buffer))
 263             (goto-char warning-series)))
 264         (if (nth 2 level-info)
 265             (funcall (nth 2 level-info)))
 266         (if noninteractive
 267             ;; Noninteractively, take the text we inserted
 268             ;; in the warnings buffer and print it.
 269             ;; Do this unconditionally, since there is no way
 270             ;; to view logged messages unless we output them.
 271             (with-current-buffer buffer
 272               (save-excursion
 273                 ;; Don't include the final newline in the arg
 274                 ;; to `message', because it adds a newline.
 275                 (goto-char end)
 276                 (if (bolp)
 277                     (forward-char -1))
 278                 (message "%s" (buffer-substring start (point)))))
 279           ;; Interactively, decide whether the warning merits
 280           ;; immediate display.
 281           (or (< (warning-numeric-level level)
 282                  (warning-numeric-level warning-minimum-level))
 283               (warning-suppress-p type warning-suppress-types)
 284               (let ((window (display-buffer buffer)))
 285                 (when (and (markerp warning-series)
 286                            (eq (marker-buffer warning-series) buffer))
 287                   (set-window-start window warning-series))
 288                 (sit-for 0)))))))
 289 \f
 290 ;;;###autoload
 291 (defun lwarn (type level message &rest args)
 292   "Display a warning message made from (format MESSAGE ARGS...).
 293 Aside from generating the message with `format',
 294 this is equivalent to `display-warning'.
 295
 296 TYPE is the warning type: either a custom group name (a symbol),
 297 or a list of symbols whose first element is a custom group name.
 298 \(The rest of the symbols represent subcategories and
 299 can be whatever you like.)
 300
 301 LEVEL should be either :debug, :warning, :error, or :emergency
 302 \(but see `warning-minimum-level' and `warning-minimum-log-level').
 303
 304 :emergency -- a problem that will seriously impair Emacs operation soon
 305               if you do not attend to it promptly.
 306 :error     -- invalid data or circumstances.
 307 :warning   -- suspicious data or circumstances.
 308 :debug     -- info for debugging only."
 309   (display-warning type (apply 'format message args) level))
 310
 311 ;;;###autoload
 312 (defun warn (message &rest args)
 313   "Display a warning message made from (format MESSAGE ARGS...).
 314 Aside from generating the message with `format',
 315 this is equivalent to `display-warning', using
 316 `emacs' as the type and `:warning' as the level."
 317   (display-warning 'emacs (apply 'format message args)))
 318
 319 (provide 'warnings)
 320
 321 ;;; arch-tag: faaad1c8-7b2a-4161-af38-5ab4afde0496
 322 ;;; warnings.el ends here