* lisp/subr.el (define-error): New function.
* doc/lispref/control.texi (Signaling Errors): Refer to define-error. (Error Symbols): Add `define-error'. * doc/lispref/errors.texi (Standard Errors): Don't refer to `error-conditions'. * lisp/progmodes/ada-xref.el (ada-error-file-not-found): Rename from error-file-not-found and define with define-error. * lisp/emacs-lisp/cl-lib.el (cl-assertion-failed): Move here from subr.el and define with define-error. * lisp/userlock.el (file-locked, file-supersession): * lisp/simple.el (mark-inactive): * lisp/progmodes/js.el (js-moz-bad-rpc, js-js-error): * lisp/progmodes/ada-mode.el (ada-mode-errors): * lisp/play/life.el (life-extinct): * lisp/nxml/xsd-regexp.el (xsdre-invalid-regexp, xsdre-parse-error): * lisp/nxml/xmltok.el (xmltok-markup-declaration-parse-error): * lisp/nxml/rng-util.el (rng-error): * lisp/nxml/rng-uri.el (rng-uri-error): * lisp/nxml/rng-match.el (rng-compile-error): * lisp/nxml/rng-cmpct.el (rng-c-incorrect-schema): * lisp/nxml/nxml-util.el (nxml-error, nxml-file-parse-error): * lisp/nxml/nxml-rap.el (nxml-scan-error): * lisp/nxml/nxml-outln.el (nxml-outline-error): * lisp/net/soap-client.el (soap-error): * lisp/net/gnutls.el (gnutls-error): * lisp/net/ange-ftp.el (ftp-error): * lisp/mpc.el (mpc-proc-error): * lisp/json.el (json-error, json-readtable-error, json-unknown-keyword) (json-number-format, json-string-escape, json-string-format) (json-key-format, json-object-format): * lisp/jka-compr.el (compression-error): * lisp/international/quail.el (quail-error): * lisp/international/kkc.el (kkc-error): * lisp/emacs-lisp/ert.el (ert-test-failed): * lisp/calc/calc.el (calc-error, inexact-result, math-overflow) (math-underflow): * lisp/bookmark.el (bookmark-error-no-filename): * lisp/epg.el (epg-error): Define with define-error.
This commit is contained in:
Stefan Monnier
parent
14ba08227d
commit
54bd972f15
34 changed files with 153 additions and 189 deletions
|
|
@ -1,3 +1,10 @@
|
|||
2013-08-09 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* errors.texi (Standard Errors): Don't refer to `error-conditions'.
|
||||
|
||||
* control.texi (Signaling Errors): Refer to define-error.
|
||||
(Error Symbols): Add `define-error'.
|
||||
|
||||
2013-08-06 Dmitry Antipov <dmantipov@yandex.ru>
|
||||
|
||||
* positions.texi (Motion by Screen Lines):
|
||||
|
|
|
|||
|
|
@ -890,9 +890,8 @@ argument @var{data} is a list of additional Lisp objects relevant to
|
|||
the circumstances of the error.
|
||||
|
||||
The argument @var{error-symbol} must be an @dfn{error symbol}---a symbol
|
||||
bearing a property @code{error-conditions} whose value is a list of
|
||||
condition names. This is how Emacs Lisp classifies different sorts of
|
||||
errors. @xref{Error Symbols}, for a description of error symbols,
|
||||
defined with @code{define-error}. This is how Emacs Lisp classifies different
|
||||
sorts of errors. @xref{Error Symbols}, for a description of error symbols,
|
||||
error conditions and condition names.
|
||||
|
||||
If the error is not handled, the two arguments are used in printing
|
||||
|
|
@ -1118,8 +1117,8 @@ Here are examples of handlers:
|
|||
@end example
|
||||
|
||||
Each error that occurs has an @dfn{error symbol} that describes what
|
||||
kind of error it is. The @code{error-conditions} property of this
|
||||
symbol is a list of condition names (@pxref{Error Symbols}). Emacs
|
||||
kind of error it is, and which describes also a list of condition names
|
||||
(@pxref{Error Symbols}). Emacs
|
||||
searches all the active @code{condition-case} forms for a handler that
|
||||
specifies one or more of these condition names; the innermost matching
|
||||
@code{condition-case} handles the error. Within this
|
||||
|
|
@ -1259,6 +1258,7 @@ should be robust if one does occur. Note that this macro uses
|
|||
@cindex condition name
|
||||
@cindex user-defined error
|
||||
@kindex error-conditions
|
||||
@kindex define-error
|
||||
|
||||
When you signal an error, you specify an @dfn{error symbol} to specify
|
||||
the kind of error you have in mind. Each error has one and only one
|
||||
|
|
@ -1275,42 +1275,37 @@ Thus, each error has one or more condition names: @code{error}, the
|
|||
error symbol if that is distinct from @code{error}, and perhaps some
|
||||
intermediate classifications.
|
||||
|
||||
In order for a symbol to be an error symbol, it must have an
|
||||
@code{error-conditions} property which gives a list of condition names.
|
||||
This list defines the conditions that this kind of error belongs to.
|
||||
(The error symbol itself, and the symbol @code{error}, should always be
|
||||
members of this list.) Thus, the hierarchy of condition names is
|
||||
defined by the @code{error-conditions} properties of the error symbols.
|
||||
Because quitting is not considered an error, the value of the
|
||||
@code{error-conditions} property of @code{quit} is just @code{(quit)}.
|
||||
@defun define-error name message &optional parent
|
||||
In order for a symbol to be an error symbol, it must be defined with
|
||||
@code{define-error} which takes a parent condition (defaults to @code{error}).
|
||||
This parent defines the conditions that this kind of error belongs to.
|
||||
The transitive set of parents always includes the error symbol itself, and the
|
||||
symbol @code{error}. Because quitting is not considered an error, the set of
|
||||
parents of @code{quit} is just @code{(quit)}.
|
||||
|
||||
@cindex peculiar error
|
||||
In addition to the @code{error-conditions} list, the error symbol
|
||||
should have an @code{error-message} property whose value is a string to
|
||||
be printed when that error is signaled but not handled. If the
|
||||
error symbol has no @code{error-message} property or if the
|
||||
@code{error-message} property exists, but is not a string, the error
|
||||
message @samp{peculiar error} is used. @xref{Definition of signal}.
|
||||
In addition to its parents, the error symbol has a var{message} which
|
||||
is a string to be printed when that error is signaled but not handled. If that
|
||||
message is not valid, the error message @samp{peculiar error} is used.
|
||||
@xref{Definition of signal}.
|
||||
|
||||
Internally, the set of parents is stored in the @code{error-conditions}
|
||||
property of the error symbol and the message is stored in the
|
||||
@code{error-message} property of the error symbol.
|
||||
|
||||
Here is how we define a new error symbol, @code{new-error}:
|
||||
|
||||
@example
|
||||
@group
|
||||
(put 'new-error
|
||||
'error-conditions
|
||||
'(error my-own-errors new-error))
|
||||
@result{} (error my-own-errors new-error)
|
||||
@end group
|
||||
@group
|
||||
(put 'new-error 'error-message "A new error")
|
||||
@result{} "A new error"
|
||||
(define-error 'new-error "A new error" 'my-own-errors)
|
||||
@end group
|
||||
@end example
|
||||
|
||||
@noindent
|
||||
This error has three condition names: @code{new-error}, the narrowest
|
||||
This error has several condition names: @code{new-error}, the narrowest
|
||||
classification; @code{my-own-errors}, which we imagine is a wider
|
||||
classification; and @code{error}, which is the widest of all.
|
||||
classification; and all the conditions of @code{my-own-errors} which should
|
||||
include @code{error}, which is the widest of all.
|
||||
|
||||
The error string should start with a capital letter but it should
|
||||
not end with a period. This is for consistency with the rest of Emacs.
|
||||
|
|
@ -1326,7 +1321,7 @@ your code can do this:
|
|||
@end group
|
||||
@end example
|
||||
|
||||
This error can be handled through any of the three condition names.
|
||||
This error can be handled through any of its condition names.
|
||||
This example handles @code{new-error} and any other errors in the class
|
||||
@code{my-own-errors}:
|
||||
|
||||
|
|
|
|||
|
|
@ -7,12 +7,11 @@
|
|||
@appendix Standard Errors
|
||||
@cindex standard errors
|
||||
|
||||
Here is a list of the more important error symbols in standard Emacs,
|
||||
grouped by concept. The list includes each symbol's message (on the
|
||||
@code{error-message} property of the symbol) and a cross reference to a
|
||||
description of how the error can occur.
|
||||
Here is a list of the more important error symbols in standard Emacs, grouped
|
||||
by concept. The list includes each symbol's message and a cross reference
|
||||
to a description of how the error can occur.
|
||||
|
||||
Each error symbol has an @code{error-conditions} property that is a
|
||||
Each error symbol has an set of parent error conditions that is a
|
||||
list of symbols. Normally this list includes the error symbol itself
|
||||
and the symbol @code{error}. Occasionally it includes additional
|
||||
symbols, which are intermediate classifications, narrower than
|
||||
|
|
@ -24,8 +23,6 @@ conditions, that means it has none.
|
|||
As a special exception, the error symbol @code{quit} does not have the
|
||||
condition @code{error}, because quitting is not considered an error.
|
||||
|
||||
@c You can grep for "(put 'foo 'error-conditions ...) to find
|
||||
@c examples defined in Lisp. E.g., soap-client.el, sasl.el.
|
||||
Most of these error symbols are defined in C (mainly @file{data.c}),
|
||||
but some are defined in Lisp. For example, the file @file{userlock.el}
|
||||
defines the @code{file-locked} and @code{file-supersession} errors.
|
||||
|
|
|
|||
3
etc/NEWS
3
etc/NEWS
|
|
@ -599,6 +599,9 @@ in the presence of files with negative time stamps.
|
|||
|
||||
* Lisp Changes in Emacs 24.4
|
||||
|
||||
+++
|
||||
** New function `define-error'.
|
||||
|
||||
** New hook `tty-setup-hook'.
|
||||
|
||||
+++
|
||||
|
|
|
|||
|
|
@ -1,5 +1,40 @@
|
|||
2013-08-09 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* subr.el (define-error): New function.
|
||||
* progmodes/ada-xref.el (ada-error-file-not-found): Rename from
|
||||
error-file-not-found and define with define-error.
|
||||
* emacs-lisp/cl-lib.el (cl-assertion-failed): Move here from subr.el
|
||||
and define with define-error.
|
||||
* userlock.el (file-locked, file-supersession):
|
||||
* simple.el (mark-inactive):
|
||||
* progmodes/js.el (js-moz-bad-rpc, js-js-error):
|
||||
* progmodes/ada-mode.el (ada-mode-errors):
|
||||
* play/life.el (life-extinct):
|
||||
* nxml/xsd-regexp.el (xsdre-invalid-regexp, xsdre-parse-error):
|
||||
* nxml/xmltok.el (xmltok-markup-declaration-parse-error):
|
||||
* nxml/rng-util.el (rng-error):
|
||||
* nxml/rng-uri.el (rng-uri-error):
|
||||
* nxml/rng-match.el (rng-compile-error):
|
||||
* nxml/rng-cmpct.el (rng-c-incorrect-schema):
|
||||
* nxml/nxml-util.el (nxml-error, nxml-file-parse-error):
|
||||
* nxml/nxml-rap.el (nxml-scan-error):
|
||||
* nxml/nxml-outln.el (nxml-outline-error):
|
||||
* net/soap-client.el (soap-error):
|
||||
* net/gnutls.el (gnutls-error):
|
||||
* net/ange-ftp.el (ftp-error):
|
||||
* mpc.el (mpc-proc-error):
|
||||
* json.el (json-error, json-readtable-error, json-unknown-keyword)
|
||||
(json-number-format, json-string-escape, json-string-format)
|
||||
(json-key-format, json-object-format):
|
||||
* jka-compr.el (compression-error):
|
||||
* international/quail.el (quail-error):
|
||||
* international/kkc.el (kkc-error):
|
||||
* emacs-lisp/ert.el (ert-test-failed):
|
||||
* calc/calc.el (calc-error, inexact-result, math-overflow)
|
||||
(math-underflow):
|
||||
* bookmark.el (bookmark-error-no-filename):
|
||||
* epg.el (epg-error): Define with define-error.
|
||||
|
||||
* time.el (display-time-event-handler)
|
||||
(display-time-next-load-average): Don't call sit-for since it seems
|
||||
unnecessary (bug#15045).
|
||||
|
|
|
|||
|
|
@ -1112,12 +1112,9 @@ then offer interactively to relocate BOOKMARK-NAME-OR-RECORD."
|
|||
(setq bookmark-current-bookmark bookmark-name-or-record))
|
||||
nil)
|
||||
|
||||
(put 'bookmark-error-no-filename
|
||||
'error-conditions
|
||||
'(error bookmark-errors bookmark-error-no-filename))
|
||||
(put 'bookmark-error-no-filename
|
||||
'error-message
|
||||
"Bookmark has no associated file (or directory)")
|
||||
(define-error 'bookmark-errors nil)
|
||||
(define-error 'bookmark-error-no-filename
|
||||
"Bookmark has no associated file (or directory)" 'bookmark-errors)
|
||||
|
||||
(defun bookmark-default-handler (bmk-record)
|
||||
"Default handler to jump to a particular bookmark location.
|
||||
|
|
|
|||
|
|
@ -921,15 +921,12 @@ Used by `calc-user-invocation'.")
|
|||
(put 'calc-mode 'mode-class 'special)
|
||||
(put 'calc-trail-mode 'mode-class 'special)
|
||||
|
||||
;; Define "inexact-result" as an e-lisp error symbol.
|
||||
(put 'inexact-result 'error-conditions '(error inexact-result calc-error))
|
||||
(put 'inexact-result 'error-message "Calc internal error (inexact-result)")
|
||||
(define-error 'calc-error "Calc internal error")
|
||||
(define-error 'inexact-result
|
||||
"Calc internal error (inexact-result)" 'calc-error)
|
||||
|
||||
;; Define "math-overflow" and "math-underflow" as e-lisp error symbols.
|
||||
(put 'math-overflow 'error-conditions '(error math-overflow calc-error))
|
||||
(put 'math-overflow 'error-message "Floating-point overflow occurred")
|
||||
(put 'math-underflow 'error-conditions '(error math-underflow calc-error))
|
||||
(put 'math-underflow 'error-message "Floating-point underflow occurred")
|
||||
(define-error 'math-overflow "Floating-point overflow occurred" 'calc-error)
|
||||
(define-error 'math-underflow "Floating-point underflow occurred" 'calc-error)
|
||||
|
||||
(defvar calc-trail-pointer nil
|
||||
"The \"current\" entry in trail buffer.")
|
||||
|
|
|
|||
|
|
@ -714,6 +714,9 @@ If ALIST is non-nil, the new pairs are prepended to it."
|
|||
|
||||
;;;###autoload
|
||||
(progn
|
||||
;; The `assert' macro from the cl package signals
|
||||
;; `cl-assertion-failed' at runtime so always define it.
|
||||
(define-error 'cl-assertion-failed (purecopy "Assertion failed"))
|
||||
;; Make sure functions defined with cl-defsubst can be inlined even in
|
||||
;; packages which do not require CL. We don't put an autoload cookie
|
||||
;; directly on that function, since those cookies only go to cl-loaddefs.
|
||||
|
|
|
|||
|
|
@ -236,8 +236,7 @@ description of valid values for RESULT-TYPE.
|
|||
"The regexp the `find-function' mechanisms use for finding test definitions.")
|
||||
|
||||
|
||||
(put 'ert-test-failed 'error-conditions '(error ert-test-failed))
|
||||
(put 'ert-test-failed 'error-message "Test failed")
|
||||
(define-error 'ert-test-failed "Test failed")
|
||||
|
||||
(defun ert-pass ()
|
||||
"Terminate the current test and mark it passed. Does not return."
|
||||
|
|
|
|||
|
|
@ -162,8 +162,7 @@
|
|||
|
||||
(defvar epg-prompt-alist nil)
|
||||
|
||||
(put 'epg-error 'error-conditions '(epg-error error))
|
||||
(put 'epg-error 'error-message "GPG error")
|
||||
(define-error 'epg-error "GPG error")
|
||||
|
||||
(defun epg-make-data-from-file (file)
|
||||
"Make a data object from FILE."
|
||||
|
|
|
|||
|
|
@ -207,7 +207,7 @@ area while indicating the current selection by `<N>'."
|
|||
kkc-current-conversions-width nil
|
||||
kkc-current-conversions (cons 0 nil)))))))
|
||||
|
||||
(put 'kkc-error 'error-conditions '(kkc-error error))
|
||||
(define-error 'kkc-error nil)
|
||||
(defun kkc-error (&rest args)
|
||||
(signal 'kkc-error (apply 'format args)))
|
||||
|
||||
|
|
|
|||
|
|
@ -1301,7 +1301,7 @@ The returned value is a Quail map specific to KEY."
|
|||
(setcdr map (funcall (cdr map) key len)))
|
||||
map))
|
||||
|
||||
(put 'quail-error 'error-conditions '(quail-error error))
|
||||
(define-error 'quail-error nil)
|
||||
(defun quail-error (&rest args)
|
||||
(signal 'quail-error (apply 'format args)))
|
||||
|
||||
|
|
|
|||
|
|
@ -109,8 +109,7 @@ data appears to be compressed already.")
|
|||
(put 'jka-compr-really-do-compress 'permanent-local t)
|
||||
|
||||
|
||||
(put 'compression-error 'error-conditions '(compression-error file-error error))
|
||||
|
||||
(define-error 'compression-error nil 'file-error)
|
||||
|
||||
(defvar jka-compr-acceptable-retval-list '(0 2 141))
|
||||
|
||||
|
|
|
|||
38
lisp/json.el
38
lisp/json.el
|
|
@ -177,36 +177,14 @@ without indentation.")
|
|||
|
||||
;; Error conditions
|
||||
|
||||
(put 'json-error 'error-message "Unknown JSON error")
|
||||
(put 'json-error 'error-conditions '(json-error error))
|
||||
|
||||
(put 'json-readtable-error 'error-message "JSON readtable error")
|
||||
(put 'json-readtable-error 'error-conditions
|
||||
'(json-readtable-error json-error error))
|
||||
|
||||
(put 'json-unknown-keyword 'error-message "Unrecognized keyword")
|
||||
(put 'json-unknown-keyword 'error-conditions
|
||||
'(json-unknown-keyword json-error error))
|
||||
|
||||
(put 'json-number-format 'error-message "Invalid number format")
|
||||
(put 'json-number-format 'error-conditions
|
||||
'(json-number-format json-error error))
|
||||
|
||||
(put 'json-string-escape 'error-message "Bad Unicode escape")
|
||||
(put 'json-string-escape 'error-conditions
|
||||
'(json-string-escape json-error error))
|
||||
|
||||
(put 'json-string-format 'error-message "Bad string format")
|
||||
(put 'json-string-format 'error-conditions
|
||||
'(json-string-format json-error error))
|
||||
|
||||
(put 'json-key-format 'error-message "Bad JSON object key")
|
||||
(put 'json-key-format 'error-conditions
|
||||
'(json-key-format json-error error))
|
||||
|
||||
(put 'json-object-format 'error-message "Bad JSON object")
|
||||
(put 'json-object-format 'error-conditions
|
||||
'(json-object-format json-error error))
|
||||
(define-error 'json-error "Unknown JSON error")
|
||||
(define-error 'json-readtable-error "JSON readtable error" 'json-error)
|
||||
(define-error 'json-unknown-keyword "Unrecognized keyword" 'json-error)
|
||||
(define-error 'json-number-format "Invalid number format" 'json-error)
|
||||
(define-error 'json-string-escape "Bad Unicode escape" 'json-error)
|
||||
(define-error 'json-string-format "Bad string format" 'json-error)
|
||||
(define-error 'json-key-format "Bad JSON object key" 'json-error)
|
||||
(define-error 'json-object-format "Bad JSON object" 'json-error)
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -209,8 +209,7 @@ defaults to 6600 and HOST defaults to localhost."
|
|||
|
||||
(defconst mpc--proc-end-re "^\\(?:OK\\(?: MPD .*\\)?\\|ACK \\(.*\\)\\)\n")
|
||||
|
||||
(put 'mpc-proc-error 'error-conditions '(mpc-proc-error error))
|
||||
(put 'mpc-proc-error 'error-message "MPD error")
|
||||
(define-error 'mpc-proc-error "MPD error")
|
||||
|
||||
(defun mpc--debug (format &rest args)
|
||||
(if (get-buffer "*MPC-debug*")
|
||||
|
|
|
|||
|
|
@ -1097,8 +1097,7 @@ All HOST values should be in lower case.")
|
|||
(defvar ange-ftp-trample-marker)
|
||||
|
||||
;; New error symbols.
|
||||
(put 'ftp-error 'error-conditions '(ftp-error file-error error))
|
||||
;; (put 'ftp-error 'error-message "FTP error")
|
||||
(define-error 'ftp-error nil 'file-error) ;"FTP error"
|
||||
|
||||
;;; ------------------------------------------------------------
|
||||
;;; Enhanced message support.
|
||||
|
|
|
|||
|
|
@ -111,11 +111,7 @@ trust and key files, and priority string."
|
|||
:type 'gnutls-x509pki
|
||||
:hostname host))
|
||||
|
||||
(put 'gnutls-error
|
||||
'error-conditions
|
||||
'(error gnutls-error))
|
||||
(put 'gnutls-error
|
||||
'error-message "GnuTLS error")
|
||||
(define-error 'gnutls-error "GnuTLS error")
|
||||
|
||||
(declare-function gnutls-boot "gnutls.c" (proc type proplist))
|
||||
(declare-function gnutls-errorp "gnutls.c" (error))
|
||||
|
|
|
|||
|
|
@ -1352,10 +1352,7 @@ This is because it is easier to work with list results in LISP."
|
|||
|
||||
;;;; Soap Envelope parsing
|
||||
|
||||
(put 'soap-error
|
||||
'error-conditions
|
||||
'(error soap-error))
|
||||
(put 'soap-error 'error-message "SOAP error")
|
||||
(define-error 'soap-error "SOAP error")
|
||||
|
||||
(defun soap-parse-envelope (node operation wsdl)
|
||||
"Parse the SOAP envelope in NODE and return the response.
|
||||
|
|
|
|||
|
|
@ -1008,13 +1008,8 @@ immediately after the section's start-tag."
|
|||
(defun nxml-outline-error (&rest args)
|
||||
(signal 'nxml-outline-error args))
|
||||
|
||||
(put 'nxml-outline-error
|
||||
'error-conditions
|
||||
'(error nxml-error nxml-outline-error))
|
||||
|
||||
(put 'nxml-outline-error
|
||||
'error-message
|
||||
"Cannot create outline of buffer that is not well-formed")
|
||||
(define-error 'nxml-outline-error
|
||||
"Cannot create outline of buffer that is not well-formed" 'nxml-error)
|
||||
|
||||
;;; Debugging
|
||||
|
||||
|
|
|
|||
|
|
@ -402,13 +402,8 @@ expected `%s'"
|
|||
(defun nxml-scan-error (&rest args)
|
||||
(signal 'nxml-scan-error args))
|
||||
|
||||
(put 'nxml-scan-error
|
||||
'error-conditions
|
||||
'(error nxml-error nxml-scan-error))
|
||||
|
||||
(put 'nxml-scan-error
|
||||
'error-message
|
||||
"Scan over element that is not well-formed")
|
||||
(define-error 'nxml-scan-error
|
||||
"Scan over element that is not well-formed" 'nxml-error)
|
||||
|
||||
(provide 'nxml-rap)
|
||||
|
||||
|
|
|
|||
|
|
@ -101,13 +101,8 @@ This is the inverse of `nxml-make-namespace'."
|
|||
(signal (or error-symbol 'nxml-file-parse-error)
|
||||
(list file pos message)))
|
||||
|
||||
(put 'nxml-file-parse-error
|
||||
'error-conditions
|
||||
'(error nxml-file-parse-error))
|
||||
|
||||
(put 'nxml-parse-file-error
|
||||
'error-message
|
||||
"Error parsing file")
|
||||
(define-error 'nxml-error nil)
|
||||
(define-error 'nxml-file-parse-error "Error parsing file" 'nxml-error)
|
||||
|
||||
(provide 'nxml-util)
|
||||
|
||||
|
|
|
|||
|
|
@ -45,13 +45,8 @@ Return a pattern."
|
|||
|
||||
;;; Error handling
|
||||
|
||||
(put 'rng-c-incorrect-schema
|
||||
'error-conditions
|
||||
'(error rng-error nxml-file-parse-error rng-c-incorrect-schema))
|
||||
|
||||
(put 'rng-c-incorrect-schema
|
||||
'error-message
|
||||
"Incorrect schema")
|
||||
(define-error 'rng-c-incorrect-schema
|
||||
"Incorrect schema" '(rng-error nxml-file-parse-error))
|
||||
|
||||
(defun rng-c-signal-incorrect-schema (filename pos message)
|
||||
(nxml-signal-file-parse-error filename
|
||||
|
|
|
|||
|
|
@ -1541,14 +1541,7 @@ nullable and y1 isn't, return a choice
|
|||
(signal 'rng-compile-error
|
||||
(list (apply 'format args))))
|
||||
|
||||
(put 'rng-compile-error
|
||||
'error-conditions
|
||||
'(error rng-error rng-compile-error))
|
||||
|
||||
(put 'rng-compile-error
|
||||
'error-message
|
||||
"Incorrect schema")
|
||||
|
||||
(define-error 'rng-compile-error "Incorrect schema" 'rng-error)
|
||||
|
||||
;;; External API
|
||||
|
||||
|
|
|
|||
|
|
@ -127,8 +127,7 @@ Signal an error if URI is not a valid file URL."
|
|||
(defun rng-uri-error (&rest args)
|
||||
(signal 'rng-uri-error (list (apply 'format args))))
|
||||
|
||||
(put 'rng-uri-error 'error-conditions '(error rng-uri-error))
|
||||
(put 'rng-uri-error 'error-message "Invalid URI")
|
||||
(define-error 'rng-uri-error "Invalid URI")
|
||||
|
||||
(defun rng-uri-split (str)
|
||||
(and (string-match "\\`\\(?:\\([^:/?#]+\\):\\)?\
|
||||
|
|
|
|||
|
|
@ -165,6 +165,8 @@ HIST, if non-nil, specifies a history list as with `completing-read'."
|
|||
(setq string (substring string 0 -1)))
|
||||
string)
|
||||
|
||||
(define-error 'rng-error nil)
|
||||
|
||||
(provide 'rng-util)
|
||||
|
||||
;;; rng-util.el ends here
|
||||
|
|
|
|||
|
|
@ -1435,13 +1435,8 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT."
|
|||
(defun xmltok-current-token-string ()
|
||||
(buffer-substring-no-properties xmltok-start (point)))
|
||||
|
||||
(put 'xmltok-markup-declaration-parse-error
|
||||
'error-conditions
|
||||
'(error xmltok-markup-declaration-parse-error))
|
||||
|
||||
(put 'xmltok-markup-declaration-parse-error
|
||||
'error-message
|
||||
"Syntax error in markup declaration")
|
||||
(define-error 'xmltok-markup-declaration-parse-error
|
||||
"Syntax error in markup declaration")
|
||||
|
||||
(defun xmltok-markup-declaration-parse-error ()
|
||||
(signal 'xmltok-markup-declaration-parse-error nil))
|
||||
|
|
|
|||
|
|
@ -466,13 +466,8 @@ whose value is a range-list."
|
|||
(- (length str)
|
||||
(length xsdre-current-regexp))))))))
|
||||
|
||||
(put 'xsdre-invalid-regexp
|
||||
'error-conditions
|
||||
'(error xsdre-invalid-regexp))
|
||||
|
||||
(put 'xsdre-invalid-regexp
|
||||
'error-message
|
||||
"Invalid W3C XML Schema Datatypes regular expression")
|
||||
(define-error 'xsdre-invalid-regexp
|
||||
"Invalid W3C XML Schema Datatypes regular expression")
|
||||
|
||||
(defun xsdre-parse-regexp ()
|
||||
(let ((branches nil))
|
||||
|
|
@ -686,13 +681,7 @@ whose value is a range-list."
|
|||
|
||||
;; This error condition is used only internally.
|
||||
|
||||
(put 'xsdre-parse-error
|
||||
'error-conditions
|
||||
'(error xsdre-parse-error))
|
||||
|
||||
(put 'xsdre-parse-error
|
||||
'error-message
|
||||
"Internal error in parsing XSD regexp")
|
||||
(define-error 'xsdre-parse-error "Internal error in parsing XSD regexp")
|
||||
|
||||
;;; Character class data
|
||||
|
||||
|
|
|
|||
|
|
@ -290,8 +290,7 @@ generations (this defaults to 1)."
|
|||
(life-display-generation 0)
|
||||
(signal 'life-extinct nil))
|
||||
|
||||
(put 'life-extinct 'error-conditions '(life-extinct quit))
|
||||
(put 'life-extinct 'error-message "All life has perished")
|
||||
(define-error 'life-extinct "All life has perished" 'quit) ;FIXME: quit really?
|
||||
|
||||
(provide 'life)
|
||||
|
||||
|
|
|
|||
|
|
@ -130,6 +130,8 @@
|
|||
(defvar ispell-check-comments)
|
||||
(defvar skeleton-further-elements)
|
||||
|
||||
(define-error 'ada-mode-errors nil)
|
||||
|
||||
(defun ada-mode-version ()
|
||||
"Return Ada mode version."
|
||||
(interactive)
|
||||
|
|
|
|||
|
|
@ -1142,7 +1142,7 @@ If OTHER-FRAME is non-nil, display the cross-reference in another frame."
|
|||
(condition-case err
|
||||
(ada-find-in-ali identlist other-frame)
|
||||
;; File not found: print explicit error message
|
||||
(error-file-not-found
|
||||
(ada-error-file-not-found
|
||||
(message (concat (error-message-string err)
|
||||
(nthcdr 1 err))))
|
||||
|
||||
|
|
@ -1637,7 +1637,7 @@ Search in project file for possible paths."
|
|||
(let ((filename (ada-find-src-file-in-dir file)))
|
||||
(if filename
|
||||
(expand-file-name filename)
|
||||
(signal 'error-file-not-found (file-name-nondirectory file)))
|
||||
(signal 'ada-error-file-not-found (file-name-nondirectory file)))
|
||||
)))
|
||||
|
||||
(defun ada-find-file-number-in-ali (file)
|
||||
|
|
@ -1828,7 +1828,7 @@ Information is extracted from the ali file."
|
|||
(ada-file-of identlist)))
|
||||
|
||||
;; Else clean up the ali file
|
||||
(error-file-not-found
|
||||
(ada-error-file-not-found
|
||||
(signal (car err) (cdr err)))
|
||||
(error
|
||||
(kill-buffer ali-buffer)
|
||||
|
|
@ -2127,7 +2127,7 @@ the declaration and documentation of the subprograms one is using."
|
|||
(string-to-number (nth 2 (nth choice list)))
|
||||
identlist
|
||||
other-frame)
|
||||
(signal 'error-file-not-found (car (nth choice list))))
|
||||
(signal 'ada-error-file-not-found (car (nth choice list))))
|
||||
(message "This is only a (good) guess at the cross-reference.")
|
||||
))))
|
||||
|
||||
|
|
@ -2362,12 +2362,8 @@ For instance, it creates the gnat-specific menus, sets some hooks for
|
|||
(add-hook 'ada-mode-hook 'ada-xref-initialize)
|
||||
|
||||
;; Define a new error type
|
||||
(put 'error-file-not-found
|
||||
'error-conditions
|
||||
'(error ada-mode-errors error-file-not-found))
|
||||
(put 'error-file-not-found
|
||||
'error-message
|
||||
"File not found in src-dir (check project file): ")
|
||||
(define-error 'ada-error-file-not-found
|
||||
"File not found in src-dir (check project file): " 'ada-mode-errors)
|
||||
|
||||
(provide 'ada-xref)
|
||||
|
||||
|
|
|
|||
|
|
@ -2244,11 +2244,8 @@ current buffer. Pushes a mark onto the tag ring just like
|
|||
|
||||
;;; MozRepl integration
|
||||
|
||||
(put 'js-moz-bad-rpc 'error-conditions '(error timeout))
|
||||
(put 'js-moz-bad-rpc 'error-message "Mozilla RPC Error")
|
||||
|
||||
(put 'js-js-error 'error-conditions '(error js-error))
|
||||
(put 'js-js-error 'error-message "Javascript Error")
|
||||
(define-error 'js-moz-bad-rpc "Mozilla RPC Error") ;; '(timeout error))
|
||||
(define-error 'js-js-error "Javascript Error") ;; '(js-error error))
|
||||
|
||||
(defun js--wait-for-matching-output
|
||||
(process regexp timeout &optional start)
|
||||
|
|
|
|||
|
|
@ -4160,8 +4160,7 @@ START and END specify the portion of the current buffer to be copied."
|
|||
(save-excursion
|
||||
(insert-buffer-substring oldbuf start end)))))
|
||||
|
||||
(put 'mark-inactive 'error-conditions '(mark-inactive error))
|
||||
(put 'mark-inactive 'error-message (purecopy "The mark is not active now"))
|
||||
(define-error 'mark-inactive (purecopy "The mark is not active now"))
|
||||
|
||||
(defvar activate-mark-hook nil
|
||||
"Hook run when the mark becomes active.
|
||||
|
|
|
|||
25
lisp/subr.el
25
lisp/subr.el
|
|
@ -312,6 +312,26 @@ result of an actual problem."
|
|||
(while t
|
||||
(signal 'user-error (list (apply #'format format args)))))
|
||||
|
||||
(defun define-error (name message &optional parent)
|
||||
"Define NAME as a new error signal.
|
||||
MESSAGE is a string that will be output to the echo area if such an error
|
||||
is signaled without being caught by a `condition-case'.
|
||||
PARENT is either a signal or a list of signals from which it inherits.
|
||||
Defaults to `error'."
|
||||
(unless parent (setq parent 'error))
|
||||
(let ((conditions
|
||||
(if (consp parent)
|
||||
(apply #'nconc
|
||||
(mapcar (lambda (parent)
|
||||
(cons parent
|
||||
(or (get parent 'error-conditions)
|
||||
(error "Unknown signal `%s'" parent))))
|
||||
parent))
|
||||
(cons parent (get parent 'error-conditions)))))
|
||||
(put name 'error-conditions
|
||||
(delete-dups (copy-sequence (cons name conditions))))
|
||||
(when message (put name 'error-message message))))
|
||||
|
||||
;; We put this here instead of in frame.el so that it's defined even on
|
||||
;; systems where frame.el isn't loaded.
|
||||
(defun frame-configuration-p (object)
|
||||
|
|
@ -2526,11 +2546,6 @@ When the hook runs, the temporary buffer is current.
|
|||
This hook is normally set up with a function to put the buffer in Help
|
||||
mode.")
|
||||
|
||||
;; The `assert' macro from the cl package signals
|
||||
;; `cl-assertion-failed' at runtime so always define it.
|
||||
(put 'cl-assertion-failed 'error-conditions '(error))
|
||||
(put 'cl-assertion-failed 'error-message (purecopy "Assertion failed"))
|
||||
|
||||
(defconst user-emacs-directory
|
||||
(if (eq system-type 'ms-dos)
|
||||
;; MS-DOS cannot have initial dot.
|
||||
|
|
|
|||
|
|
@ -30,8 +30,7 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(put 'file-locked 'error-conditions '(file-locked file-error error))
|
||||
(put 'file-locked 'error-message "File is locked")
|
||||
(define-error 'file-locked "File is locked" 'file-error)
|
||||
|
||||
;;;###autoload
|
||||
(defun ask-user-about-lock (file opponent)
|
||||
|
|
@ -94,8 +93,7 @@ You can <q>uit; don't modify this file.")
|
|||
(with-current-buffer standard-output
|
||||
(help-mode))))
|
||||
|
||||
(put
|
||||
'file-supersession 'error-conditions '(file-supersession file-error error))
|
||||
(define-error 'file-supersession nil 'file-error)
|
||||
|
||||
;;;###autoload
|
||||
(defun ask-user-about-supersession-threat (fn)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue