From 08e109d45a31af5c605c9580e55781562dedcc30 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 8 Mar 2026 23:28:11 -0400 Subject: [PATCH] Use the new error API functions * lisp/epa-file.el (epa-file--find-file-not-found-function): Use `error-slot-value` and `error-data`. (epa-file-insert-file-contents): Use `error-has-type-p`, `error-slot-value`, and `error-data`. * lisp/jka-compr.el (jka-compr-insert-file-contents): Use `error-has-type-p` and `error-slot-value` as well as new re-signaling form of `signal`. * lisp/simple.el (minibuffer-error-function): Use `error-has-type-p`. * lisp/startup.el (startup--load-user-init-file): Use `error-message-string`. (command-line): Use `error-has-type-p` and `error-message-string`. * lisp/type-break.el (type-break-demo-life): Use `error-message-string`. * lisp/emacs-lisp/bytecomp.el (batch-byte-compile-file): Use `error-message-string` and `error-has-type-p`. * lisp/emacs-lisp/edebug.el (edebug-safe-eval, edebug-report-error) (edebug-eval-expression): * lisp/emacs-lisp/debug.el (debugger-eval-expression): Use `error-message-string`. * lisp/emacs-lisp/ert.el (ert--should-error-handle-error): Use `error-has-type-p` and `error-type`. * lisp/net/sasl.el (sasl-error): Use `define-error`. * lisp/net/tramp-compat.el (tramp-error-type-p): New function. (tramp-permission-denied, tramp-compat-permission-denied): Use it. * lisp/progmodes/elisp-mode.el (elisp-completion-at-point): Use `error-type-p`. * lisp/xt-mouse.el (turn-on-xterm-mouse-tracking-on-terminal) (turn-off-xterm-mouse-tracking-on-terminal): Use `error-slot-value`. * lisp/simple.el (next-line, previous-line): Remove useless `condition-case` handler, and hence the whole `condition-case`, and then simplify. * lisp/gnus/nnrss.el (nnrss-insert): Use `with-demoted-errors`. * lisp/gnus/nnmaildir.el (nnmaildir--emlink-p, nnmaildir--enoent-p) (nnmaildir--eexist-p): Use `error-has-type-p`. (nnmaildir--new-number, nnmaildir-request-set-mark): Use single-arg `signal`. * lisp/ffap.el (ffap-machine-p): Use `error-slot-value`. * lisp/emacs-lisp/comp.el (comp--native-compile): Use `error-has-type-p` as well as single-arg `signal`. * lisp/net/ange-ftp.el (ange-ftp-hook-function): Use single-arg `signal`. * lisp/ebuff-menu.el (electric-buffer-menu-looper): Use `error-has-type-p`. * lisp/progmodes/ebrowse.el (ebrowse-electric-list-looper): Use `error-has-type-p`. (ebrowse-electric-position-looper): Make it an alias of `ebrowse-electric-list-looper`. * lisp/ibuffer.el (ibuffer-confirm-operation-on): * lisp/ls-lisp.el (ls-lisp--insert-directory): * lisp/gnus/gnus-search.el (gnus-search-run-query): * lisp/mail/mail-extr.el (mail-extr-safe-move-sexp): * lisp/net/dbus.el (dbus-set-property): * lisp/net/eudc-export.el (eudc-bbdbify-phone): * lisp/net/imap.el (imap-fetch-safe): * lisp/vc/vc.el (vc-root-dir): Use `error-slot-value` and single-arg `signal` to re-signal. --- lisp/ebuff-menu.el | 9 +++++---- lisp/emacs-lisp/bytecomp.el | 27 ++++++++------------------- lisp/emacs-lisp/comp.el | 7 ++----- lisp/emacs-lisp/debug.el | 4 +--- lisp/emacs-lisp/edebug.el | 18 +++--------------- lisp/emacs-lisp/ert.el | 9 ++++----- lisp/epa-file.el | 22 ++++++++++++---------- lisp/ffap.el | 12 +++++++----- lisp/gnus/gnus-search.el | 4 ++-- lisp/gnus/nnmaildir.el | 12 ++++++------ lisp/gnus/nnrss.el | 2 +- lisp/ibuffer.el | 11 ++++++----- lisp/jka-compr.el | 17 ++++++++--------- lisp/ls-lisp.el | 4 ++-- lisp/mail/mail-extr.el | 6 +++--- lisp/net/ange-ftp.el | 7 +++++-- lisp/net/dbus.el | 4 ++-- lisp/net/eudc-export.el | 4 ++-- lisp/net/imap.el | 4 ++-- lisp/net/sasl.el | 3 +-- lisp/net/soap-client.el | 2 +- lisp/net/tramp-compat.el | 9 +++++++-- lisp/net/tramp-message.el | 4 ++++ lisp/progmodes/ebrowse.el | 27 ++++++--------------------- lisp/progmodes/elisp-mode.el | 8 +++----- lisp/simple.el | 2 +- lisp/startup.el | 14 ++++---------- lisp/type-break.el | 4 ++-- lisp/vc/vc.el | 4 ++-- lisp/xt-mouse.el | 10 ++++++---- 30 files changed, 118 insertions(+), 152 deletions(-) diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index 492d8180848..c3f43355a31 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el @@ -172,11 +172,12 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry. (switch-to-buffer (Buffer-menu-buffer t))))))) (defun electric-buffer-menu-looper (state condition) + ;; NOTE: This code looks very much like `ebrowse-electric-list-looper'. (cond ((and condition - (not (memq (car condition) '(buffer-read-only - end-of-buffer - beginning-of-buffer)))) - (signal (car condition) (cdr condition))) + (not (or (error-has-type-p condition 'buffer-read-only) + (error-has-type-p condition 'end-of-buffer) + (error-has-type-p condition 'beginning-of-buffer)))) + (signal condition)) ((< (point) (car state)) (goto-char (point-min)) (unless Buffer-menu-use-header-line diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e2d73804eb5..aadfc4c335a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4966,9 +4966,9 @@ binding slots have been popped." (unless (and c (symbolp c)) (byte-compile-warn-x c "`%S' is not a condition name (in condition-case)" c)) - ;; In reality, the `error-conditions' property is only required + ;; In reality, the `error-conditions' property is required only ;; for the argument to `signal', not to `condition-case'. - ;;(unless (consp (get c 'error-conditions)) + ;;(unless (error-type-p c) ;; (byte-compile-warn ;; "`%s' is not a known condition name (in condition-case)" ;; c)) @@ -5778,24 +5778,13 @@ already up-to-date." (byte-compile-file file) (condition-case err (byte-compile-file file) - (file-error - (message (if (cdr err) - ">>Error occurred processing %s: %s (%s)" - ">>Error occurred processing %s: %s") - file - (get (car err) 'error-message) - (prin1-to-string (cdr err))) - (let ((destfile (byte-compile-dest-file file))) - (if (file-exists-p destfile) - (delete-file destfile))) - nil) (error - (message (if (cdr err) - ">>Error occurred processing %s: %s (%s)" - ">>Error occurred processing %s: %s") - file - (get (car err) 'error-message) - (prin1-to-string (cdr err))) + (message ">>Error occurred processing %s: %s" + file (error-message-string err)) + (when (error-has-type-p err 'file-error) + (let ((destfile (byte-compile-dest-file file))) + (if (file-exists-p destfile) + (delete-file destfile)))) nil))))) (defun byte-compile-refresh-preloaded () diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 76ad4090bef..52c08607076 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -3595,18 +3595,15 @@ the deferred compilation mechanism." ;; If we are doing an async native compilation print the ;; error in the correct format so is parsable and abort. (if (and comp-async-compilation - (not (eq (car err) 'native-compiler-error))) + (not (error-has-type-p err 'native-compiler-error))) (progn (message "%S: Error %s" function-or-file (error-message-string err)) (kill-emacs -1)) ;; Otherwise re-signal it adding the compilation input. - ;; FIXME: We can't just insert arbitrary info in the - ;; error-data part of an error: the handler may expect - ;; specific data at specific positions! (comp--error-add-context err function-or-file) - (signal (car err) (cdr err))))) + (signal err)))) (if (stringp function-or-file) data ;; So we return the compiled function. diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index bcea708c678..3019ada1bbd 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -560,9 +560,7 @@ The environment used is the one when entering the activation frame at point." (condition-case err (backtrace-eval exp nframe base) (error (setq errored - (format "%s: %s" - (get (car err) 'error-message) - (car (cdr err))))))))) + (error-message-string err))))))) (if errored (progn (message "Error: %s" errored) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 5cb781cb39f..3bb12e18842 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3745,9 +3745,7 @@ Return the result of the last expression." ;; If there is an error, a string is returned describing the error. (condition-case edebug-err (edebug-eval expr) - (error (edebug-format "%s: %s" ;; could - (get (car edebug-err) 'error-message) - (car (cdr edebug-err)))))) + (error (error-message-string edebug-err)))) ;;; Printing @@ -3755,14 +3753,7 @@ Return the result of the last expression." (defun edebug-report-error (value) ;; Print an error message like command level does. ;; This also prints the error name if it has no error-message. - (message "%s: %s" - (or (get (car value) 'error-message) - (format "peculiar error (%s)" (car value))) - (mapconcat (lambda (edebug-arg) - ;; continuing after an error may - ;; complain about edebug-arg. why?? - (prin1-to-string edebug-arg)) - (cdr value) ", "))) + (message "%s" (error-message-string value))) ;; Alternatively, we could change the definition of ;; edebug-safe-prin1-to-string to only use these if defined. @@ -3812,10 +3803,7 @@ this is the prefix key.)" (condition-case err (edebug-eval expr) (error - (setq errored - (format "%s: %s" - (get (car err) 'error-message) - (car (cdr err))))))))) + (setq errored (error-message-string err))))))) (result (unless errored (values--store-value value) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index d5e0afe3b92..6dacd568c7a 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -396,12 +396,11 @@ Returns nil." Determines whether CONDITION matches TYPE and EXCLUDE-SUBTYPES, and aborts the current test as failed if it doesn't." - (let ((signaled-conditions (get (car condition) 'error-conditions)) - (handled-conditions (pcase-exhaustive type + (let ((handled-conditions (pcase-exhaustive type ((pred listp) type) ((pred symbolp) (list type))))) - (cl-assert signaled-conditions) - (unless (cl-intersection signaled-conditions handled-conditions) + (unless (cl-some (lambda (hc) (error-has-type-p condition hc)) + handled-conditions) (ert-fail (append (funcall form-description-fn) (list @@ -409,7 +408,7 @@ and aborts the current test as failed if it doesn't." :fail-reason (concat "the error signaled did not" " have the expected type"))))) (when exclude-subtypes - (unless (member (car condition) handled-conditions) + (unless (member (error-type condition) handled-conditions) (ert-fail (append (funcall form-description-fn) (list diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 9bf6916ff7a..ced54b6eeed 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -117,10 +117,10 @@ encryption is used." (let ((error epa-file-error)) (save-window-excursion (kill-buffer)) - (if (nth 3 error) - (user-error "Wrong passphrase: %s" (nth 3 error)) + (if (error-slot-value error 3) + (user-error "Wrong passphrase: %s" (error-slot-value error 3)) (signal 'file-missing - (cons "Opening input file" (cdr error)))))) + (cons "Opening input file" (error-data error)))))) (defun epa--wrong-password-p (context) "Return whether a wrong password caused the error in CONTEXT." @@ -171,23 +171,25 @@ encryption is used." ;; signal that as a non-file error ;; so that find-file-noselect-1 won't handle it. ;; Borrowed from jka-compr.el. - (if (and (memq 'file-error (get (car error) 'error-conditions)) - (equal (cadr error) "Searching for program")) + (if (and (error-has-type-p error 'file-error) + (equal (error-slot-value error 1) + "Searching for program")) (error "Decryption program `%s' not found" - (nth 3 error))) + (error-slot-value error 3))) (let ((exists (file-exists-p local-file))) (when exists (if-let* ((wrong-password (epa--wrong-password-p context))) ;; Don't display the *error* buffer if we just ;; have a wrong password; let the later error ;; handler notify the user. - (setq error (append error (list wrong-password))) + (setf (error-data error) + (append (error-data error) (list wrong-password))) (epa-display-error context)) ;; When the .gpg file isn't an encrypted file (e.g., ;; it's a keyring.gpg file instead), then gpg will ;; say "Unexpected exit" as the error message. In ;; that case, just display the bytes. - (if (equal (caddr error) "Unexpected; Exit") + (if (equal (error-slot-value error 2) "Unexpected; Exit") (setq string (with-temp-buffer (insert-file-contents-literally local-file) (buffer-string))) @@ -197,10 +199,10 @@ encryption is used." ;; `find-file-noselect-1'. (setq-local epa-file-error error) (add-hook 'find-file-not-found-functions - 'epa-file--find-file-not-found-function + #'epa-file--find-file-not-found-function nil t))) (signal (if exists 'file-error 'file-missing) - (cons "Opening input file" (cdr error)))))) + (cons "Opening input file" (error-data error)))))) (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)! (setq-local epa-file-encrypt-to (mapcar #'car (epg-context-result-for diff --git a/lisp/ffap.el b/lisp/ffap.el index 4f77fd8af6e..aa8dffc9dcd 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -459,11 +459,12 @@ Returned values: "ffap-machine-p" nil host (or service "discard"))) t) (error - (let ((mesg (car (cdr error)))) + (let ((mesg (error-slot-value error 1))) (cond ;; v18: ((string-match "\\(^Unknown host\\|Name or service not known$\\)" - mesg) nil) + mesg) + nil) ((string-match "not responding$" mesg) mesg) ;; v19: ;; (file-error "Connection failed" "permission denied" @@ -473,12 +474,13 @@ Returned values: ;; (file-error "Connection failed" "address already in use" ;; "ftp.uu.net" "ffap-machine-p") ((equal mesg "connection failed") - (if (string= (downcase (nth 2 error)) "permission denied") + (if (string= (downcase (error-slot-value error 2)) + "permission denied") nil ; host does not exist ;; Other errors mean the host exists: - (nth 2 error))) + (error-slot-value error 2))) ;; Could be "Unknown service": - (t (signal (car error) (cdr error)))))))))))) + (t (signal error))))))))))) ;;; Possibly Remote Resources: diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 58f72f002fd..76626541bf2 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -2086,8 +2086,8 @@ Assume \"size\" key is equal to \"larger\"." (if (< 1 (length (alist-get 'search-group-spec specs))) (apply #'nnheader-message 4 "Search engine for %s improperly configured: %s" - server (cdr err)) - (signal (car err) (cdr err)))))) + server (error-slot-value err 1)) + (signal err err))))) (alist-get 'search-group-spec specs)) ;; Some search engines do their own limiting, but some don't, so ;; do it again here. This is bad because, if the user is diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 652b0804add..bb80c2551ae 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -363,14 +363,14 @@ This variable is set by `nnmaildir-request-article'.") (error . ,handler))) (defun nnmaildir--emlink-p (err) - (and (eq (car err) 'file-error) - (string= (downcase (caddr err)) "too many links"))) + (and (error-has-type-p err 'file-error) + (string= (downcase (error-slot-value err 2)) "too many links"))) (defun nnmaildir--enoent-p (err) - (eq (car err) 'file-missing)) + (error-has-type-p err 'file-missing)) (defun nnmaildir--eexist-p (err) - (eq (car err) 'file-already-exists)) + (error-has-type-p err 'file-already-exists)) (defun nnmaildir--new-number (nndir) "Allocate a new article number by atomically creating a file under NNDIR." @@ -410,7 +410,7 @@ This variable is set by `nnmaildir-request-article'.") (unless (equal (file-attribute-inode-number attr) ino-open) (setq number-open number-link number-link 0)))) - (t (signal (car err) (cdr err))))))))) + (t (signal err)))))))) (defun nnmaildir--update-nov (server group article) (let ((nnheader-file-coding-system 'undecided) @@ -1664,7 +1664,7 @@ This variable is set by `nnmaildir-request-article'.") (nnmaildir--mkfile permarkfilenew) (rename-file permarkfilenew permarkfile 'replace) (add-name-to-file permarkfile mfile))) - (t (signal (car err) (cdr err)))))))) + (t (signal err))))))) todo-marks))) (set-action (lambda (article) (funcall add-action article) diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index a5727be92a4..46e7abc81eb 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -412,7 +412,7 @@ otherwise return nil." (condition-case err (mm-url-insert url) (error (if (or debug-on-quit debug-on-error) - (signal (car err) (cdr err)) + (signal err) (message "nnrss: Failed to fetch %s" url)))))) (nnheader-remove-cr-followed-by-lf) ;; Decode text according to the encoding attribute. diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 99fe5cd2f5a..6777d652c44 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1127,11 +1127,12 @@ a new window in the current frame, splitting vertically." (error ;; Handle a failure (if (or (> (incf attempts) 4) - (and (stringp (cadr err)) - ;; This definitely falls in the - ;; ghetto hack category... - (not (string-match-p "too small" (cadr err))))) - (signal (car err) (cdr err)) + (let ((msg (error-slot-value err 1))) + (and (stringp msg) + ;; This definitely falls in the + ;; ghetto hack category... + (not (string-match-p "too small" msg))))) + (signal err) (enlarge-window 3)))))) (select-window (next-window)) (switch-to-buffer buf) diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 8258ab32495..c4643fb2d8c 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -471,22 +471,21 @@ There should be no more than seven characters after the final `/'." ;; If the file we wanted to uncompress does not exist, ;; handle that according to VISIT as `insert-file-contents' ;; would, maybe signaling the same error it normally would. - (if (and (eq (car error-code) 'file-missing) - (eq (nth 3 error-code) local-file)) + (if (and (error-has-type-p error-code 'file-missing) + (eq (error-slot-value error-code 3) local-file)) (if visit (setq notfound error-code) - (signal 'file-missing - (cons "Opening input file" - (nthcdr 2 error-code)))) + (setf (error-slot-value error-code 1) + "Opening input file") + (signal error-code)) ;; If the uncompression program can't be found, ;; signal that as a non-file error ;; so that find-file-noselect-1 won't handle it. - (if (and (memq 'file-error (get (car error-code) - 'error-conditions)) + (if (and (error-has-type-p error-code 'file-error) (equal (cadr error-code) "Searching for program")) (error "Uncompression program `%s' not found" - (nth 3 error-code))) - (signal (car error-code) (cdr error-code))))))) + (error-slot-value error-code 3)) + (signal error-code))))))) (and local-copy diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 99cfbf140c3..a34e8c3c2a2 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -312,14 +312,14 @@ are also supported; unsupported long options are silently ignored." (invalid-regexp ;; Maybe they wanted a literal file that just happens to ;; use characters special to shell wildcards. - (if (equal (cadr err) "Unmatched [ or [^") + (if (equal (error-slot-value err 1) "Unmatched [ or [^") (progn (setq wildcard-regexp (if (memq ?B switches) "[^~]\\'") file (file-relative-name orig-file)) (ls-lisp-insert-directory file switches (ls-lisp-time-index switches) nil full-directory-p)) - (signal (car err) (cdr err))))))) + (signal err)))))) (defun ls-lisp-insert-directory (file switches time-index wildcard-regexp full-directory-p) diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index ae3b37ea41c..ee009ecfda4 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -655,10 +655,10 @@ Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL t) (error ;; #### kludge kludge kludge kludge kludge kludge kludge !!! - (if (string-equal (nth 1 error) "Unbalanced parentheses") + (if (string-equal (error-slot-value error 1) "Unbalanced parentheses") nil - (while t - (signal (car error) (cdr error))))))) + (while t ;;FIXME: Why? + (signal error)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index c39d73e0ca9..0503e27a8d1 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -4401,10 +4401,13 @@ NEWNAME should be the name to give the new compressed or uncompressed file.") (condition-case err (let ((debug-on-error t)) (save-match-data (apply fn args))) - (error (signal (car err) (cdr err)))) + ;; FIXME: In which sense does this catch errors since we + ;; immediately re-throw them? Why do we let-bind `debug-on-error'? + ;; And what does this have to do with process-filters? + (error (signal err))) (ange-ftp-run-real-handler operation args)))) -;;; This sets the mode +;; This sets the mode (add-hook 'find-file-hook 'ange-ftp-set-buffer-mode) ;;; Now say where to find the handlers for particular operations. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 465de028725..7c92980e5a9 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -1666,9 +1666,9 @@ return nil. (condition-case err (dbus-get-property bus service path interface property) (dbus-error - (if (string-equal dbus-error-access-denied (cadr err)) + (if (string-equal dbus-error-access-denied (error-slot-value err 1)) (car args) - (signal (car err) (cdr err)))))) + (signal err))))) (defun dbus-get-all-properties (bus service path interface) "Return all properties of INTERFACE at BUS, SERVICE, PATH. diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index aa8e52bd792..ac212e7a817 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el @@ -187,11 +187,11 @@ LOCATION is used as the phone location for BBDB." (bbdb-parse-phone phone) (bbdb-parse-phone-number phone))) (error - (if (string= "phone number unparsable." (cadr err)) + (if (equal "phone number unparsable." (error-slot-value err 1)) (if (not (y-or-n-p (format "BBDB claims %S to be unparsable--insert anyway? " phone))) (error "Phone number unparsable") (setq phone-list (list (bbdb-string-trim phone)))) - (signal (car err) (cdr err))))) + (signal err)))) (if (= 3 (length phone-list)) (setq phone-list (append phone-list '(nil)))) (apply #'vector location phone-list))) diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 22bebbb0f0c..bb298d11d3c 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -1729,11 +1729,11 @@ See `imap-enable-exchange-bug-workaround'." ;; robust just to check for a BAD response to the ;; attempted fetch. (string-match "The specified message set is invalid" - (cadr data))) + (error-slot-value data 1))) (with-current-buffer (or buffer (current-buffer)) (setq-local imap-enable-exchange-bug-workaround t) (imap-fetch (cdr uids) props receive nouidfetch)) - (signal (car data) (cdr data)))))) + (signal data))))) (defun imap-message-copyuid-1 (mailbox) (if (imap-capability 'UIDPLUS) diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el index 289e867e672..3f805237683 100644 --- a/lisp/net/sasl.el +++ b/lisp/net/sasl.el @@ -50,8 +50,7 @@ (defvar sasl-unique-id-function #'sasl-unique-id-function) -(put 'sasl-error 'error-message "SASL error") -(put 'sasl-error 'error-conditions '(sasl-error error)) +(define-error 'sasl-error "SASL error") (defun sasl-error (datum) (signal 'sasl-error (list datum))) diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index beebe9b4445..f6d2ba229e5 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -2886,7 +2886,7 @@ decode function to perform the actual decoding." ;;;; Soap Envelope parsing -(if (fboundp 'define-error) +(if (fboundp 'define-error) ;Emacs-24.4 (define-error 'soap-error "SOAP error") ;; Support Emacs<24.4 that do not have define-error, so ;; that soap-client can remain unchanged in GNU ELPA. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index f975457d4df..ecc6fe96855 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -102,14 +102,19 @@ Add the extension of F, if existing." tramp-temp-name-prefix tramp-compat-temporary-file-directory) dir-flag (file-name-extension f t))) +(defalias 'tramp-error-type-p + (if (fboundp 'error-type-p) ;Emacs-31 + #'error-type-p + (lambda (symbol) (get symbol 'error-conditions)))) + ;; `permission-denied' is introduced in Emacs 29.1. (defconst tramp-permission-denied - (if (get 'permission-denied 'error-conditions) 'permission-denied 'file-error) + (if (tramp-error-type-p 'permission-denied) 'permission-denied 'file-error) "The error symbol for the `permission-denied' error.") (defsubst tramp-compat-permission-denied (vec file) "Emit the `permission-denied' error." - (if (get 'permission-denied 'error-conditions) + (if (tramp-error-type-p 'permission-denied) (tramp-error vec tramp-permission-denied file) (tramp-error vec tramp-permission-denied "Permission denied: %s" file))) diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index 7b405061ba8..37628e2f001 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el @@ -398,8 +398,12 @@ FMT-STRING and ARGUMENTS." vec-or-proc 1 "%s" (error-message-string (list signal + ;; FIXME: Looks redundant since `error-message-string' + ;; already uses the `error-message' property of `signal'! (get signal 'error-message) (apply #'format-message fmt-string arguments)))) + ;; FIXME: This doesn't look right: ELisp code should be able to rely on + ;; the "shape" of the list based on the type of the signal. (signal signal (list (substring-no-properties (apply #'format-message fmt-string arguments)))))) diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 2d0ab0fdeaf..67ebd7a9c06 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -1935,11 +1935,12 @@ COLLAPSE non-nil means collapse the branch." "Prevent cursor from moving beyond the buffer end. Don't let it move into the title lines. See `Electric-command-loop' for a description of STATE and CONDITION." + ;; NOTE: This code looks very much like `electric-buffer-menu-looper'. (cond ((and condition - (not (memq (car condition) - '(buffer-read-only end-of-buffer - beginning-of-buffer)))) - (signal (car condition) (cdr condition))) + (not (or (error-has-type-p condition 'buffer-read-only) + (error-has-type-p condition 'end-of-buffer) + (error-has-type-p condition 'beginning-of-buffer)))) + (signal condition)) ((< (point) (car state)) (goto-char (point-min)) (forward-line 2)) @@ -3879,23 +3880,7 @@ Runs the hook `ebrowse-electric-position-mode-hook'." (kill-buffer buffer))) -(defun ebrowse-electric-position-looper (state condition) - "Prevent moving point on invalid lines. -Called from `Electric-command-loop'. See there for the meaning -of STATE and CONDITION." - (cond ((and condition - (not (memq (car condition) '(buffer-read-only - end-of-buffer - beginning-of-buffer)))) - (signal (car condition) (cdr condition))) - ((< (point) (car state)) - (goto-char (point-min)) - (forward-line 2)) - ((> (point) (cdr state)) - (goto-char (point-max)) - (forward-line -1) - (if (pos-visible-in-window-p (point-max)) - (recenter -1))))) +(defalias 'ebrowse-electric-position-looper #'ebrowse-electric-list-looper) (defun ebrowse-electric-position-undefined () diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 946d3ba10be..2773f5e76b0 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1104,8 +1104,7 @@ functions are annotated with \"\" via the ;; specific completion table in more cases. (is-ignore-error (list t (elisp--completion-local-symbols) - :predicate (lambda (sym) - (get sym 'error-conditions)))) + :predicate #'error-type-p)) ((elisp--expect-function-p beg) (list nil (elisp--completion-local-symbols) :predicate @@ -1179,12 +1178,11 @@ functions are annotated with \"\" via the (forward-sexp 2) (< (point) beg))))) (list t (elisp--completion-local-symbols) - :predicate (lambda (sym) (get sym 'error-conditions)))) + :predicate #'error-type-p)) ;; `ignore-error' with a list CONDITION parameter. ('ignore-error (list t (elisp--completion-local-symbols) - :predicate (lambda (sym) - (get sym 'error-conditions)))) + :predicate #'error-type-p)) ((and (or ?\( 'let 'let* 'cond 'cond* 'bind*) (guard (save-excursion (goto-char (1- beg)) diff --git a/lisp/simple.el b/lisp/simple.el index 44aa26eb0d0..4bf9919299d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3397,7 +3397,7 @@ Go to the history element by the absolute history position HIST-POS." The same as `command-error-default-function' but display error messages at the end of the minibuffer using `minibuffer-message' to not obscure the minibuffer contents." - (if (memq 'minibuffer-quit (get (car data) 'error-conditions)) + (if (error-has-type-p data 'minibuffer-quit) (ding t) (discard-input) (ding)) diff --git a/lisp/startup.el b/lisp/startup.el index 9c1eafdae07..5b8f90a81c4 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1123,15 +1123,12 @@ init-file, or to a default value if loading is not possible." (display-warning 'initialization (format-message "\ -An error occurred while loading `%s':\n\n%s%s%s\n\n\ +An error occurred while loading `%s':\n\n%s\n\n\ To ensure normal operation, you should investigate and remove the cause of the error in your initialization file. Start Emacs with the `--debug-init' option to view a complete error backtrace." user-init-file - (get (car error) 'error-message) - (if (cdr error) ": " "") - (mapconcat (lambda (s) (prin1-to-string s t)) - (cdr error) ", ")) + (error-message-string error)) :warning) (setq init-file-had-error t)))))) @@ -1593,15 +1590,12 @@ please check its value") (princ (if (eq (car error) 'error) (apply #'concat (cdr error)) - (if (memq 'file-error (get (car error) 'error-conditions)) + (if (error-has-type-p error 'file-error) (format "%s: %s" (nth 1 error) (mapconcat (lambda (obj) (prin1-to-string obj t)) (cdr (cdr error)) ", ")) - (format "%s: %s" - (get (car error) 'error-message) - (mapconcat (lambda (obj) (prin1-to-string obj t)) - (cdr error) ", ")))) + (error-message-string error))) 'external-debugging-output) (terpri 'external-debugging-output) (setq initial-window-system nil) diff --git a/lisp/type-break.el b/lisp/type-break.el index 440a7136f1d..d71b41da531 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -1025,7 +1025,7 @@ With optional non-nil ALL, force redisplay of all mode-lines." (setq continue nil) (and (get-buffer "*Life*") (kill-buffer "*Life*")) - (condition-case () + (condition-case err (progn (life 3) ;; wait for user to return @@ -1033,7 +1033,7 @@ With optional non-nil ALL, force redisplay of all mode-lines." (type-break-catch-up-event) (kill-buffer "*Life*")) (life-extinct - (message "%s" (get 'life-extinct 'error-message)) + (message "%s" (error-message-string err)) ;; restart demo (setq continue t)) (quit diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 0d8e1dd0350..a1546cbc65a 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3581,8 +3581,8 @@ BACKEND is the VC backend." (condition-case err (vc-call-backend backend 'root default-directory) (vc-not-supported - (unless (eq (cadr err) 'root) - (signal (car err) (cdr err))) + (unless (eq (error-slot-value err 1) 'root) + (signal err)) nil)))) ;;;###autoload diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index 2930cc195ef..67c475d563a 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -529,9 +529,10 @@ enable, ?l to disable)." (condition-case err (send-string-to-terminal enable terminal) ;; FIXME: This should use a dedicated error signal. - (error (if (equal (cadr err) "Terminal is currently suspended") + (error (if (equal (error-slot-value err 1) + "Terminal is currently suspended") nil ; The sequence will be sent upon resume. - (signal (car err) (cdr err))))) + (signal err)))) (push enable (terminal-parameter nil 'tty-mode-set-strings)) (push disable (terminal-parameter nil 'tty-mode-reset-strings)) (set-terminal-parameter terminal 'xterm-mouse-mode t) @@ -553,9 +554,10 @@ enable, ?l to disable)." (send-string-to-terminal xterm-mouse-tracking-disable-sequence terminal) ;; FIXME: This should use a dedicated error signal. - (error (if (equal (cadr err) "Terminal is currently suspended") + (error (if (equal (error-slot-value err 1) + "Terminal is currently suspended") nil - (signal (car err) (cdr err))))) + (signal err)))) (setf (terminal-parameter nil 'tty-mode-set-strings) (remq xterm-mouse-tracking-enable-sequence (terminal-parameter nil 'tty-mode-set-strings)))