scratch/handler-bind 453f977d642 11/12: misc debug-early.el (incl. debug-early-muted)

[Stefan Monnier]

branch: scratch/handler-bind
commit 453f977d642bc2adebddfe74360c39fb7cd59464
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    misc debug-early.el (incl. debug-early-muted)
    
    (debug-early-backtrace): Exclude oneself from the backtrace.
    (debug-early-muted): New function.
---
 lisp/emacs-lisp/debug-early.el | 26 +++++++++++++++++++++++---
 1 file changed, 23 insertions(+), 3 deletions(-)

diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el
index 2e56d5ab321..01206bde86d 100644
--- a/lisp/emacs-lisp/debug-early.el
+++ b/lisp/emacs-lisp/debug-early.el
@@ -27,12 +27,15 @@
 ;; This file dumps a backtrace on stderr when an error is thrown.  It
 ;; has no dependencies on any Lisp libraries and is thus used for
 ;; generating backtraces for bugs in the early parts of bootstrapping.
-;; It is also always used in batch model.  It was introduced in Emacs
+;; It is also always used in batch mode.  It was introduced in Emacs
 ;; 29, before which there was no backtrace available during early
 ;; bootstrap.
 
 ;;; Code:
 
+;; For bootstrap reasons, we cannot use any macros here since they're
+;; not defined yet.
+
 (defalias 'debug-early-backtrace
   #'(lambda ()
       "Print a trace of Lisp function calls currently active.
@@ -68,9 +71,10 @@ of the build process."
                            (funcall prin1 (car args))
                            (setq args (cdr args)))
                     (princ " ")))
-              (princ ")\n")))))))
+              (princ ")\n")))
+        #'debug-early))))
 
-(defalias 'debug-early
+(defalias 'debug-early                  ;Called from C.
   #'(lambda (&rest args)
   "Print an error message with a backtrace of active Lisp function calls.
 The output stream used is the value of `standard-output'.
@@ -98,4 +102,20 @@ available before `debug' was usable.)"
   #'(lambda (err)
       (if backtrace-on-error-noninteractive (debug-early 'error err))))
 
+(defalias 'debug-early--muted           ;Called from C.
+  #'(lambda (err)
+      (if backtrace-on-redisplay-error
+          (save-current-buffer
+            (set-buffer (get-buffer-create "*Redisplay-trace*"))
+            ;; FIXME: The C code tested `backtrace_yet'.
+            (goto-char (point-max))
+            (if (bobp) nil
+              (insert "\n\n\n\n")) ;; Separates things in *Redisplay-trace*
+            (insert "-- Caught at " (current-time-string) "\n")
+            (let ((standard-output (current-buffer)))
+              (debug-early--handler err))
+            (setq delayed-warnings-list
+                  (cons "Error in a redisplay Lisp hook.  See buffer 
*Redisplay-trace*"
+                        delayed-warnings-list))))))
+
 ;;; debug-early.el ends here.