;;; Code:
+(defgroup warnings nil
+ "Log and display warnings."
+ :version "21.4"
+ :group 'lisp)
+
(defvar warning-levels
'((:emergency "Emergency%s: " ding)
(:error "Error%s: ")
(:warning "Warning%s: ")
(:debug "Debug%s: "))
- "List of severity level definitions for `define-warnings'.
+ "List of severity level definitions for `display-warning'.
Each element looks like (LEVEL STRING FUNCTION) and
-defines LEVEL as a severity level. STRING is the description
-to use in the buffer, and FUNCTION (which may be omitted)
-if non-nil is a function to call with no arguments
-to get the user's attention. STRING should use `%s' to
-specify where to put the warning group information.
+defines LEVEL as a severity level. STRING specifies the
+description of this level. STRING should use `%s' to
+specify where to put the warning group information,
+or it can omit the `%s' so as not to include that information.
+
+The optional FUNCTION, if non-nil, is a function to call
+with no arguments, to get the user's attention.
-:debug level is ignored by default (see `warning-minimum-level').")
+The standard levels are :emergency, :error, :warning and :debug.
+See `display-warning' for documentation of their meanings.
+Level :debug is ignored by default (see `warning-minimum-level').")
(put 'warning-levels 'risky-local-variable t)
;; These are for compatibility with XEmacs.
-;; I don't think there is any chance of finding meaningful distinctions
+;; I don't think there is any chance of designing meaningful criteria
;; to distinguish so many levels.
(defvar warning-level-aliases
'((emergency . :emergency)
(alarm . :emergency))
"Alist of aliases for severity levels for `display-warning'.
Each element looks like (ALIAS . LEVEL) and defines
-ALIAS as equivalent to LEVEL.")
-
+ALIAS as equivalent to LEVEL. LEVEL must be defined in `warning-levels';
+it may not itself be an alias.")
+\f
(defcustom warning-minimum-level :warning
"Minimum severity level for displaying the warning buffer.
If a warning's severity level is lower than this,
The element must match the first elements of GROUP.
Thus, (foo bar) as an element matches (foo bar)
or (foo bar ANYTHING...) as GROUP.
-If GROUP is a symbol FOO, that is equivalent to the list (FOO)
+If GROUP is a symbol FOO, that is equivalent to the list (FOO),
so only the element (FOO) will match it."
:group 'warnings
:type '(repeat (repeat symbol))
:group 'warnings
:type '(repeat (repeat symbol))
:version "21.4")
-
+\f
+;;; The autoload cookie is so that programs can bind this variable
+;;; safely, testing the existing value, before they call one of the
+;;; warnings functions.
+;;;###autoload
(defvar warning-prefix-function nil
"Function to generate warning prefixes.
This function, if non-nil, is called with two arguments,
and the function can insert text in it. This text becomes
the beginning of the warning.")
-(defun warning-numeric-level (level)
- "Return a numeric measure of the warning severity level LEVEL."
- (let* ((elt (assq level warning-levels))
- (link (memq elt warning-levels)))
- (length link)))
-
+;;; The autoload cookie is so that programs can bind this variable
+;;; safely, testing the existing value, before they call one of the
+;;; warnings functions.
+;;;###autoload
(defvar warning-series nil
"Non-nil means treat multiple `display-warning' calls as a series.
-An integer is a position in the warnings buffer
-which is the start of the current series.
-t means the next warning begins a series (and stores an integer here).
+A marker indicates a position in the warnings buffer
+which is the start of the current series; it means that
+additional warnings in the same buffer should not move point.
+t means the next warning begins a series (and stores a marker here).
A symbol with a function definition is like t, except
also call that function before the next warning.")
(put 'warning-series 'risky-local-variable t)
+;;; The autoload cookie is so that programs can bind this variable
+;;; safely, testing the existing value, before they call one of the
+;;; warnings functions.
+;;;###autoload
(defvar warning-fill-prefix nil
"Non-nil means fill each warning text using this string as `fill-prefix'.")
+;;; The autoload cookie is so that programs can bind this variable
+;;; safely, testing the existing value, before they call one of the
+;;; warnings functions.
+;;;###autoload
(defvar warning-group-format " (%s)"
"Format for displaying the warning group in the warning message.
The result of formatting the group this way gets included in the
message under the control of the string in `warning-levels'.")
+\f
+(defun warning-numeric-level (level)
+ "Return a numeric measure of the warning severity level LEVEL."
+ (let* ((elt (assq level warning-levels))
+ (link (memq elt warning-levels)))
+ (length link)))
(defun warning-suppress-p (group suppress-list)
"Non-nil if a warning with group GROUP should be suppressed.
;; If some element of SUPPRESS-LIST matched,
;; we return t.
some-match))
-
+\f
;;;###autoload
(defun display-warning (group message &optional level buffer-name)
"Display a warning message, MESSAGE.
-GROUP should be a custom group name (a symbol).
+GROUP should be a custom group name (a symbol),
or else a list of symbols whose first element is a custom group name.
\(The rest of the symbols represent subcategories, for warning purposes
only, and you can use whatever symbols you like.)
(goto-char (point-max))
(when (and warning-series (symbolp warning-series))
(setq warning-series
- (prog1 (point)
+ (prog1 (point-marker)
(unless (eq warning-series t)
(funcall warning-series)))))
(unless (bolp)
(if warning-prefix-function
(setq level-info (funcall warning-prefix-function
level level-info)))
- (setq group-string (format warning-group-format groupname))
- (insert (format (nth 1 level-info) group-string)
+ (insert (format (nth 1 level-info)
+ (format warning-group-format groupname))
message)
(newline)
(when (and warning-fill-prefix (not (string-match "\n" message)))
(fill-column 78))
(fill-region start (point))))
(setq end (point))
- (when warning-series
+ (when (and (markerp warning-series)
+ (eq (marker-buffer warning-series) buffer))
(goto-char warning-series)))
(if (nth 2 level-info)
(funcall (nth 2 level-info)))
;; Do this unconditionally, since there is no way
;; to view logged messages unless we output them.
(with-current-buffer buffer
- (message "%s" (buffer-substring start end)))
+ (save-excursion
+ ;; Don't include the final newline in the arg
+ ;; to `message', because it adds a newline.
+ (goto-char end)
+ (if (bolp)
+ (forward-char -1))
+ (message "%s" (buffer-substring start (point)))))
;; Interactively, decide whether the warning merits
;; immediate display.
(or (< (warning-numeric-level level)
- (warning-numeric-level warning-minimum-level))
+ (warning-numeric-level warning-minimum-level))
(warning-suppress-p group warning-suppress-types)
(let ((window (display-buffer buffer)))
- (when warning-series
+ (when (and (markerp warning-series)
+ (eq (marker-buffer warning-series) buffer))
(set-window-start window warning-series))
(sit-for 0)))))))
-
+\f
;;;###autoload
(defun lwarn (group level message &rest args)
"Display a warning message made from (format MESSAGE ARGS...).