From: Stefan Monnier Date: Wed, 20 Dec 2023 00:46:47 +0000 (-0500) Subject: startup.el: Use `handler-bind` to implement `--debug-init` X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=80b081a0ac72a5a9e459af6c96f5b0226a79894f;p=emacs.git 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`. --- diff --git a/lisp/startup.el b/lisp/startup.el index 1abbb260e30..4040d5d3774 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" ())