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