[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/handler-bind 917596160c1 05/10: startup.el: Use `handler-bind` t
|
From: |
Stefan Monnier |
|
Subject: |
scratch/handler-bind 917596160c1 05/10: startup.el: Use `handler-bind` to implement `--debug-init` |
|
Date: |
Thu, 28 Dec 2023 01:17:41 -0500 (EST) |
branch: scratch/handler-bind
commit 917596160c1c831b3a41b320a0e357e5161cb4c8
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
startup.el: Use `handler-bind` to implement `--debug-init`
This provides a more reliable fix for bug#65267 since we don't
touch `debug-on-error` nor `debug-ignore-errors` any more.
* lisp/startup.el (startup--debug): New function.
(startup--load-user-init-file): Use it and `handler-bind` instead of
let-binding `debug-on-error`.
---
lisp/startup.el | 221 +++++++++++++++++++++++++-------------------------------
1 file changed, 97 insertions(+), 124 deletions(-)
diff --git a/lisp/startup.el b/lisp/startup.el
index 255c31257b0..f53ff75d236 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -393,7 +393,7 @@ If this is nil, Emacs uses `system-name'."
"The email address of the current user.
This defaults to either: the value of EMAIL environment variable; or
user@host, using `user-login-name' and `mail-host-address' (or `system-name')."
- :initialize 'custom-initialize-delay
+ :initialize #'custom-initialize-delay
:set-after '(mail-host-address)
:type 'string
:group 'mail)
@@ -492,7 +492,7 @@ DIRS are relative."
(setq tail (cdr tail)))
;;Splice the new section in.
(when tail
- (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))))
+ (setcdr tail (append (mapcar #'expand-file-name dirs) (cdr tail))))))
;; The default location for XDG-convention Emacs init files.
(defconst startup--xdg-config-default "~/.config/emacs/")
@@ -1019,6 +1019,9 @@ If STYLE is nil, display appropriately for the terminal."
(when standard-display-table
(aset standard-display-table char nil)))))))
+(defun startup--debug (err)
+ (funcall debugger 'error err :backtrace-base #'startup--debug))
+
(defun startup--load-user-init-file
(filename-function &optional alternate-filename-function load-defaults)
"Load a user init-file.
@@ -1032,124 +1035,94 @@ is non-nil.
This function sets `user-init-file' to the name of the loaded
init-file, or to a default value if loading is not possible."
- (let ((debug-on-error-from-init-file nil)
- (debug-on-error-should-be-set nil)
- (debug-on-error-initial
- (if (eq init-file-debug t)
- 'startup--witness ;Dummy but recognizable non-nil value.
- init-file-debug))
- (d-i-e-from-init-file nil)
- (d-i-e-initial
- ;; Use (startup--witness) instead of nil, so we can detect when the
- ;; init files set `debug-ignored-errors' to nil.
- (if init-file-debug '(startup--witness) debug-ignored-errors))
- (d-i-e-standard debug-ignored-errors)
- ;; The init file might contain byte-code with embedded NULs,
- ;; which can cause problems when read back, so disable nul
- ;; byte detection. (Bug#52554)
- (inhibit-null-byte-detection t))
- (let ((debug-on-error debug-on-error-initial)
- ;; If they specified --debug-init, enter the debugger
- ;; on any error whatsoever.
- (debug-ignored-errors d-i-e-initial))
- (condition-case-unless-debug error
- (when init-file-user
- (let ((init-file-name (funcall filename-function)))
-
- ;; If `user-init-file' is t, then `load' will store
- ;; the name of the file that it loads into
- ;; `user-init-file'.
- (setq user-init-file t)
- (when init-file-name
- (load (if (equal (file-name-extension init-file-name)
- "el")
- (file-name-sans-extension init-file-name)
- init-file-name)
- 'noerror 'nomessage))
-
- (when (and (eq user-init-file t) alternate-filename-function)
- (let ((alt-file (funcall alternate-filename-function)))
- (unless init-file-name
- (setq init-file-name alt-file))
- (and (equal (file-name-extension alt-file) "el")
- (setq alt-file (file-name-sans-extension alt-file)))
- (load alt-file 'noerror 'nomessage)))
-
- ;; If we did not find the user's init file, set
- ;; user-init-file conclusively. Don't let it be
- ;; set from default.el.
- (when (eq user-init-file t)
- (setq user-init-file init-file-name)))
-
- ;; If we loaded a compiled file, set `user-init-file' to
- ;; the source version if that exists.
- (if (equal (file-name-extension user-init-file) "elc")
- (let* ((source (file-name-sans-extension user-init-file))
- (alt (concat source ".el")))
- (setq source (cond ((file-exists-p alt) alt)
- ((file-exists-p source) source)
- (t nil)))
- (when source
- (when (file-newer-than-file-p source user-init-file)
- (message "Warning: %s is newer than %s"
- source user-init-file)
- (sit-for 1))
- (setq user-init-file source)))
- ;; Else, perhaps the user init file was compiled
- (when (and (equal (file-name-extension user-init-file) "eln")
- ;; The next test is for builds without native
- ;; compilation support or builds with unexec.
- (boundp 'comp-eln-to-el-h))
- (if-let (source (gethash (file-name-nondirectory
user-init-file)
- comp-eln-to-el-h))
- ;; source exists or the .eln file would not load
- (setq user-init-file source)
- (message "Warning: unknown source file for init file %S"
- user-init-file)
- (sit-for 1))))
-
- (when (and load-defaults
- (not inhibit-default-init))
- ;; Prevent default.el from changing the value of
- ;; `inhibit-startup-screen'.
- (let ((inhibit-startup-screen nil))
- (load "default" 'noerror 'nomessage))))
- (error
- (display-warning
- 'initialization
- (format-message "\
+ ;; The init file might contain byte-code with embedded NULs,
+ ;; which can cause problems when read back, so disable nul
+ ;; byte detection. (Bug#52554)
+ (let ((inhibit-null-byte-detection t)
+ (body
+ (lambda ()
+ (condition-case-unless-debug error
+ (when init-file-user
+ (let ((init-file-name (funcall filename-function)))
+
+ ;; If `user-init-file' is t, then `load' will store
+ ;; the name of the file that it loads into
+ ;; `user-init-file'.
+ (setq user-init-file t)
+ (when init-file-name
+ (load (if (equal (file-name-extension init-file-name)
+ "el")
+ (file-name-sans-extension init-file-name)
+ init-file-name)
+ 'noerror 'nomessage))
+
+ (when (and (eq user-init-file t)
alternate-filename-function)
+ (let ((alt-file (funcall alternate-filename-function)))
+ (unless init-file-name
+ (setq init-file-name alt-file))
+ (and (equal (file-name-extension alt-file) "el")
+ (setq alt-file (file-name-sans-extension alt-file)))
+ (load alt-file 'noerror 'nomessage)))
+
+ ;; If we did not find the user's init file, set
+ ;; user-init-file conclusively. Don't let it be
+ ;; set from default.el.
+ (when (eq user-init-file t)
+ (setq user-init-file init-file-name)))
+
+ ;; If we loaded a compiled file, set `user-init-file' to
+ ;; the source version if that exists.
+ (if (equal (file-name-extension user-init-file) "elc")
+ (let* ((source (file-name-sans-extension user-init-file))
+ (alt (concat source ".el")))
+ (setq source (cond ((file-exists-p alt) alt)
+ ((file-exists-p source) source)
+ (t nil)))
+ (when source
+ (when (file-newer-than-file-p source user-init-file)
+ (message "Warning: %s is newer than %s"
+ source user-init-file)
+ (sit-for 1))
+ (setq user-init-file source)))
+ ;; Else, perhaps the user init file was compiled
+ (when (and (equal (file-name-extension user-init-file)
"eln")
+ ;; The next test is for builds without native
+ ;; compilation support or builds with unexec.
+ (boundp 'comp-eln-to-el-h))
+ (if-let (source (gethash (file-name-nondirectory
+ user-init-file)
+ comp-eln-to-el-h))
+ ;; source exists or the .eln file would not load
+ (setq user-init-file source)
+ (message "Warning: unknown source file for init file %S"
+ user-init-file)
+ (sit-for 1))))
+
+ (when (and load-defaults
+ (not inhibit-default-init))
+ ;; Prevent default.el from changing the value of
+ ;; `inhibit-startup-screen'.
+ (let ((inhibit-startup-screen nil))
+ (load "default" 'noerror 'nomessage))))
+ (error
+ (display-warning
+ 'initialization
+ (format-message "\
An error occurred while loading `%s':\n\n%s%s%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) ", "))
- :warning)
- (setq init-file-had-error t)))
-
- ;; If we can tell that the init file altered debug-on-error,
- ;; arrange to preserve the value that it set up.
- (unless (eq debug-ignored-errors d-i-e-initial)
- (if (memq 'startup--witness debug-ignored-errors)
- ;; The init file wants to add errors to the standard
- ;; value, so we need to emulate that.
- (setq d-i-e-from-init-file
- (list (append d-i-e-standard
- (remq 'startup--witness
- debug-ignored-errors))))
- ;; The init file _replaces_ the standard value.
- (setq d-i-e-from-init-file (list debug-ignored-errors))))
- (or (eq debug-on-error debug-on-error-initial)
- (setq debug-on-error-should-be-set t
- debug-on-error-from-init-file debug-on-error)))
-
- (when d-i-e-from-init-file
- (setq debug-ignored-errors (car d-i-e-from-init-file)))
- (when debug-on-error-should-be-set
- (setq debug-on-error debug-on-error-from-init-file))))
+ user-init-file
+ (get (car error) 'error-message)
+ (if (cdr error) ": " "")
+ (mapconcat (lambda (s) (prin1-to-string s t))
+ (cdr error) ", "))
+ :warning)
+ (setq init-file-had-error t))))))
+ (if (eq init-file-debug t)
+ (handler-bind ((error #'startup--debug))
+ (funcall body))
+ (funcall body))))
(defvar lisp-directory nil
"Directory where Emacs's own *.el and *.elc Lisp files are installed.")
@@ -1445,7 +1418,7 @@ please check its value")
(error
(princ
(if (eq (car error) 'error)
- (apply 'concat (cdr error))
+ (apply #'concat (cdr error))
(if (memq 'file-error (get (car error) 'error-conditions))
(format "%s: %s"
(nth 1 error)
@@ -1897,10 +1870,10 @@ Each element in the list should be a list of strings or
pairs
(let ((map (make-sparse-keymap)))
(suppress-keymap map)
(set-keymap-parent map button-buffer-map)
- (define-key map "\C-?" 'scroll-down-command)
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map " " 'scroll-up-command)
- (define-key map "q" 'exit-splash-screen)
+ (define-key map "\C-?" #'scroll-down-command)
+ (define-key map [?\S-\ ] #'scroll-down-command)
+ (define-key map " " #'scroll-up-command)
+ (define-key map "q" #'exit-splash-screen)
map)
"Keymap for splash screen buffer.")
@@ -2338,7 +2311,7 @@ To quit a partially entered command, type Control-g.\n")
;; If C-h can't be invoked, temporarily disable its
;; binding, so where-is uses alternative bindings.
(let ((map (make-sparse-keymap)))
- (define-key map [?\C-h] 'undefined)
+ (define-key map [?\C-h] #'undefined)
map))
minor-mode-overriding-map-alist)))
@@ -2530,8 +2503,8 @@ A fancy display is used on graphic displays, normal
otherwise."
(fancy-about-screen)
(normal-splash-screen nil)))
-(defalias 'about-emacs 'display-about-screen)
-(defalias 'display-splash-screen 'display-startup-screen)
+(defalias 'about-emacs #'display-about-screen)
+(defalias 'display-splash-screen #'display-startup-screen)
;; This avoids byte-compiler warning in the unexec build.
(declare-function pdumper-stats "pdumper.c" ())
- branch scratch/handler-bind created (now 26b7078705a), Stefan Monnier, 2023/12/28
- scratch/handler-bind 89a298b3d2f 02/10: Fix ert-tests.el for the new `handler-bind` code, Stefan Monnier, 2023/12/28
- scratch/handler-bind dcf7508c947 04/10: emacs-module-tests.el (mod-test-non-local-exit-signal-test): Repair test, Stefan Monnier, 2023/12/28
- scratch/handler-bind 1c1d2eb3e38 03/10: Use handler-bind to repair bytecomp-tests, Stefan Monnier, 2023/12/28
- scratch/handler-bind 6a57b9151b1 06/10: Move batch backtrace code to `top_level_2`, Stefan Monnier, 2023/12/28
- scratch/handler-bind ae21819496a 01/10: ert.el: Use `handler-bind` to record backtraces, Stefan Monnier, 2023/12/28
- scratch/handler-bind 26b7078705a 10/10: (backtrace-on-redisplay-error): Use `handler-bind`, Stefan Monnier, 2023/12/28
- scratch/handler-bind b925152bffc 09/10: (signal_or_quit): Preserve error object identity, Stefan Monnier, 2023/12/28
- scratch/handler-bind 917596160c1 05/10: startup.el: Use `handler-bind` to implement `--debug-init`,
Stefan Monnier <=
- scratch/handler-bind 634bf619476 07/10: (macroexp--with-extended-form-stack): Use plain `let`, Stefan Monnier, 2023/12/28
- scratch/handler-bind c89b234405f 08/10: eval.c: Add new var `lisp-eval-depth-reserve`, Stefan Monnier, 2023/12/28