Commit | Line | Data |
---|---|---|
3a801d0c | 1 | ;;; edebug.el --- a source-level debugger for emacs lisp |
84fc2cfa ER |
2 | |
3 | ;; Copyright (C) 1988, 1989, 1990, 1991 Free Software Foundation, Inc | |
4 | ||
3a801d0c | 5 | ;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu> |
e9571d2a | 6 | ;; Keywords: lisp, tools, maint |
3a801d0c | 7 | |
e41b2db1 ER |
8 | ;; This is Dan's 2.5 version with some header comments rearranged to separate |
9 | ;; the Change Log from the Commentary (so the package-finder code can browse | |
10 | ;; the Commentary). | |
11 | ||
84fc2cfa ER |
12 | ;; This file is part of GNU Emacs. |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY. No author or distributor | |
16 | ;; accepts responsibility to anyone for the consequences of using it | |
17 | ;; or for whether it serves any particular purpose or works at all, | |
18 | ;; unless he says so in writing. Refer to the GNU Emacs General Public | |
19 | ;; License for full details. | |
20 | ||
21 | ;; Everyone is granted permission to copy, modify and redistribute | |
22 | ;; GNU Emacs, but only under the conditions described in the | |
23 | ;; GNU Emacs General Public License. A copy of this license is | |
24 | ;; supposed to have been given to you along with GNU Emacs so you | |
25 | ;; can know your rights and responsibilities. It should be in a | |
26 | ;; file named COPYING. Among other things, the copyright notice | |
27 | ;; and this notice must be preserved on all copies. | |
28 | ||
3a801d0c ER |
29 | ;;;; Commentary: |
30 | ||
31 | ;;; This minor mode allows programmers to step through Emacs Lisp source | |
84fc2cfa ER |
32 | ;;; code while executing, set breakpoints, etc. See the texinfo |
33 | ;;; document (being constructed...) for more detailed instructions | |
34 | ;;; than contained here. Send me your enhancement, ideas, bugs, or | |
35 | ;;; fixes. | |
36 | ||
37 | ;;; Daniel LaLiberte 217-244-0785 | |
38 | ;;; University of Illinois, Urbana-Champaign | |
39 | ;;; Department of Computer Science | |
40 | ;;; 1304 W Springfield | |
41 | ;;; Urbana, IL 61801 | |
42 | ||
43 | ;;; uiucdcs!liberte | |
44 | ;;; liberte@cs.uiuc.edu | |
45 | ||
46 | ;;; Contents: | |
47 | ;;; ========= | |
84fc2cfa | 48 | ;;; Installation |
e41b2db1 | 49 | ;;; Change list |
84fc2cfa ER |
50 | ;;; Utilities |
51 | ;;; Parser | |
52 | ;;; Debugger | |
53 | ||
54 | \f | |
e41b2db1 ER |
55 | ;;; Installation |
56 | ;;; ------------ | |
57 | ;; Put edebug.el in some directory in your load-path and byte-compile it. | |
58 | ||
59 | ;; Put the following forms in your .emacs file. | |
60 | ;; (define-key emacs-lisp-mode-map "\^Xx" 'edebug-defun) | |
61 | ;; (autoload 'edebug-defun "edebug") | |
62 | ;; (autoload 'edebug-debug "edebug") | |
63 | ;; (setq debugger 'edebug-debug) | |
64 | ;; ... other options, described in the next section. | |
65 | ||
66 | ;; Evaluate a defun for edebug with edebug-defun. | |
67 | ;; Evaluate your function normally. | |
68 | ;; Use the "?" command in edebug to describe other commands. | |
69 | ;; See edebug.texinfo for more instructions. | |
70 | ||
71 | ;;; Change Log: | |
84fc2cfa | 72 | |
84fc2cfa ER |
73 | ;;; Revision 2.5 91/07/25 13:32:53 liberte |
74 | ;;; Doc string cleanup. | |
75 | ;;; If edebug-form-hook is t, evaluate all arguments. | |
76 | ;;; If edebug-form-hook is 0, evaluate no arguments. | |
77 | ;;; If edebug-form-hook is nil, evaluate macro args according | |
78 | ;;; to edebug-eval-macro-args. | |
79 | ;;; Save the outside value of executing macro. | |
80 | ;;; Save and restore the outside restriction. | |
81 | ;;; Dont force update for go and Go-nonstop. | |
82 | ;;; Save and restore last-command-char, last-command, | |
83 | ;;; this-command, last-input-char. | |
84 | ;;; For epoch, do epoch::dispatch-events before sit-for | |
85 | ;;; and input-pending-p since X events could interfere. | |
86 | ;;; Warn about unsetting non-existent breakpoint. | |
87 | ;;; Fix edebug-forward-sexp with prefix arg. | |
88 | ;;; Add edebug-step-out to exit from current sexp. | |
89 | ;;; | |
90 | ;;; Revision 2.4 91/03/18 12:35:44 liberte | |
91 | ;;; Force update after go or Go-nonstop modes, so overlay arrow is correct. | |
92 | ;;; Support debug-on-quit. Remove edebug-on-error. | |
93 | ;;; Fix edebug-anonymous. Bug found by jackr@wpd.sgi.com (Jack Repenning). | |
94 | ;;; Don't discard-input anymore. Easier to change modes this way. | |
95 | ;;; Fix max-lisp-eval-depth and max-specpdl-size incrementing. | |
96 | ;;; Save and restore points in all buffers, if | |
97 | ;;; edebug-save-buffer-points is non-nil. Expensive! | |
98 | ;;; Bug caught by wolfgang@wsrcc.com (Wolfgang S. Rupprecht) | |
99 | ;;; Save standard-output and standard-input in edebug-recursive-edit | |
100 | ;;; so that edebug-outside-excursion can restore them. | |
101 | ;;; Call set-buffer in edebug-pop-to-buffer since | |
102 | ;;; select-window does not do that. | |
103 | ;;; Fix edebug's eval-defun to remember current buffer inside evaluations | |
104 | ;;; and to evaluate top-level forms. Found by Jamie Zawinski. | |
105 | ;;; Add edebug-interactive-entry to support interactive forms with | |
106 | ;;; non-string arg. Bug found by Jack Repenning. | |
107 | ;;; Simplify edebug-restore-match-data to just store-match-data. | |
108 | ;;; Motivated by linus@lysator.liu.se. | |
109 | ;;; Move the match-data call to before the outside | |
110 | ;;; buffer is changed, since it assumes that. | |
111 | ;;; | |
112 | ;;; Revision 2.3 91/01/17 20:55:14 liberte | |
113 | ;;; Fix bug found by hollen@megatek.uucp. | |
114 | ;;; Current buffer was not being restored. | |
115 | ;;; Call edebug with (edebug begin end 'exp) | |
116 | ;;; and add additional wrapper around body of functions: | |
117 | ;;; (edebug-enter function body). | |
118 | ;;; Make &optional only apply to immediate next arg | |
119 | ;;; in edebug-form-parser (was edebug-macro-parser). | |
120 | ;;; Catch debug errors with edebug. Yeah! | |
121 | ;;; Reset edebug-mode on first function entry. Yeah! | |
122 | ;;; Motivated by Dion Hollenbeck. | |
123 | ;;; Add the missing bindings to the global-edebug-map. | |
124 | ;;; eval-current-buffer now uses eval-region. | |
125 | ;;; eval-region now does not narrow region. | |
126 | ;;; Narrowing was the cause of the window-start being set wrong. | |
127 | ;;; Reset edebug-mode only on | |
128 | ;;; first entry of any function at each recursive-edit level. | |
129 | ;;; Add edebug-backtrace, to generate cleaned up | |
eb8c3be9 | 130 | ;;; backtrace. It doesn't "work" like the debug backtrace, however. |
84fc2cfa ER |
131 | ;;; Require reselecting outside window even if |
132 | ;;; quit occurs, otherwise save-excursions may restore | |
133 | ;;; buffer to the wrong window. | |
134 | ;;; | |
135 | ;;; Revision 2.2 90/11/26 21:14:22 liberte | |
136 | ;;; Shadow eval-defun and eval-region. Toggle | |
137 | ;;; edebugging with edebug-all-defuns. | |
138 | ;;; Call edebug with (edebug 'function begin end 'exp) | |
139 | ;;; Suggested by Jamie Zawinski <jwz@lucid.com>. | |
140 | ;;; Add edebug-form-parser to process macro args. | |
141 | ;;; Motivated by Darryl Okahata darrylo@hpnmxx.hp.com. | |
142 | ;;; Fix by Roland McGrath <roland@ai.mit.edu> | |
143 | ;;; to wrap body of edebug-save-restriction in progn. | |
144 | ;;; Fix by Darryl Okahata <darrylo%hpnmd@hpcea.hp.com> | |
145 | ;;; to add (set-window-hscroll (selected-window) 0) to | |
146 | ;;; edebug-pop-to-buffer. | |
147 | ;;; | |
148 | ;;; Revision 2.1 90/11/16 21:55:35 liberte | |
149 | ;;; Clean up. | |
150 | ;;; Add edebug-form-hook to edebug macro calls. Thanks to Joe Wells. | |
151 | ;;; edebug-forward-sexp uses step mode if no forward-sexp. | |
152 | ;;; | |
153 | ;;; Revision 2.0 90/11/14 22:30:54 liberte | |
154 | ;;; Handle lambda forms, function, interactive evals, defmacro. | |
155 | ;;; Clean up display for Epoch - save and restore screen configurations. | |
156 | ;;; Note: epoch 3.2 broke set-window-configuration. | |
157 | ;;; Also, sit-for pauses do not always work in epoch. | |
158 | ;;; Display evaluations window. | |
159 | ;;; Display result after expression evaluation. | |
160 | ;;; Thanks to discussions with Shinichirou Sugou. | |
161 | ;;; Conditional and temporary breakpoints. | |
162 | ;;; Change "continue" to "go" mode and add different "continue" mode. | |
163 | ;;; Option to stop before symbols. | |
164 | ;;; | |
165 | ;;; Fix by: Glen Ditchfield gjditchfield@violet.uwaterloo.ca | |
166 | ;;; to handle ?# type chars. | |
167 | ;;; | |
168 | ;;; Revision 1.5 89/05/10 02:39:27 liberte | |
169 | ;;; Fix condition-case expression lists. | |
170 | ;;; Reorganize edebug. | |
171 | ;;; | |
172 | ;;; Revision 1.4 89/02/14 22:58:34 liberte | |
173 | ;;; Fix broken breakpointing. | |
3a801d0c | 174 | ;;; Temporarily widen Emacs Lisp buffer during edebug. |
84fc2cfa ER |
175 | ;;; |
176 | ;;; Revision 1.3 89/01/30 00:26:09 liberte | |
177 | ;;; More bug fixes for cond and let. | |
178 | ;;; Another parsing fix backquote. | |
179 | ;;; Fix for lambda forms inside defuns. | |
180 | ;;; Leave point at syntax error, mark at starting position. | |
181 | ;;; | |
182 | ;;; Revision 1.2 88/11/28 12:14:15 liberte | |
eb8c3be9 JB |
183 | ;;; Bug fixes: cond construct didn't execute. |
184 | ;;; () in sexp list didn't parse | |
185 | ;;; () as variable in condition-case didn't parse. | |
84fc2cfa ER |
186 | ;;; |
187 | ;;; Revision 1.1 88/11/28 12:11:27 liberte | |
188 | ;;; Initial revision | |
189 | ;;; | |
190 | ||
3a801d0c ER |
191 | ;;; Code: |
192 | ||
84fc2cfa ER |
193 | \f |
194 | ;;; Options | |
195 | ;;; ------- | |
196 | ||
197 | (defvar edebug-all-defuns nil | |
198 | "*If non-nil, all defuns and defmacros evaluated will use edebug. | |
199 | eval-defun without prefix arg and eval-region will use edebug-defun. | |
200 | ||
201 | If nil, eval-region evaluates normally, but eval-defun with prefix arg | |
202 | uses edebug-defun. eval-region is called by eval-defun, eval-last-sexp, | |
203 | and eval-print-last-sexp. | |
204 | ||
3a801d0c | 205 | You may wish to make this variable local to each Emacs Lisp buffer by calling |
84fc2cfa ER |
206 | (make-local-variable 'edebug-all-defuns) in your emacs-lisp-mode-hook. |
207 | You can use the function edebug-all-defuns to toggle its value.") | |
208 | ||
209 | ||
210 | (defvar edebug-eval-macro-args nil | |
211 | "*If non-nil, edebug will assume that all macro call arguments for | |
212 | macros that have no edebug-form-hook may be evaluated, otherwise it | |
213 | will not. To specify exceptions for macros that have some arguments | |
214 | evaluated and some not, you should specify an edebug-form-hook") | |
215 | ||
216 | (defvar edebug-stop-before-symbols nil | |
217 | "*Non-nil causes edebug to stop before symbols as well as after. | |
218 | In any case, it is possible to stop before a symbol with a breakpoint or | |
219 | interrupt.") | |
220 | ||
221 | (defvar edebug-save-windows t | |
222 | "*If non-nil, save and restore window configuration on edebug calls. | |
223 | It takes some time to save and restore, so if your program does not care | |
224 | what happens to the window configurations, it is better to set this | |
225 | variable to nil.") | |
226 | ||
227 | (defvar edebug-save-point t | |
228 | "*If non-nil, save and restore the point and mark in source code buffers.") | |
229 | ||
230 | (defvar edebug-save-buffer-points nil | |
231 | "*If non-nil, save and restore the points of all buffers, displayed or not. | |
232 | ||
233 | Saving and restoring buffer points is necessary if you are debugging | |
234 | code that changes the point of a buffer which is displayed in a | |
235 | non-selected window. If edebug or the user then selects the | |
236 | window, the buffer's point will be changed to the window's point. | |
237 | ||
238 | Saving and restoring all the points is an expensive operation since it | |
239 | visits each buffer twice for each edebug call, so it is best to avoid | |
240 | it if you can.") | |
241 | ||
242 | (defvar edebug-initial-mode 'step | |
243 | "*Global initial mode for edebug, if non-nil. | |
244 | This is used when edebug is first entered for each recursive-edit level. | |
245 | Possible values are nil (meaning keep using edebug-mode), step, go, | |
246 | Go-nonstop, trace, Trace-fast, continue, and Continue-fast.") | |
247 | ||
248 | (defvar edebug-trace nil | |
249 | "*Non-nil if edebug should show a trace of function entry and exit. | |
250 | Tracing output is displayed in a buffer named *edebug-trace*, one | |
251 | function entry or exit per line, indented by the recursion level. You | |
252 | can customize by replacing functions edebug-print-trace-entry and | |
253 | edebug-print-trace-exit.") | |
254 | ||
255 | ||
256 | \f | |
257 | ;;;======================================================================== | |
258 | ;;; Utilities | |
259 | ;;; --------- | |
260 | ||
261 | (defun edebug-which-function () | |
262 | "Return the symbol of the function we are in" | |
263 | (save-excursion | |
264 | (end-of-defun) | |
265 | (beginning-of-defun) | |
266 | (down-list 1) | |
267 | (if (not (memq (read (current-buffer)) '(defun defmacro))) | |
4897b0a0 | 268 | (error "Not in defun or defmacro")) |
84fc2cfa ER |
269 | (read (current-buffer)))) |
270 | ||
271 | (defun edebug-last-sexp () | |
272 | "Return the last sexp before point in current buffer. | |
3a801d0c | 273 | Assumes Emacs Lisp syntax is active." |
84fc2cfa ER |
274 | (car |
275 | (read-from-string | |
276 | (buffer-substring | |
277 | (save-excursion | |
278 | (forward-sexp -1) | |
279 | (point)) | |
280 | (point))))) | |
281 | ||
282 | (defun edebug-window-list () | |
283 | "Return a list of windows, in order of next-window." | |
eb8c3be9 | 284 | ;; This doesn't work for epoch. |
84fc2cfa ER |
285 | (let* ((first-window (selected-window)) |
286 | (window-list (list first-window)) | |
287 | (next (next-window first-window))) | |
288 | (while (not (eq next first-window)) | |
289 | (setq window-list (cons next window-list)) | |
290 | (setq next (next-window next))) | |
291 | (nreverse window-list))) | |
292 | ||
293 | (defun edebug-get-buffer-points () | |
294 | "Return a list of buffer point pairs, for all buffers." | |
295 | (save-excursion | |
296 | (mapcar (function (lambda (buf) | |
297 | (set-buffer buf) | |
298 | (cons buf (point)))) | |
299 | (buffer-list)))) | |
300 | ||
301 | (defun edebug-set-buffer-points () | |
302 | "Restore the buffer-points given by edebug-get-buffer-points." | |
303 | (mapcar (function (lambda (buf-point) | |
304 | (if (buffer-name (car buf-point)) ; still exists | |
305 | (progn | |
306 | (set-buffer (car buf-point)) | |
307 | (goto-char (cdr buf-point)))))) | |
308 | edebug-buffer-points)) | |
309 | ||
310 | (defun edebug-two-window-p () | |
311 | "Return t if there are two windows." | |
312 | (and (not (one-window-p)) | |
313 | (eq (selected-window) | |
314 | (next-window (next-window (selected-window)))))) | |
315 | ||
316 | (defun edebug-macrop (object) | |
317 | "Return the macro named by OBJECT, or nil if it is not a macro." | |
318 | (while (and (symbolp object) (fboundp object)) | |
319 | (setq object (symbol-function object))) | |
320 | (if (and (listp object) | |
321 | (eq 'macro (car object)) | |
322 | (edebug-functionp (cdr object))) | |
323 | object)) | |
324 | ||
325 | (defun edebug-functionp (object) | |
326 | "Returns the function named by OBJECT, or nil if it is not a function." | |
327 | (while (and (symbolp object) (fboundp object)) | |
328 | (setq object (symbol-function object))) | |
329 | (if (or (subrp object) | |
d4ce6b18 | 330 | (byte-code-function-p object) |
84fc2cfa ER |
331 | (and (listp object) |
332 | (eq (car object) 'lambda) | |
333 | (listp (car (cdr object))))) | |
334 | object)) | |
335 | ||
336 | (defun edebug-sort-alist (alist function) | |
337 | "Return the ALIST sorted with comparison function FUNCTION. | |
338 | This uses 'sort so the sorting is destructive." | |
339 | (sort alist (function | |
340 | (lambda (e1 e2) | |
341 | (funcall function (car e1) (car e2)))))) | |
342 | ||
343 | (put 'edebug-save-restriction 'edebug-form-hook | |
344 | '(&rest form)) | |
345 | ||
346 | (defmacro edebug-save-restriction (&rest body) | |
347 | "Evaluate BODY while saving the current buffers restriction. | |
348 | BODY may change buffer outside of current restriction, unlike | |
349 | save-restriction. BODY may change the current buffer, | |
350 | and the restriction will be restored to the original buffer, | |
351 | and the current buffer remains current. | |
352 | Return the result of the last expression in BODY." | |
353 | (` (let ((edebug:s-r-beg (point-min-marker)) | |
354 | (edebug:s-r-end (point-max-marker))) | |
355 | (unwind-protect | |
356 | (progn (,@ body)) | |
357 | (save-excursion | |
358 | (set-buffer (marker-buffer edebug:s-r-beg)) | |
359 | (narrow-to-region edebug:s-r-beg edebug:s-r-end)))))) | |
360 | ||
361 | \f | |
362 | ;;;============================================================= | |
363 | ;;; Redefine eval-defun, eval-region, and eval-current-buffer. | |
364 | ;;; ----------------------------------------------------------- | |
365 | ||
366 | (defun edebug-all-defuns () | |
367 | "Toggle edebugging of all defuns and defmacros, | |
368 | not including those evaluated in the minibuffer, or during load." | |
369 | (interactive) | |
370 | (setq edebug-all-defuns (not edebug-all-defuns)) | |
371 | (message "Edebugging is %s." (if edebug-all-defuns "on" "off"))) | |
372 | ||
373 | ||
374 | (if (not (fboundp 'edebug-emacs-eval-defun)) | |
375 | (fset 'edebug-emacs-eval-defun (symbol-function 'eval-defun))) | |
376 | ;;(fset 'eval-defun (symbol-function 'edebug-emacs-eval-defun)) | |
377 | ||
378 | (defun eval-defun (edebug-debug) | |
379 | "Edebug replacement for eval-defun. Print value in the minibuffer. | |
380 | Evaluate the top-level form that point is in or before. Note: | |
381 | eval-defun normally evaluates any top-level form, not just defuns. | |
382 | ||
383 | Here are the differences from the standard eval-defun. If the prefix | |
384 | argument is the same as edebug-all-defuns (nil or non-nil), evaluate | |
385 | normally; otherwise edebug-defun is called to wrap edebug calls around | |
386 | evaluatable expressions in the defun or defmacro body. Also, the | |
387 | value printed by edebug-defun is not just the function name." | |
388 | (interactive "P") | |
389 | (let ((edebug-all-defuns | |
390 | (not (eq (not edebug-debug) (not edebug-all-defuns))))) | |
391 | (edebug-emacs-eval-defun nil) | |
392 | )) | |
393 | ||
394 | ||
395 | (if (not (fboundp 'edebug-emacs-eval-region)) | |
396 | (fset 'edebug-emacs-eval-region (symbol-function 'eval-region))) | |
397 | ;; (fset 'eval-region (symbol-function 'edebug-emacs-eval-region)) | |
398 | ||
399 | (defun eval-region (edebug-e-r-start edebug-e-r-end | |
400 | &optional edebug-e-r-output) | |
401 | "Edebug replacement for eval-defun. | |
402 | Like eval-region, but call edebug-defun for defuns or defmacros. | |
403 | Also, this eval-region does not narrow to the region and | |
404 | if an error occurs, point is left at the error." | |
405 | ;; One other piddling difference concerns whitespace after the expression. | |
406 | (interactive "r") | |
407 | (let ((standard-output (or edebug-e-r-output 'symbolp)) | |
408 | (edebug-e-r-pnt (point)) | |
409 | (edebug-e-r-buf (current-buffer)) | |
410 | (edebug-e-r-inside-buf (current-buffer)) | |
411 | ;; Mark the end because it may move. | |
412 | (edebug-e-r-end-marker (set-marker (make-marker) edebug-e-r-end)) | |
413 | edebug-e-r-val | |
414 | ) | |
415 | (goto-char edebug-e-r-start) | |
416 | (edebug-skip-whitespace) | |
417 | (while (< (point) edebug-e-r-end-marker) | |
418 | (if (and edebug-all-defuns | |
419 | (eq 'lparen (edebug-next-token-class)) | |
420 | (save-excursion | |
421 | (forward-char 1) ; skip \( | |
422 | (memq (edebug-read-sexp) '(defun defmacro)))) | |
423 | (progn | |
424 | (edebug-defun) | |
425 | ;; Potential problem: edebug-defun always prints name. | |
426 | (forward-sexp 1) ; skip the defun | |
427 | ) | |
428 | (if (and (eq 'lparen (edebug-next-token-class)) | |
429 | (save-excursion | |
430 | (forward-char 1) ; skip \( | |
431 | (memq (edebug-read-sexp) '(defun defmacro)))) | |
432 | ;; If it's a defun or defmacro, but not edebug-all-defuns | |
433 | ;; reset the symbols edebug property to be just a marker at | |
434 | ;; the definitions source code. | |
435 | (put (edebug-which-function) 'edebug (point-marker))) | |
436 | ||
437 | ;; Evaluate normally - after restoring the current-buffer. | |
438 | (setq edebug-e-r-val (edebug-read-sexp)) | |
439 | (save-excursion | |
440 | (set-buffer edebug-e-r-inside-buf) | |
441 | (setq edebug-e-r-val (eval edebug-e-r-val)) | |
442 | ;; Remember current buffer for next time. | |
443 | (setq edebug-e-r-inside-buf (current-buffer))) | |
444 | ||
445 | (if edebug-e-r-output | |
446 | (progn | |
447 | (setq values (cons edebug-e-r-val values)) | |
448 | (if (eq standard-output t) | |
449 | (prin1 edebug-e-r-val) | |
450 | (print edebug-e-r-val)))) | |
451 | ) | |
452 | (goto-char | |
453 | (min (max edebug-e-r-end-marker (point)) | |
454 | (progn (edebug-skip-whitespace) (point)))) | |
455 | ) ; while | |
456 | (if (null edebug-e-r-output) | |
457 | ;; do the save-excursion recovery | |
458 | (progn | |
459 | ;; but mark is not restored | |
460 | (set-buffer edebug-e-r-buf) | |
461 | (goto-char edebug-e-r-pnt))) | |
462 | nil | |
463 | )) | |
464 | ||
465 | ||
daa37602 | 466 | (defun edebug-eval-current-buffer (&optional edebug-e-c-b-output) |
84fc2cfa ER |
467 | "Call eval-region on the whole buffer." |
468 | (interactive) | |
469 | (eval-region (point-min) (point-max) edebug-e-c-b-output)) | |
470 | ||
daa37602 JB |
471 | (defun edebug-eval-buffer (&optional buffer edebug-e-c-b-output) |
472 | "Call eval-region on the whole buffer." | |
473 | (interactive "bEval buffer: ") | |
474 | (save-excursion | |
475 | (set-buffer buffer) | |
476 | (eval-region (point-min) (point-max) edebug-e-c-b-output))) | |
477 | ||
478 | ;; The standard eval-current-buffer doesn't use eval-region. | |
479 | (if (and (fboundp 'eval-current-buffer) | |
480 | (not (fboundp 'edebug-emacs-eval-current-buffer))) | |
481 | (progn | |
482 | (fset 'edebug-emacs-eval-current-buffer | |
483 | (symbol-function 'eval-current-buffer)) | |
484 | (fset 'eval-current-buffer 'edebug-eval-current-buffer))) | |
485 | (if (and (fboundp 'eval-buffer) | |
486 | (not (fboundp 'edebug-emacs-eval-buffer))) | |
487 | (progn | |
488 | (fset 'edebug-emacs-eval-buffer | |
489 | (symbol-function 'eval-buffer)) | |
490 | (fset 'eval-buffer 'edebug-eval-buffer))) | |
491 | ||
84fc2cfa ER |
492 | |
493 | \f | |
494 | ;;;====================================================================== | |
495 | ;;; The Parser | |
496 | ;;; ---------- | |
497 | ||
498 | ;;; The top level function for parsing defuns is edebug-defun; it | |
499 | ;;; calls all the rest. It checks the syntax a bit and leaves point | |
500 | ;;; at any error it finds, but otherwise should appear to work like | |
501 | ;;; eval-defun. | |
502 | ||
503 | ;;; The basic plan is to surround each expression with a call to the | |
504 | ;;; function edebug together with indexes into a table of positions of | |
505 | ;;; all expressions. Thus an expression "exp" in function foo | |
506 | ;;; becomes: | |
507 | ||
508 | ;;; (edebug 1 2 'exp) | |
509 | ||
510 | ;;; First point moved to to the beginning of exp (offset 1 of the | |
511 | ;;; current function). Then the expression is evaluated and point is | |
512 | ;;; moved to offset 2, at the end of exp. | |
513 | ||
514 | ;;; The top level expressions of the function are wrapped in a call to | |
515 | ;;; edebug-enter, which supplies the function name and the actual | |
516 | ;;; arguments to the function. See functions edebug and edebug-enter | |
517 | ;;; for more details. | |
518 | ||
519 | ||
daa37602 | 520 | ;;;###autoload |
84fc2cfa ER |
521 | (defun edebug-defun () |
522 | "Evaluate defun or defmacro, like eval-defun, but with edebug calls. | |
523 | Print its name in the minibuffer and leave point after any error it finds, | |
524 | with mark at the original point." | |
525 | (interactive) | |
526 | (let (def-kind ; whether defmacro or defun | |
527 | def-name | |
528 | def-args | |
529 | def-docstring | |
530 | defun-interactive | |
531 | (edebug-offset-index 0) | |
532 | edebug-offset-list | |
533 | edebug-func-mark | |
534 | (starting-point (point)) | |
535 | tmp-point | |
536 | (parse-sexp-ignore-comments t)) | |
537 | ||
538 | (condition-case err | |
539 | (progn | |
540 | (end-of-defun) | |
541 | (beginning-of-defun) | |
542 | (down-list 1) | |
543 | ||
544 | (setq edebug-func-mark (point-marker)) | |
545 | (if (not (eq 'defun (setq def-kind (edebug-read-sexp)))) | |
546 | (if (not (eq 'defmacro def-kind)) | |
547 | (edebug-syntax-error "%s is not a defun or defmacro." | |
548 | def-kind))) | |
549 | (setq def-name (edebug-read-sexp)) | |
550 | (if (not (symbolp def-name)) | |
551 | (edebug-syntax-error "Bad defun name: %s" def-name)) | |
552 | (setq def-args (edebug-read-sexp)) | |
553 | (if (not (listp def-args)) | |
554 | (edebug-syntax-error "Bad defun arg list: %s" def-args)) | |
555 | ||
556 | ;; look for doc string | |
557 | (setq tmp-point (point)) | |
558 | (if (eq 'string (edebug-next-token-class)) | |
559 | (progn | |
560 | (setq def-docstring (edebug-read-sexp)) | |
561 | (setq tmp-point (point)))) | |
562 | ||
563 | ;; look for interactive form | |
564 | (if (eq 'lparen (edebug-next-token-class)) | |
565 | (progn | |
566 | (forward-char 1) ; skip \( | |
567 | (if (eq 'interactive (edebug-read-sexp)) | |
568 | (progn | |
569 | (setq defun-interactive | |
570 | (cons 'interactive (edebug-interactive))) | |
571 | (forward-char 1) ; skip \) | |
572 | (setq tmp-point (point)) | |
573 | )))) | |
574 | ||
575 | (goto-char tmp-point) | |
576 | ||
577 | ;; build the new definition | |
578 | (fset def-name (` (lambda | |
579 | (, def-args) | |
580 | (, def-docstring) | |
581 | (, defun-interactive) | |
582 | ;; the remainder is a list of sexps | |
583 | (edebug-enter | |
584 | (quote (, def-name)) | |
585 | (quote (, def-args)) | |
586 | (quote (progn | |
587 | (,@ (edebug-sexp-list t))))) | |
588 | ))) | |
589 | ;; if it is a defmacro, prepend 'macro | |
590 | (if (eq 'defmacro def-kind) | |
591 | (fset def-name (cons 'macro (symbol-function def-name)))) | |
592 | ||
593 | ;; recover point, like save-excursion but only if no error occurs | |
594 | (goto-char starting-point) | |
595 | ||
596 | ;; store the offset list in functions property list | |
597 | (put def-name 'edebug | |
598 | (list edebug-func-mark | |
599 | nil ; clear breakpoints | |
600 | (vconcat (nreverse edebug-offset-list)))) | |
601 | (message "edebug: %s" def-name) | |
602 | ) ; progn | |
603 | ||
604 | (invalid-read-syntax | |
605 | ;; Set mark at starting-point so user can return. | |
606 | ;; Leave point at error. | |
607 | (save-excursion | |
608 | (goto-char starting-point) | |
609 | (set-mark-command nil)) | |
610 | (message "Syntax error: %s" (cdr err)) | |
611 | ;; (signal 'invalid-read-syntax (cdr err)) ; pass it on, to who? | |
612 | ) | |
613 | ) ; condition-case | |
614 | def-name | |
615 | )) | |
616 | ||
617 | ||
618 | (defun edebug-sexp-list (debuggable) | |
619 | "Return an edebug form built from the sexp list following point in the | |
620 | current buffer. If DEBUGGABLE then wrap edebug calls around each sexp. | |
621 | The sexp list does not start with a left paren; we are already in the list. | |
622 | Leave point at (before) the trailing right paren." | |
623 | (let (sexp-list) | |
624 | (while (not (eq 'rparen (edebug-next-token-class))) | |
625 | (setq sexp-list (cons (if debuggable | |
626 | (edebug-form) | |
627 | (edebug-read-sexp)) | |
628 | sexp-list))) | |
629 | (nreverse sexp-list))) | |
630 | ||
631 | ||
632 | (defun edebug-increment-offset () | |
633 | ;; accesses edebug-offset-index and edebug-offset-list | |
634 | (setq edebug-offset-index (1+ edebug-offset-index)) | |
635 | (setq edebug-offset-list (cons (- (point) edebug-func-mark) | |
636 | edebug-offset-list))) | |
637 | ||
638 | ||
639 | (defun edebug-make-edebug-form (index form) | |
640 | "Return the edebug form for the current function at offset INDEX given FORM. | |
641 | Looks like: (edebug def-name INDEX edebug-offset-index 'FORM). | |
642 | Also increment the offset index." | |
643 | (prog1 | |
644 | (list 'edebug | |
645 | index | |
646 | edebug-offset-index | |
647 | (list 'quote form)) | |
648 | (edebug-increment-offset) | |
649 | )) | |
650 | ||
651 | ||
652 | (defun edebug-form () | |
653 | "Return the debug form for the following form. Add the point offset | |
654 | to the edebug-offset-list for the function and move point to | |
655 | immediately after the form." | |
656 | (let* ((index edebug-offset-index) | |
657 | form class) | |
658 | ;; The point must be added to the offset list now | |
659 | ;; because edebug-list will add more offsets indirectly. | |
660 | (edebug-skip-whitespace) | |
661 | (edebug-increment-offset) | |
662 | (setq class (edebug-next-token-class)) | |
663 | (cond | |
664 | ((eq 'lparen class) | |
665 | (edebug-make-edebug-form index (edebug-list))) | |
666 | ||
667 | ((eq 'symbol class) | |
668 | (if (and (not (memq (setq form (edebug-read-sexp)) '(nil t))) | |
669 | ;; note: symbol includes numbers, see parsing utilities | |
670 | (not (numberp form))) | |
671 | (edebug-make-edebug-form index form) | |
672 | form)) | |
673 | (t (edebug-read-sexp))))) | |
674 | ||
675 | ||
676 | (defun edebug-list () | |
677 | "Return an edebug form built from the list form that follows point. | |
678 | Insert debug calls as appropriate to the form. Start with point at | |
679 | the left paren. Leave point after the right paren." | |
680 | (let ((beginning (point)) | |
681 | class | |
682 | head) | |
683 | ||
684 | (forward-char 1) ; skip \( | |
685 | (setq class (edebug-next-token-class)) | |
686 | (cond | |
687 | ((eq 'symbol class) | |
688 | (setq head (edebug-read-sexp))) | |
689 | ((eq 'lparen class) | |
690 | (setq head (edebug-anonymous))) | |
691 | ((eq 'rparen class) | |
692 | (setq head nil)) | |
693 | (t (edebug-syntax-error | |
694 | "Head of list must be a symbol or lambda expression."))) | |
695 | ||
696 | (prog1 | |
697 | (if head | |
698 | (cons head | |
699 | (cond | |
700 | ||
701 | ;; None of the edebug-form-hooks defined below are used, for speed. | |
702 | ;; They are included for documentation, though the hook would not | |
703 | ;; necessarily behave the same as the function it is replacing. | |
704 | ||
705 | ;;; Using the edebug-form-hooks should work, but would take more time. | |
706 | ;;; ((symbolp head) | |
707 | ;;; (let ((form (get head 'edebug-form-hook))) | |
708 | ;;; (if form | |
709 | ;;; (edebug-form-parser form) | |
710 | ;;; (if (edebug-macrop head) | |
711 | ;;; (if edebug-eval-macro-args | |
712 | ;;; (edebug-sexp-list t) | |
713 | ;;; (edebug-sexp-list nil)) | |
714 | ;;; ;; assume it is a function | |
715 | ;;; (edebug-sexp-list t))))) | |
716 | ||
717 | ;; handle all special-forms with unevaluated arguments | |
718 | ((memq head '(let let*)) (edebug-let)) | |
719 | ((memq head '(setq setq-default)) (edebug-setq)) | |
720 | ((eq head 'cond) (edebug-cond)) | |
721 | ((eq head 'condition-case) (edebug-condition-case)) | |
722 | ||
723 | ((memq head '(quote ; permits more than one arg | |
724 | defun defvar defconst defmacro)) | |
725 | (edebug-sexp-list nil)) | |
726 | ((eq head 'function) | |
727 | (list | |
728 | (if (eq 'lparen (edebug-next-token-class)) | |
729 | (edebug-anonymous) | |
730 | (edebug-read-sexp) ; should be just a symbol | |
731 | ))) | |
732 | ||
733 | ;; is it a lisp macro? | |
734 | ((edebug-macrop head) | |
735 | (or (and (symbolp head) | |
736 | (let ((form (get head 'edebug-form-hook))) | |
737 | (if form | |
738 | (if (eq form t) | |
739 | (edebug-sexp-list t) | |
740 | (if (eq form 0) | |
741 | (edebug-sexp-list nil) | |
742 | (edebug-form-parser form)))))) | |
743 | (edebug-sexp-list edebug-eval-macro-args))) | |
744 | ||
745 | ((eq head 'interactive) | |
746 | (edebug-syntax-error "interactive not expected here.")) | |
747 | ||
748 | ;; otherwise it is a function call | |
749 | (t (edebug-sexp-list t)) | |
750 | ))) | |
751 | ||
752 | (if (eq 'rparen (edebug-next-token-class)) | |
753 | (forward-char 1) ; skip \) | |
754 | (edebug-syntax-error "Too many arguments.")) | |
755 | ))) | |
756 | ||
757 | ||
758 | (defun edebug-form-parser (args) | |
759 | "Parse the macro arguments that follow based on ARGS. | |
760 | ARGS describes the types of the arguments of a list form. Each of the ARGS | |
761 | is processed left to right, in the same order as the arguments of the | |
762 | list form. See the edebug documentation for more details. The ARGS | |
763 | may be one of the following: | |
764 | ||
765 | symbolp - an unevaluated symbol | |
766 | integerp - an unevaluated number | |
767 | stringp - an unevaluated string | |
768 | vectorp - an unevaluated vector | |
769 | atom - an unevaluated number, string, symbol, or vector | |
770 | ||
771 | sexp - an unevaluated sexp (atom or list); may not be empty | |
772 | form - an evaluated sexp; may not be empty | |
773 | ||
774 | foo - any other symbol should be the name of a function; this | |
775 | function is called on the argument as a predicate and an error | |
776 | is signaled if the predicate fails. | |
777 | ||
778 | &optional - one following arg in the list may or may not appear. | |
779 | &rest - all following args are repeated zero or more times as a group. | |
780 | This is an extension of the normal meaning of &rest. | |
781 | &or - each of the following args are alternatives, processed left to | |
782 | right until one succeeds. There is no way to group | |
783 | more than one list element as one alternative. | |
784 | ||
785 | (...) - a sublist, of the same format as the top level, processed recursively. | |
786 | Special case: if the car of the list is quote, the argument must match | |
787 | the quoted sexp (see example below of 'for macro). | |
788 | " | |
789 | ||
790 | (let ((arglist args) | |
791 | arg form form-list class | |
792 | &optional &rest &or) | |
793 | (while (and arglist | |
794 | (not (eq 'rparen (setq class (edebug-next-token-class))))) | |
795 | (catch 'no-match | |
796 | (setq arg (car arglist)) | |
797 | (setq arglist (cdr arglist)) | |
798 | (if (and &rest (null arglist)) | |
799 | (setq arglist &rest)) | |
800 | ||
801 | (cond | |
802 | ((memq arg '(&optional &rest &or)) | |
803 | ;; remember arglist at this point | |
804 | (set arg arglist) | |
805 | (throw 'no-match nil)) | |
806 | ||
807 | ((eq arg 'form) | |
808 | (setq form (edebug-form))) | |
809 | ||
810 | ((eq arg 'sexp) | |
811 | (setq form (edebug-read-sexp))) | |
812 | ||
813 | ((listp arg) | |
814 | (if (eq 'quote (car arg)) | |
815 | ;; special case, match the quoted symbol | |
816 | (let ((pnt (point))) | |
817 | (setq arg (car (cdr arg))) | |
818 | (if (not (eq arg (setq form (edebug-read-sexp)))) | |
819 | (edebug-form-parser-error) | |
820 | )) | |
821 | (if (eq class 'lparen) | |
822 | (progn | |
823 | (forward-char 1) ; skip \( | |
824 | (setq form (edebug-form-parser arg)) | |
825 | (forward-char 1) ; skip \) | |
826 | )))) | |
827 | ((symbolp arg) | |
828 | (let ((pnt (point)) | |
829 | (pred (if (fboundp arg) (symbol-function arg)))) | |
830 | (and pred | |
831 | (not (funcall pred (setq form (edebug-read-sexp)))) | |
832 | (edebug-form-parser-error) | |
833 | ))) | |
834 | (t (throw 'no-match nil)) | |
835 | ) ; cond | |
836 | (setq &optional nil) ; only lasts for one match | |
837 | (setq form-list (cons form form-list)) ; skipped by no-match throw | |
838 | )) ; while | |
839 | ||
840 | (if (and arglist (not (or &optional &rest | |
841 | (memq (car arglist) '(&optional &rest))))) | |
842 | (edebug-syntax-error "Not enough arguments.")) | |
843 | (if (not (eq 'rparen (edebug-next-token-class))) | |
844 | (if &or | |
845 | (edebug-syntax-error "Unrecognized argument.") | |
846 | (edebug-syntax-error "Too many arguments."))) | |
847 | (nreverse form-list))) | |
848 | ||
849 | ||
850 | (defun edebug-form-parser-error () | |
851 | (goto-char pnt) | |
852 | (if &or | |
853 | (throw 'no-match nil) | |
854 | (if &optional | |
855 | (progn | |
856 | (setq &optional nil) ; only lasts for one failed match not in &or | |
857 | (throw 'no-match nil)) | |
858 | (edebug-syntax-error "%s is not %s" form arg)))) | |
859 | ||
3a801d0c | 860 | ;; for loop defined in Emacs Lisp manual |
84fc2cfa ER |
861 | (put 'for 'edebug-form-hook |
862 | '(symbolp 'from form 'to form 'do &rest form)) | |
863 | ||
864 | ;; case and do defined in cl.el | |
865 | (put 'case 'edebug-form-hook | |
866 | '(form &rest (sexp form))) | |
867 | ||
868 | (put 'do 'edebug-form-hook | |
869 | '((&rest | |
870 | &or symbolp | |
871 | (symbolp &optional form | |
872 | &optional form)) | |
873 | (form &rest form) | |
874 | &rest body)) | |
875 | ||
876 | (put 'defvar 'edebug-form-hook | |
877 | (put 'defconst 'edebug-form-hook | |
878 | '(symbolp &optional form &optional stringp))) | |
879 | ||
880 | (put 'defun 'edebug-form-hook | |
881 | (put 'defmacro 'edebug-form-hook | |
882 | '(symbolp (&rest symbolp) | |
883 | &optional stringp | |
884 | &optional ('interactive &or stringp form) | |
885 | &rest form))) | |
886 | ||
887 | (put 'anonymous 'edebug-form-hook | |
888 | '(&optional 'macro 'lambda (&rest symbolp) &rest form)) | |
889 | ||
890 | (defun edebug-anonymous () | |
891 | "Return the edebug form for an anonymous lambda or macro. | |
892 | Point starts before the left paren and ends after it." | |
893 | (forward-char 1) ; skip \( | |
894 | (prog1 | |
895 | (let ((head (edebug-read-sexp))) | |
896 | (cond | |
897 | ((eq head 'lambda) | |
898 | (edebug-lambda)) | |
899 | ((eq head 'macro) | |
900 | (if (not (eq 'lambda (edebug-read-sexp))) | |
901 | (edebug-syntax-error "lambda expected.")) | |
902 | (cons 'macro (edebug-lambda))) | |
903 | (t (edebug-syntax-error "Anonymous lambda or macro expected.")))) | |
904 | (forward-char 1) ; skip \) | |
905 | )) | |
906 | ||
907 | ||
908 | (defun edebug-lambda () | |
909 | "Return the edebug form for the lambda form that follows. | |
910 | Point starts after the lambda symbol and is moved to before the right paren." | |
911 | (append | |
912 | (list 'lambda (edebug-read-sexp)) ; the args | |
913 | (edebug-sexp-list t))) ; the body | |
914 | ||
915 | ||
916 | ||
917 | (put 'let 'edebug-form-hook | |
918 | (put 'let* 'edebug-form-hook | |
919 | '((&rest | |
920 | &or (symbolp &optional form) | |
921 | symbolp) | |
922 | &rest form))) | |
923 | ||
924 | (defun edebug-let () | |
925 | "Return the edebug form of the let or let* form. | |
926 | Leave point before the right paren." | |
927 | (let (var-value-list | |
928 | token | |
929 | class) | |
930 | (cons | |
931 | ;; first process the var/value list | |
932 | (if (not (eq 'lparen (edebug-next-token-class))) | |
933 | (if (setq token (edebug-read-sexp)) | |
934 | (edebug-syntax-error "Bad var list in let.") ; should be nil | |
935 | token ; == nil | |
936 | ) | |
937 | ||
938 | (forward-char 1) ; lparen | |
939 | (while (not (eq 'rparen (setq class (edebug-next-token-class)))) | |
940 | (setq var-value-list | |
941 | (cons | |
942 | (if (not (eq 'lparen class)) | |
943 | (edebug-read-sexp) | |
944 | (forward-char 1) ; lparen | |
945 | (prog1 | |
946 | (edebug-var-value) | |
947 | (if (not (eq 'rparen (edebug-next-token-class))) | |
948 | (edebug-syntax-error "Right paren expected in let.") | |
949 | (forward-char 1) ; rparen | |
950 | ))) | |
951 | var-value-list))) | |
952 | (forward-char 1) ; rparen | |
953 | (nreverse var-value-list)) | |
954 | ||
955 | ;; now process the expression list | |
956 | (edebug-sexp-list t)))) | |
957 | ||
958 | ||
959 | (defun edebug-var-value () | |
960 | "Return the edebug form of the var and optional value that follow point. | |
961 | Leave point after the value, if there is one." | |
962 | (list | |
963 | (edebug-read-sexp) ; the variable | |
964 | (and (not (eq 'rparen (edebug-next-token-class))) | |
965 | (edebug-form)))) | |
966 | ||
967 | ||
968 | (put 'setq 'edebug-form-hook | |
969 | (put 'setq-default 'edebug-form-hook | |
970 | '(&rest symbolp form))) | |
971 | ||
972 | (defun edebug-setq () | |
973 | "Return the edebug form of the setq or setq-default var-value list." | |
974 | (let (var-value-list) | |
975 | (while (not (eq 'rparen (edebug-next-token-class))) | |
976 | (setq var-value-list | |
977 | (append var-value-list | |
978 | (edebug-var-value)))) | |
979 | var-value-list)) | |
980 | ||
981 | ||
982 | (put 'interactive 'edebug-form-hook | |
983 | '(&optional &or stringp form)) | |
984 | ||
985 | (defun edebug-interactive () | |
986 | "Return the edebug form of the interactive form." | |
987 | (list | |
988 | (if (not (eq 'rparen (edebug-next-token-class))) | |
989 | (if (eq 'string (edebug-next-token-class)) | |
990 | (edebug-read-sexp) | |
991 | (prog1 | |
992 | (` (edebug-interactive-entry | |
993 | (quote (, def-name)) | |
994 | (quote ((,@ (edebug-form)))))) | |
995 | (if (not (eq 'rparen (edebug-next-token-class))) | |
996 | (edebug-syntax-error | |
997 | "Only first expression used in interactive form."))))))) | |
998 | ||
999 | ||
1000 | (put 'cond 'edebug-form-hook | |
1001 | '(&rest (form &rest form))) | |
1002 | ||
1003 | (defun edebug-cond () | |
1004 | "Return the edebug form of the cond form." | |
1005 | (let (value-value-list | |
1006 | class) | |
1007 | (while (not (eq 'rparen (setq class (edebug-next-token-class)))) | |
1008 | (setq value-value-list | |
1009 | (cons | |
1010 | (if (not (eq 'lparen class)) | |
1011 | (let ((thing (edebug-read-sexp))) | |
1012 | (if thing | |
1013 | (edebug-syntax-error "Condition expected in cond") | |
1014 | nil)) | |
1015 | (forward-char 1) ; \( | |
1016 | (prog1 | |
1017 | (cons | |
1018 | (edebug-form) | |
1019 | (if (eq 'rparen (edebug-next-token-class)) | |
1020 | nil | |
1021 | (edebug-sexp-list t))) | |
1022 | (if (not (eq 'rparen (edebug-next-token-class))) | |
1023 | (edebug-syntax-error "Right paren expected in cond")) | |
1024 | (forward-char 1) ; \) | |
1025 | )) | |
1026 | value-value-list))) | |
1027 | (nreverse value-value-list))) | |
1028 | ||
1029 | ||
eb8c3be9 | 1030 | ;; Bug: this doesn't support condition name lists |
84fc2cfa ER |
1031 | (put 'condition-case 'edebug-form-hook |
1032 | '(symbolp | |
1033 | form | |
1034 | &rest (symbolp &optional form))) | |
1035 | ||
1036 | (defun edebug-condition-case () | |
1037 | "Return the edebug form of the condition-case form." | |
1038 | (cons | |
1039 | (let (token) | |
1040 | ;; read the variable or nil | |
1041 | (setq token (edebug-read-sexp)) | |
1042 | (if (not (symbolp token)) | |
1043 | (edebug-syntax-error | |
1044 | "Variable or nil required for condition-case; found: %s" token)) | |
1045 | token) | |
1046 | ||
1047 | (cons | |
1048 | (edebug-form) ; the form | |
1049 | ||
1050 | ;; process handlers | |
1051 | (let (symb-sexp-list | |
1052 | class) | |
1053 | (while (not (eq 'rparen (setq class (edebug-next-token-class)))) | |
1054 | (setq symb-sexp-list | |
1055 | (cons | |
1056 | (if (not (eq 'lparen class)) | |
1057 | (edebug-syntax-error "Bad handler in condition-case.") | |
1058 | (forward-char 1) ; \( | |
1059 | (prog1 | |
1060 | (cons | |
1061 | (edebug-read-sexp) ; the error-condition | |
1062 | (and (not (eq 'rparen (edebug-next-token-class))) | |
1063 | (edebug-sexp-list t))) | |
1064 | (forward-char 1) ; \) | |
1065 | )) | |
1066 | symb-sexp-list))) | |
1067 | (nreverse symb-sexp-list))))) | |
1068 | ||
1069 | ||
1070 | \f | |
1071 | ;;------------------------------------------------ | |
1072 | ;; Parser utilities | |
1073 | ||
1074 | (defun edebug-syntax-error (msg &rest args) | |
1075 | "Signal an invalid-read-syntax with MSG and ARGS. | |
1076 | This is caught by edebug-defun." | |
1077 | (signal 'invalid-read-syntax (apply 'format msg args))) | |
1078 | ||
1079 | ||
1080 | (defun edebug-skip-whitespace () | |
1081 | "Leave point before the next token, skipping white space and comments." | |
1082 | (skip-chars-forward " \t\r\n\f") | |
1083 | (while (= (following-char) ?\;) | |
1084 | (skip-chars-forward "^\n\r") ; skip the comment | |
1085 | (skip-chars-forward " \t\r\n\f"))) | |
1086 | ||
1087 | (defun edebug-read-sexp () | |
1088 | "Read one sexp from the current buffer starting at point. | |
1089 | Leave point immediately after it. A sexp can be a list or atom. | |
1090 | An atom is a symbol (or number), character, string, or vector." | |
1091 | ;; This is gummed up by parser inconsistencies (bugs?) | |
1092 | (let (token) | |
1093 | (edebug-skip-whitespace) | |
1094 | (if (or (= (following-char) ?\[) (= (following-char) ??)) | |
1095 | ;; scan-sexps doesn't read vectors or character literals correctly, | |
1096 | ;; but read does. | |
1097 | (setq token (read (current-buffer))) | |
1098 | (goto-char | |
1099 | (min ; use the lesser of the read and scan-sexps motion | |
1100 | ;; read goes one too far if (quoted) string or symbol | |
1101 | ;; is immediately followed by non-whitespace | |
1102 | (save-excursion | |
1103 | (setq token (read (current-buffer))) | |
1104 | (point)) | |
1105 | ;; scan-sexps reads too far if a quoting character is read | |
1106 | (scan-sexps (point) 1)))) | |
1107 | token)) | |
1108 | ||
1109 | (defconst edebug-syntax-table | |
1110 | (let ((table (make-vector 256 'symbol))) | |
1111 | ;; Treat numbers as symbols, because of confusion with -, -1, and 1-. | |
1112 | (aset table ?\( 'lparen) | |
1113 | (aset table ?\) 'rparen) | |
1114 | (aset table ?\' 'quote) | |
1115 | (aset table ?\" 'string) | |
1116 | (aset table ?\? 'char) | |
1117 | (aset table ?\[ 'vector) | |
1118 | (aset table ?\. 'dot) | |
1119 | ;; We dont care about any other chars since they wont be seen. | |
1120 | table) | |
1121 | "Lookup table for the token class of each character.") | |
1122 | ||
1123 | (defun edebug-next-token-class () | |
1124 | "Move to the next token and return its class. We only care about | |
1125 | lparen, rparen, dot, quote, string, char, vector, or symbol." | |
1126 | (edebug-skip-whitespace) | |
1127 | (aref edebug-syntax-table (following-char))) | |
1128 | ||
1129 | \f | |
1130 | ;;;================================================================= | |
1131 | ;;; The debugger itself | |
1132 | ;;; ------------------- | |
1133 | ||
1134 | ||
1135 | (defvar edebug-active nil | |
1136 | "Non-nil when edebug is active") | |
1137 | ||
1138 | ||
1139 | ;;; add minor-mode-alist entry | |
1140 | (or (assq 'edebug-active minor-mode-alist) | |
1141 | (setq minor-mode-alist (cons (list 'edebug-active " *Debugging*") | |
1142 | minor-mode-alist))) | |
1143 | ||
1144 | (defvar edebug-backtrace nil | |
1145 | "Stack of active functions evaluated via edebug. | |
1146 | Should be nil at the top level.") | |
1147 | ||
1148 | (defvar edebug-offset-indices nil ; not used yet. | |
1149 | "Stack of offset indices of visited edebug sexps. | |
1150 | Should be nil at the top level.") | |
1151 | ||
1152 | (defvar edebug-entered nil | |
1153 | "Non-nil if edebug has already been entered at this recursive edit level.") | |
1154 | ||
1155 | ||
1156 | (defun edebug-enter (edebug-func edebug-args edebug-body) | |
1157 | "Entering FUNC. The arguments are ARGS, and the body is BODY. | |
1158 | Setup edebug variables and evaluate BODY. This function is called | |
1159 | when a function evaluated with edebug-defun is entered. Return the | |
1160 | result of BODY." | |
1161 | ||
1162 | ;; Is this the first time we are entering edebug since | |
1163 | ;; lower-level recursive-edit command? | |
1164 | (if (and (not edebug-entered) | |
1165 | edebug-initial-mode) | |
1166 | ;; Reset edebug-mode to the initial mode. | |
1167 | (setq edebug-mode edebug-initial-mode)) | |
1168 | (let* ((edebug-entered t) | |
9c0415e0 BF |
1169 | (pre-command-hook (if (memq edebug-func pre-command-hook) |
1170 | nil pre-command-hook)) | |
1171 | (post-command-hook (if (memq edebug-func post-command-hook) | |
1172 | nil post-command-hook)) | |
84fc2cfa ER |
1173 | (edebug-data (get edebug-func 'edebug)) |
1174 | ;; pull out parts of the edebug-data | |
1175 | (edebug-func-mark (car edebug-data)) ; mark at function start | |
1176 | ||
1177 | (edebug-buffer (marker-buffer edebug-func-mark)) | |
1178 | (edebug-backtrace (cons edebug-func edebug-backtrace)) | |
1179 | (max-lisp-eval-depth (+ 6 max-lisp-eval-depth)) ; too much?? | |
1180 | (max-specpdl-size (+ 10 max-specpdl-size)) ; the args and these vars | |
1181 | ) | |
1182 | (if edebug-trace | |
1183 | (let ((edebug-stack-depth (1- (length edebug-backtrace))) | |
1184 | edebug-result) | |
1185 | (edebug-print-trace-entry | |
1186 | "*edebug-trace*" edebug-func edebug-args edebug-stack-depth) | |
1187 | (setq edebug-result (eval edebug-body)) | |
1188 | (edebug-print-trace-exit | |
1189 | "*edebug-trace*" edebug-func edebug-result edebug-stack-depth) | |
1190 | edebug-result) | |
1191 | (eval edebug-body) | |
1192 | ))) | |
1193 | ||
1194 | (defun edebug-interactive-entry (edebug-func edebug-args) | |
1195 | "Evaluating FUNCs non-string argument of interactive form ARGS." | |
1196 | (if (and (not edebug-entered) | |
1197 | edebug-initial-mode) | |
1198 | ;; Reset edebug-mode to the initial mode. | |
1199 | (setq edebug-mode edebug-initial-mode)) | |
1200 | (let* ((edebug-entered t) | |
1201 | (edebug-data (get edebug-func 'edebug)) | |
1202 | ;; pull out parts of the edebug-data | |
1203 | (edebug-func-mark (car edebug-data)) ; mark at function start | |
1204 | ||
1205 | (edebug-buffer (marker-buffer edebug-func-mark)) | |
1206 | ;; (edebug-backtrace (cons edebug-func edebug-backtrace)) | |
1207 | ) | |
1208 | (eval edebug-args))) | |
1209 | ||
1210 | ||
1211 | (defun edebug-print-trace-entry | |
1212 | (edebug-stream edebug-function edebug-args edebug-stack-depth) | |
1213 | (edebug-trace-display | |
1214 | edebug-stream | |
1215 | "%sEnter: %s\n" (make-string edebug-stack-depth ?\ ) edebug-function) | |
1216 | ) | |
1217 | ||
1218 | (defun edebug-print-trace-exit | |
1219 | (edebug-stream edebug-function edebug-result edebug-stack-depth) | |
1220 | (edebug-trace-display | |
1221 | edebug-stream | |
1222 | "%sExit: %s\n" (make-string edebug-stack-depth ?\ ) edebug-function) | |
1223 | ) | |
1224 | ||
1225 | ||
1226 | (defun edebug (edebug-before-index edebug-after-index edebug-exp) | |
1227 | "Debug current function given BEFORE and AFTER positions around EXP. | |
1228 | BEFORE and AFTER are indexes into the position offset vector in the | |
1229 | functions 'edebug property. edebug is called from functions compiled | |
1230 | with edebug-defun." | |
1231 | (let ((max-lisp-eval-depth (+ 5 max-lisp-eval-depth)) ; enough?? | |
1232 | (max-specpdl-size (+ 7 max-specpdl-size)) ; the args and these vars | |
1233 | (edebug-offset-indices | |
1234 | (cons edebug-before-index edebug-offset-indices)) | |
1235 | ;; Save the outside value of executing macro. | |
1236 | (edebug-outside-executing-macro executing-macro) | |
1237 | ;; Don't keep reading from an executing kbd macro within edebug! | |
1238 | (executing-macro nil) | |
1239 | ) | |
1240 | (if (and (eq edebug-mode 'Go-nonstop) | |
1241 | (not (edebug-input-pending-p))) | |
1242 | ;; Just return evalled expression. | |
1243 | (eval edebug-exp) | |
1244 | (edebug-debugger edebug-before-index 'enter edebug-exp) | |
1245 | (edebug-debugger edebug-after-index 'exit (eval edebug-exp)) | |
1246 | ))) | |
1247 | ||
1248 | ||
1249 | (defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-exp) | |
1250 | "Determine if edebug display should be updated." | |
1251 | (let* ( | |
1252 | ;; This needs to be here since breakpoints may be changed. | |
1253 | (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints | |
1254 | (edebug-break-data (assq edebug-offset-index edebug-breakpoints)) | |
1255 | (edebug-break | |
1256 | (if edebug-break-data | |
1257 | (let ((edebug-break-condition | |
1258 | (car (cdr edebug-break-data)))) | |
1259 | (or (not edebug-break-condition) | |
1260 | (eval edebug-break-condition))))) | |
1261 | ) | |
1262 | (if (and edebug-break | |
1263 | (car (cdr (cdr edebug-break-data)))) ; is it temporary? | |
1264 | ;; Delete the breakpoint. | |
1265 | (setcdr edebug-data | |
1266 | (cons (delq edebug-break-data edebug-breakpoints) | |
1267 | (cdr (cdr edebug-data))))) | |
1268 | ||
1269 | ;; Dont do anything if mode is go, continue, or Continue-fast | |
1270 | ;; and no break, and no input. | |
1271 | (if (or (and (not (memq edebug-mode '(go continue Continue-fast))) | |
1272 | (or edebug-stop-before-symbols | |
1273 | (not (and (eq edebug-arg-mode 'enter) | |
1274 | (symbolp edebug-exp))))) | |
1275 | (edebug-input-pending-p) | |
1276 | edebug-break) | |
1277 | (edebug-display)) | |
1278 | ||
1279 | edebug-exp | |
1280 | )) | |
1281 | ||
1282 | ||
1283 | (defvar edebug-window-start 0 | |
1284 | "Remember where each buffers' window starts between edebug calls. | |
1285 | This is to avoid spurious recentering.") | |
1286 | ||
1287 | (setq-default edebug-window-start 0) | |
1288 | (make-variable-buffer-local 'edebug-window-start) | |
1289 | ||
1290 | (defun edebug-display () | |
1291 | "Setup windows for edebug, determine mode, maybe enter recursive-edit." | |
1292 | ;; uses local variables of edebug-enter, edebug, and edebug-debugger. | |
1293 | (let ((edebug-active t) ; for minor mode alist | |
1294 | edebug-stop ; should we enter recursive-edit | |
1295 | (edebug-point (+ edebug-func-mark | |
1296 | (aref (car (cdr (cdr edebug-data))) | |
1297 | edebug-offset-index))) | |
1298 | (edebug-buffer-points | |
1299 | (if edebug-save-buffer-points (edebug-get-buffer-points))) | |
1300 | edebug-window ; window displaying edebug-buffer | |
1301 | edebug-inside-window ; window displayed after recursive edit | |
1302 | (edebug-outside-window (selected-window)) | |
1303 | (edebug-outside-buffer (current-buffer)) | |
1304 | (edebug-outside-point (point)) | |
85dd3810 | 1305 | (edebug-outside-mark (mark t)) |
84fc2cfa ER |
1306 | edebug-outside-windows ; window or screen configuration |
1307 | edebug-outside-edebug-point ; old point in edebug buffer | |
1308 | edebug-outside-edebug-mark | |
1309 | ||
1310 | edebug-eval-buffer ; declared here so we can kill it below | |
1311 | (edebug-eval-result-list (and edebug-eval-list | |
1312 | (edebug-eval-result-list))) | |
1313 | (edebug-outside-o-a-p overlay-arrow-position) | |
1314 | (edebug-outside-o-a-s overlay-arrow-string) | |
1315 | (edebug-outside-c-i-e-a cursor-in-echo-area) | |
1316 | ||
1317 | edebug-outside-point-min | |
1318 | edebug-outside-point-max | |
1319 | ||
1320 | overlay-arrow-position | |
1321 | overlay-arrow-string | |
1322 | (cursor-in-echo-area nil) | |
1323 | ;; any others?? | |
1324 | ) | |
1325 | (if (not (buffer-name edebug-buffer)) | |
4897b0a0 RS |
1326 | (let ((debug-on-error nil)) |
1327 | (error "Buffer defining %s not found" edebug-func))) | |
84fc2cfa ER |
1328 | |
1329 | ;; Save windows now before we modify them. | |
1330 | (if edebug-save-windows | |
1331 | (setq edebug-outside-windows | |
1332 | (edebug-current-window-configuration))) | |
1333 | ||
1334 | ;; If edebug-buffer is not currently displayed, | |
1335 | ;; first find a window for it. | |
1336 | (edebug-pop-to-buffer edebug-buffer) | |
1337 | (setq edebug-window (selected-window)) | |
1338 | ||
1339 | ;; Now display eval list, if any. | |
1340 | ;; This is done after the pop to edebug-buffer | |
1341 | ;; so that buffer-window correspondence is correct after quit. | |
1342 | (edebug-eval-display edebug-eval-result-list) | |
1343 | (select-window edebug-window) | |
1344 | ||
1345 | (if edebug-save-point | |
1346 | (progn | |
1347 | (setq edebug-outside-edebug-point (point)) | |
85dd3810 | 1348 | (setq edebug-outside-edebug-mark (mark t)))) |
84fc2cfa ER |
1349 | |
1350 | (edebug-save-restriction | |
1351 | (setq edebug-outside-point-min (point-min)) | |
1352 | (setq edebug-outside-point-max (point-max)) | |
1353 | (widen) | |
1354 | (goto-char edebug-point) | |
1355 | ||
1356 | (setq edebug-window-start | |
1357 | (edebug-adjust-window edebug-window-start)) | |
1358 | ||
1359 | (if (edebug-input-pending-p) ; not including keyboard macros | |
1360 | (progn | |
1361 | (setq edebug-mode 'step) | |
1362 | (setq edebug-stop t) | |
1363 | (edebug-stop) | |
1364 | ;; (discard-input) ; is this unfriendly?? | |
1365 | )) | |
1366 | (edebug-overlay-arrow) | |
1367 | ||
1368 | (cond | |
1369 | ((eq 'exit edebug-arg-mode) | |
1370 | ;; Display result of previous evaluation. | |
1371 | (setq edebug-previous-result edebug-exp) | |
1372 | (edebug-previous-result)) | |
1373 | ||
1374 | ((eq 'error edebug-arg-mode) | |
1375 | ;; Display error message | |
1376 | (beep) | |
1377 | (if (eq 'quit (car edebug-exp)) | |
1378 | (message "Quit") | |
1379 | (message "%s: %s" | |
1380 | (get (car edebug-exp) 'error-message) | |
1381 | (car (cdr edebug-exp))))) | |
1382 | ||
1383 | (edebug-break | |
1384 | (message "Break")) | |
1385 | (t (message ""))) | |
1386 | ||
1387 | (if edebug-break | |
1388 | (if (not (memq edebug-mode '(continue Continue-fast))) | |
1389 | (setq edebug-stop t) | |
1390 | (if (eq edebug-mode 'continue) | |
1391 | (edebug-sit-for 1) | |
1392 | (edebug-sit-for 0))) | |
1393 | ;; not edebug-break | |
1394 | (if (eq edebug-mode 'trace) | |
1395 | (edebug-sit-for 1) ; Force update and pause. | |
1396 | (if (eq edebug-mode 'Trace-fast) | |
1397 | (edebug-sit-for 0) ; Force update and continue. | |
1398 | ))) | |
1399 | ||
1400 | (unwind-protect | |
1401 | (if (or edebug-stop | |
1402 | (eq edebug-mode 'step) | |
1403 | (eq edebug-arg-mode 'error)) | |
1404 | (progn | |
1405 | (setq edebug-mode 'step) | |
eb8c3be9 | 1406 | (edebug-overlay-arrow) ; this doesn't always show up. |
84fc2cfa ER |
1407 | (edebug-recursive-edit));; <<<<<< Recursive edit |
1408 | ) | |
1409 | ||
1410 | (if edebug-save-buffer-points | |
1411 | (edebug-set-buffer-points)) | |
1412 | ;; Since we may be in a save-excursion, in case of quit | |
1413 | ;; restore the outside window only. | |
1414 | (select-window edebug-outside-window) | |
1415 | ) ; unwind-protect | |
1416 | ||
1417 | ;; None of the following is done if quit or signal occurs. | |
1418 | (if edebug-save-point | |
1419 | ;; Restore point and mark in edebug-buffer. | |
1420 | ;; This does the save-excursion recovery only if no quit. | |
1421 | ;; If edebug-buffer == edebug-outside-buffer, | |
1422 | ;; then this is redundant with outside save-excursion. | |
1423 | (progn | |
1424 | (set-buffer edebug-buffer) | |
1425 | (goto-char edebug-outside-edebug-point) | |
1426 | (if (mark-marker) | |
1427 | (set-marker (mark-marker) edebug-outside-edebug-mark)) | |
1428 | )) | |
1429 | ) ; edebug-save-restriction | |
1430 | ||
1431 | ;; Restore windows, buffer, point, and mark. | |
1432 | (if edebug-save-windows | |
1433 | ;; Restore windows before continuing. | |
1434 | (edebug-set-window-configuration edebug-outside-windows)) | |
1435 | (set-buffer edebug-outside-buffer) | |
1436 | (goto-char edebug-outside-point) | |
1437 | (if (mark-marker) | |
1438 | (set-marker (mark-marker) edebug-outside-mark)) | |
1439 | ;; The following is not sufficient, and sometimes annoying. | |
1440 | ;; (if (memq edebug-mode '(go Go-nonstop)) | |
1441 | ;; (edebug-sit-for 0)) | |
1442 | )) | |
1443 | ||
1444 | ||
1445 | (defvar edebug-depth 0 | |
1446 | "Number of recursive edits started by edebug. | |
1447 | Should be 0 at the top level.") | |
1448 | ||
1449 | (defvar edebug-recursion-depth 0 | |
1450 | "Value of recursion-depth when edebug was called.") | |
1451 | ||
1452 | ||
1453 | (defun edebug-recursive-edit () | |
1454 | "Start up a recursive edit inside of edebug." | |
1455 | ;; The current buffer is the edebug-buffer, which is put into edebug-mode. | |
1456 | (let ((edebug-buffer-read-only buffer-read-only) | |
1457 | ;; match-data must be done in the outside buffer | |
1458 | (edebug-outside-match-data | |
1459 | (save-excursion | |
1460 | (set-buffer edebug-outside-buffer) | |
1461 | (match-data))) | |
1462 | ||
1463 | (edebug-depth (1+ edebug-depth)) | |
1464 | (edebug-recursion-depth (recursion-depth)) | |
1465 | edebug-entered ; bind locally to nil | |
1466 | edebug-backtrace-buffer ; each recursive edit gets its own | |
1467 | ;; The window configuration may be saved and restored | |
1468 | ;; during a recursive-edit | |
1469 | edebug-inside-windows | |
1470 | ||
1471 | (edebug-outside-map (current-local-map)) | |
1472 | (edebug-outside-standard-output standard-output) | |
1473 | (edebug-outside-standard-input standard-input) | |
1474 | ||
1475 | (edebug-outside-last-command-char last-command-char) | |
1476 | (edebug-outside-last-command last-command) | |
1477 | (edebug-outside-this-command this-command) | |
1478 | (edebug-outside-last-input-char last-input-char) | |
1479 | ;; (edebug-outside-unread-command-char unread-command-char) | |
1480 | ||
1481 | ;; Declare the following local variables to protect global values. | |
1482 | ;; We could set these to the values for previous edebug call. | |
1483 | ;; But instead make it local, but use global value. | |
1484 | (last-command-char last-command-char) | |
1485 | (last-command last-command) | |
1486 | (this-command this-command) | |
1487 | (last-input-char last-input-char) | |
dbc4e1c1 | 1488 | ;; Assume no edebug command sets unread-command-events. |
84fc2cfa ER |
1489 | ;; (unread-command-char -1) |
1490 | ||
1491 | (debug-on-error debug-on-error) | |
1492 | ||
1493 | ;; others?? | |
1494 | ) | |
1495 | ||
1496 | (if (and (eq edebug-mode 'go) | |
1497 | (not (memq edebug-arg-mode '(exit error)))) | |
1498 | (message "Break")) | |
1499 | (edebug-mode) | |
1500 | (if (boundp 'edebug-outside-debug-on-error) | |
1501 | (setq debug-on-error edebug-outside-debug-on-error)) | |
1502 | ||
1503 | (setq buffer-read-only t) | |
1504 | (unwind-protect | |
1505 | (recursive-edit) ; <<<<<<<<<< Recursive edit | |
1506 | ||
1507 | ;; Do the following, even if quit occurs. | |
1508 | (if edebug-backtrace-buffer | |
1509 | (kill-buffer edebug-backtrace-buffer)) | |
1510 | ;; Could be an option to keep eval display up. | |
1511 | (if edebug-eval-buffer (kill-buffer edebug-eval-buffer)) | |
1512 | ||
1513 | ;; Remember selected-window after recursive-edit. | |
1514 | (setq edebug-inside-window (selected-window)) | |
1515 | ||
1516 | (store-match-data edebug-outside-match-data) | |
1517 | ||
1518 | ;; Recursive edit may have changed buffers, | |
1519 | ;; so set it back before exiting let. | |
1520 | (if (buffer-name edebug-buffer) ; if it still exists | |
1521 | (progn | |
1522 | (set-buffer edebug-buffer) | |
1523 | (if (memq edebug-mode '(go Go-nonstop)) | |
1524 | (edebug-overlay-arrow)) | |
1525 | (setq buffer-read-only edebug-buffer-read-only) | |
1526 | (use-local-map edebug-outside-map) | |
1527 | ;; Remember current window-start for next visit. | |
1528 | (select-window edebug-window) | |
1529 | (if (eq edebug-buffer (window-buffer edebug-window)) | |
1530 | (setq edebug-window-start (window-start))) | |
1531 | (select-window edebug-inside-window) | |
1532 | )) | |
1533 | ))) | |
1534 | ||
1535 | \f | |
1536 | ;;-------------------------- | |
1537 | ;; Display related functions | |
1538 | ||
1539 | (defun edebug-adjust-window (old-start) | |
1540 | "Adjust window to fit as much as possible following point. | |
1541 | The display should prefer to start at OLD-START if point is not visible. | |
1542 | Return the new window-start." | |
1543 | (if (not (pos-visible-in-window-p)) | |
1544 | (progn | |
1545 | (set-window-start (selected-window) old-start) | |
1546 | (if (not (pos-visible-in-window-p)) | |
1547 | (let ((start (window-start)) | |
1548 | (pnt (point))) | |
1549 | (set-window-start | |
1550 | (selected-window) | |
1551 | (save-excursion | |
1552 | (forward-line | |
1553 | (if (< pnt start) -1 ; one line before | |
1554 | (- (/ (window-height) 2)) ; center the line | |
1555 | )) | |
1556 | (beginning-of-line) | |
1557 | (point))))))) | |
1558 | (window-start)) | |
1559 | ||
1560 | ||
1561 | (defconst edebug-arrow-alist | |
1562 | '((Continue-fast . ">") | |
1563 | (Trace-fast . ">") | |
1564 | (continue . ">") | |
1565 | (trace . "->") | |
1566 | (step . "=>") | |
1567 | (go . "<>") | |
1568 | (Go-nonstop . "..") ; not used | |
1569 | ) | |
1570 | "Association list of arrows for each edebug mode. | |
1571 | If you come up with arrows that make more sense, let me know.") | |
1572 | ||
1573 | (defun edebug-overlay-arrow () | |
1574 | "Set up the overlay arrow at beginning-of-line in current buffer. | |
1575 | The arrow string is derived from edebug-arrow-alist and edebug-mode." | |
1576 | (let* ((pos)) | |
1577 | (save-excursion | |
1578 | (beginning-of-line) | |
1579 | (setq pos (point))) | |
1580 | (setq overlay-arrow-string | |
1581 | (cdr (assq edebug-mode edebug-arrow-alist))) | |
1582 | (setq overlay-arrow-position (make-marker)) | |
1583 | (set-marker overlay-arrow-position pos (current-buffer)))) | |
1584 | ||
1585 | ||
1586 | (put 'edebug-outside-excursion 'edebug-form-hook | |
1587 | '(&rest form)) | |
1588 | ||
1589 | (defmacro edebug-outside-excursion (&rest body) | |
1590 | "Evaluate an expression list in the outside context. | |
1591 | Return the result of the last expression." | |
1592 | (` (save-excursion ; of current-buffer | |
1593 | (if edebug-save-windows | |
1594 | (progn | |
1595 | ;; After excursion, we will | |
1596 | ;; restore to current window configuration. | |
1597 | (setq edebug-inside-windows | |
1598 | (edebug-current-window-configuration)) | |
1599 | ;; Restore outside windows. | |
1600 | (edebug-set-window-configuration edebug-outside-windows))) | |
1601 | ||
1602 | (set-buffer edebug-buffer) | |
1603 | ;; Restore outside context. | |
1604 | (let ((edebug-inside-map (current-local-map)) | |
1605 | (last-command-char edebug-outside-last-command-char) | |
1606 | (last-command edebug-outside-last-command) | |
1607 | (this-command edebug-outside-this-command) | |
1608 | ;; (unread-command-char edebug-outside-unread-command-char) | |
1609 | (last-input-char edebug-outside-last-input-char) | |
1610 | (overlay-arrow-position edebug-outside-o-a-p) | |
1611 | (overlay-arrow-string edebug-outside-o-a-s) | |
1612 | (cursor-in-echo-area edebug-outside-c-i-e-a) | |
1613 | (standard-output edebug-outside-standard-output) | |
1614 | (standard-input edebug-outside-standard-input) | |
1615 | (executing-macro edebug-outside-executing-macro) | |
1616 | ) | |
1617 | (unwind-protect | |
1618 | (save-restriction | |
1619 | (narrow-to-region edebug-outside-point-min | |
1620 | edebug-outside-point-max) | |
1621 | (save-excursion ; of edebug-buffer | |
1622 | (if edebug-save-point | |
1623 | (progn | |
1624 | (goto-char edebug-outside-edebug-point) | |
1625 | (if (mark-marker) | |
1626 | (set-marker (mark-marker) | |
1627 | edebug-outside-edebug-mark)) | |
1628 | )) | |
1629 | (use-local-map edebug-outside-map) | |
1630 | (store-match-data edebug-outside-match-data) | |
1631 | (select-window edebug-outside-window) | |
1632 | (set-buffer edebug-outside-buffer) | |
1633 | (goto-char edebug-outside-point) | |
1634 | (,@ body) | |
1635 | ) ; save-excursion | |
1636 | ) ; save-restriction | |
1637 | ;; Back to edebug-buffer. Restore rest of inside context. | |
1638 | (use-local-map edebug-inside-map) | |
1639 | (if edebug-save-windows | |
1640 | ;; Restore inside windows. | |
1641 | (edebug-set-window-configuration edebug-inside-windows)) | |
1642 | )) ; let | |
1643 | ))) | |
1644 | ||
1645 | ||
1646 | (defun edebug-toggle-save-windows () | |
1647 | "Toggle the edebug-save-windows variable. | |
1648 | Each time you toggle it, the inside and outside window configurations | |
1649 | become the same as the current configuration." | |
1650 | (interactive) | |
1651 | (if (setq edebug-save-windows (not edebug-save-windows)) | |
1652 | (setq edebug-inside-windows | |
1653 | (setq edebug-outside-windows | |
1654 | (edebug-current-window-configuration)))) | |
1655 | (message "Window saving is %s." | |
1656 | (if edebug-save-windows "on" "off"))) | |
1657 | ||
1658 | ||
1659 | (defun edebug-where () | |
1660 | "Show the debug windows and where we stopped in the program." | |
1661 | (interactive) | |
1662 | (if (not edebug-active) | |
4897b0a0 | 1663 | (error "edebug is not active")) |
84fc2cfa ER |
1664 | (edebug-pop-to-buffer edebug-buffer) |
1665 | (goto-char edebug-point) ; from edebug | |
1666 | ) | |
1667 | ||
1668 | (defun edebug-view-outside () | |
1669 | "Change to the outside window configuration." | |
1670 | (interactive) | |
1671 | (if (not edebug-active) | |
4897b0a0 | 1672 | (error "edebug is not active")) |
84fc2cfa ER |
1673 | (setq edebug-inside-windows (edebug-current-window-configuration)) |
1674 | (edebug-set-window-configuration edebug-outside-windows) | |
1675 | (goto-char edebug-outside-point) | |
1676 | (message "Window configuration outside of edebug. Return with %s" | |
1677 | (substitute-command-keys "\\<global-map>\\[edebug-where]"))) | |
1678 | ||
1679 | ||
1680 | (defun edebug-bounce-point () | |
1681 | "Bounce the point in the outside current buffer." | |
1682 | (interactive) | |
1683 | (if (not edebug-active) | |
4897b0a0 | 1684 | (error "edebug is not active")) |
84fc2cfa ER |
1685 | (save-excursion |
1686 | ;; If the buffer's currently displayed, avoid the set-window-configuration. | |
1687 | (save-window-excursion | |
1688 | (edebug-pop-to-buffer edebug-outside-buffer) | |
1689 | ;; (edebug-sit-for 1) ; this shouldnt be necessary | |
1690 | (goto-char edebug-outside-point) | |
1691 | ;; (message "current buffer: %s" (current-buffer)) | |
1692 | (edebug-sit-for 1) | |
1693 | (edebug-pop-to-buffer edebug-buffer)))) | |
1694 | ||
1695 | ||
1696 | \f | |
1697 | ;;-------------------------- | |
1698 | ;; epoch related things | |
1699 | ||
1700 | (defvar edebug-epoch-running (and (boundp 'epoch::version) epoch::version) | |
1701 | "non-nil if epoch is running. | |
1702 | Windows are handled a little differently under epoch.") | |
1703 | ||
1704 | ||
1705 | (defun edebug-current-window-configuration () | |
f98955ea | 1706 | "Return the current window or frame configuration." |
84fc2cfa ER |
1707 | (if edebug-epoch-running |
1708 | (edebug-current-screen-configuration) | |
1709 | (current-window-configuration))) | |
1710 | ||
1711 | ||
1712 | (defun edebug-set-window-configuration (conf) | |
f98955ea | 1713 | "Set the window or frame configuration to CONF." |
84fc2cfa ER |
1714 | (if edebug-epoch-running |
1715 | (edebug-set-screen-configuration conf) | |
1716 | (set-window-configuration conf))) | |
1717 | ||
1718 | ||
1719 | (defun edebug-get-buffer-window (buffer) | |
1720 | (if edebug-epoch-running | |
1721 | (epoch::get-buffer-window buffer) | |
1722 | (get-buffer-window buffer))) | |
1723 | ||
1724 | ||
1725 | (defun edebug-pop-to-buffer (buffer) | |
f98955ea | 1726 | "Like pop-to-buffer, but select a frame that buffer was shown in." |
84fc2cfa ER |
1727 | (let ((edebug-window (edebug-get-buffer-window buffer))) |
1728 | (if edebug-window | |
1729 | (select-window edebug-window) | |
1730 | ;; It is not currently displayed, so find some place to display it. | |
1731 | (if edebug-epoch-running | |
1732 | ;; Select a screen that the buffer has been displayed in before | |
1733 | ;; or the current screen otherwise. | |
1734 | (select-screen | |
1735 | ;; allowed-screens in epoch 3.2, was called screens before that | |
1736 | (or (car (symbol-buffer-value 'allowed-screens buffer)) | |
1737 | (epoch::current-screen)))) | |
1738 | (if (one-window-p) | |
1739 | (split-window)) | |
1740 | (select-window (next-window)) | |
1741 | (set-window-buffer (selected-window) buffer) | |
1742 | (set-window-hscroll (selected-window) 0) | |
1743 | )) | |
1744 | ;; Selecting the window does not set the buffer. | |
1745 | (set-buffer buffer) | |
1746 | ) | |
1747 | ||
1748 | ||
1749 | (defun edebug-current-screen-configuration () | |
1750 | "Return an object recording the current configuration of Epoch screen-list. | |
1751 | The object is a list of pairs of the form (SCREEN . CONFIGURATION) | |
1752 | where SCREEN has window-configuration CONFIGURATION. The current | |
1753 | screen is the head of the list." | |
1754 | (let ((screen-list (epoch::screen-list 'unmapped)) | |
1755 | (current-screen (epoch::get-screen)) | |
1756 | (current-buffer (current-buffer)) | |
1757 | ) | |
1758 | ;; put current screen first | |
1759 | (setq screen-list (cons current-screen (delq current-screen screen-list))) | |
1760 | (prog1 | |
1761 | (mapcar (function | |
1762 | (lambda (screen) | |
1763 | (cons screen | |
1764 | (progn | |
1765 | (epoch::select-screen screen) | |
1766 | (current-window-configuration))))) | |
1767 | screen-list) | |
1768 | (epoch::select-screen current-screen) | |
1769 | (set-buffer current-buffer) | |
1770 | ))) | |
1771 | ||
1772 | (defun edebug-set-screen-configuration (sc) | |
1773 | "Set the window-configuration for all the screens in SC. | |
1774 | Set the current screen to be the head of SC." | |
1775 | (mapcar (function | |
1776 | (lambda (screen-conf) | |
1777 | (if (epoch::screen-p (car screen-conf)) ; still exist? | |
1778 | (progn | |
1779 | (epoch::select-screen (car screen-conf)) | |
1780 | (set-window-configuration (cdr screen-conf)))))) | |
1781 | sc) | |
1782 | (if (epoch::screen-p (car (car sc))) | |
1783 | (epoch::select-screen (car (car sc)))) | |
1784 | ) | |
1785 | ||
1786 | ||
1787 | (defun edebug-sit-for (arg) | |
1788 | (if edebug-epoch-running | |
1789 | (epoch::dispatch-events)) | |
1790 | (sit-for arg) | |
1791 | ) | |
1792 | ||
1793 | (defun edebug-input-pending-p () | |
1794 | (if edebug-epoch-running | |
1795 | (epoch::dispatch-events)) | |
1796 | (input-pending-p) | |
1797 | ) | |
1798 | ||
1799 | ||
1800 | \f | |
1801 | ;;-------------------------- | |
1802 | ;; breakpoint related functions | |
1803 | ||
1804 | (defun edebug-find-stop-point () | |
1805 | "Return (function . index) of the nearest edebug stop point." | |
1806 | (let* ((def-name (edebug-which-function)) | |
1807 | (edebug-data | |
1808 | (or (get def-name 'edebug) | |
1809 | (error | |
4897b0a0 | 1810 | "%s must first be evaluated with edebug-defun" def-name))) |
84fc2cfa ER |
1811 | ;; pull out parts of edebug-data. |
1812 | (edebug-func-mark (car edebug-data)) | |
1813 | (edebug-breakpoints (car (cdr edebug-data))) | |
1814 | ||
1815 | (offset-vector (car (cdr (cdr edebug-data)))) | |
1816 | (offset (- (save-excursion | |
1817 | (if (looking-at "[ \t]") | |
1818 | ;; skip backwards until non-whitespace, or bol | |
1819 | (skip-chars-backward " \t")) | |
1820 | (point)) | |
1821 | edebug-func-mark)) | |
1822 | len i) | |
1823 | ;; the offsets are in order so we can do a linear search | |
1824 | (setq len (length offset-vector)) | |
1825 | (setq i 0) | |
1826 | (while (and (< i len) (> offset (aref offset-vector i))) | |
1827 | (setq i (1+ i))) | |
1828 | (if (and (< i len) | |
1829 | (<= offset (aref offset-vector i))) | |
1830 | ;; return the relevant info | |
1831 | (cons def-name i) | |
1832 | (message "Point is not on an expression in %s." | |
1833 | def-name) | |
1834 | ))) | |
1835 | ||
1836 | ||
1837 | (defun edebug-next-breakpoint () | |
1838 | "Move point to the next breakpoint, or first if none past point." | |
1839 | (interactive) | |
1840 | (let ((edebug-stop-point (edebug-find-stop-point))) | |
1841 | (if edebug-stop-point | |
1842 | (let* ((def-name (car edebug-stop-point)) | |
1843 | (index (cdr edebug-stop-point)) | |
1844 | (edebug-data (get def-name 'edebug)) | |
1845 | ||
1846 | ;; pull out parts of edebug-data | |
1847 | (edebug-func-mark (car edebug-data)) | |
1848 | (edebug-breakpoints (car (cdr edebug-data))) | |
1849 | (offset-vector (car (cdr (cdr edebug-data)))) | |
1850 | breakpoint) | |
1851 | (if (not edebug-breakpoints) | |
1852 | (message "No breakpoints in this function.") | |
1853 | (let ((breaks edebug-breakpoints)) | |
1854 | (while (and breaks | |
1855 | (<= (car (car breaks)) index)) | |
1856 | (setq breaks (cdr breaks))) | |
1857 | (setq breakpoint | |
1858 | (if breaks | |
1859 | (car breaks) | |
1860 | ;; goto the first breakpoint | |
1861 | (car edebug-breakpoints))) | |
1862 | (goto-char (+ edebug-func-mark | |
1863 | (aref offset-vector (car breakpoint)))) | |
1864 | ||
1865 | (message (concat (if (car (cdr (cdr breakpoint))) | |
1866 | "Temporary " "") | |
1867 | (if (car (cdr breakpoint)) | |
1868 | (format "Condition: %s" | |
1869 | (prin1-to-string | |
1870 | (car (cdr breakpoint)))) | |
1871 | ""))) | |
1872 | )))))) | |
1873 | ||
1874 | ||
1875 | (defun edebug-modify-breakpoint (flag &optional condition temporary) | |
1876 | "Modify the breakpoint for the form at point or after it according | |
1877 | to FLAG: set if t, clear if nil. Then move to that point. | |
1878 | If CONDITION or TEMPORARY are non-nil, add those attributes to | |
1879 | the breakpoint. " | |
1880 | (let ((edebug-stop-point (edebug-find-stop-point))) | |
1881 | (if edebug-stop-point | |
1882 | (let* ((def-name (car edebug-stop-point)) | |
1883 | (index (cdr edebug-stop-point)) | |
1884 | (edebug-data (get def-name 'edebug)) | |
1885 | ||
1886 | ;; pull out parts of edebug-data | |
1887 | (edebug-func-mark (car edebug-data)) | |
1888 | (edebug-breakpoints (car (cdr edebug-data))) | |
1889 | (offset-vector (car (cdr (cdr edebug-data)))) | |
1890 | present) | |
1891 | ;; delete it either way | |
1892 | (setq present (assq index edebug-breakpoints)) | |
1893 | (setq edebug-breakpoints (delq present edebug-breakpoints)) | |
1894 | (if flag | |
1895 | (progn | |
1896 | ;; add it to the list and resort | |
1897 | (setq edebug-breakpoints | |
1898 | (edebug-sort-alist | |
1899 | (cons | |
1900 | (list index condition temporary) | |
1901 | edebug-breakpoints) '<)) | |
1902 | (message "Breakpoint set in %s." def-name)) | |
1903 | (if present | |
1904 | (message "Breakpoint unset in %s." def-name) | |
1905 | (message "No breakpoint here."))) | |
1906 | ||
1907 | (setcdr edebug-data | |
1908 | (cons edebug-breakpoints (cdr (cdr edebug-data)))) | |
1909 | (goto-char (+ edebug-func-mark (aref offset-vector index))) | |
1910 | )))) | |
1911 | ||
1912 | (defun edebug-set-breakpoint (arg) | |
1913 | "Set the breakpoint of nearest sexp. | |
1914 | With prefix argument, make it a temporary breakpoint." | |
1915 | (interactive "P") | |
1916 | (edebug-modify-breakpoint t nil arg)) | |
1917 | ||
1918 | (defun edebug-unset-breakpoint () | |
1919 | "Clear the breakpoint of nearest sexp." | |
1920 | (interactive) | |
1921 | (edebug-modify-breakpoint nil)) | |
1922 | ||
1923 | (defun edebug-set-conditional-breakpoint (arg condition) | |
1924 | "Set a conditional breakpoint at nearest sexp. | |
1925 | The condition is evaluated in the outside context. | |
1926 | With prefix argument, make it a temporary breakpoint." | |
1927 | (interactive "P\nxCondition: ") | |
1928 | (edebug-modify-breakpoint t condition arg)) | |
1929 | ||
1930 | \f | |
1931 | ;;-------------------------- | |
1932 | ;; Mode switching functions | |
1933 | ||
1934 | (defun edebug-set-mode (mode shortmsg msg) | |
1935 | "Set the edebug mode to MODE. | |
1936 | Display SHORTMSG, or MSG if not within edebug." | |
1937 | (interactive) | |
1938 | (setq edebug-mode mode) | |
1939 | (if (< 0 edebug-depth) | |
1940 | (if (eq (current-buffer) edebug-buffer) | |
1941 | (progn | |
1942 | (message shortmsg) | |
1943 | (exit-recursive-edit))) | |
1944 | (message msg))) | |
1945 | ||
1946 | ||
1947 | (defun edebug-step-through () | |
1948 | "Proceed to next debug step." | |
1949 | (interactive) | |
1950 | (edebug-set-mode 'step "" "edebug will stop before next eval.")) | |
1951 | ||
1952 | (defun edebug-go (arg) | |
1953 | "Go, evaluating until break. | |
1954 | With ARG set temporary break at stop point and go." | |
1955 | (interactive "P") | |
1956 | (if arg | |
1957 | (edebug-set-breakpoint t)) | |
1958 | (edebug-set-mode 'go "Go..." "edebug will go until break.")) | |
1959 | ||
1960 | (defun edebug-Go-nonstop () | |
1961 | "Go, evaluating without debugging." | |
1962 | (interactive) | |
1963 | (edebug-set-mode 'Go-nonstop "Go-Nonstop..." | |
1964 | "edebug will not stop at breaks.")) | |
1965 | ||
1966 | (defun edebug-forward-sexp (arg) | |
1967 | "Proceed from the current point to the end of the ARGth sexp ahead. | |
1968 | If there are not ARG sexps ahead, then do edebug-step-out." | |
1969 | (interactive "p") | |
1970 | (condition-case err | |
1971 | (let ((parse-sexp-ignore-comments t)) | |
1972 | ;; Call forward-sexp repeatedly until done or failure. | |
1973 | (forward-sexp arg) | |
1974 | (edebug-go t)) | |
1975 | (error | |
1976 | (edebug-step-out) | |
1977 | ))) | |
1978 | ||
1979 | (defun edebug-step-out () | |
1980 | "Proceed from the current point to the end of the containing sexp. | |
1981 | If there is no containing sexp that is not the top level defun, | |
1982 | go to the end of the last sexp, or if that is the same point, then step." | |
1983 | (interactive) | |
1984 | (condition-case err | |
1985 | (let ((parse-sexp-ignore-comments t)) | |
1986 | (up-list 1) | |
1987 | (save-excursion | |
1988 | ;; Is there still a containing expression? | |
1989 | (up-list 1)) | |
1990 | (edebug-go t)) | |
1991 | (error | |
1992 | ;; At top level - 1, so first check if there are more sexps at this level. | |
1993 | (let ((start-point (point))) | |
1994 | ;; (up-list 1) | |
1995 | (down-list -1) | |
1996 | (if (= (point) start-point) | |
1997 | (edebug-step-through) ; No more at this level, so step. | |
1998 | (edebug-go t) | |
1999 | ))))) | |
2000 | ||
2001 | ||
2002 | (defun edebug-goto-here () | |
2003 | "Proceed to this stop point." | |
2004 | (interactive) | |
2005 | (edebug-go t) | |
2006 | ) | |
2007 | ||
2008 | (defun edebug-trace () | |
2009 | "Begin trace mode." | |
2010 | (interactive) | |
2011 | (edebug-set-mode 'trace "Tracing..." "edebug will trace with pause.")) | |
2012 | ||
2013 | (defun edebug-Trace-fast () | |
2014 | "Trace with no wait at each step." | |
2015 | (interactive) | |
2016 | (edebug-set-mode 'Trace-fast | |
2017 | "Trace fast..." "edebug will trace without pause.")) | |
2018 | ||
2019 | (defun edebug-continue () | |
2020 | "Begin continue mode." | |
2021 | (interactive) | |
2022 | (edebug-set-mode 'continue "Continue..." | |
2023 | "edebug will pause at breakpoints.")) | |
2024 | ||
2025 | (defun edebug-Continue-fast () | |
2026 | "Trace with no wait at each step." | |
2027 | (interactive) | |
2028 | (edebug-set-mode 'Continue-fast "Continue fast..." | |
2029 | "edebug will stop and go at breakpoints.")) | |
2030 | ||
2031 | ||
2032 | (defun edebug-step-in () | |
2033 | "Step into the function about to be called. | |
2034 | Do this before the arguments are evaluated since otherwise it will be | |
2035 | too late. One side effect of using edebug-step-in is that the next | |
2036 | time the function is called, edebug will be called there as well." | |
2037 | (interactive) | |
2038 | (if (not (eq 'enter edebug-arg-mode)) | |
4897b0a0 | 2039 | (error "You must be in front of a function or macro call")) |
84fc2cfa ER |
2040 | (let* ((func (car edebug-exp)) |
2041 | (func-marker (get func 'edebug))) | |
2042 | (cond | |
2043 | ((markerp func-marker) | |
2044 | (save-excursion | |
2045 | (set-buffer (marker-buffer func-marker)) | |
2046 | (goto-char func-marker) | |
2047 | (edebug-defun))) | |
2048 | ((listp func-marker) | |
2049 | ;; its already been evaluated for edebug | |
2050 | nil) | |
4897b0a0 | 2051 | (t (error "You must first evaluate %s in a buffer" func)))) |
84fc2cfa ER |
2052 | (exit-recursive-edit)) |
2053 | ||
2054 | ||
2055 | ;;(defun edebug-exit-out () | |
2056 | ;; "Go until the current function exits." | |
2057 | ;; (interactive) | |
2058 | ;; (edebug-set-mode 'exiting "Exit...")) | |
2059 | ||
2060 | ||
2061 | (defun edebug-stop () | |
2062 | "Useful for exiting from trace loop." | |
2063 | (interactive) | |
2064 | (message "Stop")) | |
2065 | ||
2066 | ||
2067 | ;;; The following initial mode setting definitions are not used yet. | |
2068 | ||
2069 | (defconst edebug-initial-mode-alist | |
2070 | '((edebug-Continue-fast . Continue-fast) | |
2071 | (edebug-Trace-fast . Trace-fast) | |
2072 | (edebug-continue . continue) | |
2073 | (edebug-trace . trace) | |
2074 | (edebug-go . go) | |
2075 | (edebug-step-through . step) | |
2076 | (edebug-Go-nonstop . Go-nonstop) | |
2077 | ) | |
2078 | "Association list between commands and the modes they set.") | |
2079 | ||
2080 | ||
2081 | (defun edebug-set-initial-mode () | |
2082 | "Ask for the initial mode of the enclosing function. | |
2083 | The mode is requested via the key that would be used to set the mode in | |
2084 | edebug-mode." | |
2085 | (interactive) | |
2086 | (let* ((this-function (edebug-which-function)) | |
2087 | (keymap (if (eq edebug-mode-map (current-local-map)) | |
2088 | edebug-mode-map)) | |
2089 | (old-mode (or (get this-function 'edebug-initial-mode) | |
2090 | edebug-initial-mode)) | |
2091 | (key (read-key-sequence | |
2092 | (format | |
2093 | "Change initial edebug mode for %s from %s (%s) to (enter key): " | |
2094 | this-function | |
2095 | old-mode | |
2096 | (where-is-internal | |
2097 | (car (rassq old-mode edebug-initial-mode-alist)) | |
2098 | keymap 'firstonly | |
2099 | )))) | |
2100 | (mode (cdr (assq (key-binding key) edebug-initial-mode-alist))) | |
2101 | ) | |
2102 | (if (and mode | |
2103 | (or (get this-function 'edebug-initial-mode) | |
2104 | (not (eq mode edebug-initial-mode)))) | |
2105 | (progn | |
2106 | (put this-function 'edebug-initial-mode mode) | |
2107 | (message "Initial mode for %s is now: %s" | |
2108 | this-function mode)) | |
4897b0a0 | 2109 | (error "Key must map to one of the mode changing commands") |
84fc2cfa ER |
2110 | ))) |
2111 | ||
2112 | ||
2113 | \f | |
2114 | ;;-------------------------- | |
2115 | ;; Evaluation of expressions | |
2116 | ||
2117 | (defvar edebug-previous-result nil | |
2118 | "Last result returned from an expression.") | |
2119 | ||
2120 | (defun edebug-previous-result () | |
2121 | "Return the previous result." | |
2122 | (interactive) | |
2123 | (let ((print-escape-newlines t) | |
2124 | (print-length 20)) | |
2125 | (message "Result: %s" (prin1-to-string edebug-previous-result)))) | |
2126 | ||
2127 | ||
2128 | (defun edebug-eval (expr) | |
2129 | "Evaluate EXPR in the outside environment." | |
2130 | (if (not edebug-active) | |
4897b0a0 | 2131 | (error "edebug is not active")) |
84fc2cfa ER |
2132 | (edebug-outside-excursion |
2133 | (eval expr))) | |
2134 | ||
2135 | (defun edebug-eval-expression (expr) | |
2136 | "Prompt and evaluate an expression in the outside environment. | |
2137 | Print result in minibuffer." | |
2138 | (interactive "xEval: ") | |
2139 | (prin1 (edebug-eval expr))) | |
2140 | ||
2141 | (defun edebug-eval-last-sexp () | |
2142 | "Evaluate sexp before point in the outside environment; | |
2143 | print value in minibuffer." | |
2144 | (interactive) | |
2145 | (prin1 (edebug-eval (edebug-last-sexp)))) | |
2146 | ||
2147 | (defun edebug-eval-print-last-sexp () | |
2148 | "Evaluate sexp before point in the outside environment; | |
2149 | print value into current buffer." | |
2150 | (interactive) | |
2151 | (let ((standard-output (current-buffer))) | |
2152 | ||
2153 | (condition-case err | |
2154 | (edebug-eval (edebug-last-sexp)) | |
2155 | (error (format "%s: %s" | |
2156 | (get (car err) 'error-message) | |
2157 | (car (cdr err)))))))) | |
2158 | \f | |
2159 | ;;;--------------------------------- | |
2160 | ;;; edebug minor mode initialization | |
2161 | ||
2162 | (defvar edebug-mode 'step | |
2163 | "Current edebug mode set by user.") | |
2164 | ||
2165 | (defvar edebug-mode-map nil) | |
2166 | (if edebug-mode-map | |
2167 | nil | |
2168 | (progn | |
2169 | (setq edebug-mode-map (copy-keymap emacs-lisp-mode-map)) | |
2170 | ;; control | |
2171 | (define-key edebug-mode-map " " 'edebug-step-through) | |
2172 | (define-key edebug-mode-map "g" 'edebug-go) | |
2173 | (define-key edebug-mode-map "G" 'edebug-Go-nonstop) | |
2174 | (define-key edebug-mode-map "t" 'edebug-trace) | |
2175 | (define-key edebug-mode-map "T" 'edebug-Trace-fast) | |
2176 | (define-key edebug-mode-map "c" 'edebug-continue) | |
2177 | (define-key edebug-mode-map "C" 'edebug-Continue-fast) | |
2178 | ||
2179 | (define-key edebug-mode-map "f" 'edebug-forward-sexp) | |
2180 | (define-key edebug-mode-map "h" 'edebug-goto-here) | |
2181 | ||
2182 | (define-key edebug-mode-map "r" 'edebug-previous-result) | |
2183 | ||
2184 | (define-key edebug-mode-map "i" 'edebug-step-in) | |
2185 | (define-key edebug-mode-map "o" 'edebug-step-out) | |
2186 | ||
2187 | ;; (define-key edebug-mode-map "m" 'edebug-set-initial-mode) | |
2188 | ||
2189 | (define-key edebug-mode-map "q" 'top-level) | |
2190 | (define-key edebug-mode-map "a" 'abort-recursive-edit) | |
2191 | (define-key edebug-mode-map "S" 'edebug-stop) | |
2192 | ||
2193 | ;; breakpoints | |
2194 | (define-key edebug-mode-map "b" 'edebug-set-breakpoint) | |
2195 | (define-key edebug-mode-map "u" 'edebug-unset-breakpoint) | |
2196 | (define-key edebug-mode-map "B" 'edebug-next-breakpoint) | |
2197 | (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint) | |
2198 | ||
2199 | ;; evaluation | |
2200 | (define-key edebug-mode-map "e" 'edebug-eval-expression) | |
2201 | (define-key edebug-mode-map "\C-x\C-e" 'edebug-eval-last-sexp) | |
2202 | (define-key edebug-mode-map "E" 'edebug-visit-eval-list) | |
2203 | ||
2204 | ;; views | |
2205 | (define-key edebug-mode-map "w" 'edebug-where) | |
2206 | (define-key edebug-mode-map "v" 'edebug-view-outside) | |
2207 | (define-key edebug-mode-map "p" 'edebug-bounce-point) | |
2208 | (define-key edebug-mode-map "W" 'edebug-toggle-save-windows) | |
2209 | ||
2210 | ;; misc | |
2211 | (define-key edebug-mode-map "?" 'edebug-help) | |
2212 | (define-key edebug-mode-map "d" 'edebug-backtrace) | |
2213 | ||
2214 | (define-key edebug-mode-map "-" 'negative-argument) | |
2215 | )) | |
2216 | ||
85dd3810 | 2217 | ;;;###autoload |
84fc2cfa ER |
2218 | (defvar global-edebug-prefix "\^XX" |
2219 | "Prefix key for global edebug commands, available from any buffer.") | |
2220 | ||
85dd3810 | 2221 | ;;;###autoload |
84fc2cfa ER |
2222 | (defvar global-edebug-map nil |
2223 | "Global map of edebug commands, available from any buffer.") | |
2224 | ||
85dd3810 | 2225 | ;;;###autoload |
84fc2cfa ER |
2226 | (if global-edebug-map |
2227 | nil | |
2228 | (setq global-edebug-map (make-sparse-keymap)) | |
2229 | ||
2230 | (global-unset-key global-edebug-prefix) | |
2231 | (global-set-key global-edebug-prefix global-edebug-map) | |
2232 | ||
2233 | ;; (define-key global-edebug-map "X" 'edebug-step-through) | |
85dd3810 | 2234 | (define-key global-edebug-map "d" 'edebug-defun) |
84fc2cfa ER |
2235 | (define-key global-edebug-map " " 'edebug-step-through) |
2236 | (define-key global-edebug-map "g" 'edebug-go) | |
2237 | (define-key global-edebug-map "G" 'edebug-Go-nonstop) | |
2238 | (define-key global-edebug-map "t" 'edebug-trace) | |
2239 | (define-key global-edebug-map "T" 'edebug-Trace-fast) | |
2240 | (define-key global-edebug-map "c" 'edebug-continue) | |
2241 | (define-key global-edebug-map "C" 'edebug-Continue-fast) | |
2242 | ||
2243 | ;; (define-key global-edebug-map "m" 'edebug-set-initial-mode) | |
2244 | (define-key global-edebug-map "b" 'edebug-set-breakpoint) | |
2245 | (define-key global-edebug-map "x" 'edebug-set-conditional-breakpoint) | |
2246 | (define-key global-edebug-map "u" 'edebug-unset-breakpoint) | |
2247 | (define-key global-edebug-map "w" 'edebug-where) | |
2248 | (define-key global-edebug-map "q" 'top-level) | |
2249 | ) | |
2250 | ||
2251 | ||
2252 | (defun edebug-help () | |
2253 | (interactive) | |
2254 | (describe-function 'edebug-mode)) | |
2255 | ||
2256 | ||
2257 | (defun edebug-mode () | |
3a801d0c | 2258 | "Mode for Emacs Lisp buffers while in edebug. Under construction. |
84fc2cfa ER |
2259 | |
2260 | There are both buffer local and global key bindings to several | |
2261 | functions. E.g. edebug-step-through is bound to | |
2262 | \\[edebug-step-through] in the debug buffer and | |
2263 | \\<global-map>\\[edebug-step-through] in any buffer. | |
2264 | ||
2265 | edebug buffer commands: | |
2266 | \\{edebug-mode-map} | |
2267 | ||
2268 | Global commands prefixed by global-edbug-prefix: | |
2269 | \\{global-edebug-map} | |
2270 | ||
2271 | Options: | |
2272 | edebug-all-defuns | |
2273 | edebug-eval-macro-args | |
2274 | edebug-stop-before-symbols | |
2275 | edebug-save-windows | |
2276 | edebug-save-point | |
2277 | edebug-save-buffer-points | |
2278 | edebug-initial-mode | |
2279 | edebug-trace | |
2280 | " | |
2281 | (use-local-map edebug-mode-map)) | |
2282 | ||
2283 | ||
2284 | \f | |
2285 | ;;=============================================== | |
2286 | ;; edebug eval list mode | |
2287 | ;; A list of expressions and their evaluations is displayed | |
2288 | ;; in edebug-eval-buffer | |
2289 | ||
2290 | (defvar edebug-eval-list nil | |
2291 | "List of expressions to evaluate.") | |
2292 | ||
2293 | ;;(defvar edebug-eval-buffer "*edebug*" | |
2294 | ;; "*Declared globally so edebug-eval-display can be called independent | |
2295 | ;;of edebug (not implemented yet).") | |
2296 | ||
2297 | ||
2298 | (defun edebug-eval-result-list () | |
2299 | "Return a list of evaluations of edebug-eval-list" | |
2300 | ;; Assumes in outside environment. | |
2301 | (mapcar (function | |
2302 | (lambda (expr) | |
2303 | (condition-case err | |
2304 | (eval expr) | |
2305 | (error (format "%s: %s" | |
2306 | (get (car err) 'error-message) | |
2307 | (car (cdr err)))) | |
2308 | ))) | |
2309 | edebug-eval-list)) | |
2310 | ||
2311 | (defun edebug-eval-display-list (edebug-eval-result-list) | |
2312 | ;; Assumes edebug-eval-buffer exists. | |
2313 | (let ((edebug-eval-list-temp edebug-eval-list) | |
2314 | (standard-output edebug-eval-buffer) | |
2315 | (edebug-display-line | |
2316 | (format ";%s\n" (make-string (- (window-width) 2) ?-)))) | |
2317 | (edebug-pop-to-buffer edebug-eval-buffer) | |
2318 | (erase-buffer) | |
2319 | (while edebug-eval-list-temp | |
2320 | (prin1 (car edebug-eval-list-temp)) (terpri) | |
2321 | (prin1 (car edebug-eval-result-list)) (terpri) | |
2322 | (princ edebug-display-line) | |
2323 | (setq edebug-eval-list-temp (cdr edebug-eval-list-temp)) | |
2324 | (setq edebug-eval-result-list (cdr edebug-eval-result-list))) | |
2325 | )) | |
2326 | ||
2327 | (defun edebug-create-eval-buffer () | |
2328 | (if (not (and edebug-eval-buffer (buffer-name edebug-eval-buffer))) | |
2329 | (progn | |
2330 | (set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*"))) | |
2331 | (edebug-eval-mode)))) | |
2332 | ||
2333 | ;; Should generalize this to be callable outside of edebug | |
2334 | ;; with calls in user functions, e.g. (edebug-eval-display) | |
2335 | ||
2336 | (defun edebug-eval-display (edebug-eval-result-list) | |
2337 | "Display expressions and evaluations in EVAL-LIST. | |
2338 | It modifies the context by popping up the eval display." | |
2339 | (if edebug-eval-result-list | |
2340 | (progn | |
2341 | (edebug-create-eval-buffer) | |
2342 | (edebug-pop-to-buffer edebug-eval-buffer) | |
2343 | (edebug-eval-display-list edebug-eval-result-list) | |
2344 | ))) | |
2345 | ||
2346 | (defun edebug-eval-redisplay () | |
2347 | "Redisplay eval list in outside environment. | |
2348 | May only be called from within edebug-recursive-edit." | |
2349 | (edebug-create-eval-buffer) | |
2350 | (edebug-pop-to-buffer edebug-eval-buffer) | |
2351 | (edebug-outside-excursion | |
2352 | (edebug-eval-display-list (edebug-eval-result-list)) | |
2353 | )) | |
2354 | ||
2355 | (defun edebug-visit-eval-list () | |
2356 | (interactive) | |
2357 | (edebug-eval-redisplay) | |
2358 | (edebug-pop-to-buffer edebug-eval-buffer)) | |
2359 | ||
2360 | ||
2361 | (defun edebug-update-eval-list () | |
2362 | "Replace the evaluation list with the sexps now in the eval buffer." | |
2363 | (interactive) | |
2364 | (let ((starting-point (point)) | |
2365 | new-list) | |
2366 | (goto-char (point-min)) | |
2367 | ;; get the first expression | |
2368 | (edebug-skip-whitespace) | |
2369 | (if (not (eobp)) | |
2370 | (progn | |
2371 | (forward-sexp 1) | |
2372 | (setq new-list (cons (edebug-last-sexp) new-list)))) | |
2373 | ||
2374 | (while (re-search-forward "^;" nil t) | |
2375 | (forward-line 1) | |
2376 | (skip-chars-forward " \t\n\r") | |
2377 | (if (and (/= ?\; (following-char)) | |
2378 | (not (eobp))) | |
2379 | (progn | |
2380 | (forward-sexp 1) | |
2381 | (setq new-list (cons (edebug-last-sexp) new-list))))) | |
2382 | ||
2383 | (setq edebug-eval-list (nreverse new-list)) | |
2384 | (edebug-eval-redisplay) | |
2385 | (goto-char starting-point))) | |
2386 | ||
2387 | ||
2388 | (defun edebug-delete-eval-item () | |
2389 | "Delete the item under point and redisplay." | |
2390 | ;; could add arg to do repeatedly | |
2391 | (interactive) | |
2392 | (if (re-search-backward "^;" nil 'nofail) | |
2393 | (forward-line 1)) | |
2394 | (delete-region | |
2395 | (point) (progn (re-search-forward "^;" nil 'nofail) | |
2396 | (beginning-of-line) | |
2397 | (point))) | |
2398 | (edebug-update-eval-list)) | |
2399 | ||
2400 | ||
2401 | ||
2402 | (defvar edebug-eval-mode-map nil | |
2403 | "Keymap for edebug-eval-mode. Superset of lisp-interaction-mode.") | |
2404 | ||
2405 | (if edebug-eval-mode-map | |
2406 | nil | |
2407 | (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map)) | |
2408 | ||
2409 | (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where) | |
2410 | (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item) | |
2411 | (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list) | |
2412 | (define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp) | |
2413 | (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp) | |
2414 | ) | |
2415 | ||
2416 | ||
2417 | (defun edebug-eval-mode () | |
2418 | "Mode for data display buffer while in edebug. Under construction. | |
2419 | ... ignore the following... | |
2420 | There are both buffer local and global key bindings to several | |
2421 | functions. E.g. edebug-step-through is bound to | |
2422 | \\[edebug-step-through] in the debug buffer and | |
2423 | \\<global-map>\\[edebug-step-through] in any buffer. | |
2424 | ||
2425 | Eval list buffer commands: | |
2426 | \\{edebug-eval-mode-map} | |
2427 | ||
2428 | Global commands prefixed by global-edbug-prefix: | |
2429 | \\{global-edebug-map} | |
2430 | " | |
2431 | (lisp-interaction-mode) | |
2432 | (setq major-mode 'edebug-eval-mode) | |
2433 | (setq mode-name "Edebug-Eval") | |
2434 | (use-local-map edebug-eval-mode-map)) | |
2435 | ||
2436 | ||
2437 | ;;======================================== | |
2438 | ;; Interface with standard debugger. | |
2439 | ||
2440 | (setq debugger 'edebug-debug) | |
2441 | ;; (setq debugger 'debug) ; use the default | |
2442 | ||
2443 | ;; Note that debug and its utilities must be byte-compiled to work, since | |
2444 | ;; they depend on the backtrace looking a certain way. | |
2445 | ||
daa37602 | 2446 | ;;;###autoload |
84fc2cfa ER |
2447 | (defun edebug-debug (&rest debugger-args) |
2448 | "Replacement for debug. | |
2449 | If an error or quit occurred and we are running an edebugged function, | |
2450 | show where we last were. Otherwise call debug normally." | |
2451 | (if (and edebug-backtrace ; anything active? | |
2452 | (eq (recursion-depth) edebug-recursion-depth) | |
2453 | ) | |
2454 | ||
2455 | ;; Where were we before the error occurred? | |
2456 | (let ((edebug-offset-index (car edebug-offset-indices)) | |
2457 | (edebug-arg-mode (car debugger-args)) | |
2458 | (edebug-exp (car (cdr debugger-args))) | |
2459 | edebug-break-data | |
2460 | edebug-break | |
2461 | (edebug-outside-debug-on-eror debug-on-error) | |
2462 | (debug-on-error nil)) | |
2463 | (edebug-display) | |
2464 | ) | |
2465 | ||
2466 | ;; Otherwise call debug normally. | |
2467 | ;; Still need to remove extraneous edebug calls from stack. | |
2468 | (apply 'debug debugger-args) | |
2469 | )) | |
2470 | ||
2471 | ||
2472 | (defun edebug-backtrace () | |
2473 | "Display a non-working backtrace. Better than nothing..." | |
2474 | (interactive) | |
2475 | (let ((old-buf (current-buffer))) | |
2476 | (if (not edebug-backtrace-buffer) | |
2477 | (setq edebug-backtrace-buffer | |
2478 | (let ((default-major-mode 'fundamental-mode)) | |
2479 | (generate-new-buffer "*Backtrace*")))) | |
2480 | (edebug-pop-to-buffer edebug-backtrace-buffer) | |
2481 | (erase-buffer) | |
2482 | (let ((standard-output (current-buffer)) | |
2483 | (print-escape-newlines t) | |
2484 | (print-length 50) | |
2485 | last-ok-point | |
2486 | ) | |
2487 | (setq truncate-lines t) | |
2488 | (backtrace) | |
2489 | ||
2490 | ;; Clean up the backtrace. | |
2491 | (goto-char (point-min)) | |
2492 | (delete-region | |
2493 | (point) | |
2494 | (progn | |
2495 | ;; Everything up to the first edebug is internal. | |
2496 | (re-search-forward "^ edebug(") | |
2497 | (forward-line 1) | |
2498 | (point))) | |
2499 | (forward-line 1) | |
2500 | (setq last-ok-point (point)) | |
2501 | ||
2502 | ;; Delete interspersed edebug internals. | |
2503 | (while (re-search-forward "^ edebug" nil t) | |
2504 | (if (looking-at "-enter") | |
2505 | ;; delete extraneous progn at top level of function body | |
2506 | (save-excursion | |
2507 | (goto-char last-ok-point) | |
2508 | (forward-line -1) | |
2509 | (setq last-ok-point (point)))) | |
2510 | (forward-line 1) | |
2511 | (delete-region last-ok-point (point)) | |
2512 | (forward-line 1) ; skip past the good line | |
2513 | (setq last-ok-point (point)) | |
2514 | ) | |
2515 | ) | |
2516 | (edebug-pop-to-buffer old-buf) | |
2517 | )) | |
2518 | ||
2519 | \f | |
2520 | ;;======================================================================== | |
2521 | ;; Trace display - append text to a buffer, and update display. | |
2522 | ;;; e.g. | |
2523 | ;;; (edebug-trace-display | |
2524 | ;;; "*trace-point*" | |
2525 | ;;; "saving: point = %s window-start = %s\n" | |
2526 | ;;; (point) (window-start)) | |
2527 | ||
2528 | (defun edebug-trace-display (buf-name fmt &rest args) | |
2529 | "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible. | |
2530 | The buffer is created if it does not exist. | |
2531 | You must include newlines in FMT to break lines." | |
2532 | (let* ((selected-window (selected-window)) | |
2533 | (buffer (get-buffer-create buf-name)) | |
2534 | (buf-window)) | |
2535 | (edebug-pop-to-buffer buffer) | |
2536 | (save-excursion | |
2537 | (setq buf-window (selected-window)) | |
2538 | (set-buffer buffer) | |
2539 | (goto-char (point-max)) | |
2540 | (insert (apply 'format fmt args)) | |
2541 | (set-window-point buf-window (point)) | |
2542 | (forward-line (- 1 (window-height buf-window))) | |
2543 | (set-window-start buf-window (point)) | |
2544 | ;; (edebug-sit-for 1) | |
2545 | (bury-buffer buffer) | |
2546 | ) | |
2547 | (select-window selected-window))) | |
2548 | ||
e8544af2 RS |
2549 | (provide 'edebug) |
2550 | ||
84fc2cfa | 2551 | ;;; edebug.el ends here |