procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

* lisp/emacs-lisp/debug.el: Don't bail on errors inside cl-print

Browse source 
(debugger--print): New function.
(debugger-insert-backtrace, debugger-setup-buffer): Use it.
This commit is contained in:
Stefan Monnier 2017-10-13 22:45:41 -04:00
parent 78479a3984
commit dcb86584fd
1 changed files with 12 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -270,6 +270,12 @@ first will be printed into the backtrace buffer."
(setq debug-on-next-call debugger-step-after-exit)
debugger-value)))
(defun debugger--print (obj &optional stream)
(condition-case err
(funcall debugger-print-function obj stream)
(error
(message "Error in debug printer: %S" err)
(prin1 obj stream))))
(defun debugger-insert-backtrace (frames do-xrefs)
"Format and insert the backtrace FRAMES at point.
@ -284,10 +290,10 @@ Make functions into cross-reference buttons if DO-XREFS is non-nil."
(fun-pt (point)))
(cond
((and evald (not debugger-stack-frame-as-list))
(funcall debugger-print-function fun)
(if args (funcall debugger-print-function args) (princ "()")))
(debugger--print fun)
(if args (debugger--print args) (princ "()")))
(t
(funcall debugger-print-function (cons fun args))
(debugger--print (cons fun args))
(cl-incf fun-pt)))
(when fun-file
(make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
@ -333,7 +339,7 @@ That buffer should be current already."
(insert "--returning value: ")
(setq pos (point))
(setq debugger-value (nth 1 args))
(funcall debugger-print-function debugger-value (current-buffer))
(debugger--print debugger-value (current-buffer))
(setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil)
(insert ?\n))
;; Watchpoint triggered.
@ -358,7 +364,7 @@ That buffer should be current already."
(`error
(insert "--Lisp error: ")
(setq pos (point))
(funcall debugger-print-function (nth 1 args) (current-buffer))
(debugger--print (nth 1 args) (current-buffer))
(insert ?\n))
;; debug-on-call, when the next thing is an eval.
(`t
@ -368,7 +374,7 @@ That buffer should be current already."
(_
(insert ": ")
(setq pos (point))
(funcall debugger-print-function
(debugger--print
(if (eq (car args) 'nil)
(cdr args) args)
(current-buffer))