lisp/warnings.el

   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