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