[Emacs-diffs] master 0ae28c7 5/7: Hide byte code in backtraces (Bug#6991)

[Noam Postavsky]

branch: master
commit 0ae28c71c739dfecbe94a5ff6786e81021d2d1cf
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>

    Hide byte code in backtraces (Bug#6991)
    
    * lisp/emacs-lisp/debug.el (debugger-print-function): New defcustom,
    defaulting to `cl-print'.
    (debugger-insert-backtrace, debugger-setup-buffer): Use it instead of
    `prin1'.
    * etc/NEWS: Announce it.
---
 etc/NEWS                 |  5 +++++
 lisp/emacs-lisp/debug.el | 26 ++++++++++++++++++--------
 2 files changed, 23 insertions(+), 8 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 5e10ca9..319b40f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -320,6 +320,11 @@ questions, with a handy way to display help texts.
 all call stack frames in a Lisp backtrace buffer as lists.  Both
 debug.el and edebug.el have been updated to heed to this variable.
 
+---
+** Values in call stack frames are now displayed using 'cl-prin1'.
+The old behaviour of using 'prin1' can be restored by customizing the
+new option 'debugger-print-function'.
+
 +++
 ** The new variable 'x-ctrl-keysym' has been added to the existing
 roster of X keysyms.  It can be used in combination with another
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 7db0f91..726005a 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -49,6 +49,12 @@ the middle is discarded, and just the beginning and end are 
displayed."
   :group 'debugger
   :version "21.1")
 
+(defcustom debugger-print-function #'cl-prin1
+  "Function used to print values in the debugger backtraces."
+  :type 'function
+  :options '(cl-prin1 prin1)
+  :version "26.1")
+
 (defcustom debugger-bury-or-kill 'bury
   "What to do with the debugger buffer when exiting `debug'.
 The value affects the behavior of operations on any window
@@ -265,10 +271,13 @@ first will be printed into the backtrace buffer."
       debugger-value)))
 
 
+(defvar cl-print-compiled-button)
+
 (defun debugger-insert-backtrace (frames do-xrefs)
   "Format and insert the backtrace FRAMES at point.
 Make functions into cross-reference buttons if DO-XREFS is non-nil."
   (let ((standard-output (current-buffer))
+        (cl-print-compiled-button t)
         (eval-buffers eval-buffer-list))
     (require 'help-mode)     ; Define `help-function-def' button type.
     (pcase-dolist (`(,evald ,fun ,args ,flags) frames)
@@ -278,10 +287,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))
-          (prin1 fun)
-          (if args (prin1 args) (princ "()")))
+          (funcall debugger-print-function fun)
+          (if args (funcall debugger-print-function args) (princ "()")))
          (t
-          (prin1 (cons fun args))
+          (funcall debugger-print-function (cons fun args))
           (cl-incf fun-pt)))
         (when fun-file
           (make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
@@ -327,7 +336,7 @@ That buffer should be current already."
        (insert "--returning value: ")
        (setq pos (point))
        (setq debugger-value (nth 1 args))
-       (prin1 debugger-value (current-buffer))
+       (funcall debugger-print-function debugger-value (current-buffer))
        (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil)
        (insert ?\n))
       ;; Watchpoint triggered.
@@ -352,7 +361,7 @@ That buffer should be current already."
       (`error
        (insert "--Lisp error: ")
        (setq pos (point))
-       (prin1 (nth 1 args) (current-buffer))
+       (funcall debugger-print-function (nth 1 args) (current-buffer))
        (insert ?\n))
       ;; debug-on-call, when the next thing is an eval.
       (`t
@@ -362,9 +371,10 @@ That buffer should be current already."
       (_
        (insert ": ")
        (setq pos (point))
-       (prin1 (if (eq (car args) 'nil)
-                  (cdr args) args)
-              (current-buffer))
+       (funcall debugger-print-function
+                (if (eq (car args) 'nil)
+                    (cdr args) args)
+                (current-buffer))
        (insert ?\n)))
     (debugger-insert-backtrace frames t)
     ;; Place point on "stack frame 0" (bug#15101).