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

30 files changed, 115 insertions, 153 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 122634d144c..7cbf733b45f 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 b1cdedb83c5..9514317809b 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 e72d0aacd5d..2eeb880c34d 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 2ab6b7ad089..e826cf4375a 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 1f5edefea08..98576687f3d 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 b832ead4d68..33c0443dd91 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 a7d3ac5d017..13833fad66b 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 68fffc0e817..245f7975d91 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 5664a890cb1..7266dc9ec80 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 29beaedebe9..aaa7bb0c499 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 0800af1bd36..825eb3c05d4 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 f6efc56023a..c3adb7208e9 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 243c64ec459..37755806616 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 4ba8e5b5854..1d4a9b573da 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 dab22f7559f..5fe6cfefa83 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 ac4e9ac4cd9..398c107cf01 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 6ba6d21f7ed..75479160cbb 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 111dab82633..6697195cebb 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 3c949ada668..36bd23b3768 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 b5f6983ab7f..8c0d409d520 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 0d97f9c3f12..7af6ae231c5 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 b80335362a1..9bfcd21618d 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 f63b2e6defb..8c0b26cdab9 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 a52c5477bb7..a73f3a58e66 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 805444d08b9..33b21d6cc07 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 e44b7c191bf..d29fa8c1d36 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 28ee859f9db..49a21933133 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 d64c0c9ac74..0edf5ca8d9c 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 43a9fc015b1..b8b0d5af3b8 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 4ad96eb41ce..9409409a608 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)