![[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] / 43BSD / contrib / emacs / lisp|
Return to debug.el CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / lisp |
1.1 root 1: ;; Debuggers and related commands for Emacs
2: ;; Copyright (C) 1985 Richard M. Stallman.
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 (generate-new-buffer "*Backtrace*"))
38: debugger-step-after-exit)
39: (unwind-protect
40: (save-excursion
41: (save-window-excursion
42: (pop-to-buffer debugger-buffer)
43: (erase-buffer)
44: (let ((standard-output (current-buffer))
45: (print-length 50))
46: (backtrace))
47: (goto-char (point-min))
48: (debugger-mode)
49: (delete-region (point)
50: (progn
51: (forward-sexp 8)
52: (forward-line 1)
53: (point)))
54: (cond ((memq (car debugger-args) '(lambda debug))
55: (insert "Entering:\n")
56: (if (eq (car debugger-args) 'debug)
57: (progn
58: (backtrace-debug 4 t)
59: (delete-char 1)
60: (insert ?*)
61: (beginning-of-line))))
62: ((eq (car debugger-args) 'exit)
63: (insert "Return value: ")
64: (setq debugger-value (nth 1 debugger-args))
65: (prin1 debugger-value (current-buffer))
66: (insert ?\n)
67: (delete-char 1)
68: (insert ? )
69: (beginning-of-line))
70: ((eq (car debugger-args) 'error)
71: (insert "Signalling: ")
72: (prin1 (nth 1 debugger-args) (current-buffer))
73: (insert ?\n))
74: ((eq (car debugger-args) t)
75: (insert "Beginning evaluation of function call form:\n"))
76: (t
77: (prin1 (if (eq (car debugger-args) 'nil)
78: (cdr debugger-args) debugger-args)
79: (current-buffer))
80: (insert ?\n)))
81: (message "")
82: (let ((inhibit-trace t)
83: (standard-output nil)
84: (buffer-read-only t))
85: (message "")
86: (recursive-edit))))
87: ;; So that users do not try to execute debugger commands
88: ;; in an invalid context
89: (kill-buffer debugger-buffer)
90: (store-match-data debugger-match-data))
91: (setq debug-on-next-call debugger-step-after-exit)
92: debugger-value))
93:
94: (defun debugger-step-through ()
95: "Proceed, stepping through subexpressions of this expression.
96: Enter another debugger on next entry to eval, apply or funcall."
97: (interactive)
98: (setq debugger-step-after-exit t)
99: (message "Proceding, will debug on next eval or call.")
100: (exit-recursive-edit))
101:
102: (defun debugger-continue ()
103: "Continue, evaluating this expression without stopping."
104: (interactive)
105: (message "Continuing.")
106: (exit-recursive-edit))
107:
108: (defun debugger-return-value (val)
109: "Continue, specifying value to return.
110: This is only useful when the value returned from the debugger
111: will be used, such as in a debug on exit from a frame."
112: (interactive "XReturn value (evaluated): ")
113: (setq debugger-value val)
114: (princ "Returning " t)
115: (prin1 debugger-value)
116: (exit-recursive-edit))
117:
118: (defun debugger-frame-number ()
119: "Return number of frames in backtrace before the one point points at."
120: (save-excursion
121: (beginning-of-line)
122: (let ((opoint (point))
123: (count 0))
124: (goto-char (point-min))
125: (if (or (equal (buffer-substring (point) (+ (point) 6))
126: "Signal")
127: (equal (buffer-substring (point) (+ (point) 6))
128: "Return"))
129: (progn
130: (search-forward ":")
131: (forward-sexp 1)))
132: (forward-line 1)
133: (while (progn
134: (forward-char 2)
135: (if (= (following-char) ?\()
136: (forward-sexp 1)
137: (forward-sexp 2))
138: (forward-line 1)
139: (<= (point) opoint))
140: (setq count (1+ count)))
141: count)))
142:
143: ;; Chosen empirically to account for all the frames
144: ;; that will exist when debugger-frame is called
145: ;; within the first one that appears in the backtrace buffer.
146: ;; Assumes debugger-frame is called from a key;
147: ;; will be wrong if it is called with Meta-x.
148: (defconst debugger-frame-offset 8 "")
149:
150: (defun debugger-frame ()
151: "Request entry to debugger when this frame exits.
152: Applies to the frame whose line point is on in the backtrace."
153: (interactive)
154: (beginning-of-line)
155: (let ((level (debugger-frame-number)))
156: (backtrace-debug (+ level debugger-frame-offset) t))
157: (if (= (following-char) ? )
158: (let ((buffer-read-only nil))
159: (delete-char 1)
160: (insert ?*)))
161: (beginning-of-line))
162:
163: (defun debugger-frame-clear ()
164: "Do not enter to debugger when this frame exits.
165: Applies to the frame whose line point is on in the backtrace."
166: (interactive)
167: (beginning-of-line)
168: (let ((level (debugger-frame-number)))
169: (backtrace-debug (+ level debugger-frame-offset) nil))
170: (if (= (following-char) ?*)
171: (let ((buffer-read-only nil))
172: (delete-char 1)
173: (insert ? )))
174: (beginning-of-line))
175:
176: ;; These two function names are equivalent except that
177: ;; debugger-eval-expression is not normally disabled.
178: (fset 'debugger-eval-expression 'eval-expression)
179:
180: (defvar debugger-mode-map nil)
181: (if debugger-mode-map
182: nil
183: (let ((loop ? ))
184: (setq debugger-mode-map (make-keymap))
185: (suppress-keymap debugger-mode-map)
186: (define-key debugger-mode-map "-" 'negative-argument)
187: (define-key debugger-mode-map "b" 'debugger-frame)
188: (define-key debugger-mode-map "c" 'debugger-continue)
189: (define-key debugger-mode-map "r" 'debugger-return-value)
190: (define-key debugger-mode-map "u" 'debugger-frame-clear)
191: (define-key debugger-mode-map "d" 'debugger-step-through)
192: (define-key debugger-mode-map "h" 'describe-mode)
193: (define-key debugger-mode-map "q" 'top-level)
194: (define-key debugger-mode-map "e" 'debugger-eval-expression)
195: (define-key debugger-mode-map " " 'next-line)))
196:
197: (defun debugger-mode ()
198: "Mode for backtrace buffers, selected in debugger.
199: \\{debugger-mode-map}
200: For the r command, when in debugger due to frame being exited,
201: the value specified here will be used as the value of that frame.
202:
203: Note lines starting with * are frames that will
204: enter debugger when exited."
205: (kill-all-local-variables)
206: (setq major-mode 'debugger-mode)
207: (setq mode-name "Debugger")
208: (setq truncate-lines t)
209: (set-syntax-table lisp-mode-syntax-table)
210: (use-local-map debugger-mode-map))
211:
212: (defun debug-on-entry (function)
213: "Request FUNCTION to invoke debugger each time it is called.
214: If the user continues, FUNCTION's execution proceeds.
215: Works by modifying the definition of FUNCTION,
216: which must be written in Lisp, not predefined."
217: (interactive "aDebug on entry (to function): ")
218: (let ((defn (symbol-function function)))
219: (if (eq (car defn) 'macro)
220: (fset function (cons 'macro (debug-on-entry-1 function (cdr defn) t)))
221: (fset function (debug-on-entry-1 function defn t))))
222: function)
223:
224: (defun cancel-debug-on-entry (function)
225: "Undoes effect of debug-on-entry on FUNCTION."
226: (interactive "aCancel debug on entry (to function): ")
227: (let ((defn (symbol-function function)))
228: (if (eq (car defn) 'macro)
229: (fset function (cons 'macro (debug-on-entry-1 function (cdr defn)) nil))
230: (fset function (debug-on-entry-1 function defn nil))))
231: function)
232:
233: (defun debug-on-entry-1 (function defn flag)
234: (or (eq (car defn) 'lambda)
235: (error "%s not user-defined Lisp function." function))
236: (let (tail prec)
237: (if (stringp (car (nthcdr 2 defn)))
238: (setq tail (nthcdr 3 defn)
239: prec (list (car defn) (car (cdr defn)) (car (cdr (cdr defn)))))
240: (setq tail (nthcdr 2 defn)
241: prec (list (car defn) (car (cdr defn)))))
242: (if (eq flag (equal (car tail) '(debug 'debug)))
243: nil
244: (if flag
245: (nconc prec (cons '(debug 'debug) tail))
246: (nconc prec (cdr tail))))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.