Line data Source code
1 : ;;; debug.el --- debuggers and related commands for Emacs -*- lexical-binding: t -*-
2 :
3 : ;; Copyright (C) 1985-1986, 1994, 2001-2017 Free Software Foundation,
4 : ;; Inc.
5 :
6 : ;; Maintainer: emacs-devel@gnu.org
7 : ;; Keywords: lisp, tools, maint
8 :
9 : ;; This file is part of GNU Emacs.
10 :
11 : ;; GNU Emacs is free software: you can redistribute it and/or modify
12 : ;; it under the terms of the GNU General Public License as published by
13 : ;; the Free Software Foundation, either version 3 of the License, or
14 : ;; (at your option) any later version.
15 :
16 : ;; GNU Emacs is distributed in the hope that it will be useful,
17 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 : ;; GNU General Public License for more details.
20 :
21 : ;; You should have received a copy of the GNU General Public License
22 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 :
24 : ;;; Commentary:
25 :
26 : ;; This is a major mode documented in the Emacs Lisp manual.
27 :
28 : ;;; Code:
29 :
30 : (require 'button)
31 :
32 : (defgroup debugger nil
33 : "Debuggers and related commands for Emacs."
34 : :prefix "debugger-"
35 : :group 'debug)
36 :
37 : (defcustom debugger-mode-hook nil
38 : "Hooks run when `debugger-mode' is turned on."
39 : :type 'hook
40 : :group 'debugger
41 : :version "20.3")
42 :
43 : (defcustom debugger-batch-max-lines 40
44 : "Maximum lines to show in debugger buffer in a noninteractive Emacs.
45 : When the debugger is entered and Emacs is running in batch mode,
46 : if the backtrace text has more than this many lines,
47 : the middle is discarded, and just the beginning and end are displayed."
48 : :type 'integer
49 : :group 'debugger
50 : :version "21.1")
51 :
52 : (defcustom debugger-print-function #'cl-prin1
53 : "Function used to print values in the debugger backtraces."
54 : :type 'function
55 : :options '(cl-prin1 prin1)
56 : :version "26.1")
57 :
58 : (defcustom debugger-bury-or-kill 'bury
59 : "What to do with the debugger buffer when exiting `debug'.
60 : The value affects the behavior of operations on any window
61 : previously showing the debugger buffer.
62 :
63 : nil means that if its window is not deleted when exiting the
64 : debugger, invoking `switch-to-prev-buffer' will usually show
65 : the debugger buffer again.
66 :
67 : `append' means that if the window is not deleted, the debugger
68 : buffer moves to the end of the window's previous buffers so
69 : it's less likely that a future invocation of
70 : `switch-to-prev-buffer' will switch to it. Also, it moves the
71 : buffer to the end of the frame's buffer list.
72 :
73 : `bury' means that if the window is not deleted, its buffer is
74 : removed from the window's list of previous buffers. Also, it
75 : moves the buffer to the end of the frame's buffer list. This
76 : value provides the most reliable remedy to not have
77 : `switch-to-prev-buffer' switch to the debugger buffer again
78 : without killing the buffer.
79 :
80 : `kill' means to kill the debugger buffer.
81 :
82 : The value used here is passed to `quit-restore-window'."
83 : :type '(choice
84 : (const :tag "Keep alive" nil)
85 : (const :tag "Append" append)
86 : (const :tag "Bury" bury)
87 : (const :tag "Kill" kill))
88 : :group 'debugger
89 : :version "24.3")
90 :
91 : (defvar debugger-step-after-exit nil
92 : "Non-nil means \"single-step\" after the debugger exits.")
93 :
94 : (defvar debugger-value nil
95 : "This is the value for the debugger to return, when it returns.")
96 :
97 : (defvar debugger-old-buffer nil
98 : "This is the buffer that was current when the debugger was entered.")
99 :
100 : (defvar debugger-previous-window nil
101 : "This is the window last showing the debugger buffer.")
102 :
103 : (defvar debugger-previous-window-height nil
104 : "The last recorded height of `debugger-previous-window'.")
105 :
106 : (defvar debugger-previous-backtrace nil
107 : "The contents of the previous backtrace (including text properties).
108 : This is to optimize `debugger-make-xrefs'.")
109 :
110 : (defvar debugger-outer-match-data)
111 : (defvar debugger-will-be-back nil
112 : "Non-nil if we expect to get back in the debugger soon.")
113 :
114 : (defvar inhibit-debug-on-entry nil
115 : "Non-nil means that `debug-on-entry' is disabled.")
116 :
117 : (defvar debugger-jumping-flag nil
118 : "Non-nil means that `debug-on-entry' is disabled.
119 : This variable is used by `debugger-jump', `debugger-step-through',
120 : and `debugger-reenable' to temporarily disable debug-on-entry.")
121 :
122 : (defvar inhibit-trace) ;Not yet implemented.
123 :
124 : (defvar debugger-args nil
125 : "Arguments with which the debugger was called.
126 : It is a list expected to take the form (CAUSE . REST)
127 : where CAUSE can be:
128 : - debug: called for entry to a flagged function.
129 : - t: called because of debug-on-next-call.
130 : - lambda: same thing but via `funcall'.
131 : - exit: called because of exit of a flagged function.
132 : - error: called because of `debug-on-error'.")
133 :
134 : ;;;###autoload
135 : (setq debugger 'debug)
136 : ;;;###autoload
137 : (defun debug (&rest args)
138 : "Enter debugger. \\<debugger-mode-map>`\\[debugger-continue]' returns from the debugger.
139 : Arguments are mainly for use when this is called from the internals
140 : of the evaluator.
141 :
142 : You may call with no args, or you may pass nil as the first arg and
143 : any other args you like. In that case, the list of args after the
144 : first will be printed into the backtrace buffer."
145 : (interactive)
146 0 : (if inhibit-redisplay
147 : ;; Don't really try to enter debugger within an eval from redisplay.
148 0 : debugger-value
149 0 : (unless noninteractive
150 0 : (message "Entering debugger..."))
151 0 : (let (debugger-value
152 : (debugger-previous-state
153 0 : (if (get-buffer "*Backtrace*")
154 0 : (with-current-buffer (get-buffer "*Backtrace*")
155 0 : (list major-mode (buffer-string)))))
156 0 : (debugger-args args)
157 0 : (debugger-buffer (get-buffer-create "*Backtrace*"))
158 0 : (debugger-old-buffer (current-buffer))
159 : (debugger-window nil)
160 : (debugger-step-after-exit nil)
161 : (debugger-will-be-back nil)
162 : ;; Don't keep reading from an executing kbd macro!
163 : (executing-kbd-macro nil)
164 : ;; Save the outer values of these vars for the `e' command
165 : ;; before we replace the values.
166 0 : (debugger-outer-match-data (match-data))
167 0 : (debugger-with-timeout-suspend (with-timeout-suspend)))
168 : ;; Set this instead of binding it, so that `q'
169 : ;; will not restore it.
170 0 : (setq overriding-terminal-local-map nil)
171 : ;; Don't let these magic variables affect the debugger itself.
172 0 : (let ((last-command nil) this-command track-mouse
173 : (inhibit-trace t)
174 : unread-command-events
175 : unread-post-input-method-events
176 : last-input-event last-command-event last-nonmenu-event
177 : last-event-frame
178 : overriding-local-map
179 : load-read-function
180 : ;; If we are inside a minibuffer, allow nesting
181 : ;; so that we don't get an error from the `e' command.
182 : (enable-recursive-minibuffers
183 0 : (or enable-recursive-minibuffers (> (minibuffer-depth) 0)))
184 : (standard-input t) (standard-output t)
185 : inhibit-redisplay
186 : (cursor-in-echo-area nil)
187 0 : (window-configuration (current-window-configuration)))
188 0 : (unwind-protect
189 0 : (save-excursion
190 0 : (when (eq (car debugger-args) 'debug)
191 : ;; Skip the frames for backtrace-debug, byte-code,
192 : ;; debug--implement-debug-on-entry and the advice's `apply'.
193 0 : (backtrace-debug 4 t)
194 : ;; Place an extra debug-on-exit for macro's.
195 0 : (when (eq 'lambda (car-safe (cadr (backtrace-frame 4))))
196 0 : (backtrace-debug 5 t)))
197 0 : (pop-to-buffer
198 0 : debugger-buffer
199 0 : `((display-buffer-reuse-window
200 : display-buffer-in-previous-window)
201 0 : . (,(when (and (window-live-p debugger-previous-window)
202 0 : (frame-visible-p
203 0 : (window-frame debugger-previous-window)))
204 0 : `(previous-window . ,debugger-previous-window)))))
205 0 : (setq debugger-window (selected-window))
206 0 : (if (eq debugger-previous-window debugger-window)
207 0 : (when debugger-jumping-flag
208 : ;; Try to restore previous height of debugger
209 : ;; window.
210 0 : (condition-case nil
211 0 : (window-resize
212 0 : debugger-window
213 0 : (- debugger-previous-window-height
214 0 : (window-total-height debugger-window)))
215 0 : (error nil)))
216 0 : (setq debugger-previous-window debugger-window))
217 0 : (debugger-mode)
218 0 : (debugger-setup-buffer debugger-args)
219 0 : (when noninteractive
220 : ;; If the backtrace is long, save the beginning
221 : ;; and the end, but discard the middle.
222 0 : (when (> (count-lines (point-min) (point-max))
223 0 : debugger-batch-max-lines)
224 0 : (goto-char (point-min))
225 0 : (forward-line (/ 2 debugger-batch-max-lines))
226 0 : (let ((middlestart (point)))
227 0 : (goto-char (point-max))
228 0 : (forward-line (- (/ 2 debugger-batch-max-lines)
229 0 : debugger-batch-max-lines))
230 0 : (delete-region middlestart (point)))
231 0 : (insert "...\n"))
232 0 : (goto-char (point-min))
233 0 : (message "%s" (buffer-string))
234 0 : (kill-emacs -1))
235 0 : (message "")
236 0 : (let ((standard-output nil)
237 : (buffer-read-only t))
238 0 : (message "")
239 : ;; Make sure we unbind buffer-read-only in the right buffer.
240 0 : (save-excursion
241 0 : (recursive-edit))))
242 0 : (when (and (window-live-p debugger-window)
243 0 : (eq (window-buffer debugger-window) debugger-buffer))
244 : ;; Record height of debugger window.
245 0 : (setq debugger-previous-window-height
246 0 : (window-total-height debugger-window)))
247 0 : (if debugger-will-be-back
248 : ;; Restore previous window configuration (Bug#12623).
249 0 : (set-window-configuration window-configuration)
250 0 : (when (and (window-live-p debugger-window)
251 0 : (eq (window-buffer debugger-window) debugger-buffer))
252 0 : (progn
253 : ;; Unshow debugger-buffer.
254 0 : (quit-restore-window debugger-window debugger-bury-or-kill)
255 : ;; Restore current buffer (Bug#12502).
256 0 : (set-buffer debugger-old-buffer))))
257 : ;; Restore previous state of debugger-buffer in case we were
258 : ;; in a recursive invocation of the debugger, otherwise just
259 : ;; erase the buffer and put it into fundamental mode.
260 0 : (when (buffer-live-p debugger-buffer)
261 0 : (with-current-buffer debugger-buffer
262 0 : (let ((inhibit-read-only t))
263 0 : (erase-buffer)
264 0 : (if (null debugger-previous-state)
265 0 : (fundamental-mode)
266 0 : (insert (nth 1 debugger-previous-state))
267 0 : (funcall (nth 0 debugger-previous-state))))))
268 0 : (with-timeout-unsuspend debugger-with-timeout-suspend)
269 0 : (set-match-data debugger-outer-match-data)))
270 0 : (setq debug-on-next-call debugger-step-after-exit)
271 0 : debugger-value)))
272 :
273 :
274 : (defun debugger-insert-backtrace (frames do-xrefs)
275 : "Format and insert the backtrace FRAMES at point.
276 : Make functions into cross-reference buttons if DO-XREFS is non-nil."
277 1 : (let ((standard-output (current-buffer))
278 1 : (eval-buffers eval-buffer-list))
279 1 : (require 'help-mode) ; Define `help-function-def' button type.
280 1 : (pcase-dolist (`(,evald ,fun ,args ,flags) frames)
281 10 : (insert (if (plist-get flags :debug-on-exit)
282 10 : "* " " "))
283 10 : (let ((fun-file (and do-xrefs (symbol-file fun 'defun)))
284 10 : (fun-pt (point)))
285 10 : (cond
286 10 : ((and evald (not debugger-stack-frame-as-list))
287 7 : (funcall debugger-print-function fun)
288 6 : (if args (funcall debugger-print-function args) (princ "()")))
289 : (t
290 3 : (funcall debugger-print-function (cons fun args))
291 9 : (cl-incf fun-pt)))
292 9 : (when fun-file
293 0 : (make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
294 : :type 'help-function-def
295 9 : 'help-args (list fun fun-file))))
296 : ;; After any frame that uses eval-buffer, insert a line that
297 : ;; states the buffer position it's reading at.
298 9 : (when (and eval-buffers (memq fun '(eval-buffer eval-region)))
299 0 : (insert (format " ; Reading at buffer position %d"
300 : ;; This will get the wrong result if there are
301 : ;; two nested eval-region calls for the same
302 : ;; buffer. That's not a very useful case.
303 0 : (with-current-buffer (pop eval-buffers)
304 9 : (point)))))
305 9 : (insert "\n"))))
306 :
307 : (defun debugger-setup-buffer (args)
308 : "Initialize the `*Backtrace*' buffer for entry to the debugger.
309 : That buffer should be current already."
310 0 : (setq buffer-read-only nil)
311 0 : (erase-buffer)
312 0 : (set-buffer-multibyte t) ;Why was it nil ? -stef
313 0 : (setq buffer-undo-list t)
314 0 : (insert "Debugger entered")
315 0 : (let ((frames (nthcdr
316 : ;; Remove debug--implement-debug-on-entry and the
317 : ;; advice's `apply' frame.
318 0 : (if (eq (car args) 'debug) 3 1)
319 0 : (backtrace-frames 'debug)))
320 : (print-escape-newlines t)
321 : (print-escape-control-characters t)
322 : (print-level 8)
323 : (print-length 50)
324 0 : (pos (point)))
325 0 : (pcase (car args)
326 : ;; lambda is for debug-on-call when a function call is next.
327 : ;; debug is for debug-on-entry function called.
328 : ((or `lambda `debug)
329 0 : (insert "--entering a function:\n")
330 0 : (setq pos (1- (point))))
331 : ;; Exiting a function.
332 : (`exit
333 0 : (insert "--returning value: ")
334 0 : (setq pos (point))
335 0 : (setq debugger-value (nth 1 args))
336 0 : (funcall debugger-print-function debugger-value (current-buffer))
337 0 : (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil)
338 0 : (insert ?\n))
339 : ;; Watchpoint triggered.
340 0 : ((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
341 0 : (insert
342 : "--"
343 0 : (pcase details
344 0 : (`(makunbound nil) (format "making %s void" symbol))
345 0 : (`(makunbound ,buffer) (format "killing local value of %s in buffer %s"
346 0 : symbol buffer))
347 0 : (`(defvaralias ,_) (format "aliasing %s to %s" symbol newval))
348 0 : (`(let ,_) (format "let-binding %s to %S" symbol newval))
349 0 : (`(unlet ,_) (format "ending let-binding of %s" symbol))
350 0 : (`(set nil) (format "setting %s to %S" symbol newval))
351 0 : (`(set ,buffer) (format "setting %s in buffer %s to %S"
352 0 : symbol buffer newval))
353 0 : (_ (error "unrecognized watchpoint triggered %S" (cdr args))))
354 0 : ": ")
355 0 : (setq pos (point))
356 0 : (insert ?\n))
357 : ;; Debugger entered for an error.
358 : (`error
359 0 : (insert "--Lisp error: ")
360 0 : (setq pos (point))
361 0 : (funcall debugger-print-function (nth 1 args) (current-buffer))
362 0 : (insert ?\n))
363 : ;; debug-on-call, when the next thing is an eval.
364 : (`t
365 0 : (insert "--beginning evaluation of function call form:\n")
366 0 : (setq pos (1- (point))))
367 : ;; User calls debug directly.
368 : (_
369 0 : (insert ": ")
370 0 : (setq pos (point))
371 0 : (funcall debugger-print-function
372 0 : (if (eq (car args) 'nil)
373 0 : (cdr args) args)
374 0 : (current-buffer))
375 0 : (insert ?\n)))
376 0 : (debugger-insert-backtrace frames t)
377 : ;; Place point on "stack frame 0" (bug#15101).
378 0 : (goto-char pos)))
379 :
380 :
381 : (defun debugger-step-through ()
382 : "Proceed, stepping through subexpressions of this expression.
383 : Enter another debugger on next entry to eval, apply or funcall."
384 : (interactive)
385 0 : (setq debugger-step-after-exit t)
386 0 : (setq debugger-jumping-flag t)
387 0 : (setq debugger-will-be-back t)
388 0 : (add-hook 'post-command-hook 'debugger-reenable)
389 0 : (message "Proceeding, will debug on next eval or call.")
390 0 : (exit-recursive-edit))
391 :
392 : (defun debugger-continue ()
393 : "Continue, evaluating this expression without stopping."
394 : (interactive)
395 0 : (unless debugger-may-continue
396 0 : (error "Cannot continue"))
397 0 : (message "Continuing.")
398 0 : (save-excursion
399 : ;; Check to see if we've flagged some frame for debug-on-exit, in which
400 : ;; case we'll probably come back to the debugger soon.
401 0 : (goto-char (point-min))
402 0 : (if (re-search-forward "^\\* " nil t)
403 0 : (setq debugger-will-be-back t)))
404 0 : (exit-recursive-edit))
405 :
406 : (defun debugger-return-value (val)
407 : "Continue, specifying value to return.
408 : This is only useful when the value returned from the debugger
409 : will be used, such as in a debug on exit from a frame."
410 : (interactive "XReturn value (evaluated): ")
411 0 : (when (memq (car debugger-args) '(t lambda error debug))
412 0 : (error "Cannot return a value %s"
413 0 : (if (eq (car debugger-args) 'error)
414 0 : "from an error" "at function entrance")))
415 0 : (setq debugger-value val)
416 0 : (princ "Returning " t)
417 0 : (prin1 debugger-value)
418 0 : (save-excursion
419 : ;; Check to see if we've flagged some frame for debug-on-exit, in which
420 : ;; case we'll probably come back to the debugger soon.
421 0 : (goto-char (point-min))
422 0 : (if (re-search-forward "^\\* " nil t)
423 0 : (setq debugger-will-be-back t)))
424 0 : (exit-recursive-edit))
425 :
426 : (defun debugger-jump ()
427 : "Continue to exit from this frame, with all debug-on-entry suspended."
428 : (interactive)
429 0 : (debugger-frame)
430 0 : (setq debugger-jumping-flag t)
431 0 : (add-hook 'post-command-hook 'debugger-reenable)
432 0 : (message "Continuing through this frame")
433 0 : (setq debugger-will-be-back t)
434 0 : (exit-recursive-edit))
435 :
436 : (defun debugger-reenable ()
437 : "Turn all debug-on-entry functions back on.
438 : This function is put on `post-command-hook' by `debugger-jump' and
439 : removes itself from that hook."
440 0 : (setq debugger-jumping-flag nil)
441 0 : (remove-hook 'post-command-hook 'debugger-reenable))
442 :
443 : (defun debugger-frame-number (&optional skip-base)
444 : "Return number of frames in backtrace before the one point points at."
445 0 : (save-excursion
446 0 : (beginning-of-line)
447 0 : (if (looking-at " *;;;\\|[a-z]")
448 0 : (error "This line is not a function call"))
449 0 : (let ((opoint (point))
450 : (count 0))
451 0 : (unless skip-base
452 0 : (while (not (eq (cadr (backtrace-frame count)) 'debug))
453 0 : (setq count (1+ count)))
454 : ;; Skip debug--implement-debug-on-entry frame.
455 0 : (when (eq 'debug--implement-debug-on-entry
456 0 : (cadr (backtrace-frame (1+ count))))
457 0 : (setq count (+ 2 count))))
458 0 : (goto-char (point-min))
459 0 : (when (looking-at "Debugger entered--\\(Lisp error\\|returning value\\):")
460 0 : (goto-char (match-end 0))
461 0 : (forward-sexp 1))
462 0 : (forward-line 1)
463 0 : (while (progn
464 0 : (forward-char 2)
465 0 : (cond ((debugger--locals-visible-p)
466 0 : (goto-char (next-single-char-property-change
467 0 : (point) 'locals-visible)))
468 0 : ((= (following-char) ?\()
469 0 : (forward-sexp 1))
470 : (t
471 0 : (forward-sexp 2)))
472 0 : (forward-line 1)
473 0 : (<= (point) opoint))
474 0 : (if (looking-at " *;;;")
475 0 : (forward-line 1))
476 0 : (setq count (1+ count)))
477 0 : count)))
478 :
479 : (defun debugger-frame ()
480 : "Request entry to debugger when this frame exits.
481 : Applies to the frame whose line point is on in the backtrace."
482 : (interactive)
483 0 : (backtrace-debug (debugger-frame-number) t)
484 0 : (beginning-of-line)
485 0 : (if (= (following-char) ? )
486 0 : (let ((inhibit-read-only t))
487 0 : (delete-char 1)
488 0 : (insert ?*)))
489 0 : (beginning-of-line))
490 :
491 : (defun debugger-frame-clear ()
492 : "Do not enter debugger when this frame exits.
493 : Applies to the frame whose line point is on in the backtrace."
494 : (interactive)
495 0 : (backtrace-debug (debugger-frame-number) nil)
496 0 : (beginning-of-line)
497 0 : (if (= (following-char) ?*)
498 0 : (let ((inhibit-read-only t))
499 0 : (delete-char 1)
500 0 : (insert ? )))
501 0 : (beginning-of-line))
502 :
503 : (defmacro debugger-env-macro (&rest body)
504 : "Run BODY in original environment."
505 : (declare (indent 0))
506 1 : `(progn
507 : (set-match-data debugger-outer-match-data)
508 : (prog1
509 1 : (progn ,@body)
510 1 : (setq debugger-outer-match-data (match-data)))))
511 :
512 : (defun debugger--backtrace-base ()
513 : "Return the function name that marks the top of the backtrace.
514 : See `backtrace-frame'."
515 0 : (cond ((eq 'debug--implement-debug-on-entry
516 0 : (cadr (backtrace-frame 1 'debug)))
517 : 'debug--implement-debug-on-entry)
518 0 : (t 'debug)))
519 :
520 : (defun debugger-eval-expression (exp &optional nframe)
521 : "Eval an expression, in an environment like that outside the debugger.
522 : The environment used is the one when entering the activation frame at point."
523 : (interactive
524 0 : (list (read--expression "Eval in stack frame: ")))
525 0 : (let ((nframe (or nframe
526 0 : (condition-case nil (1+ (debugger-frame-number 'skip-base))
527 0 : (error 0)))) ;; If on first line.
528 0 : (base (debugger--backtrace-base)))
529 0 : (debugger-env-macro
530 : (let ((val (backtrace-eval exp nframe base)))
531 : (prog1
532 : (prin1 val t)
533 : (let ((str (eval-expression-print-format val)))
534 0 : (if str (princ str t))))))))
535 :
536 : (defun debugger--locals-visible-p ()
537 : "Are the local variables of the current stack frame visible?"
538 0 : (save-excursion
539 0 : (move-to-column 2)
540 0 : (get-text-property (point) 'locals-visible)))
541 :
542 : (defun debugger--insert-locals (locals)
543 : "Insert the local variables LOCALS at point."
544 0 : (cond ((null locals)
545 0 : (insert "\n [no locals]"))
546 : (t
547 0 : (let ((print-escape-newlines t))
548 0 : (dolist (s+v locals)
549 0 : (let ((symbol (car s+v))
550 0 : (value (cdr s+v)))
551 0 : (insert "\n ")
552 0 : (prin1 symbol (current-buffer))
553 0 : (insert " = ")
554 0 : (prin1 value (current-buffer))))))))
555 :
556 : (defun debugger--show-locals ()
557 : "For the frame at point, insert locals and add text properties."
558 0 : (let* ((nframe (1+ (debugger-frame-number 'skip-base)))
559 0 : (base (debugger--backtrace-base))
560 0 : (locals (backtrace--locals nframe base))
561 : (inhibit-read-only t))
562 0 : (save-excursion
563 0 : (let ((start (progn
564 0 : (move-to-column 2)
565 0 : (point))))
566 0 : (end-of-line)
567 0 : (debugger--insert-locals locals)
568 0 : (add-text-properties start (point) '(locals-visible t))))))
569 :
570 : (defun debugger--hide-locals ()
571 : "Delete local variables and remove the text property."
572 0 : (let* ((col (current-column))
573 0 : (end (progn
574 0 : (move-to-column 2)
575 0 : (next-single-char-property-change (point) 'locals-visible)))
576 0 : (start (previous-single-char-property-change end 'locals-visible))
577 : (inhibit-read-only t))
578 0 : (remove-text-properties start end '(locals-visible))
579 0 : (goto-char start)
580 0 : (end-of-line)
581 0 : (delete-region (point) end)
582 0 : (move-to-column col)))
583 :
584 : (defun debugger-toggle-locals ()
585 : "Show or hide local variables of the current stack frame."
586 : (interactive)
587 0 : (cond ((debugger--locals-visible-p)
588 0 : (debugger--hide-locals))
589 : (t
590 0 : (debugger--show-locals))))
591 :
592 :
593 : (defvar debugger-mode-map
594 : (let ((map (make-keymap))
595 : (menu-map (make-sparse-keymap)))
596 : (set-keymap-parent map button-buffer-map)
597 : (suppress-keymap map)
598 : (define-key map "-" 'negative-argument)
599 : (define-key map "b" 'debugger-frame)
600 : (define-key map "c" 'debugger-continue)
601 : (define-key map "j" 'debugger-jump)
602 : (define-key map "r" 'debugger-return-value)
603 : (define-key map "u" 'debugger-frame-clear)
604 : (define-key map "d" 'debugger-step-through)
605 : (define-key map "l" 'debugger-list-functions)
606 : (define-key map "h" 'describe-mode)
607 : (define-key map "q" 'top-level)
608 : (define-key map "e" 'debugger-eval-expression)
609 : (define-key map "v" 'debugger-toggle-locals) ; "v" is for "variables".
610 : (define-key map " " 'next-line)
611 : (define-key map "R" 'debugger-record-expression)
612 : (define-key map "\C-m" 'debug-help-follow)
613 : (define-key map [mouse-2] 'push-button)
614 : (define-key map [menu-bar debugger] (cons "Debugger" menu-map))
615 : (define-key menu-map [deb-top]
616 : '(menu-item "Quit" top-level
617 : :help "Quit debugging and return to top level"))
618 : (define-key menu-map [deb-s0] '("--"))
619 : (define-key menu-map [deb-descr]
620 : '(menu-item "Describe Debugger Mode" describe-mode
621 : :help "Display documentation for debugger-mode"))
622 : (define-key menu-map [deb-hfol]
623 : '(menu-item "Help Follow" debug-help-follow
624 : :help "Follow cross-reference"))
625 : (define-key menu-map [deb-nxt]
626 : '(menu-item "Next Line" next-line
627 : :help "Move cursor down"))
628 : (define-key menu-map [deb-s1] '("--"))
629 : (define-key menu-map [deb-lfunc]
630 : '(menu-item "List debug on entry functions" debugger-list-functions
631 : :help "Display a list of all the functions now set to debug on entry"))
632 : (define-key menu-map [deb-fclear]
633 : '(menu-item "Cancel debug frame" debugger-frame-clear
634 : :help "Do not enter debugger when this frame exits"))
635 : (define-key menu-map [deb-frame]
636 : '(menu-item "Debug frame" debugger-frame
637 : :help "Request entry to debugger when this frame exits"))
638 : (define-key menu-map [deb-s2] '("--"))
639 : (define-key menu-map [deb-ret]
640 : '(menu-item "Return value..." debugger-return-value
641 : :help "Continue, specifying value to return."))
642 : (define-key menu-map [deb-rec]
643 : '(menu-item "Display and Record Expression" debugger-record-expression
644 : :help "Display a variable's value and record it in `*Backtrace-record*' buffer"))
645 : (define-key menu-map [deb-eval]
646 : '(menu-item "Eval Expression..." debugger-eval-expression
647 : :help "Eval an expression, in an environment like that outside the debugger"))
648 : (define-key menu-map [deb-jump]
649 : '(menu-item "Jump" debugger-jump
650 : :help "Continue to exit from this frame, with all debug-on-entry suspended"))
651 : (define-key menu-map [deb-cont]
652 : '(menu-item "Continue" debugger-continue
653 : :help "Continue, evaluating this expression without stopping"))
654 : (define-key menu-map [deb-step]
655 : '(menu-item "Step through" debugger-step-through
656 : :help "Proceed, stepping through subexpressions of this expression"))
657 : map))
658 :
659 : (put 'debugger-mode 'mode-class 'special)
660 :
661 : (define-derived-mode debugger-mode fundamental-mode "Debugger"
662 : "Mode for backtrace buffers, selected in debugger.
663 : \\<debugger-mode-map>
664 : A line starts with `*' if exiting that frame will call the debugger.
665 : Type \\[debugger-frame] or \\[debugger-frame-clear] to set or remove the `*'.
666 :
667 : When in debugger due to frame being exited,
668 : use the \\[debugger-return-value] command to override the value
669 : being returned from that frame.
670 :
671 : Use \\[debug-on-entry] and \\[cancel-debug-on-entry] to control
672 : which functions will enter the debugger when called.
673 :
674 : Complete list of commands:
675 : \\{debugger-mode-map}"
676 0 : (setq truncate-lines t)
677 0 : (set-syntax-table emacs-lisp-mode-syntax-table)
678 0 : (add-hook 'kill-buffer-hook
679 0 : (lambda () (if (> (recursion-depth) 0) (top-level)))
680 0 : nil t)
681 0 : (use-local-map debugger-mode-map))
682 :
683 : (defcustom debugger-record-buffer "*Debugger-record*"
684 : "Buffer name for expression values, for \\[debugger-record-expression]."
685 : :type 'string
686 : :group 'debugger
687 : :version "20.3")
688 :
689 : (defun debugger-record-expression (exp)
690 : "Display a variable's value and record it in `*Backtrace-record*' buffer."
691 : (interactive
692 0 : (list (read--expression "Record Eval: ")))
693 0 : (let* ((buffer (get-buffer-create debugger-record-buffer))
694 0 : (standard-output buffer))
695 0 : (princ (format "Debugger Eval (%s): " exp))
696 0 : (princ (debugger-eval-expression exp))
697 0 : (terpri))
698 :
699 0 : (with-current-buffer (get-buffer debugger-record-buffer)
700 0 : (message "%s"
701 0 : (buffer-substring (line-beginning-position 0)
702 0 : (line-end-position 0)))))
703 :
704 : (defun debug-help-follow (&optional pos)
705 : "Follow cross-reference at POS, defaulting to point.
706 :
707 : For the cross-reference format, see `help-make-xrefs'."
708 : (interactive "d")
709 : ;; Ideally we'd just do (call-interactively 'help-follow) except that this
710 : ;; assumes we're already in a *Help* buffer and reuses it, so it ends up
711 : ;; incorrectly "reusing" the *Backtrace* buffer to show the help info.
712 0 : (unless pos
713 0 : (setq pos (point)))
714 0 : (unless (push-button pos)
715 : ;; check if the symbol under point is a function or variable
716 0 : (let ((sym
717 0 : (intern
718 0 : (save-excursion
719 0 : (goto-char pos) (skip-syntax-backward "w_")
720 0 : (buffer-substring (point)
721 0 : (progn (skip-syntax-forward "w_")
722 0 : (point)))))))
723 0 : (when (or (boundp sym) (fboundp sym) (facep sym))
724 0 : (describe-symbol sym)))))
725 :
726 : ;; When you change this, you may also need to change the number of
727 : ;; frames that the debugger skips.
728 : (defun debug--implement-debug-on-entry (&rest _ignore)
729 : "Conditionally call the debugger.
730 : A call to this function is inserted by `debug-on-entry' to cause
731 : functions to break on entry."
732 0 : (if (or inhibit-debug-on-entry debugger-jumping-flag)
733 : nil
734 0 : (let ((inhibit-debug-on-entry t))
735 0 : (funcall debugger 'debug))))
736 :
737 : ;;;###autoload
738 : (defun debug-on-entry (function)
739 : "Request FUNCTION to invoke debugger each time it is called.
740 :
741 : When called interactively, prompt for FUNCTION in the minibuffer.
742 :
743 : This works by modifying the definition of FUNCTION. If you tell the
744 : debugger to continue, FUNCTION's execution proceeds. If FUNCTION is a
745 : normal function or a macro written in Lisp, you can also step through
746 : its execution. FUNCTION can also be a primitive that is not a special
747 : form, in which case stepping is not possible. Break-on-entry for
748 : primitive functions only works when that function is called from Lisp.
749 :
750 : Use \\[cancel-debug-on-entry] to cancel the effect of this command.
751 : Redefining FUNCTION also cancels it."
752 : (interactive
753 0 : (let ((fn (function-called-at-point)) val)
754 0 : (when (special-form-p fn)
755 0 : (setq fn nil))
756 0 : (setq val (completing-read
757 0 : (if fn
758 0 : (format "Debug on entry to function (default %s): " fn)
759 0 : "Debug on entry to function: ")
760 0 : obarray
761 0 : #'(lambda (symbol)
762 0 : (and (fboundp symbol)
763 0 : (not (special-form-p symbol))))
764 0 : t nil nil (symbol-name fn)))
765 0 : (list (if (equal val "") fn (intern val)))))
766 0 : (advice-add function :before #'debug--implement-debug-on-entry
767 0 : '((depth . -100)))
768 0 : function)
769 :
770 : (defun debug--function-list ()
771 : "List of functions currently set for debug on entry."
772 0 : (let ((funs '()))
773 0 : (mapatoms
774 : (lambda (s)
775 0 : (when (advice-member-p #'debug--implement-debug-on-entry s)
776 0 : (push s funs))))
777 0 : funs))
778 :
779 : ;;;###autoload
780 : (defun cancel-debug-on-entry (&optional function)
781 : "Undo effect of \\[debug-on-entry] on FUNCTION.
782 : If FUNCTION is nil, cancel debug-on-entry for all functions.
783 : When called interactively, prompt for FUNCTION in the minibuffer.
784 : To specify a nil argument interactively, exit with an empty minibuffer."
785 : (interactive
786 0 : (list (let ((name
787 0 : (completing-read
788 : "Cancel debug on entry to function (default all functions): "
789 0 : (mapcar #'symbol-name (debug--function-list)) nil t)))
790 0 : (when name
791 0 : (unless (string= name "")
792 0 : (intern name))))))
793 0 : (if function
794 0 : (progn
795 0 : (advice-remove function #'debug--implement-debug-on-entry)
796 0 : function)
797 0 : (message "Canceling debug-on-entry for all functions")
798 0 : (mapcar #'cancel-debug-on-entry (debug--function-list))))
799 :
800 : (defun debugger-list-functions ()
801 : "Display a list of all the functions now set to debug on entry."
802 : (interactive)
803 0 : (require 'help-mode)
804 0 : (help-setup-xref '(debugger-list-functions)
805 0 : (called-interactively-p 'interactive))
806 0 : (with-output-to-temp-buffer (help-buffer)
807 0 : (with-current-buffer standard-output
808 0 : (let ((funs (debug--function-list)))
809 0 : (if (null funs)
810 0 : (princ "No debug-on-entry functions now\n")
811 0 : (princ "Functions set to debug on entry:\n\n")
812 0 : (dolist (fun funs)
813 0 : (make-text-button (point) (progn (prin1 fun) (point))
814 : 'type 'help-function
815 0 : 'help-args (list fun))
816 0 : (terpri))
817 : ;; Now that debug--function-list uses advice-member-p, its
818 : ;; output should be reliable (except for bugs and the exceptional
819 : ;; case where some other advice ends up overriding ours).
820 : ;;(terpri)
821 : ;;(princ "Note: if you have redefined a function, then it may no longer\n")
822 : ;;(princ "be set to debug on entry, even if it is in the list.")
823 0 : )))))
824 :
825 : (defun debug--implement-debug-watch (symbol newval op where)
826 : "Conditionally call the debugger.
827 : This function is called when SYMBOL's value is modified."
828 0 : (if (or inhibit-debug-on-entry debugger-jumping-flag)
829 : nil
830 0 : (let ((inhibit-debug-on-entry t))
831 0 : (funcall debugger 'watchpoint symbol newval op where))))
832 :
833 : ;;;###autoload
834 : (defun debug-on-variable-change (variable)
835 : "Trigger a debugger invocation when VARIABLE is changed.
836 :
837 : When called interactively, prompt for VARIABLE in the minibuffer.
838 :
839 : This works by calling `add-variable-watch' on VARIABLE. If you
840 : quit from the debugger, this will abort the change (unless the
841 : change is caused by the termination of a let-binding).
842 :
843 : The watchpoint may be circumvented by C code that changes the
844 : variable directly (i.e., not via `set'). Changing the value of
845 : the variable (e.g., `setcar' on a list variable) will not trigger
846 : watchpoint.
847 :
848 : Use \\[cancel-debug-on-variable-change] to cancel the effect of
849 : this command. Uninterning VARIABLE or making it an alias of
850 : another symbol also cancels it."
851 : (interactive
852 0 : (let* ((var-at-point (variable-at-point))
853 0 : (var (and (symbolp var-at-point) var-at-point))
854 0 : (val (completing-read
855 0 : (concat "Debug when setting variable"
856 0 : (if var (format " (default %s): " var) ": "))
857 0 : obarray #'boundp
858 0 : t nil nil (and var (symbol-name var)))))
859 0 : (list (if (equal val "") var (intern val)))))
860 0 : (add-variable-watcher variable #'debug--implement-debug-watch))
861 :
862 : ;;;###autoload
863 : (defalias 'debug-watch #'debug-on-variable-change)
864 :
865 :
866 : (defun debug--variable-list ()
867 : "List of variables currently set for debug on set."
868 0 : (let ((vars '()))
869 0 : (mapatoms
870 : (lambda (s)
871 0 : (when (memq #'debug--implement-debug-watch
872 0 : (get s 'watchers))
873 0 : (push s vars))))
874 0 : vars))
875 :
876 : ;;;###autoload
877 : (defun cancel-debug-on-variable-change (&optional variable)
878 : "Undo effect of \\[debug-on-variable-change] on VARIABLE.
879 : If VARIABLE is nil, cancel debug-on-variable-change for all variables.
880 : When called interactively, prompt for VARIABLE in the minibuffer.
881 : To specify a nil argument interactively, exit with an empty minibuffer."
882 : (interactive
883 0 : (list (let ((name
884 0 : (completing-read
885 : "Cancel debug on set for variable (default all variables): "
886 0 : (mapcar #'symbol-name (debug--variable-list)) nil t)))
887 0 : (when name
888 0 : (unless (string= name "")
889 0 : (intern name))))))
890 0 : (if variable
891 0 : (remove-variable-watcher variable #'debug--implement-debug-watch)
892 0 : (message "Canceling debug-watch for all variables")
893 0 : (mapc #'cancel-debug-watch (debug--variable-list))))
894 :
895 : ;;;###autoload
896 : (defalias 'cancel-debug-watch #'cancel-debug-on-variable-change)
897 :
898 : (provide 'debug)
899 :
900 : ;;; debug.el ends here
|