From a1358530f533a1151c7207e1ad634b1b9fae5a91 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 8 Mar 2026 19:11:13 -0400 Subject: [PATCH 1/7] Improve the error API Define new functions to manipulate error descriptors and add support for `signal` to *re*signal a previous error. * src/eval.c (Fsignal): Make the second arg optional and document the possibility of passing a whole error descriptor to re-signal it. (signal_or_quit): Fix a few corner case issues when DATA is `nil` and ERROR_SYMBOL is an error descriptor. * lisp/subr.el (error-type-p, error--p, error-type, error-data) (error-has-type-p, error-slot-value): New function. * doc/lispref/control.texi (Handling Errors): Prefer "error descriptor" to "error description". Use the new single-arg call to `signal` to re-throw an error. Document `error-type`, `error-data` and `error-slot-value`. (Error Symbols): Document the new functions `error-type-p` and `error-has-type-p`. --- doc/lispref/control.texi | 41 ++++++++++++++++++++++++++++++++++------ etc/NEWS | 7 +++++++ lisp/subr.el | 32 +++++++++++++++++++++++++++++++ src/eval.c | 12 +++++++++--- 4 files changed, 83 insertions(+), 9 deletions(-) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index a7d605cf0a0..3925bdd1b40 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -2447,12 +2447,13 @@ as the overall value. The argument @var{var} is a variable. @code{condition-case} does not bind this variable when executing the @var{protected-form}, only when it handles an error. At that time, it binds @var{var} locally to an -@dfn{error description}, which is a list giving the particulars of the -error. The error description has the form @code{(@var{error-symbol} +@dfn{error descriptor}, also sometimes called error description, +which is a list giving the particulars of the error. +The error descriptor has the form @code{(@var{error-symbol} . @var{data})}. The handler can refer to this list to decide what to do. For example, if the error is for failure opening a file, the file name is the second element of @var{data}---the third element of the -error description. +error descriptor. If @var{var} is @code{nil}, that means no variable is bound. Then the error symbol and associated data are not available to the handler. @@ -2469,15 +2470,31 @@ Sometimes it is necessary to re-throw a signal caught by how to do that: @example - (signal (car err) (cdr err)) + (signal err) @end example @noindent -where @code{err} is the error description variable, the first argument +where @code{err} is the error descriptor variable, the first argument to @code{condition-case} whose error condition you want to re-throw. @xref{Definition of signal}. @end defspec +@defun error-type error +This function returns the error symbol of the error descriptor @var{error}. +@end defun + +@defun error-data error +This function returns the data of the error descriptor @var{error}. +@end defun + +@defun error-slot-value error pos +This function returns the value in the field number @var{pos} of the error +descriptor @var{error}. The fields are numbered starting with 1. E.g., +for an error of type @code{wrong-type-argument}, @code{(error-slot-value +@var{error} 2)} returns the object that failed the type test, and +@code{(error-slot-value @var{error} 1)} returns the predicate that failed. +@end defun + @defun error-message-string error-descriptor This function returns the error message string for a given error descriptor. It is useful if you want to handle an error by printing the @@ -2615,7 +2632,7 @@ Emacs searches all the active @code{condition-case} and specifies one or more of these condition names. When the innermost matching handler is one installed by @code{handler-bind}, the @var{handler} function is called with a single argument holding the -error description. +error descriptor. Contrary to what happens with @code{condition-case}, @var{handler} is called in the dynamic context where the error happened. This means it @@ -2799,6 +2816,18 @@ make it possible to categorize errors at various levels of generality when you write an error handler. Using error symbols alone would eliminate all but the narrowest level of classification. +@defun error-type-p symbol +This function returns non-@code{nil} if @var{symbol} is a valid +error condition name. +@end defun + +@defun error-has-type-p error condition +This function tests whether @var{condition} is a parent of the error +symbol of the error descriptor @var{error}. +It returns non-@code{nil} if the type of the error descriptor +@var{error} belongs to the condition name @var{condition}. +@end defun + @xref{Standard Errors}, for a list of the main error symbols and their conditions. diff --git a/etc/NEWS b/etc/NEWS index c26baa03266..09fb35322d3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -4009,6 +4009,13 @@ that will provide an Xref backend when used. * Lisp Changes in Emacs 31.1 ++++ +** Extended error API +The API to manipulate error descriptors has been improved. +You can now do (signal err) instead (signal (car err) (cdr err)). +And there are new functions: 'error-type-p', 'error-type', +'error-has-type-p', and 'error-slot-value'. + +++ ** 'secure-hash' now supports generating SHA-3 message digests. The list returned by 'secure-hash-algorithms' now contains the symbols diff --git a/lisp/subr.el b/lisp/subr.el index 0ad86fd30a1..3cf4e8276d6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -568,8 +568,40 @@ Defaults to `error'." (cons parent (get parent 'error-conditions))))) (put name 'error-conditions (delete-dups (copy-sequence (cons name conditions)))) + ;; FIXME: Make `error-message-string' more flexible, e.g. allow + ;; the message to be specified by a `format' string or a function. (when message (put name 'error-message message)))) +(defun error-type-p (symbol) + "Return non-nil if SYMBOL is a condition type." + (get symbol 'error-conditions)) + +(defun error--p (object) + "Return non-nil if OBJECT looks like a valid error descriptor." + (let ((type (car-safe object))) + (and type (symbolp type) (listp (cdr object)) + (error-type-p type)))) + +(defalias 'error-type #'car + "Return the symbol which represents the type of ERROR. +\n(fn ERROR)") + +(defalias 'error-data #'cdr + "Return the slots attached to ERROR, as a list. +\n(fn ERROR)") + +(defun error-has-type-p (error condition) + "Return non-nil if ERROR is of type CONDITION (or a subtype of it)." + (unless (error--p error) + (signal 'wrong-type-argument (list #'error--p error))) + (or (eq condition t) + (memq condition (get (car error) 'error-conditions)))) + +(defalias 'error-slot-value #'elt + "Access the SLOT of object ERROR. +Slots are specified by position, and slot 0 is the error symbol. +\n(fn ERROR SLOT)") + ;; 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) diff --git a/src/eval.c b/src/eval.c index 7ca9d761a7e..0b451b2c891 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1871,10 +1871,15 @@ probably_quit (void) unbind_to (gc_count, Qnil); } -DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, +DEFUN ("signal", Fsignal, Ssignal, 1, 2, 0, doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. This function does not return. +When signaling a new error, the DATA argument is mandatory. +When re-signaling an error to propagate it to further handlers, +DATA has to be omitted and the first argument has to be the whole +error descriptor. + When `noninteractive' is non-nil (in particular, in batch mode), an unhandled error calls `kill-emacs', which terminates the Emacs session with a non-zero exit code. @@ -1942,13 +1947,14 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable) /* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */ /* FIXME: Here we still "split" the error object into its error-symbol and its error-data? */ - calln (Vsignal_hook_function, error_symbol, data); + calln (Vsignal_hook_function, real_error_symbol, + NILP (data) && CONSP (error) ? XCDR (error) : data); unbind_to (count, Qnil); } conditions = Fget (real_error_symbol, Qerror_conditions); if (NILP (conditions)) - signal_error ("Invalid error symbol", error_symbol); + signal_error ("Invalid error symbol", real_error_symbol); /* Remember from where signal was called. Skip over the frame for `signal' itself. If a frame for `error' follows, skip that, From 08e109d45a31af5c605c9580e55781562dedcc30 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 8 Mar 2026 23:28:11 -0400 Subject: [PATCH 2/7] 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))) From 9348c19b8250cd885a0bac8b2e97b93127ac8e61 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 9 Mar 2026 10:34:05 -0400 Subject: [PATCH 3/7] Use single-arg form of `signal` to re-throw an error * lisp/vc/smerge-mode.el (smerge-extend): * lisp/vc/diff-mode.el (diff-beginning-of-file-and-junk): * lisp/transient.el (transient--with-emergency-exit): * lisp/textmodes/tex-mode.el (latex-forward-sexp): * lisp/tar-mode.el (tar-mode): * lisp/savehist.el (savehist--reload): * lisp/progmodes/octave.el (inferior-octave-resync-dirs): * lisp/progmodes/js.el (js--re-search-forward): * lisp/plstore.el (plstore--decrypt): * lisp/net/dbus.el (dbus-ignore-errors, dbus-register-signal) (dbus-handle-event): * lisp/mouse.el (mouse-drag-track, mouse-drag-region-rectangle): * lisp/minibuffer.el (completion-pcm--find-all-completions): * lisp/mail/rfc2231.el (rfc2231-parse-string): * lisp/mail/rfc2047.el (rfc2047-encode-region): * lisp/jit-lock.el (jit-lock-fontify-now): * lisp/international/ja-dic-utl.el (skkdic-lookup-key): * lisp/gnus/nnselect.el (nnselect-generate-artlist): * lisp/gnus/mml-sec.el (mml-secure-epg-encrypt, mml-secure-epg-sign): * lisp/gnus/mail-source.el (mail-source-fetch-pop) (mail-source-check-pop): * lisp/gnus/gnus-art.el (gnus-article-read-summary-keys): * lisp/files.el (basic-save-buffer-2, files--ensure-directory) (files--force, copy-directory): * lisp/eshell/esh-io.el (eshell-output-object-to-target): * lisp/epa.el (epa-decrypt-file, epa-verify-file, epa-sign-file) (epa-encrypt-file, epa-decrypt-region, epa-verify-region) (epa-sign-region, epa-encrypt-region, epa-delete-keys) (epa-export-keys, epa-insert-keys): * lisp/emacs-lisp/package.el (package--unless-error): * lisp/emacs-lisp/multisession.el (multisession--read-file-value): * lisp/emacs-lisp/lisp.el (up-list-default-function): * lisp/desktop.el (desktop-kill): * lisp/calendar/time-date.el (date-to-time): * lisp/calendar/appt.el (appt-display-message): * lisp/calc/calc.el (calc-do): * lisp/bookmark.el (bookmark-handle-bookmark): * src/fileio.c (report_file_errno): * lisp/vc/vc.el (vc-checkout, vc-pull): Use `(signal err)` instead of `(signal (car err) (cdr err))`. --- lisp/bookmark.el | 2 +- lisp/calc/calc.el | 2 +- lisp/calendar/appt.el | 2 +- lisp/calendar/time-date.el | 2 +- lisp/desktop.el | 2 +- lisp/emacs-lisp/lisp.el | 2 +- lisp/emacs-lisp/multisession.el | 2 +- lisp/emacs-lisp/package.el | 3 +-- lisp/epa.el | 22 +++++++++++----------- lisp/eshell/esh-io.el | 2 +- lisp/files.el | 8 ++++---- lisp/gnus/gnus-art.el | 2 +- lisp/gnus/mail-source.el | 4 ++-- lisp/gnus/mml-sec.el | 4 ++-- lisp/gnus/nnselect.el | 3 +-- lisp/international/ja-dic-utl.el | 2 +- lisp/jit-lock.el | 2 +- lisp/mail/rfc2047.el | 2 +- lisp/mail/rfc2231.el | 2 +- lisp/minibuffer.el | 2 +- lisp/mouse.el | 4 ++-- lisp/net/dbus.el | 6 +++--- lisp/plstore.el | 2 +- lisp/progmodes/js.el | 2 +- lisp/progmodes/octave.el | 2 +- lisp/savehist.el | 2 +- lisp/tar-mode.el | 2 +- lisp/textmodes/tex-mode.el | 2 +- lisp/transient.el | 2 +- lisp/vc/diff-mode.el | 2 +- lisp/vc/smerge-mode.el | 2 +- lisp/vc/vc.el | 4 ++-- src/fileio.c | 3 +-- 33 files changed, 52 insertions(+), 55 deletions(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index c75a8d33da3..1113144f87a 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1381,7 +1381,7 @@ then offer interactively to relocate BOOKMARK-NAME-OR-RECORD." (message "Bookmark not relocated; consider removing it (%s)." bookmark-name-or-record) - (signal (car err) (cdr err)))))))))) + (signal err))))))))) ;; Added by db. (when (stringp bookmark-name-or-record) (setq bookmark-current-bookmark bookmark-name-or-record)) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 6a23f860123..98bf1e4c2a4 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1688,7 +1688,7 @@ See calc-keypad for details." (error (substitute-command-keys "Computation got stuck or ran too long. Type \\`M' to increase the limit")) (setq calc-aborted-prefix nil) - (signal (car err) (cdr err))))) + (signal err)))) (when calc-aborted-prefix (calc-record "" calc-aborted-prefix)) (and calc-start-time diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index df8e28319e5..f12a51c3dc9 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -232,7 +232,7 @@ also calls `beep' for an audible reminder." time string) (wrong-type-argument (if (not (listp mins)) - (signal (car err) (cdr err)) + (signal err) (message "Argtype error in `appt-disp-window-function' - \ update it for multiple appts?") ;; Fallback to just displaying the first appt, as we used to. diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index bd1e7a88f16..83764074eec 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -161,7 +161,7 @@ If DATE lacks time zone information, local time is assumed." (encode-time parsed)) (error (if (equal err '(error "Specified time is not representable")) - (signal (car err) (cdr err)) + (signal err) (error "Invalid date: %s" date))))) ;;;###autoload diff --git a/lisp/desktop.el b/lisp/desktop.el index df98079b1c2..f478cf2307b 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -812,7 +812,7 @@ is nil, ask the user where to save the desktop." (desktop-save desktop-dirname t) (file-error (unless (yes-or-no-p "Error while saving the desktop. Ignore? ") - (signal (car err) (cdr err)))))) + (signal err))))) (desktop--on-kill) t) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 5cbd4213028..936d5f91a06 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -331,7 +331,7 @@ On error, location of point is unspecified." (if no-syntax-crossing ;; Assume called interactively; don't signal an error. (user-error "At top level") - (signal (car err) (cdr err))))))) + (signal err)))))) (setq arg (- arg inc))))) (defun kill-sexp (&optional arg interactive) diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el index f3cc4b73338..8df3d9e4b22 100644 --- a/lisp/emacs-lisp/multisession.el +++ b/lisp/emacs-lisp/multisession.el @@ -295,7 +295,7 @@ DOC should be a doc string, and ARGS are keywords as applicable to (setq i (1+ i) last-error err) (sleep-for (+ 0.1 (/ (float (random 10)) 10)))))) - (signal (car last-error) (cdr last-error))))) + (signal last-error)))) (defun multisession--object-file-name (object) (expand-file-name diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c30f7758df4..706614e9df1 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1219,8 +1219,7 @@ errors signaled by ERROR-FORM or by BODY). (when (condition-case ,err (progn ,@before-body t) (error (funcall error-function) - (unless noerror - (signal (car ,err) (cdr ,err))))) + (unless noerror (signal ,err)))) (funcall ,body))))) (cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys) diff --git a/lisp/epa.el b/lisp/epa.el index 8d3315891b4..09208a0a3cc 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -702,7 +702,7 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use." (epg-decrypt-file context decrypt-file plain-file) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Decrypting %s...wrote %s" (file-name-nondirectory decrypt-file) (file-name-nondirectory plain-file)) (if (epg-context-result-for context 'verify) @@ -727,7 +727,7 @@ If you do not specify PLAIN-FILE, this functions prompts for the value to use." (epg-verify-file context file plain) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Verifying %s...done" (file-name-nondirectory file)) (if (epg-context-result-for context 'verify) (epa-display-info (epg-verify-result-to-string @@ -798,7 +798,7 @@ If no one is selected, default secret key is used. " (epg-sign-file context file signature mode) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Signing %s...wrote %s" (file-name-nondirectory file) (file-name-nondirectory signature)))) @@ -828,7 +828,7 @@ If no one is selected, symmetric encryption will be performed. "))) (epg-encrypt-file context file recipients cipher) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Encrypting %s...wrote %s" (file-name-nondirectory file) (file-name-nondirectory cipher)))) @@ -870,7 +870,7 @@ For example: (setq plain (epg-decrypt-string context (buffer-substring start end))) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Decrypting...done") (setq plain (decode-coding-string plain @@ -969,7 +969,7 @@ For example: (get-text-property start 'epa-coding-system-used))))) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Verifying...done") (setq plain (decode-coding-string plain @@ -1077,7 +1077,7 @@ If no one is selected, default secret key is used. " mode)) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Signing...done") (delete-region start end) (goto-char start) @@ -1155,7 +1155,7 @@ If no one is selected, symmetric encryption will be performed. ") sign)) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Encrypting...done") (delete-region start end) (goto-char start) @@ -1185,7 +1185,7 @@ If no one is selected, symmetric encryption will be performed. ") (epg-delete-keys context keys allow-secret) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Deleting...done") (apply #'epa--list-keys epa-list-keys-arguments))) @@ -1273,7 +1273,7 @@ If no one is selected, symmetric encryption will be performed. ") (epg-export-keys-to-file context keys file) (error (epa-display-error context) - (signal (car error) (cdr error)))) + (signal error))) (message "Exporting to %s...done" (file-name-nondirectory file)))) ;;;###autoload @@ -1290,7 +1290,7 @@ If no one is selected, default public key is exported. "))) (insert (epg-export-keys-to-string context keys)) (error (epa-display-error context) - (signal (car error) (cdr error)))))) + (signal error))))) (provide 'epa) diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 7c0b878e3cf..ea7dbb2e122 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -751,7 +751,7 @@ Returns what was actually sent, or nil if nothing was sent.") ;; here. Maybe `process-send-string' should handle SIGPIPE even ;; in batch mode (bug#66186). (if (process-live-p target) - (signal (car err) (cdr err)) + (signal err) (signal 'eshell-pipe-broken (list target))))) object) diff --git a/lisp/files.el b/lisp/files.el index edbeb43e9b9..54d21a8a5be 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6276,7 +6276,7 @@ Before and after saving the buffer, this function runs (when save-silently (message nil))) ;; If we failed, restore the buffer's modtime. (error (set-visited-file-modtime old-modtime) - (signal (car err) (cdr err)))) + (signal err))) ;; Since we have created an entirely new file, ;; make sure it gets the right permission bits set. (setq setmodes @@ -6680,7 +6680,7 @@ Return non-nil if DIR is already a directory." (make-directory-internal dir) (error (or (file-directory-p dir) - (signal (car err) (cdr err)))))) + (signal err))))) (defun make-directory (dir &optional parents) "Create the directory DIR and optionally any nonexistent parent dirs. @@ -6753,7 +6753,7 @@ This acts like (apply FN ARGS) except it returns NO-SUCH if it is non-nil and if FN fails due to a missing file or directory." (condition-case err (apply fn args) - (file-missing (or no-such (signal (car err) (cdr err)))))) + (file-missing (or no-such (signal err))))) (defun delete-file (filename &optional trash) "Delete file named FILENAME. If it is a symlink, remove the symlink. @@ -6994,7 +6994,7 @@ into NEWNAME instead." (make-directory (directory-file-name newname) parents) (error (or (file-directory-p newname) - (signal (car err) (cdr err))))))) + (signal err)))))) ;; Copy recursively. (dolist (file diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 56473f81f06..301dec87cf7 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6946,7 +6946,7 @@ not have a face in `gnus-article-boring-faces'." (set-window-hscroll win new-sum-hscroll)))) (set-window-configuration owin) (if err - (signal (car err) (cdr err)) + (signal err) (ding)))))))) (defun gnus-article-read-summary-send-keys () diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index bc1c7272283..a1e954d5367 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -831,7 +831,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (setq mail-source-password-cache (delq (assoc from mail-source-password-cache) mail-source-password-cache)) - (signal (car err) (cdr err))))))))) + (signal err)))))))) (if result (progn (when (eq authentication 'password) @@ -896,7 +896,7 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (setq mail-source-password-cache (delq (assoc from mail-source-password-cache) mail-source-password-cache)) - (signal (car err) (cdr err))))))))) + (signal err)))))))) (if result ;; Inform display-time that we have new mail. (setq mail-source-new-mail-available (> result 0)) diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 700a99fe5d8..85b7d3a879c 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -939,7 +939,7 @@ If no one is selected, symmetric encryption will be performed. " mml-secure-secret-key-id-list nil) (error (mml-secure-clear-secret-key-id-list) - (signal (car error) (cdr error)))) + (signal error))) cipher)) (defun mml-secure-sender-sign-query (protocol sender) @@ -1029,7 +1029,7 @@ Returns non-nil if the user has chosen to use SENDER." mml-secure-secret-key-id-list nil) (error (mml-secure-clear-secret-key-id-list) - (signal (car error) (cdr error)))) + (signal error))) (if (epg-context-result-for context 'sign) (setq micalg (epg-new-signature-digest-algorithm (car (epg-context-result-for context 'sign))))) diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index b90a6c8b235..71bac870aca 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -346,8 +346,7 @@ group info." gnus-newsgroup-selection)) ;; Don't swallow gnus-search errors; the user should be made ;; aware of them. - (gnus-search-error - (signal (car err) (cdr err))) + (gnus-search-error (signal err)) (error (gnus-error 3 diff --git a/lisp/international/ja-dic-utl.el b/lisp/international/ja-dic-utl.el index 3f6500669a4..66e402c12db 100644 --- a/lisp/international/ja-dic-utl.el +++ b/lisp/international/ja-dic-utl.el @@ -115,7 +115,7 @@ The library `ja-dic' can't be loaded. This might indicate a problem with your Emacs installation, as LEIM (Libraries of Emacs Input Method) should normally always be installed together with Emacs."))) - (signal (car err) (cdr err))))) + (signal err)))) (let ((vec (make-vector len 0)) (i 0) diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index d78c1d03deb..ac692340e74 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -449,7 +449,7 @@ Defaults to the whole buffer. END can be out of bounds." ;; on-the-fly jit-locking), make sure the fontification ;; will be performed before displaying the block again. (quit (put-text-property start next 'fontified nil) - (signal (car err) (cdr err)))))) + (signal err))))) ;; In case we fontified more than requested, take ;; advantage of the good news. diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el index a48b876443b..3961c2a1e25 100644 --- a/lisp/mail/rfc2047.el +++ b/lisp/mail/rfc2047.el @@ -543,7 +543,7 @@ Dynamically bind `rfc2047-encoding-type' to change that." (setq last-encoded nil))))) (error (if (or debug-on-quit debug-on-error) - (signal (car err) (cdr err)) + (signal err) (error "Invalid data for rfc2047 encoding: %s" (replace-regexp-in-string "[ \t\n]+" " " orig-text)))))))) (unless dont-fold diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el index d096176a9b1..70f73018674 100644 --- a/lisp/mail/rfc2231.el +++ b/lisp/mail/rfc2231.el @@ -176,7 +176,7 @@ must never cause a Lisp error." (error (setq parameters nil) (when signal-error - (signal (car err) (cdr err))))) + (signal err)))) ;; Now collect and concatenate continuation parameters. (let ((cparams nil) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 1ac83134dbe..13d0e712821 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -4634,7 +4634,7 @@ filter out additional entries (because TABLE might not obey PRED)." (if between (list between)) pattern)) (setq prefix subprefix))) (if (and (null all) firsterror) - (signal (car firsterror) (cdr firsterror)) + (signal firsterror) (list pattern all prefix suffix))))) (defun completion-pcm-all-completions (string table pred point) diff --git a/lisp/mouse.el b/lisp/mouse.el index a6d553b60a1..24fe57cdc50 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2025,7 +2025,7 @@ The region will be defined with mark and point." (pop-mark))))) ;; Cleanup on errors (error (funcall cleanup) - (signal (car err) (cdr err)))))) + (signal err))))) (defun mouse--drag-set-mark-and-point (start click click-count) (let* ((range (mouse-start-end start click click-count)) @@ -2790,7 +2790,7 @@ This must be bound to a button-down mouse event." ;; Clean up in case something went wrong. (error (setq track-mouse old-track-mouse) (setq mouse-fine-grained-tracking old-mouse-fine-grained-tracking) - (signal (car err) (cdr err)))))) + (signal err))))) ;; The drag event must be bound to something but does not need any effect, ;; as everything takes place in `mouse-drag-region-rectangle'. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 7c92980e5a9..0c748e76fcf 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -245,7 +245,7 @@ Otherwise, return result of last form in BODY, or all other errors." (declare (indent 0) (debug t)) `(condition-case err (progn ,@body) - (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) + (dbus-error (when dbus-debug (signal err))))) (defvar dbus-event-error-functions '(dbus-notice-synchronous-call-errors @@ -878,7 +878,7 @@ Example: "AddMatch" rule) (dbus-error (if (not (string-match-p "eavesdrop" rule)) - (signal (car err) (cdr err)) + (signal err) ;; The D-Bus spec says we shall fall back to a rule without eavesdrop. (when dbus-debug (message "Removing eavesdrop from rule %s" rule)) (setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule t t)) @@ -1234,7 +1234,7 @@ If the HANDLER returns a `dbus-error', it is propagated as return message." ;; Propagate D-Bus error messages. (run-hook-with-args 'dbus-event-error-functions event err) (when dbus-debug - (signal (car err) (cdr err)))))) + (signal err))))) (defun dbus-event-bus-name (event) "Return the bus name the event is coming from. diff --git a/lisp/plstore.el b/lisp/plstore.el index 08c9f5a423e..0964e6ccaf6 100644 --- a/lisp/plstore.el +++ b/lisp/plstore.el @@ -432,7 +432,7 @@ accordingly." plstore-passphrase-alist))) (if entry (setcdr entry nil))) - (signal (car error) (cdr error)))) + (signal error))) (plstore--set-secret-alist plstore (car (read-from-string plain))) (plstore--merge-secret plstore) (plstore--set-encrypted-data plstore nil)))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index 44c54a60757..a5e1d8ac023 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -849,7 +849,7 @@ macro as normal text." (search-failed (goto-char saved-point) (unless noerror - (signal (car err) (cdr err))))))) + (signal err)))))) (defun js--re-search-backward-inner (regexp &optional bound count) diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index d5e1dc39790..18800e29aa5 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -995,7 +995,7 @@ directory and makes this the current buffer's default directory." (progn (cd (car inferior-octave-output-list)) t) - (error (unless noerror (signal (car err) (cdr err)))))) + (error (unless noerror (signal err))))) (defcustom inferior-octave-minimal-columns 80 "The minimal column width for the inferior Octave process." diff --git a/lisp/savehist.el b/lisp/savehist.el index 03f0889ef58..8f46adbeb95 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -235,7 +235,7 @@ Be careful to do it while preserving the current history data." ;; effectively destroy the user's data at the next save. (setq savehist-mode nil) (savehist-uninstall) - (signal (car errvar) (cdr errvar)))) + (signal errvar))) ;; In case we're loading the file late, there was info in the history ;; variables that may have been overwritten by the info extracted from diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 8cad7472089..e7400e81e00 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -879,7 +879,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;; tar data. Rather than show a mysterious empty buffer, let's ;; revert to fundamental-mode. (fundamental-mode) - (signal (car err) (cdr err))))) + (signal err)))) (autoload 'woman-tar-extract-file "woman" "In tar mode, run the WoMan man-page browser on this file." t) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 9385207f767..86a4b1d006e 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1874,7 +1874,7 @@ Mark is left at original location." (progn (latex-backward-sexp-1) (1+ arg))))) (scan-error (goto-char pos) - (signal (car err) (cdr err)))))) + (signal err))))) (defun latex-syntax-after () "Like (char-syntax (char-after)) but aware of multi-char elements." diff --git a/lisp/transient.el b/lisp/transient.el index a7e2e5daa23..e77fef1f98a 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -64,7 +64,7 @@ ,(macroexp-progn body)) ((debug error) (transient--emergency-exit ,id) - (signal (car err) (cdr err))))) + (signal err)))) (defun transient--exit-and-debug (&rest args) (transient--emergency-exit :debugger) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 559310ff770..86095780f67 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -981,7 +981,7 @@ data such as \"Index: ...\" and such." ;; File starts *after* the starting point: we really weren't in ;; a file diff but elsewhere. (goto-char orig) - (signal (car err) (cdr err))))) + (signal err)))) (defun diff-file-kill (&optional delete) "Kill current file's hunks. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index c0f6fd426c1..3744ec501ec 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1444,7 +1444,7 @@ region, or with a numeric prefix. By default it uses a numeric prefix of 1." ;; conflicts instead! (condition-case err (smerge-match-conflict) - (error (if (not (markerp otherpos)) (signal (car err) (cdr err)) + (error (if (not (markerp otherpos)) (signal err) (goto-char (prog1 otherpos (setq otherpos (point-marker)))) (smerge-match-conflict)))) (let ((beg (match-beginning 0)) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index a1546cbc65a..37d2bc3612f 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2045,7 +2045,7 @@ After check-out, runs the normal hook `vc-checkout-hook'." (when t (let ((buf (get-file-buffer file))) (when buf (with-current-buffer buf (read-only-mode -1))))) - (signal (car err) (cdr err)))) + (signal err))) `((vc-state . ,(if (or (eq (vc-checkout-model backend (list file)) 'implicit) nil) 'up-to-date @@ -4695,7 +4695,7 @@ tip revision are merged into the working file." (and-let* ((fileset (vc-deduce-fileset 'not-state-changing 'allow-unregistered))) (vc-find-backend-function (car fileset) 'pull))) - (signal (car ret) (cdr ret)))) + (signal ret))) (:success (setq backend (car ret) files (cadr ret) fn (vc-find-backend-function backend 'pull)))) diff --git a/src/fileio.c b/src/fileio.c index cc6590130f7..beb020810be 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -286,8 +286,7 @@ void report_file_errno (char const *string, Lisp_Object name, int errorno) { Lisp_Object data = get_file_errno_data (string, name, errorno); - - xsignal (Fcar (data), Fcdr (data)); + xsignal (data, Qnil); } /* Signal a file-access failure that set errno. STRING describes the From 6d8b3d1077278b5c22652c796d3d878880cca1f3 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 9 Mar 2026 22:40:31 -0400 Subject: [PATCH 4/7] test subdirectory: Use new error-API * test/lisp/vc/vc-tests/vc-tests.el (vc-test--run-maybe-unsupported-function): Remove dummy branch in `condition-case`. * test/lisp/arc-mode-tests.el (define-arc-mode-test-on-type): Use `error-slot-value`. * test/src/process-tests.el (process-tests--ignore-EMFILE): * test/src/filelock-tests.el (filelock-tests-unlock-spoiled) (filelock-tests-kill-buffer-spoiled): * test/lisp/vc/vc-git-tests.el (vc-git-test--run): * test/lisp/proced-tests.el (proced--assert-process-valid-cpu-refinement): * test/lisp/emacs-lisp/pp-tests.el (pp-tests--sanity): * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-with-normal-env) (edebug-tests-post-command): * test/lisp/autorevert-tests.el (auto-revert--deftest-remote): * test/infra/android/test-controller.el (ats-connect): --- test/infra/android/test-controller.el | 2 +- test/lisp/arc-mode-tests.el | 5 +++-- test/lisp/autorevert-tests.el | 2 +- test/lisp/emacs-lisp/edebug-tests.el | 5 ++--- test/lisp/emacs-lisp/pp-tests.el | 2 +- test/lisp/proced-tests.el | 2 +- test/lisp/vc/vc-git-tests.el | 2 +- test/lisp/vc/vc-tests/vc-tests.el | 3 +-- test/src/filelock-tests.el | 6 ++---- test/src/process-tests.el | 2 +- 10 files changed, 14 insertions(+), 17 deletions(-) diff --git a/test/infra/android/test-controller.el b/test/infra/android/test-controller.el index 07c6f0e5ba0..34a0e9bfe33 100644 --- a/test/infra/android/test-controller.el +++ b/test/infra/android/test-controller.el @@ -1910,7 +1910,7 @@ this machine and an SSH daemon be executing on the host)." (with-demoted-errors "Winding up failed connection: %S" (ats-adb "-s" device "forward" "--remove" (format "tcp:%d" host-port))) - (signal (car err) (cdr err)))))))))) + (signal err))))))))) diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el index 43a441918a5..235a67c8649 100644 --- a/test/lisp/arc-mode-tests.el +++ b/test/lisp/arc-mode-tests.el @@ -113,9 +113,10 @@ member MEMBER. Then the test finds ARCHIVE and ensures that function ;; turn the most likely error into a nice ;; and self-explaining symbol that can be ;; compared in a `should' - (if (string= (cadr err) "Buffer format not recognized") + (if (equal (error-slot-value err 1) + "Buffer format not recognized") 'signature-not-recognized - (signal (car err) (cdr err)))))) + (signal err))))) (should (eq type (quote ,type))))) (when buffer (kill-buffer buffer)) (dolist (file (list member archive)) diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index 8a0ce146fbb..dfdfbafc5fa 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -203,7 +203,7 @@ It is checked for buffer-local `auto-revert-notify-watch-descriptor'." (tramp-dissect-file-name auto-revert--test-rootdir) t 'keep-password) (condition-case err (funcall (ert-test-body ert-test)) - (error (message "%s" err) (signal (car err) (cdr err))))))) + (error (message "%S" err) (signal err)))))) (defmacro with-auto-revert-test (&rest body) (declare (debug t)) diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index c93dfad0a0d..61e909437c7 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el @@ -120,8 +120,7 @@ back to the top level.") (eval-buffer) ,@body (when edebug-tests-failure-in-post-command - (signal (car edebug-tests-failure-in-post-command) - (cdr edebug-tests-failure-in-post-command)))) + (signal edebug-tests-failure-in-post-command))) (unload-feature 'edebug-test-code) (with-current-buffer (find-file-noselect edebug-tests-temp-file) (set-buffer-modified-p nil)) @@ -246,7 +245,7 @@ keyboard macro." (funcall thunk) (error (setq edebug-tests-failure-in-post-command err) - (signal (car err) (cdr err))))) + (signal err)))) (setq edebug-tests-kbd-macro-index executing-kbd-macro-index)))) (defvar edebug-tests-func nil diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el index ed4c9fcf978..c4e93e16005 100644 --- a/test/lisp/emacs-lisp/pp-tests.el +++ b/test/lisp/emacs-lisp/pp-tests.el @@ -82,7 +82,7 @@ (invalid-read-syntax (message "Invalid fill result with i=%d:\n%s" i (buffer-string)) - (signal (car err) (cdr err)) + (signal err) )))))))) (ert-deftest pp-tests--bug76715 () diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el index fce3c2bc048..52d1e8850ca 100644 --- a/test/lisp/proced-tests.el +++ b/test/lisp/proced-tests.el @@ -61,7 +61,7 @@ (proced--move-to-column "%CPU") (condition-case err (>= (proced--cpu-at-point) cpu) - (ert-test-skipped (signal (car err) (cdr err))) + (ert-test-skipped (signal err)) (error (ert-fail (list err (proced--assert-process-valid-cpu-refinement-explainer cpu)))))) diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el index e93ee72210d..96fa3d65c05 100644 --- a/test/lisp/vc/vc-git-tests.el +++ b/test/lisp/vc/vc-git-tests.el @@ -111,7 +111,7 @@ If the exit status is non-zero, log the command output and re-throw." (apply 'vc-git-command t 0 nil args) (t (message "Error running Git: %s" err) (message "(buffer-string:\n%s\n)" (buffer-string)) - (signal (car err) (cdr err)))) + (signal err))) (buffer-string))) (defun vc-git-test--start-branch () diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index ca79a340a46..737ee09415e 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -238,8 +238,7 @@ For backends which don't support it, `vc-not-supported' is signaled." Catch the `vc-not-supported' error." `(condition-case err (funcall ,func ,@args) - (vc-not-supported 'vc-not-supported) - (t (signal (car err) (cdr err))))) + (vc-not-supported 'vc-not-supported))) (defun vc-test--register (backend) "Register and unregister a file. diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el index 795039cd9cb..9284edd8b26 100644 --- a/test/src/filelock-tests.el +++ b/test/src/filelock-tests.el @@ -137,8 +137,7 @@ the case)." ;; Errors from `unlock-buffer' should call ;; `userlock--handle-unlock-error' (bug#46397). - (cl-letf (((symbol-function 'userlock--handle-unlock-error) - (lambda (err) (signal (car err) (cdr err))))) + (cl-letf (((symbol-function 'userlock--handle-unlock-error) #'signal)) (should (equal '(file-error "Unlocking file") (seq-subseq (should-error (unlock-buffer)) 0 2)))))) @@ -160,8 +159,7 @@ the case)." ;; File errors from unlocking files should call ;; `userlock--handle-unlock-error' (bug#46397). (cl-letf (((symbol-function 'yes-or-no-p) #'always) - ((symbol-function 'userlock--handle-unlock-error) - (lambda (err) (signal (car err) (cdr err))))) + ((symbol-function 'userlock--handle-unlock-error) #'signal)) (should (equal '(file-error "Unlocking file") (seq-subseq (should-error (kill-buffer)) 0 2)))))) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 2cc5b37b187..55657a23fa9 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -546,7 +546,7 @@ See Bug#30460." ;; all `file-error' signals. (and ,message (not (string-equal (caddr ,err) ,message)) - (signal (car ,err) (cdr ,err)))))))) + (signal ,err))))))) (defmacro process-tests--with-buffers (var &rest body) "Bind VAR to nil and evaluate BODY. From fa6f2cb63c887ab322f7146fd65b1642348f6718 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 10 Mar 2026 10:31:14 -0400 Subject: [PATCH 5/7] (error-data): Delete function Remove `error-data` from the new error API: it is not really compatible with a more abstract view of error descriptors, and in practice it seems to be used only in two ways (both of them rare): - To add some contextual info to an error. We should maybe add a dedicated support for that, but it's not clear what shape it should take, ideally (there was a discussion about with Alan and myself in emacs-devel a few years ago). - To do some other massaging whose correctness is dubious anyway. * doc/lispref/control.texi (Handling Errors): Remove `error-data`. * lisp/epa-file.el (epa-file--find-file-not-found-function): Don't use `error-data`. (epa-file--error-add-context): New function, extracted from `epa-file-insert-file-contents`. (epa-file-insert-file-contents): Use it instead of `error-data`. * lisp/subr.el (error-data): Delete function. --- doc/lispref/control.texi | 4 ---- lisp/epa-file.el | 18 +++++++++++++----- lisp/subr.el | 4 ---- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 3925bdd1b40..d3662f727cc 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -2483,10 +2483,6 @@ to @code{condition-case} whose error condition you want to re-throw. This function returns the error symbol of the error descriptor @var{error}. @end defun -@defun error-data error -This function returns the data of the error descriptor @var{error}. -@end defun - @defun error-slot-value error pos This function returns the value in the field number @var{pos} of the error descriptor @var{error}. The fields are numbered starting with 1. E.g., diff --git a/lisp/epa-file.el b/lisp/epa-file.el index ced54b6eeed..e45dbd1754e 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -116,11 +116,15 @@ encryption is used." (defun epa-file--find-file-not-found-function () (let ((error epa-file-error)) (save-window-excursion - (kill-buffer)) + (kill-buffer)) + ;; FIXME: How do we know that slot 3 can hold only a message related + ;; to a wrong passphrase? (if (error-slot-value error 3) (user-error "Wrong passphrase: %s" (error-slot-value error 3)) + ;; FIXME: Why does it make sense to add the data fields of ERROR, + ;; shifted by one position? (signal 'file-missing - (cons "Opening input file" (error-data error)))))) + (cons "Opening input file" (cdr error)))))) (defun epa--wrong-password-p (context) "Return whether a wrong password caused the error in CONTEXT." @@ -136,6 +140,9 @@ encryption is used." error-string) (match-string 1 error-string)))) +(defun epa-file--error-add-context (err ctxt) + (setf (cdr error) (append (cdr error) (list ctx)))) + (defvar last-coding-system-used) (defun epa-file-insert-file-contents (file &optional visit beg end replace) (barf-if-buffer-read-only) @@ -182,8 +189,7 @@ encryption is used." ;; Don't display the *error* buffer if we just ;; have a wrong password; let the later error ;; handler notify the user. - (setf (error-data error) - (append (error-data error) (list wrong-password))) + (epa-file--error-add-context error 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 @@ -201,8 +207,10 @@ encryption is used." (add-hook 'find-file-not-found-functions #'epa-file--find-file-not-found-function nil t))) + ;; FIXME: Why does it make sense to add the data fields + ;; of ERROR, shifted by one position? (signal (if exists 'file-error 'file-missing) - (cons "Opening input file" (error-data error)))))) + (cons "Opening input file" (cdr 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/subr.el b/lisp/subr.el index 3cf4e8276d6..0c2acfec335 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -586,10 +586,6 @@ Defaults to `error'." "Return the symbol which represents the type of ERROR. \n(fn ERROR)") -(defalias 'error-data #'cdr - "Return the slots attached to ERROR, as a list. -\n(fn ERROR)") - (defun error-has-type-p (error condition) "Return non-nil if ERROR is of type CONDITION (or a subtype of it)." (unless (error--p error) From 261f4a012ef109481881324fa67a62bfe6f67610 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 11 Mar 2026 12:38:36 -0400 Subject: [PATCH 6/7] (subr-error-API): New test. Also, improve the etc/NEWS * test/lisp/subr-tests.el (subr-error-API): New test. --- etc/NEWS | 9 +++++---- test/lisp/subr-tests.el | 21 +++++++++++++++++++++ 2 files changed, 26 insertions(+), 4 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 09fb35322d3..c0e404f8106 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -4010,11 +4010,12 @@ that will provide an Xref backend when used. * Lisp Changes in Emacs 31.1 +++ -** Extended error API -The API to manipulate error descriptors has been improved. -You can now do (signal err) instead (signal (car err) (cdr err)). -And there are new functions: 'error-type-p', 'error-type', +** The API to manipulate error descriptors has been improved. +there are new functions: 'error-type-p', 'error-type', 'error-has-type-p', and 'error-slot-value'. +And you can now do (signal err) instead (signal (car err) (cdr err)), which +is not just more concise but also preserves the 'eq'uality of the +error descriptor. +++ ** 'secure-hash' now supports generating SHA-3 message digests. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 5cdc30e8965..b6cabb4ec2a 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1463,6 +1463,27 @@ final or penultimate step during initialization.")) (t x) (:success (1+ x))) '(error ""))))) +(ert-deftest subr-error-API () + (should (error-type-p 'error)) + (should (error-type-p 'wrong-type-argument)) + (should-not (error-type-p 'car)) + + (let ((error-err (condition-case err (error "Foo") (error err))) + (wta-err (condition-case err (car 5) (error err)))) + (should (error-has-type-p error-err 't)) + (should-not (error-has-type-p error-err 'wrong-type-argument)) + (should (error-has-type-p wta-err 'error)) + (should (error-has-type-p wta-err 'wrong-type-argument)) + (should-not (error-has-type-p wta-err 'wrong-number-of-arguments)) + + (should (equal "Foo" (error-slot-value error-err 1))) + (should (equal 'listp (error-slot-value wta-err 1))) + (should (equal 5 (error-slot-value wta-err 2))) + + (should (equal wta-err (condition-case err (car 5) (error err)))) + (should-not (eq wta-err (condition-case err (car 5) (error err)))) + (should (eq wta-err (condition-case err (signal wta-err) (error err)))))) + (ert-deftest subr--subst-char-in-string () ;; Cross-validate `subst-char-in-string' with `string-replace', ;; which should produce the same results when there are no properties. From 8d356c55ad75577435205a1091201fd7f666dba6 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 11 Mar 2026 20:21:58 +0100 Subject: [PATCH 7/7] Tweak recent error descriptor changes * etc/NEWS: Fix capitalization and markup. * lisp/emacs-lisp/ert.el (ert--should-error-handle-error): Prefer any over cl-some where either will do. * lisp/epa-file.el (epa-file--find-file-not-found-function): Reindent. (epa-file--error-add-context): Use correct variables. Add docstring. * lisp/ffap.el (ffap-machine-p): * lisp/gnus/nnmaildir.el (nnmaildir--emlink-p): Prefer string-equal-ignore-case over case fiddling. * lisp/gnus/gnus-search.el (gnus-search-run-query): Fix typo in error re-signaling. * lisp/ibuffer.el (ibuffer-confirm-operation-on): Prefer string search over regexp matching where either will do. * test/lisp/vc/vc-tests/vc-tests.el (vc-test--run-maybe-unsupported-function): Pacify unused condition-case error variable warnings (bug#72212). --- etc/NEWS | 8 ++++---- lisp/emacs-lisp/ert.el | 4 ++-- lisp/epa-file.el | 7 ++++--- lisp/ffap.el | 4 ++-- lisp/gnus/gnus-search.el | 2 +- lisp/gnus/nnmaildir.el | 2 +- lisp/ibuffer.el | 2 +- test/lisp/vc/vc-tests/vc-tests.el | 2 +- 8 files changed, 16 insertions(+), 15 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index c0e404f8106..0e2a6849ca6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -4011,11 +4011,11 @@ that will provide an Xref backend when used. +++ ** The API to manipulate error descriptors has been improved. -there are new functions: 'error-type-p', 'error-type', +There are new functions: 'error-type-p', 'error-type', 'error-has-type-p', and 'error-slot-value'. -And you can now do (signal err) instead (signal (car err) (cdr err)), which -is not just more concise but also preserves the 'eq'uality of the -error descriptor. +And you can now do '(signal err)' instead of +'(signal (car err) (cdr err))', which is not only more concise +but also preserves the 'eq'uality of the error descriptor. +++ ** 'secure-hash' now supports generating SHA-3 message digests. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 6dacd568c7a..1c2df07f137 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -399,8 +399,8 @@ and aborts the current test as failed if it doesn't." (let ((handled-conditions (pcase-exhaustive type ((pred listp) type) ((pred symbolp) (list type))))) - (unless (cl-some (lambda (hc) (error-has-type-p condition hc)) - handled-conditions) + (unless (any (lambda (hc) (error-has-type-p condition hc)) + handled-conditions) (ert-fail (append (funcall form-description-fn) (list diff --git a/lisp/epa-file.el b/lisp/epa-file.el index e45dbd1754e..b2a89907867 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -116,7 +116,7 @@ encryption is used." (defun epa-file--find-file-not-found-function () (let ((error epa-file-error)) (save-window-excursion - (kill-buffer)) + (kill-buffer)) ;; FIXME: How do we know that slot 3 can hold only a message related ;; to a wrong passphrase? (if (error-slot-value error 3) @@ -140,8 +140,9 @@ encryption is used." error-string) (match-string 1 error-string)))) -(defun epa-file--error-add-context (err ctxt) - (setf (cdr error) (append (cdr error) (list ctx)))) +(defun epa-file--error-add-context (error context) + "Append CONTEXT to ERROR data by side effect." + (setf (cdr error) (append (cdr error) (list context)))) (defvar last-coding-system-used) (defun epa-file-insert-file-contents (file &optional visit beg end replace) diff --git a/lisp/ffap.el b/lisp/ffap.el index aa8dffc9dcd..800437d69c9 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -474,8 +474,8 @@ Returned values: ;; (file-error "Connection failed" "address already in use" ;; "ftp.uu.net" "ffap-machine-p") ((equal mesg "connection failed") - (if (string= (downcase (error-slot-value error 2)) - "permission denied") + (if (string-equal-ignore-case (error-slot-value error 2) + "permission denied") nil ; host does not exist ;; Other errors mean the host exists: (error-slot-value error 2))) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 76626541bf2..2e9adeec23d 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -2087,7 +2087,7 @@ Assume \"size\" key is equal to \"larger\"." (apply #'nnheader-message 4 "Search engine for %s improperly configured: %s" server (error-slot-value err 1)) - (signal err err))))) + (signal 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 bb80c2551ae..750ebc413b6 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -364,7 +364,7 @@ This variable is set by `nnmaildir-request-article'.") (defun nnmaildir--emlink-p (err) (and (error-has-type-p err 'file-error) - (string= (downcase (error-slot-value err 2)) "too many links"))) + (string-equal-ignore-case (error-slot-value err 2) "too many links"))) (defun nnmaildir--enoent-p (err) (error-has-type-p err 'file-missing)) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 6777d652c44..04cc631ba6f 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1131,7 +1131,7 @@ a new window in the current frame, splitting vertically." (and (stringp msg) ;; This definitely falls in the ;; ghetto hack category... - (not (string-match-p "too small" msg))))) + (not (string-search "too small" msg))))) (signal err) (enlarge-window 3)))))) (select-window (next-window)) diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index 737ee09415e..a64bee00de2 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -236,7 +236,7 @@ For backends which don't support it, `vc-not-supported' is signaled." (defmacro vc-test--run-maybe-unsupported-function (func &rest args) "Run FUNC with ARGS as arguments. Catch the `vc-not-supported' error." - `(condition-case err + `(condition-case nil (funcall ,func ,@args) (vc-not-supported 'vc-not-supported)))