martin/emacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Use the new error API functions

Browse Source 
* 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.
This commit is contained in:
Stefan Monnier
2026-03-08 23:28:11 -04:00
parent a1358530f5
commit 08e109d45a
30 changed files with 118 additions and 152 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

22
lisp/epa-file.el
View File

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

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= (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:

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

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

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.

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

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

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.

4
lisp/net/dbus.el
View File

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

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

@@ -1104,8 +1104,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
@@ -1179,12 +1178,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/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)

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

4
lisp/vc/vc.el
View File

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

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