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