diff options
Diffstat (limited to 'lisp/emacs-lisp/debug.el')
| -rw-r--r-- | lisp/emacs-lisp/debug.el | 207 |
1 files changed, 84 insertions, 123 deletions
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 83456fc31a2..1ebbc0e0086 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -19,7 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -49,6 +49,13 @@ 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 '(choice (const cl-prin1) + (const prin1) + function) + :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 @@ -247,7 +254,9 @@ first will be printed into the backtrace buffer." ;; Unshow debugger-buffer. (quit-restore-window debugger-window debugger-bury-or-kill) ;; Restore current buffer (Bug#12502). - (set-buffer debugger-old-buffer)))) + (set-buffer debugger-old-buffer))) + ;; Forget debugger window, it won't be back (Bug#17882). + (setq debugger-previous-window nil)) ;; Restore previous state of debugger-buffer in case we were ;; in a recursive invocation of the debugger, otherwise just ;; erase the buffer and put it into fundamental mode. @@ -264,6 +273,46 @@ 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. +Make functions into cross-reference buttons if DO-XREFS is non-nil." + (let ((standard-output (current-buffer)) + (eval-buffers eval-buffer-list)) + (require 'help-mode) ; Define `help-function-def' button type. + (pcase-dolist (`(,evald ,fun ,args ,flags) frames) + (insert (if (plist-get flags :debug-on-exit) + "* " " ")) + (let ((fun-file (and do-xrefs (symbol-file fun 'defun))) + (fun-pt (point))) + (cond + ((and evald (not debugger-stack-frame-as-list)) + (debugger--print fun) + (if args (debugger--print args) (princ "()"))) + (t + (debugger--print (cons fun args)) + (cl-incf fun-pt))) + (when fun-file + (make-text-button fun-pt (+ fun-pt (length (symbol-name fun))) + :type 'help-function-def + 'help-args (list fun fun-file)))) + ;; After any frame that uses eval-buffer, insert a line that + ;; states the buffer position it's reading at. + (when (and eval-buffers (memq fun '(eval-buffer eval-region))) + (insert (format " ; Reading at buffer position %d" + ;; This will get the wrong result if there are + ;; two nested eval-region calls for the same + ;; buffer. That's not a very useful case. + (with-current-buffer (pop eval-buffers) + (point))))) + (insert "\n")))) + (defun debugger-setup-buffer (args) "Initialize the `*Backtrace*' buffer for entry to the debugger. That buffer should be current already." @@ -271,27 +320,20 @@ That buffer should be current already." (erase-buffer) (set-buffer-multibyte t) ;Why was it nil ? -stef (setq buffer-undo-list t) - (let ((standard-output (current-buffer)) - (print-escape-newlines t) - (print-level 8) - (print-length 50)) - ;; FIXME the debugger could pass a custom callback to mapbacktrace - ;; instead of manipulating printed results. - (mapbacktrace #'backtrace--print-frame 'debug)) - (goto-char (point-min)) - (delete-region (point) - (progn - (forward-line (if (eq (car args) 'debug) - ;; Remove debug--implement-debug-on-entry - ;; and the advice's `apply' frame. - 3 - 1)) - (point))) (insert "Debugger entered") - ;; lambda is for debug-on-call when a function call is next. - ;; debug is for debug-on-entry function called. - (let ((pos (point))) + (let ((frames (nthcdr + ;; Remove debug--implement-debug-on-entry and the + ;; advice's `apply' frame. + (if (eq (car args) 'debug) 3 1) + (backtrace-frames 'debug))) + (print-escape-newlines t) + (print-escape-control-characters t) + (print-level 8) + (print-length 50) + (pos (point))) (pcase (car args) + ;; lambda is for debug-on-call when a function call is next. + ;; debug is for debug-on-entry function called. ((or `lambda `debug) (insert "--entering a function:\n") (setq pos (1- (point)))) @@ -300,11 +342,9 @@ That buffer should be current already." (insert "--returning value: ") (setq pos (point)) (setq debugger-value (nth 1 args)) - (prin1 debugger-value (current-buffer)) - (insert ?\n) - (delete-char 1) - (insert ? ) - (beginning-of-line)) + (debugger--print debugger-value (current-buffer)) + (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil) + (insert ?\n)) ;; Watchpoint triggered. ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args))) (insert @@ -327,7 +367,7 @@ That buffer should be current already." (`error (insert "--Lisp error: ") (setq pos (point)) - (prin1 (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 @@ -337,98 +377,15 @@ That buffer should be current already." (_ (insert ": ") (setq pos (point)) - (prin1 (if (eq (car args) 'nil) - (cdr args) args) - (current-buffer)) + (debugger--print + (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). - (goto-char pos)) - ;; After any frame that uses eval-buffer, - ;; insert a line that states the buffer position it's reading at. - (save-excursion - (let ((tem eval-buffer-list)) - (while (and tem - (re-search-forward "^ eval-\\(buffer\\|region\\)(" nil t)) - (end-of-line) - (insert (format " ; Reading at buffer position %d" - ;; This will get the wrong result - ;; if there are two nested eval-region calls - ;; for the same buffer. That's not a very useful case. - (with-current-buffer (car tem) - (point)))) - (pop tem)))) - (debugger-make-xrefs)) - -(defun debugger-make-xrefs (&optional buffer) - "Attach cross-references to function names in the `*Backtrace*' buffer." - (interactive "b") - (with-current-buffer (or buffer (current-buffer)) - (save-excursion - (setq buffer (current-buffer)) - (let ((inhibit-read-only t) - (old-end (point-min)) (new-end (point-min))) - ;; If we saved an old backtrace, find the common part - ;; between the new and the old. - ;; Compare line by line, starting from the end, - ;; because that's the part that is likely to be unchanged. - (if debugger-previous-backtrace - (let (old-start new-start (all-match t)) - (goto-char (point-max)) - (with-temp-buffer - (insert debugger-previous-backtrace) - (while (and all-match (not (bobp))) - (setq old-end (point)) - (forward-line -1) - (setq old-start (point)) - (with-current-buffer buffer - (setq new-end (point)) - (forward-line -1) - (setq new-start (point))) - (if (not (zerop - (let ((case-fold-search nil)) - (compare-buffer-substrings - (current-buffer) old-start old-end - buffer new-start new-end)))) - (setq all-match nil)))) - ;; Now new-end is the position of the start of the - ;; unchanged part in the current buffer, and old-end is - ;; the position of that same text in the saved old - ;; backtrace. But we must subtract (point-min) since strings are - ;; indexed in origin 0. - - ;; Replace the unchanged part of the backtrace - ;; with the text from debugger-previous-backtrace, - ;; since that already has the proper xrefs. - ;; With this optimization, we only need to scan - ;; the changed part of the backtrace. - (delete-region new-end (point-max)) - (goto-char (point-max)) - (insert (substring debugger-previous-backtrace - (- old-end (point-min)))) - ;; Make the unchanged part of the backtrace inaccessible - ;; so it won't be scanned. - (narrow-to-region (point-min) new-end))) - - ;; Scan the new part of the backtrace, inserting xrefs. - (goto-char (point-min)) - (while (progn - (goto-char (+ (point) 2)) - (skip-syntax-forward "^w_") - (not (eobp))) - (let* ((beg (point)) - (end (progn (skip-syntax-forward "w_") (point))) - (sym (intern-soft (buffer-substring-no-properties - beg end))) - (file (and sym (symbol-file sym 'defun)))) - (when file - (goto-char beg) - ;; help-xref-button needs to operate on something matched - ;; by a regexp, so set that up for it. - (re-search-forward "\\(\\sw\\|\\s_\\)+") - (help-xref-button 0 'help-function-def sym file))) - (forward-line 1)) - (widen)) - (setq debugger-previous-backtrace (buffer-string))))) + (goto-char pos))) + (defun debugger-step-through () "Proceed, stepping through subexpressions of this expression. @@ -466,7 +423,7 @@ will be used, such as in a debug on exit from a frame." "from an error" "at function entrance"))) (setq debugger-value val) (princ "Returning " t) - (prin1 debugger-value) + (debugger--print debugger-value) (save-excursion ;; Check to see if we've flagged some frame for debug-on-exit, in which ;; case we'll probably come back to the debugger soon. @@ -581,7 +538,7 @@ The environment used is the one when entering the activation frame at point." (debugger-env-macro (let ((val (backtrace-eval exp nframe base))) (prog1 - (prin1 val t) + (debugger--print val t) (let ((str (eval-expression-print-format val))) (if str (princ str t)))))))) @@ -603,7 +560,7 @@ The environment used is the one when entering the activation frame at point." (insert "\n ") (prin1 symbol (current-buffer)) (insert " = ") - (prin1 value (current-buffer)))))))) + (debugger--print value (current-buffer)))))))) (defun debugger--show-locals () "For the frame at point, insert locals and add text properties." @@ -866,9 +823,13 @@ To specify a nil argument interactively, exit with an empty minibuffer." 'type 'help-function 'help-args (list fun)) (terpri)) - (terpri) - (princ "Note: if you have redefined a function, then it may no longer\n") - (princ "be set to debug on entry, even if it is in the list.")))))) + ;; Now that debug--function-list uses advice-member-p, its + ;; output should be reliable (except for bugs and the exceptional + ;; case where some other advice ends up overriding ours). + ;;(terpri) + ;;(princ "Note: if you have redefined a function, then it may no longer\n") + ;;(princ "be set to debug on entry, even if it is in the list.") + ))))) (defun debug--implement-debug-watch (symbol newval op where) "Conditionally call the debugger. |