LCOV - code coverage report
Current view: top level - lisp/emacs-lisp - warnings.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 0 91 0.0 %
Date: 2017-08-30 10:12:24 Functions: 0 5 0.0 %

          Line data    Source code
       1             : ;;; warnings.el --- log and display warnings
       2             : 
       3             : ;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Maintainer: emacs-devel@gnu.org
       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 3 of the License, or
      13             : ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
      22             : 
      23             : ;;; Commentary:
      24             : 
      25             : ;; This file implements the entry points `warn', `lwarn'
      26             : ;; and `display-warning'.
      27             : 
      28             : ;;; Code:
      29             : 
      30             : (defgroup warnings nil
      31             :   "Log and display warnings."
      32             :   :version "22.1"
      33             :   :group 'lisp)
      34             : 
      35             : (defvar warning-levels
      36             :   '((:emergency "Emergency%s: " ding)
      37             :     (:error "Error%s: ")
      38             :     (:warning "Warning%s: ")
      39             :     (:debug "Debug%s: "))
      40             :   "List of severity level definitions for `display-warning'.
      41             : Each element looks like (LEVEL STRING FUNCTION) and
      42             : defines LEVEL as a severity level.  STRING specifies the
      43             : description of this level.  STRING should use `%s' to
      44             : specify where to put the warning type information,
      45             : or it can omit the `%s' so as not to include that information.
      46             : 
      47             : The optional FUNCTION, if non-nil, is a function to call
      48             : with no arguments, to get the user's attention.
      49             : 
      50             : The standard levels are :emergency, :error, :warning and :debug.
      51             : See `display-warning' for documentation of their meanings.
      52             : Level :debug is ignored by default (see `warning-minimum-level').")
      53             : (put 'warning-levels 'risky-local-variable t)
      54             : 
      55             : ;; These are for compatibility with XEmacs.
      56             : ;; I don't think there is any chance of designing meaningful criteria
      57             : ;; to distinguish so many levels.
      58             : (defvar warning-level-aliases
      59             :   '((emergency . :emergency)
      60             :     (error . :error)
      61             :     (warning . :warning)
      62             :     (notice . :warning)
      63             :     (info . :warning)
      64             :     (critical . :emergency)
      65             :     (alarm . :emergency))
      66             :   "Alist of aliases for severity levels for `display-warning'.
      67             : Each element looks like (ALIAS . LEVEL) and defines ALIAS as
      68             : equivalent to LEVEL.  LEVEL must be defined in `warning-levels';
      69             : it may not itself be an alias.")
      70             : 
      71             : (defcustom warning-minimum-level :warning
      72             :   "Minimum severity level for displaying the warning buffer.
      73             : If a warning's severity level is lower than this,
      74             : the warning is logged in the warnings buffer, but the buffer
      75             : is not immediately displayed.  See also `warning-minimum-log-level'."
      76             :   :group 'warnings
      77             :   :type '(choice (const :emergency) (const :error)
      78             :                  (const :warning) (const :debug))
      79             :   :version "22.1")
      80             : (defvaralias 'display-warning-minimum-level 'warning-minimum-level)
      81             : 
      82             : (defcustom warning-minimum-log-level :warning
      83             :   "Minimum severity level for logging a warning.
      84             : If a warning severity level is lower than this,
      85             : the warning is completely ignored.
      86             : Value must be lower or equal than `warning-minimum-level',
      87             : because warnings not logged aren't displayed either."
      88             :   :group 'warnings
      89             :   :type '(choice (const :emergency) (const :error)
      90             :                  (const :warning) (const :debug))
      91             :   :version "22.1")
      92             : (defvaralias 'log-warning-minimum-level 'warning-minimum-log-level)
      93             : 
      94             : (defcustom warning-suppress-log-types nil
      95             :   "List of warning types that should not be logged.
      96             : If any element of this list matches the TYPE argument to `display-warning',
      97             : the warning is completely ignored.
      98             : The element must match the first elements of TYPE.
      99             : Thus, (foo bar) as an element matches (foo bar)
     100             : or (foo bar ANYTHING...) as TYPE.
     101             : If TYPE is a symbol FOO, that is equivalent to the list (FOO),
     102             : so only the element (FOO) will match it."
     103             :   :group 'warnings
     104             :   :type '(repeat (repeat symbol))
     105             :   :version "22.1")
     106             : 
     107             : (defcustom warning-suppress-types nil
     108             :   "List of warning types not to display immediately.
     109             : If any element of this list matches the TYPE argument to `display-warning',
     110             : the warning is logged nonetheless, but the warnings buffer is
     111             : not immediately displayed.
     112             : The element must match an initial segment of the list TYPE.
     113             : Thus, (foo bar) as an element matches (foo bar)
     114             : or (foo bar ANYTHING...) as TYPE.
     115             : If TYPE is a symbol FOO, that is equivalent to the list (FOO),
     116             : so only the element (FOO) will match it.
     117             : See also `warning-suppress-log-types'."
     118             :   :group 'warnings
     119             :   :type '(repeat (repeat symbol))
     120             :   :version "22.1")
     121             : 
     122             : ;; The autoload cookie is so that programs can bind this variable
     123             : ;; safely, testing the existing value, before they call one of the
     124             : ;; warnings functions.
     125             : ;;;###autoload
     126             : (defvar warning-prefix-function nil
     127             :   "Function to generate warning prefixes.
     128             : This function, if non-nil, is called with two arguments,
     129             : the severity level and its entry in `warning-levels',
     130             : and should return the entry that should actually be used.
     131             : The warnings buffer is current when this function is called
     132             : and the function can insert text in it.  This text becomes
     133             : the beginning of the warning.")
     134             : 
     135             : ;; The autoload cookie is so that programs can bind this variable
     136             : ;; safely, testing the existing value, before they call one of the
     137             : ;; warnings functions.
     138             : ;;;###autoload
     139             : (defvar warning-series nil
     140             :   "Non-nil means treat multiple `display-warning' calls as a series.
     141             : A marker indicates a position in the warnings buffer
     142             : which is the start of the current series; it means that
     143             : additional warnings in the same buffer should not move point.
     144             : If t, the next warning begins a series (and stores a marker here).
     145             : A symbol with a function definition is like t, except
     146             : also call that function before the next warning.")
     147             : (put 'warning-series 'risky-local-variable t)
     148             : 
     149             : ;; The autoload cookie is so that programs can bind this variable
     150             : ;; safely, testing the existing value, before they call one of the
     151             : ;; warnings functions.
     152             : ;;;###autoload
     153             : (defvar warning-fill-prefix nil
     154             :   "Non-nil means fill each warning text using this string as `fill-prefix'.")
     155             : 
     156             : ;; The autoload cookie is so that programs can bind this variable
     157             : ;; safely, testing the existing value, before they call one of the
     158             : ;; warnings functions.
     159             : ;;;###autoload
     160             : (defvar warning-type-format (purecopy " (%s)")
     161             :   "Format for displaying the warning type in the warning message.
     162             : The result of formatting the type this way gets included in the
     163             : message under the control of the string in `warning-levels'.")
     164             : 
     165             : (defun warning-numeric-level (level)
     166             :   "Return a numeric measure of the warning severity level LEVEL."
     167           0 :   (let* ((elt (assq level warning-levels))
     168           0 :          (link (memq elt warning-levels)))
     169           0 :     (length link)))
     170             : 
     171             : (defun warning-suppress-p (type suppress-list)
     172             :   "Non-nil if a warning with type TYPE should be suppressed.
     173             : SUPPRESS-LIST is the list of kinds of warnings to suppress."
     174           0 :   (let (some-match)
     175           0 :     (dolist (elt suppress-list)
     176           0 :       (if (symbolp type)
     177             :           ;; If TYPE is a symbol, the ELT must be (TYPE).
     178           0 :           (if (and (consp elt)
     179           0 :                    (eq (car elt) type)
     180           0 :                    (null (cdr elt)))
     181           0 :               (setq some-match t))
     182             :         ;; If TYPE is a list, ELT must match it or some initial segment of it.
     183           0 :         (let ((tem1 type)
     184           0 :               (tem2 elt)
     185             :               (match t))
     186             :           ;; Check elements of ELT until we run out of them.
     187           0 :           (while tem2
     188           0 :             (if (not (equal (car tem1) (car tem2)))
     189           0 :                 (setq match nil))
     190           0 :             (setq tem1 (cdr tem1)
     191           0 :                   tem2 (cdr tem2)))
     192             :           ;; If ELT is an initial segment of TYPE, MATCH is t now.
     193             :           ;; So set SOME-MATCH.
     194           0 :           (if match
     195           0 :               (setq some-match t)))))
     196             :     ;; If some element of SUPPRESS-LIST matched,
     197             :     ;; we return t.
     198           0 :     some-match))
     199             : 
     200             : ;;;###autoload
     201             : (defun display-warning (type message &optional level buffer-name)
     202             :   "Display a warning message, MESSAGE.
     203             : TYPE is the warning type: either a custom group name (a symbol),
     204             : or a list of symbols whose first element is a custom group name.
     205             : \(The rest of the symbols represent subcategories, for warning purposes
     206             : only, and you can use whatever symbols you like.)
     207             : 
     208             : LEVEL should be either :debug, :warning, :error, or :emergency
     209             : \(but see `warning-minimum-level' and `warning-minimum-log-level').
     210             : Default is :warning.
     211             : 
     212             : :emergency -- a problem that will seriously impair Emacs operation soon
     213             :               if you do not attend to it promptly.
     214             : :error     -- data or circumstances that are inherently wrong.
     215             : :warning   -- data or circumstances that are not inherently wrong,
     216             :               but raise suspicion of a possible problem.
     217             : :debug     -- info for debugging only.
     218             : 
     219             : BUFFER-NAME, if specified, is the name of the buffer for logging
     220             : the warning.  By default, it is `*Warnings*'.  If this function
     221             : has to create the buffer, it disables undo in the buffer.
     222             : 
     223             : See the `warnings' custom group for user customization features.
     224             : 
     225             : See also `warning-series', `warning-prefix-function' and
     226             : `warning-fill-prefix' for additional programming features."
     227           0 :   (if (not (or after-init-time noninteractive (daemonp)))
     228             :       ;; Ensure warnings that happen early in the startup sequence
     229             :       ;; are visible when startup completes (bug#20792).
     230           0 :       (delay-warning type message level buffer-name)
     231           0 :     (unless level
     232           0 :       (setq level :warning))
     233           0 :     (unless buffer-name
     234           0 :       (setq buffer-name "*Warnings*"))
     235           0 :     (if (assq level warning-level-aliases)
     236           0 :         (setq level (cdr (assq level warning-level-aliases))))
     237           0 :     (or (< (warning-numeric-level level)
     238           0 :            (warning-numeric-level warning-minimum-log-level))
     239           0 :         (warning-suppress-p type warning-suppress-log-types)
     240           0 :         (let* ((typename (if (consp type) (car type) type))
     241           0 :                (old (get-buffer buffer-name))
     242           0 :                (buffer (or old (get-buffer-create buffer-name)))
     243           0 :                (level-info (assq level warning-levels))
     244             :                start end)
     245           0 :           (with-current-buffer buffer
     246             :             ;; If we created the buffer, disable undo.
     247           0 :             (unless old
     248           0 :               (special-mode)
     249           0 :               (setq buffer-read-only t)
     250           0 :               (setq buffer-undo-list t))
     251           0 :             (goto-char (point-max))
     252           0 :             (when (and warning-series (symbolp warning-series))
     253           0 :               (setq warning-series
     254           0 :                     (prog1 (point-marker)
     255           0 :                       (unless (eq warning-series t)
     256           0 :                         (funcall warning-series)))))
     257           0 :             (let ((inhibit-read-only t))
     258           0 :               (unless (bolp)
     259           0 :                 (newline))
     260           0 :               (setq start (point))
     261           0 :               (if warning-prefix-function
     262           0 :                   (setq level-info (funcall warning-prefix-function
     263           0 :                                             level level-info)))
     264           0 :               (insert (format (nth 1 level-info)
     265           0 :                               (format warning-type-format typename))
     266           0 :                       message)
     267           0 :               (newline)
     268           0 :               (when (and warning-fill-prefix (not (string-match "\n" message)))
     269           0 :                 (let ((fill-prefix warning-fill-prefix)
     270             :                       (fill-column 78))
     271           0 :                   (fill-region start (point))))
     272           0 :               (setq end (point)))
     273           0 :             (when (and (markerp warning-series)
     274           0 :                        (eq (marker-buffer warning-series) buffer))
     275           0 :               (goto-char warning-series)))
     276           0 :           (if (nth 2 level-info)
     277           0 :               (funcall (nth 2 level-info)))
     278           0 :           (cond (noninteractive
     279             :                  ;; Noninteractively, take the text we inserted
     280             :                  ;; in the warnings buffer and print it.
     281             :                  ;; Do this unconditionally, since there is no way
     282             :                  ;; to view logged messages unless we output them.
     283           0 :                  (with-current-buffer buffer
     284           0 :                    (save-excursion
     285             :                      ;; Don't include the final newline in the arg
     286             :                      ;; to `message', because it adds a newline.
     287           0 :                      (goto-char end)
     288           0 :                      (if (bolp)
     289           0 :                          (forward-char -1))
     290           0 :                      (message "%s" (buffer-substring start (point))))))
     291           0 :                 ((and (daemonp) (null after-init-time))
     292             :                  ;; Warnings assigned during daemon initialization go into
     293             :                  ;; the messages buffer.
     294           0 :                  (message "%s"
     295           0 :                           (with-current-buffer buffer
     296           0 :                             (save-excursion
     297           0 :                               (goto-char end)
     298           0 :                               (if (bolp)
     299           0 :                                   (forward-char -1))
     300           0 :                               (buffer-substring start (point))))))
     301             :                 (t
     302             :                  ;; Interactively, decide whether the warning merits
     303             :                  ;; immediate display.
     304           0 :                  (or (< (warning-numeric-level level)
     305           0 :                         (warning-numeric-level warning-minimum-level))
     306           0 :                      (warning-suppress-p type warning-suppress-types)
     307           0 :                      (let ((window (display-buffer buffer)))
     308           0 :                        (when (and (markerp warning-series)
     309           0 :                                   (eq (marker-buffer warning-series) buffer))
     310           0 :                          (set-window-start window warning-series))
     311           0 :                        (sit-for 0)))))))))
     312             : 
     313             : ;; Use \\<special-mode-map> so that help-enable-auto-load can do its thing.
     314             : ;; Any keymap that is defined will do.
     315             : ;;;###autoload
     316             : (defun lwarn (type level message &rest args)
     317             :   "Display a warning message made from (format-message MESSAGE ARGS...).
     318             : \\<special-mode-map>
     319             : Aside from generating the message with `format-message',
     320             : this is equivalent to `display-warning'.
     321             : 
     322             : TYPE is the warning type: either a custom group name (a symbol),
     323             : or a list of symbols whose first element is a custom group name.
     324             : \(The rest of the symbols represent subcategories and
     325             : can be whatever you like.)
     326             : 
     327             : LEVEL should be either :debug, :warning, :error, or :emergency
     328             : \(but see `warning-minimum-level' and `warning-minimum-log-level').
     329             : 
     330             : :emergency -- a problem that will seriously impair Emacs operation soon
     331             :               if you do not attend to it promptly.
     332             : :error     -- invalid data or circumstances.
     333             : :warning   -- suspicious data or circumstances.
     334             : :debug     -- info for debugging only."
     335           0 :   (display-warning type (apply #'format-message message args) level))
     336             : 
     337             : ;;;###autoload
     338             : (defun warn (message &rest args)
     339             :   "Display a warning message made from (format-message MESSAGE ARGS...).
     340             : Aside from generating the message with `format-message',
     341             : this is equivalent to `display-warning', using
     342             : `emacs' as the type and `:warning' as the level."
     343           0 :   (display-warning 'emacs (apply #'format-message message args)))
     344             : 
     345             : (provide 'warnings)
     346             : 
     347             : ;;; warnings.el ends here

Generated by: LCOV version 1.12