view lisp/warnings.el @ 51151:fe11e703042b

Summary: MIME support added for e-mail processing that skips encoded regions. Allow user to skip saving Fcc messages with large attachments. Fixed region skipping bug with multi-line comments - e.g. tex $ regions spanning multiple lines. Added support for postscript and uuencoded regions. Redundant dictionary file names purged. Dictionary definition field name changed from "Character Set" to "Coding System". Fixed bug in reloading dictionaries. Modified headers to reflect new version. XEmacs menu now adds customize item. (ispell-check-version): No longer an aliased function. Returns library path if not called interactively. Variable `temporary-file-directory' protected if not loaded. (check-ispell-version): Now the alias for `ispell-check-version'. (ispell-message-fcc-skip): New variable that determines if and when to query about saving Fcc copy of message if an attachment is large. (ispell-skip-html): Declared buffer-local. (ispell-local-dictionary-alist): Docstring expanded. Tag name changed from "Character Set" to "Coding System". (ispell-dictionary-alist-1): Removed redundant command-line option to load brasileiro, british, and castellano dictionary files. (ispell-dictionary-alist-2): Removed redundant command-line option to load czech dictionary file. (ispell-dictionary-alist-3): Moved francais-tex here. (ispell-dictionary-alist-4): Removed german and german8 dictionaries. The deutsch ones are the correct definitions. `nederlands' and `nederlands8' dictionaries moved here. (ispell-dictionary-alist-5): `polish' and `portugues' dictionaries moved here. Removed redundant command-line option to `norsk' and `portugues'. (ispell-dictionary-alist-6): Removed redundant command-line option to load `russian' and `slovak' dictionary files. (ispell-dictionary-alist): Tag name changed from "Character Set" to "Coding System". (ispell-version): Updated to 3.6. (ispell-library-directory): Calls non-deprecated function. (ispell-valid-dictionary-list): New function returning all valid dictionaries on machine. (ispell-checking-message): Documentation string improved. (ispell-skip-region-alist): Added uuencoded and postscript region skipping. Improved http/e-mail/file regexp to not match `/.\w'. (ispell-html-skip-alists): New variable for html region support. (ispell-send-string): Removed redundant xemacs check. (ispell-word): Fix spelling error in documentation string, added extent information to support highlighting in ispell-minor-mode. (ispell-command-loop): Disable horizontal scrollbar in XEmacs choices buffer. (ispell-show-choices): Directly select `choices-window'. (ispell-help): Use default buffer size for electric help. (ispell-adjusted-window-height): Correct for xemacs detection. (ispell-start-process): Don't double specify dictionary file name. (ispell-init-process): Set `ispell-library-path' each call. (ispell-change-dictionary): Now only completes valid dictionaries. (ispell-region): Add support for MIME region skipping and Fcc message query for large attachments. (ispell-begin-skip-region-regexp): Add documentation string. Added message support and cleaned up code for generic and html regions. (ispell-begin-skip-region): Function is now requires alist argument. (ispell-begin-tex-skip-regexp): Added comments and support improved html and message regions. (ispell-skip-region-list): New function for MIME and region skipping. (ispell-tex-arg-end): Add documentation string. (ispell-ignore-fcc): New function to query saving Fcc message. (ispell-skip-region): Calculate alist for key match dynamically, html skipping pushed to alists. (ispell-get-line): Add support for multi-line comment regions. (ispell): Check that variables to continue spelling are bound. (ispell-message-text-end): Postscript and uuencoded regions now supported as MIME regions, rather than as end-of-message region. (ispell-mime-multipartp): New function supporting MIME. (ispell-mime-skip-part): New function supporting MIME. (ispell-message): Add MIME support. (ispell-buffer-local-parsing): Variable `ispell-skip-html' now local. (ispell-buffer-local-dict): Fixed bug for detecting and reloading new dictionary.

;;; warnings.el --- log and display warnings

;; Copyright (C) 2002 Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: internal

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This file implements the entry points `warn', `lwarn'
;; and `display-warnings'.

;;; 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 `display-warning'.
Each element looks like (LEVEL STRING FUNCTION) and
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.

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 designing meaningful criteria
;; to distinguish so many levels.
(defvar warning-level-aliases
  '((emergency . :emergency)
    (error . :error)
    (warning . :warning)
    (notice . :warning)
    (info . :warning)
    (critical . :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.  LEVEL must be defined in `warning-levels';
it may not itself be an alias.")

(defcustom warning-minimum-level :warning
  "Minimum severity level for displaying the warning buffer.
If a warning's severity level is lower than this,
the warning is logged in the warnings buffer, but the buffer
is not immediately displayed.  See also `warning-minimum-log-level'."
  :group 'warnings
  :type '(choice (const :emergency) (const :error) (const :warning))
  :version "21.4")
(defvaralias 'display-warning-minimum-level 'warning-minimum-level)

(defcustom warning-minimum-log-level :warning
  "Minimum severity level for logging a warning.
If a warning severity level is lower than this,
the warning is completely ignored."
  :group 'warnings
  :type '(choice (const :emergency) (const :error) (const :warning))
  :version "21.4")
(defvaralias 'log-warning-minimum-level 'warning-minimum-log-level)

(defcustom warning-suppress-log-types nil
  "List of warning types that should not be logged.
If any element of this list matches the GROUP argument to `display-warning',
the warning is completely ignored.
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),
so only the element (FOO) will match it."
  :group 'warnings
  :type '(repeat (repeat symbol))
  :version "21.4")

(defcustom warning-suppress-types nil
  "Custom groups for warnings not to display immediately.
If any element of this list matches the GROUP argument to `display-warning',
the warning is logged nonetheless, but the warnings buffer is
not immediately displayed.
The element must match an initial segment of the list 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),
so only the element (FOO) will match it.
See also `warning-suppress-log-types'."
  :group 'warnings
  :type '(repeat (repeat symbol))
  :version "21.4")

;;; 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,
the severity level and its entry in `warning-levels',
and should return the entry that should actually be used.
The warnings buffer is current when this function is called
and the function can insert text in it.  This text becomes
the beginning of the warning.")

;;; 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.
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'.")

(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.
SUPPRESS-LIST is the list of kinds of warnings to suppress."
  (let (some-match)
    (dolist (elt suppress-list)
      (if (symbolp group)
	  ;; If GROUP is a symbol, the ELT must be (GROUP).
	  (if (and (consp elt)
		   (eq (car elt) group)
		   (null (cdr elt)))
	      (setq some-match t))
	;; If GROUP is a list, ELT must match it or some initial segment of it.
	(let ((tem1 group)
	      (tem2 elt)
	      (match t))
	  ;; Check elements of ELT until we run out of them.
	  (while tem2
	    (if (not (equal (car tem1) (car tem2)))
		(setq match nil))
	    (setq tem1 (cdr tem1)
		  tem2 (cdr tem2)))
	  ;; If ELT is an initial segment of GROUP, MATCH is t now.
	  ;; So set SOME-MATCH.
	  (if match
	      (setq some-match t)))))
    ;; If some element of SUPPRESS-LIST matched,
    ;; we return t.
    some-match))

;;;###autoload
(defun display-warning (group message &optional level buffer-name)
  "Display a warning message, MESSAGE.
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.)

LEVEL should be either :warning, :error, or :emergency.
:emergency -- a problem that will seriously impair Emacs operation soon
	      if you do not attend to it promptly.
:error     -- data or circumstances that are inherently wrong.
:warning   -- data or circumstances that are not inherently wrong,
	      but raise suspicion of a possible problem.
:debug     -- info for debugging only.

BUFFER-NAME, if specified, is the name of the buffer for logging the
warning.  By default, it is `*Warnings*'.

See the `warnings' custom group for user customization features.

See also `warning-series', `warning-prefix-function' and
`warning-fill-prefix' for additional programming features."
  (unless level
    (setq level :warning))
  (if (assq level warning-level-aliases)
      (setq level (cdr (assq level warning-level-aliases))))
  (or (< (warning-numeric-level level)
	 (warning-numeric-level warning-minimum-log-level))
      (warning-suppress-p group warning-suppress-log-types)
      (let* ((groupname (if (consp group) (car group) group))
	     (buffer (get-buffer-create (or buffer-name "*Warnings*")))
	     (level-info (assq level warning-levels))
	     start end)
	(with-current-buffer buffer
	  (goto-char (point-max))
	  (when (and warning-series (symbolp warning-series))
	    (setq warning-series
		  (prog1 (point-marker)
		    (unless (eq warning-series t)
		      (funcall warning-series)))))
	  (unless (bolp)
	    (newline))
	  (setq start (point))
	  (if warning-prefix-function
	      (setq level-info (funcall warning-prefix-function
					level level-info)))
	  (insert (format (nth 1 level-info)
                          (format warning-group-format groupname))
		  message)
	  (newline)
	  (when (and warning-fill-prefix (not (string-match "\n" message)))
	    (let ((fill-prefix warning-fill-prefix)
		  (fill-column 78))
	      (fill-region start (point))))
	  (setq end (point))
	  (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)))
	(if noninteractive
	    ;; Noninteractively, take the text we inserted
	    ;; in the warnings buffer and print it.
	    ;; Do this unconditionally, since there is no way
	    ;; to view logged messages unless we output them.
	    (with-current-buffer buffer
	      (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-suppress-p group warning-suppress-types)
	      (let ((window (display-buffer buffer)))
		(when (and (markerp warning-series)
			   (eq (marker-buffer warning-series) buffer))
		  (set-window-start window warning-series))
		(sit-for 0)))))))

;;;###autoload
(defun lwarn (group level message &rest args)
  "Display a warning message made from (format MESSAGE ARGS...).
Aside from generating the message with `format',
this is equivalent to `display-warning'.

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 and
can be whatever you like.)

LEVEL should be either :warning, :error, or :emergency.
:emergency -- a problem that will seriously impair Emacs operation soon
	      if you do not attend to it promptly.
:error     -- invalid data or circumstances.
:warning   -- suspicious data or circumstances."
  (display-warning group (apply 'format message args) level))

;;;###autoload
(defun warn (message &rest args)
  "Display a warning message made from (format MESSAGE ARGS...).
Aside from generating the message with `format',
this is equivalent to `display-warning', using
`emacs' as the group and `:warning' as the level."
  (display-warning 'emacs (apply 'format message args)))

(provide 'warnings)

;;; warnings.el ends here