![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to debug.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to debug.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp |
1.1 root 1: ;; Debuggers and related commands for Emacs
2: ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
3:
4: ;; This file is part of GNU Emacs.
5:
6: ;; GNU Emacs is distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
21:
22: (setq debugger 'debug)
23:
24: (defun debug (&rest debugger-args)
25: "Enter debugger. Returns if user says \"continue\".
26: Arguments are mainly for use when this is called
27: from the internals of the evaluator.
28: You may call with no args, or you may
29: pass nil as the first arg and any other args you like.
30: In that case, the list of args after the first will
31: be printed into the backtrace buffer."
32: (message "Entering debugger...")
33: (let (debugger-value
34: (debugger-match-data (match-data))
35: (debug-on-error nil)
36: (debug-on-quit nil)
37: (debugger-buffer (let ((default-major-mode 'fundamental-mode))
38: (generate-new-buffer "*Backtrace*")))
39: (debugger-old-buffer (current-buffer))
40: (debugger-step-after-exit nil)
41: ;; Don't keep reading from an executing kbd macro!
42: (executing-macro nil)
43: (cursor-in-echo-area nil))
44: (unwind-protect
45: (save-excursion
46: (save-window-excursion
47: (pop-to-buffer debugger-buffer)
48: (erase-buffer)
49: (let ((standard-output (current-buffer))
50: (print-escape-newlines t)
51: (print-length 50))
52: (backtrace))
53: (goto-char (point-min))
54: (debugger-mode)
55: (delete-region (point)
56: (progn
57: (forward-sexp 8)
58: (forward-line 1)
59: (point)))
60: (cond ((memq (car debugger-args) '(lambda debug))
61: (insert "Entering:\n")
62: (if (eq (car debugger-args) 'debug)
63: (progn
64: (backtrace-debug 4 t)
65: (delete-char 1)
66: (insert ?*)
67: (beginning-of-line))))
68: ((eq (car debugger-args) 'exit)
69: (insert "Return value: ")
70: (setq debugger-value (nth 1 debugger-args))
71: (prin1 debugger-value (current-buffer))
72: (insert ?\n)
73: (delete-char 1)
74: (insert ? )
75: (beginning-of-line))
76: ((eq (car debugger-args) 'error)
77: (insert "Signalling: ")
78: (prin1 (nth 1 debugger-args) (current-buffer))
79: (insert ?\n))
80: ((eq (car debugger-args) t)
81: (insert "Beginning evaluation of function call form:\n"))
82: (t
83: (prin1 (if (eq (car debugger-args) 'nil)
84: (cdr debugger-args) debugger-args)
85: (current-buffer))
86: (insert ?\n)))
87: (message "")
88: (let ((inhibit-trace t)
89: (standard-output nil)
90: (buffer-read-only t))
91: (message "")
92: (recursive-edit))))
93: ;; So that users do not try to execute debugger commands
94: ;; in an invalid context
95: (kill-buffer debugger-buffer)
96: (catch 'foo
97: (let ((d debugger-match-data))
98: (while d
99: (and (car d)
100: (null (marker-buffer (car d)))
101: ;; match-data buffer is deleted.
102: (throw 'foo nil))
103: (setq d (cdr d)))
104: (store-match-data debugger-match-data))))
105: (setq debug-on-next-call debugger-step-after-exit)
106: debugger-value))
107:
108: (defun debugger-step-through ()
109: "Proceed, stepping through subexpressions of this expression.
110: Enter another debugger on next entry to eval, apply or funcall."
111: (interactive)
112: (setq debugger-step-after-exit t)
113: (message "Proceding, will debug on next eval or call.")
114: (exit-recursive-edit))
115:
116: (defun debugger-continue ()
117: "Continue, evaluating this expression without stopping."
118: (interactive)
119: (message "Continuing.")
120: (exit-recursive-edit))
121:
122: (defun debugger-return-value (val)
123: "Continue, specifying value to return.
124: This is only useful when the value returned from the debugger
125: will be used, such as in a debug on exit from a frame."
126: (interactive "XReturn value (evaluated): ")
127: (setq debugger-value val)
128: (princ "Returning " t)
129: (prin1 debugger-value)
130: (exit-recursive-edit))
131:
132: (defun debugger-frame-number ()
133: "Return number of frames in backtrace before the one point points at."
134: (save-excursion
135: (beginning-of-line)
136: (let ((opoint (point))
137: (count 0))
138: (goto-char (point-min))
139: (if (or (equal (buffer-substring (point) (+ (point) 6))
140: "Signal")
141: (equal (buffer-substring (point) (+ (point) 6))
142: "Return"))
143: (progn
144: (search-forward ":")
145: (forward-sexp 1)))
146: (forward-line 1)
147: (while (progn
148: (forward-char 2)
149: (if (= (following-char) ?\()
150: (forward-sexp 1)
151: (forward-sexp 2))
152: (forward-line 1)
153: (<= (point) opoint))
154: (setq count (1+ count)))
155: count)))
156:
157: ;; Chosen empirically to account for all the frames
158: ;; that will exist when debugger-frame is called
159: ;; within the first one that appears in the backtrace buffer.
160: ;; Assumes debugger-frame is called from a key;
161: ;; will be wrong if it is called with Meta-x.
162: (defconst debugger-frame-offset 8 "")
163:
164: (defun debugger-frame ()
165: "Request entry to debugger when this frame exits.
166: Applies to the frame whose line point is on in the backtrace."
167: (interactive)
168: (beginning-of-line)
169: (let ((level (debugger-frame-number)))
170: (backtrace-debug (+ level debugger-frame-offset) t))
171: (if (= (following-char) ? )
172: (let ((buffer-read-only nil))
173: (delete-char 1)
174: (insert ?*)))
175: (beginning-of-line))
176:
177: (defun debugger-frame-clear ()
178: "Do not enter to debugger when this frame exits.
179: Applies to the frame whose line point is on in the backtrace."
180: (interactive)
181: (beginning-of-line)
182: (let ((level (debugger-frame-number)))
183: (backtrace-debug (+ level debugger-frame-offset) nil))
184: (if (= (following-char) ?*)
185: (let ((buffer-read-only nil))
186: (delete-char 1)
187: (insert ? )))
188: (beginning-of-line))
189:
190: (defun debugger-eval-expression (exp)
191: (interactive "xEval: ")
192: (save-excursion
193: (if (null (buffer-name debugger-old-buffer))
194: ;; old buffer deleted
195: (setq debugger-old-buffer (current-buffer)))
196: (set-buffer debugger-old-buffer)
197: (eval-expression exp)))
198:
199: (defvar debugger-mode-map nil)
200: (if debugger-mode-map
201: nil
202: (let ((loop ? ))
203: (setq debugger-mode-map (make-keymap))
204: (suppress-keymap debugger-mode-map)
205: (define-key debugger-mode-map "-" 'negative-argument)
206: (define-key debugger-mode-map "b" 'debugger-frame)
207: (define-key debugger-mode-map "c" 'debugger-continue)
208: (define-key debugger-mode-map "r" 'debugger-return-value)
209: (define-key debugger-mode-map "u" 'debugger-frame-clear)
210: (define-key debugger-mode-map "d" 'debugger-step-through)
211: (define-key debugger-mode-map "h" 'describe-mode)
212: (define-key debugger-mode-map "q" 'top-level)
213: (define-key debugger-mode-map "e" 'debugger-eval-expression)
214: (define-key debugger-mode-map " " 'next-line)))
215:
216: (put 'debugger-mode 'mode-class 'special)
217:
218: (defun debugger-mode ()
219: "Mode for backtrace buffers, selected in debugger.
220: \\{debugger-mode-map}
221: For the r command, when in debugger due to frame being exited,
222: the value specified here will be used as the value of that frame.
223:
224: Note lines starting with * are frames that will
225: enter debugger when exited."
226: (kill-all-local-variables)
227: (setq major-mode 'debugger-mode)
228: (setq mode-name "Debugger")
229: (setq truncate-lines t)
230: (set-syntax-table emacs-lisp-mode-syntax-table)
231: (use-local-map debugger-mode-map))
232:
233: (defun debug-on-entry (function)
234: "Request FUNCTION to invoke debugger each time it is called.
235: If the user continues, FUNCTION's execution proceeds.
236: Works by modifying the definition of FUNCTION,
237: which must be written in Lisp, not predefined.
238: Use `cancel-debug-on-entry' to cancel the effect of this command.
239: Redefining FUNCTION also does that."
240: (interactive "aDebug on entry (to function): ")
241: (let ((defn (symbol-function function)))
242: (if (eq (car defn) 'macro)
243: (fset function (cons 'macro (debug-on-entry-1 function (cdr defn) t)))
244: (fset function (debug-on-entry-1 function defn t))))
245: function)
246:
247: (defun cancel-debug-on-entry (function)
248: "Undoes effect of debug-on-entry on FUNCTION."
249: (interactive "aCancel debug on entry (to function): ")
250: (let ((defn (symbol-function function)))
251: (if (eq (car defn) 'macro)
252: (fset function
253: (cons 'macro (debug-on-entry-1 function (cdr defn) nil)))
254: (fset function (debug-on-entry-1 function defn nil))))
255: function)
256:
257: (defun debug-on-entry-1 (function defn flag)
258: (or (eq (car defn) 'lambda)
259: (error "%s not user-defined Lisp function." function))
260: (let (tail prec)
261: (if (stringp (car (nthcdr 2 defn)))
262: (setq tail (nthcdr 3 defn)
263: prec (list (car defn) (car (cdr defn)) (car (cdr (cdr defn)))))
264: (setq tail (nthcdr 2 defn)
265: prec (list (car defn) (car (cdr defn)))))
266: (if (eq flag (equal (car tail) '(debug 'debug)))
267: nil
268: (if flag
269: (nconc prec (cons '(debug 'debug) tail))
270: (nconc prec (cdr tail))))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.