From 54bd972f159fb8c25b4f4042ac6db5da557d9108 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Aug 2013 17:22:44 -0400 Subject: [PATCH] * 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. --- doc/lispref/ChangeLog | 7 +++++ doc/lispref/control.texi | 55 +++++++++++++++++-------------------- doc/lispref/errors.texi | 11 +++----- etc/NEWS | 3 ++ lisp/ChangeLog | 35 +++++++++++++++++++++++ lisp/bookmark.el | 9 ++---- lisp/calc/calc.el | 15 ++++------ lisp/emacs-lisp/cl-lib.el | 3 ++ lisp/emacs-lisp/ert.el | 3 +- lisp/epg.el | 3 +- lisp/international/kkc.el | 2 +- lisp/international/quail.el | 2 +- lisp/jka-compr.el | 3 +- lisp/json.el | 38 ++++++------------------- lisp/mpc.el | 3 +- lisp/net/ange-ftp.el | 3 +- lisp/net/gnutls.el | 6 +--- lisp/net/soap-client.el | 5 +--- lisp/nxml/nxml-outln.el | 9 ++---- lisp/nxml/nxml-rap.el | 9 ++---- lisp/nxml/nxml-util.el | 9 ++---- lisp/nxml/rng-cmpct.el | 9 ++---- lisp/nxml/rng-match.el | 9 +----- lisp/nxml/rng-uri.el | 3 +- lisp/nxml/rng-util.el | 2 ++ lisp/nxml/xmltok.el | 9 ++---- lisp/nxml/xsd-regexp.el | 17 ++---------- lisp/play/life.el | 3 +- lisp/progmodes/ada-mode.el | 2 ++ lisp/progmodes/ada-xref.el | 16 ++++------- lisp/progmodes/js.el | 7 ++--- lisp/simple.el | 3 +- lisp/subr.el | 25 +++++++++++++---- lisp/userlock.el | 6 ++-- 34 files changed, 154 insertions(+), 190 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 0aac5235a2..611badcbaa 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,10 @@ +2013-08-09 Stefan Monnier + + * 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 * positions.texi (Motion by Screen Lines): diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 9ee0129926..b68f318439 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -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}: diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index 87cfcfa532..8a10fbf0c4 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -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. diff --git a/etc/NEWS b/etc/NEWS index 11b675add1..370a9c8271 100644 --- a/etc/NEWS +++ b/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'. +++ diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 122634d144..7cbf733b45 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,40 @@ 2013-08-09 Stefan Monnier + * 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). diff --git a/lisp/bookmark.el b/lisp/bookmark.el index b1cdedb83c..9514317809 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -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. diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index e72d0aacd5..2eeb880c34 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -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 "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 'calc-error "Calc internal error") +(define-error 'inexact-result + "Calc internal error (inexact-result)" 'calc-error) + +(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.") diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 2ab6b7ad08..e826cf4375 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -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. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 1f5edefea0..98576687f3 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -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." diff --git a/lisp/epg.el b/lisp/epg.el index b832ead4d6..33c0443dd9 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -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." diff --git a/lisp/international/kkc.el b/lisp/international/kkc.el index a7d3ac5d01..13833fad66 100644 --- a/lisp/international/kkc.el +++ b/lisp/international/kkc.el @@ -207,7 +207,7 @@ area while indicating the current selection by `'." 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))) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 68fffc0e81..245f7975d9 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -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))) diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 5664a890cb..7266dc9ec8 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -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)) diff --git a/lisp/json.el b/lisp/json.el index 29beaedebe..aaa7bb0c49 100644 --- a/lisp/json.el +++ b/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) diff --git a/lisp/mpc.el b/lisp/mpc.el index 0800af1bd3..825eb3c05d 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -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*") diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index f6efc56023..c3adb7208e 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -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. diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 243c64ec45..3775580661 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -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)) diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index 4ba8e5b585..1d4a9b573d 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -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. diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el index dab22f7559..5fe6cfefa8 100644 --- a/lisp/nxml/nxml-outln.el +++ b/lisp/nxml/nxml-outln.el @@ -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 diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el index ac4e9ac4cd..398c107cf0 100644 --- a/lisp/nxml/nxml-rap.el +++ b/lisp/nxml/nxml-rap.el @@ -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) diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el index 6ba6d21f7e..75479160cb 100644 --- a/lisp/nxml/nxml-util.el +++ b/lisp/nxml/nxml-util.el @@ -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) diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el index 111dab8263..6697195ceb 100644 --- a/lisp/nxml/rng-cmpct.el +++ b/lisp/nxml/rng-cmpct.el @@ -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 diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el index 3c949ada66..36bd23b376 100644 --- a/lisp/nxml/rng-match.el +++ b/lisp/nxml/rng-match.el @@ -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 diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el index b5f6983ab7..8c0d409d52 100644 --- a/lisp/nxml/rng-uri.el +++ b/lisp/nxml/rng-uri.el @@ -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 "\\`\\(?:\\([^:/?#]+\\):\\)?\ diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el index 0d97f9c3f1..7af6ae231c 100644 --- a/lisp/nxml/rng-util.el +++ b/lisp/nxml/rng-util.el @@ -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 diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el index b80335362a..9bfcd21618 100644 --- a/lisp/nxml/xmltok.el +++ b/lisp/nxml/xmltok.el @@ -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)) diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el index f63b2e6def..8c0b26cdab 100644 --- a/lisp/nxml/xsd-regexp.el +++ b/lisp/nxml/xsd-regexp.el @@ -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 diff --git a/lisp/play/life.el b/lisp/play/life.el index a52c5477bb..a73f3a58e6 100644 --- a/lisp/play/life.el +++ b/lisp/play/life.el @@ -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) diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 805444d08b..33b21d6cc0 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -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) diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index e44b7c191b..d29fa8c1d3 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -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) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 28ee859f9d..49a2193313 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -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) diff --git a/lisp/simple.el b/lisp/simple.el index d64c0c9ac7..0edf5ca8d9 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -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. diff --git a/lisp/subr.el b/lisp/subr.el index 43a9fc015b..b8b0d5af3b 100644 --- a/lisp/subr.el +++ b/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. diff --git a/lisp/userlock.el b/lisp/userlock.el index 4ad96eb41c..9409409a60 100644 --- a/lisp/userlock.el +++ b/lisp/userlock.el @@ -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 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) -- 2.20.1