Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-06-14 12:31:25 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge remote-tracking branch 'origin/scratch/error-API'

Browse source
This commit is contained in:
Stefan Monnier 2026-03-15 17:17:21 -04:00
commit e2004eb56f
76 changed files with 289 additions and 232 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
doc/lispref/control.texi
View file

@ -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,27 @@ 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-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 +2628,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 +2812,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.

8
etc/NEWS
View file

@ -4044,6 +4044,14 @@ that will provide an Xref backend when used.
* Lisp Changes in Emacs 31.1
+++
** 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 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.
The list returned by 'secure-hash-algorithms' now contains the symbols

2
lisp/bookmark.el
View file

@ -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))

2
lisp/calc/calc.el
View file

@ -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 "<Aborted>" calc-aborted-prefix))
(and calc-start-time

2
lisp/calendar/appt.el
View file

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

2
lisp/calendar/time-date.el
View file

@ -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

2
lisp/desktop.el
View file

@ -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)

9
lisp/ebuff-menu.el
View file

@ -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

27
lisp/emacs-lisp/bytecomp.el
View file

@ -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 ()

7
lisp/emacs-lisp/comp.el
View file

@ -3604,18 +3604,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.

4
lisp/emacs-lisp/debug.el
View file

@ -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)

18
lisp/emacs-lisp/edebug.el
View file

@ -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)

9
lisp/emacs-lisp/ert.el
View file

@ -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 (any (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

2
lisp/emacs-lisp/lisp.el
View file

@ -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)

2
lisp/emacs-lisp/multisession.el
View file

@ -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

3
lisp/emacs-lisp/package.el
View file

@ -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)

27
lisp/epa-file.el
View file

@ -117,8 +117,12 @@ 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))
;; 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" (cdr error))))))
@ -136,6 +140,10 @@ encryption is used."
error-string)
(match-string 1 error-string))))
(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)
(barf-if-buffer-read-only)
@ -171,23 +179,24 @@ 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)))
(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
;; 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,8 +206,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)))
;; 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" (cdr error))))))
(set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)!

22
lisp/epa.el
View file

@ -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)

2
lisp/eshell/esh-io.el
View file

@ -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)

12
lisp/ffap.el
View file

@ -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-equal-ignore-case (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:

8
lisp/files.el
View file

@ -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

2
lisp/gnus/gnus-art.el
View file

@ -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 ()

4
lisp/gnus/gnus-search.el
View file

@ -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)))))
(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

4
lisp/gnus/mail-source.el
View file

@ -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))

4
lisp/gnus/mml-sec.el
View file

@ -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)))))

12
lisp/gnus/nnmaildir.el
View file

@ -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-equal-ignore-case (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)

2
lisp/gnus/nnrss.el
View file

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

3
lisp/gnus/nnselect.el
View file

@ -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

11
lisp/ibuffer.el
View file

@ -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-search "too small" msg)))))
(signal err)
(enlarge-window 3))))))
(select-window (next-window))
(switch-to-buffer buf)

2
lisp/international/ja-dic-utl.el
View file

@ -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)

2
lisp/jit-lock.el
View file

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

17
lisp/jka-compr.el
View file

@ -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

4
lisp/ls-lisp.el
View file

@ -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)

6
lisp/mail/mail-extr.el
View file

@ -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))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;

2
lisp/mail/rfc2047.el
View file

@ -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

2
lisp/mail/rfc2231.el
View file

@ -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)

2
lisp/minibuffer.el
View file

@ -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)

4
lisp/mouse.el
View file

@ -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'.

7
lisp/net/ange-ftp.el
View file

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

10
lisp/net/dbus.el
View file

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

4
lisp/net/eudc-export.el
View file

@ -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)))

4
lisp/net/imap.el
View file

@ -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)

3
lisp/net/sasl.el
View file

@ -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)))

2
lisp/net/soap-client.el
View file

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

9
lisp/net/tramp-compat.el
View file

@ -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)))

4
lisp/net/tramp-message.el
View file

@ -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))))))

2
lisp/plstore.el
View file

@ -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))))

27
lisp/progmodes/ebrowse.el
View file

@ -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 ()

8
lisp/progmodes/elisp-mode.el
View file

@ -1111,8 +1111,7 @@ functions are annotated with \"<f>\" 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
@ -1186,12 +1185,11 @@ functions are annotated with \"<f>\" 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))

2
lisp/progmodes/js.el
View file

@ -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)

2
lisp/progmodes/octave.el
View file

@ -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."

2
lisp/savehist.el
View file

@ -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

2
lisp/simple.el
View file

@ -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))

14
lisp/startup.el
View file

@ -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)

28
lisp/subr.el
View file

@ -568,8 +568,36 @@ 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)")
(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)

2
lisp/tar-mode.el
View file

@ -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)

2
lisp/textmodes/tex-mode.el
View file

@ -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."

2
lisp/transient.el
View file

@ -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)

4
lisp/type-break.el
View file

@ -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

2
lisp/vc/diff-mode.el
View file

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

2
lisp/vc/smerge-mode.el
View file

@ -1478,7 +1478,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))

8
lisp/vc/vc.el
View file

@ -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
@ -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
@ -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))))

10
lisp/xt-mouse.el
View file

@ -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)))

12
src/eval.c
View file

@ -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,

3
src/fileio.c
View file

@ -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

2
test/infra/android/test-controller.el
View file

@ -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)))))))))

5
test/lisp/arc-mode-tests.el
View file

@ -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))

2
test/lisp/autorevert-tests.el
View file

@ -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))

5
test/lisp/emacs-lisp/edebug-tests.el
View file

@ -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

2
test/lisp/emacs-lisp/pp-tests.el
View file

@ -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 ()

2
test/lisp/proced-tests.el
View file

@ -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))))))

21
test/lisp/subr-tests.el
View file

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

2
test/lisp/vc/vc-git-tests.el
View file

@ -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 ()

5
test/lisp/vc/vc-tests/vc-tests.el
View file

@ -236,10 +236,9 @@ 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)
(t (signal (car err) (cdr err)))))
(vc-not-supported 'vc-not-supported)))
(defun vc-test--register (backend)
"Register and unregister a file.

6
test/src/filelock-tests.el
View file

@ -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))))))

2
test/src/process-tests.el
View file

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