* 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.

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  <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):
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  <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).
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 `<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)))
 
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 <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)