aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2017-10-13 22:45:41 -0400
committerStefan Monnier2017-10-13 22:45:41 -0400
commitdcb86584fd12fc44d246bbe033372693785c127d (patch)
treed2f0b91e469d5b6b486f1b9fa24cfdd49451371d
parent78479a3984047a8153b43571e6b5ebfb674223a4 (diff)
downloademacs-dcb86584fd12fc44d246bbe033372693785c127d.tar.gz
emacs-dcb86584fd12fc44d246bbe033372693785c127d.zip
* lisp/emacs-lisp/debug.el: Don't bail on errors inside cl-print
(debugger--print): New function. (debugger-insert-backtrace, debugger-setup-buffer): Use it.
-rw-r--r--lisp/emacs-lisp/debug.el18
1 files changed, 12 insertions, 6 deletions
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 0247179a843..473ead12f5a 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -270,6 +270,12 @@ first will be printed into the backtrace buffer."
270 (setq debug-on-next-call debugger-step-after-exit) 270 (setq debug-on-next-call debugger-step-after-exit)
271 debugger-value))) 271 debugger-value)))
272 272
273(defun debugger--print (obj &optional stream)
274 (condition-case err
275 (funcall debugger-print-function obj stream)
276 (error
277 (message "Error in debug printer: %S" err)
278 (prin1 obj stream))))
273 279
274(defun debugger-insert-backtrace (frames do-xrefs) 280(defun debugger-insert-backtrace (frames do-xrefs)
275 "Format and insert the backtrace FRAMES at point. 281 "Format and insert the backtrace FRAMES at point.
@@ -284,10 +290,10 @@ Make functions into cross-reference buttons if DO-XREFS is non-nil."
284 (fun-pt (point))) 290 (fun-pt (point)))
285 (cond 291 (cond
286 ((and evald (not debugger-stack-frame-as-list)) 292 ((and evald (not debugger-stack-frame-as-list))
287 (funcall debugger-print-function fun) 293 (debugger--print fun)
288 (if args (funcall debugger-print-function args) (princ "()"))) 294 (if args (debugger--print args) (princ "()")))
289 (t 295 (t
290 (funcall debugger-print-function (cons fun args)) 296 (debugger--print (cons fun args))
291 (cl-incf fun-pt))) 297 (cl-incf fun-pt)))
292 (when fun-file 298 (when fun-file
293 (make-text-button fun-pt (+ fun-pt (length (symbol-name fun))) 299 (make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
@@ -333,7 +339,7 @@ That buffer should be current already."
333 (insert "--returning value: ") 339 (insert "--returning value: ")
334 (setq pos (point)) 340 (setq pos (point))
335 (setq debugger-value (nth 1 args)) 341 (setq debugger-value (nth 1 args))
336 (funcall debugger-print-function debugger-value (current-buffer)) 342 (debugger--print debugger-value (current-buffer))
337 (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil) 343 (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil)
338 (insert ?\n)) 344 (insert ?\n))
339 ;; Watchpoint triggered. 345 ;; Watchpoint triggered.
@@ -358,7 +364,7 @@ That buffer should be current already."
358 (`error 364 (`error
359 (insert "--Lisp error: ") 365 (insert "--Lisp error: ")
360 (setq pos (point)) 366 (setq pos (point))
361 (funcall debugger-print-function (nth 1 args) (current-buffer)) 367 (debugger--print (nth 1 args) (current-buffer))
362 (insert ?\n)) 368 (insert ?\n))
363 ;; debug-on-call, when the next thing is an eval. 369 ;; debug-on-call, when the next thing is an eval.
364 (`t 370 (`t
@@ -368,7 +374,7 @@ That buffer should be current already."
368 (_ 374 (_
369 (insert ": ") 375 (insert ": ")
370 (setq pos (point)) 376 (setq pos (point))
371 (funcall debugger-print-function 377 (debugger--print
372 (if (eq (car args) 'nil) 378 (if (eq (car args) 'nil)
373 (cdr args) args) 379 (cdr args) args)
374 (current-buffer)) 380 (current-buffer))