|
0
|
1 ;;; edebug.el --- a source-level debugger for Emacs Lisp
|
|
|
2
|
|
|
3 ;; Copyright (C) 1988,'89,'90,'91,'92,'93,'94,'95 Free Software Foundation, Inc
|
|
|
4
|
|
|
5 ;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
|
|
|
6 ;; Keywords: lisp, tools, maint
|
|
|
7
|
|
|
8 ;; LCD Archive Entry:
|
|
|
9 ;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu
|
|
|
10 ;; |A source level debugger for Emacs Lisp.
|
|
|
11 ;; |$Date: 1996/12/18 03:33:28 $|$Revision: 1.1.1.1 $|~/modes/edebug.el|
|
|
|
12
|
|
|
13 ;; This file is part of GNU Emacs.
|
|
|
14
|
|
|
15 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
16 ;; it under the terms of the GNU General Public License as published by
|
|
|
17 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
18 ;; any later version.
|
|
|
19
|
|
|
20 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
23 ;; GNU General Public License for more details.
|
|
|
24
|
|
|
25 ;; You should have received a copy of the GNU General Public License
|
|
|
26 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
27 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
28
|
|
|
29 ;;;; Commentary:
|
|
|
30
|
|
|
31 ;;; This minor mode allows programmers to step through Emacs Lisp
|
|
|
32 ;;; source code while executing functions. You can also set
|
|
|
33 ;;; breakpoints, trace (stopping at each expression), evaluate
|
|
|
34 ;;; expressions as if outside Edebug, reevaluate and display a list of
|
|
|
35 ;;; expressions, trap errors normally caught by debug, and display a
|
|
|
36 ;;; debug style backtrace.
|
|
|
37
|
|
|
38 ;;;; Installation
|
|
|
39 ;;; =============
|
|
|
40
|
|
|
41 ;;; Put edebug.el in some directory in your load-path and
|
|
|
42 ;;; byte-compile it. Also read the beginning of edebug-epoch.el,
|
|
|
43 ;;; cl-specs.el, and edebug-cl-read.el if they apply to you.
|
|
|
44
|
|
|
45 ;;; Unless you are using Emacs 19 which is already set up to use Edebug,
|
|
|
46 ;;; put the following forms in your .emacs file.
|
|
|
47 ;;; (define-key emacs-lisp-mode-map "\C-xx" 'edebug-eval-top-level-form)
|
|
|
48 ;;; (autoload 'edebug-eval-top-level-form "edebug")
|
|
|
49
|
|
|
50 ;;; If you wish to change the default edebug global command prefix, change:
|
|
|
51 ;;; (setq edebug-global-prefix "\C-xX")
|
|
|
52
|
|
|
53 ;;; Other options, are described in the manual.
|
|
|
54
|
|
|
55 ;;; In previous versions of Edebug, users were directed to set
|
|
|
56 ;;; `debugger' to `edebug-debug'. This is no longer necessary
|
|
|
57 ;;; since Edebug automatically sets it whenever Edebug is active.
|
|
|
58
|
|
|
59 ;;;; Minimal Instructions
|
|
|
60 ;;; =====================
|
|
|
61
|
|
|
62 ;;; First evaluate a defun with C-xx, then run the function. Step
|
|
|
63 ;;; through the code with SPC, mark breakpoints with b, go until a
|
|
|
64 ;;; breakpoint is reached with g, and quit execution with q. Use the
|
|
|
65 ;;; "?" command in edebug to describe other commands. See edebug.tex
|
|
|
66 ;;; or the Emacs 19 Lisp Reference Manual for more instructions.
|
|
|
67
|
|
|
68 ;;; Send me your enhancements, ideas, bugs, or fixes.
|
|
|
69 ;;; For bugs, you can call edebug-submit-bug-report if you have reporter.el.
|
|
|
70 ;;; There is an edebug mailing list if you want to keep up
|
|
|
71 ;;; with the latest developments. Requests to: edebug-request@cs.uiuc.edu
|
|
|
72
|
|
|
73 ;;; Daniel LaLiberte 217-398-4114
|
|
|
74 ;;; University of Illinois, Urbana-Champaign
|
|
|
75 ;;; Department of Computer Science
|
|
|
76 ;;; 1304 W Springfield
|
|
|
77 ;;; Urbana, IL 61801
|
|
|
78
|
|
|
79 ;;; uiucdcs!liberte
|
|
|
80 ;;; liberte@cs.uiuc.edu
|
|
|
81
|
|
|
82 ;;; ===============================
|
|
|
83 ;;; For the early revision history, see edebug-history.
|
|
|
84
|
|
|
85 (defconst edebug-version
|
|
|
86 (let ((raw-version "$Revision: 1.1.1.1 $"))
|
|
|
87 (substring raw-version (string-match "[0-9.]*" raw-version)
|
|
|
88 (match-end 0))))
|
|
|
89
|
|
|
90 (require 'backquote)
|
|
|
91
|
|
|
92 ;; Emacs 18 doesnt have defalias.
|
|
|
93 (eval-and-compile
|
|
|
94 (or (fboundp 'defalias) (fset 'defalias 'fset)))
|
|
|
95
|
|
|
96
|
|
|
97 ;;;; Bug reporting
|
|
|
98 ;;; ==============
|
|
|
99
|
|
|
100 (defconst edebug-maintainer-address "liberte@cs.uiuc.edu")
|
|
|
101
|
|
|
102 (defun edebug-submit-bug-report ()
|
|
|
103 "Submit, via mail, a bug report on edebug."
|
|
|
104 (interactive)
|
|
|
105 (require 'reporter)
|
|
|
106 (and (y-or-n-p "Do you really want to submit a report on edebug? ")
|
|
|
107 (reporter-submit-bug-report
|
|
|
108 edebug-maintainer-address
|
|
|
109 (concat "edebug.el " edebug-version)
|
|
|
110 (list 'edebug-setup-hook
|
|
|
111 'edebug-all-defs
|
|
|
112 'edebug-all-forms
|
|
|
113 'edebug-eval-macro-args
|
|
|
114 'edebug-stop-before-symbols
|
|
|
115 'edebug-save-windows
|
|
|
116 'edebug-save-displayed-buffer-points
|
|
|
117 'edebug-initial-mode
|
|
|
118 'edebug-trace
|
|
|
119 'edebug-test-coverage
|
|
|
120 'edebug-continue-kbd-macro
|
|
|
121 'edebug-print-length
|
|
|
122 'edebug-print-level
|
|
|
123 'edebug-print-circle
|
|
|
124 ))))
|
|
|
125
|
|
|
126
|
|
|
127 ;;;; Options
|
|
|
128 ;;; ===============================
|
|
|
129
|
|
|
130 (defvar edebug-setup-hook nil
|
|
|
131 "*Functions to call before edebug is used.
|
|
|
132 Each time it is set to a new value, Edebug will call those functions
|
|
|
133 once and then `edebug-setup-hook' is reset to nil. You could use this
|
|
|
134 to load up Edebug specifications associated with a package you are
|
|
|
135 using but only when you also use Edebug.")
|
|
|
136
|
|
|
137 (defvar edebug-all-defs nil
|
|
|
138 "*If non-nil, evaluation of any defining forms will instrument for Edebug.
|
|
|
139 This applies to `eval-defun', `eval-region', `eval-buffer', and
|
|
|
140 `eval-current-buffer'. `eval-region' is also called by
|
|
|
141 `eval-last-sexp', and `eval-print-last-sexp'.
|
|
|
142
|
|
|
143 You can use the command `edebug-all-defs' to toggle the value of this
|
|
|
144 variable. You may wish to make it local to each buffer with
|
|
|
145 \(make-local-variable 'edebug-all-defs) in your
|
|
|
146 `emacs-lisp-mode-hook'.")
|
|
|
147
|
|
|
148 (defvar edebug-all-forms nil
|
|
|
149 "*Non-nil evaluation of all forms will instrument for Edebug.
|
|
|
150 This doesn't apply to loading or evaluations in the minibuffer.
|
|
|
151 Use the command `edebug-all-forms' to toggle the value of this option.")
|
|
|
152
|
|
|
153 (defvar edebug-eval-macro-args nil
|
|
|
154 "*Non-nil means all macro call arguments may be evaluated.
|
|
|
155 If this variable is nil, the default, Edebug will *not* wrap
|
|
|
156 macro call arguments as if they will be evaluated.
|
|
|
157 For each macro, a `edebug-form-spec' overrides this option.
|
|
|
158 So to specify exceptions for macros that have some arguments evaluated
|
|
|
159 and some not, you should specify an `edebug-form-spec'.
|
|
|
160
|
|
|
161 This option is going away soon.")
|
|
|
162
|
|
|
163 (defvar edebug-stop-before-symbols nil
|
|
|
164 "*Non-nil causes Edebug to stop before symbols as well as after.
|
|
|
165 In any case, a breakpoint or interrupt may stop before a symbol.
|
|
|
166
|
|
|
167 This option is going away soon.")
|
|
|
168
|
|
|
169 (defvar edebug-save-windows t
|
|
|
170 "*If non-nil, Edebug saves and restores the window configuration.
|
|
|
171 That takes some time, so if your program does not care what happens to
|
|
|
172 the window configurations, it is better to set this variable to nil.
|
|
|
173
|
|
|
174 If the value is a list, only the listed windows are saved and
|
|
|
175 restored.
|
|
|
176
|
|
|
177 `edebug-toggle-save-windows' may be used to change this variable.")
|
|
|
178
|
|
|
179 (defvar edebug-save-displayed-buffer-points nil
|
|
|
180 "*If non-nil, save and restore point in all displayed buffers.
|
|
|
181
|
|
|
182 Saving and restoring point in other buffers is necessary if you are
|
|
|
183 debugging code that changes the point of a buffer which is displayed
|
|
|
184 in a non-selected window. If Edebug or the user then selects the
|
|
|
185 window, the buffer's point will be changed to the window's point.
|
|
|
186
|
|
|
187 Saving and restoring point in all buffers is expensive, since it
|
|
|
188 requires selecting each window twice, so enable this only if you need
|
|
|
189 it.")
|
|
|
190
|
|
|
191 (defvar edebug-initial-mode 'step
|
|
|
192 "*Initial execution mode for Edebug, if non-nil. If this variable
|
|
|
193 is non-@code{nil}, it specifies the initial execution mode for Edebug
|
|
|
194 when it is first activated. Possible values are step, next, go,
|
|
|
195 Go-nonstop, trace, Trace-fast, continue, and Continue-fast.")
|
|
|
196
|
|
|
197 (defvar edebug-trace nil
|
|
|
198 "*Non-nil means display a trace of function entry and exit.
|
|
|
199 Tracing output is displayed in a buffer named `*edebug-trace*', one
|
|
|
200 function entry or exit per line, indented by the recursion level.
|
|
|
201
|
|
|
202 You can customize by replacing functions `edebug-print-trace-before'
|
|
|
203 and `edebug-print-trace-after'.")
|
|
|
204
|
|
|
205 (defvar edebug-test-coverage nil
|
|
|
206 "*If non-nil, Edebug tests coverage of all expressions debugged.
|
|
|
207 This is done by comparing the result of each expression
|
|
|
208 with the previous result. Coverage is considered OK if two different
|
|
|
209 results are found.
|
|
|
210
|
|
|
211 Use `edebug-display-freq-count' to display the frequency count and
|
|
|
212 coverage information for a definition.")
|
|
|
213
|
|
|
214 (defvar edebug-continue-kbd-macro nil
|
|
|
215 "*If non-nil, continue defining or executing any keyboard macro.
|
|
|
216 Use this with caution since it is not debugged.")
|
|
|
217
|
|
|
218
|
|
|
219 (defvar edebug-print-length 50
|
|
|
220 "*Default value of `print-length' to use while printing results in Edebug.")
|
|
|
221 (defvar edebug-print-level 50
|
|
|
222 "*Default value of `print-level' to use while printing results in Edebug.")
|
|
|
223 (defvar edebug-print-circle t
|
|
|
224 "*Default value of `print-circle' to use while printing results in Edebug.")
|
|
|
225
|
|
|
226 (defvar edebug-unwrap-results nil
|
|
|
227 "*Non-nil if Edebug should unwrap results of expressions.
|
|
|
228 This is useful when debugging macros where the results of expressions
|
|
|
229 are instrumented expressions. But don't do this when results might be
|
|
|
230 circular or an infinite loop will result.")
|
|
|
231
|
|
|
232 (defvar edebug-on-error t
|
|
|
233 "*Value bound to `debug-on-error' while Edebug is active.
|
|
|
234
|
|
|
235 If `debug-on-error' is non-nil, that value is still used.
|
|
|
236
|
|
|
237 If the value is a list of signal names, Edebug will stop when any of
|
|
|
238 these errors are signaled from Lisp code whether or not the signal is
|
|
|
239 handled by a `condition-case'. This option is useful for debugging
|
|
|
240 signals that *are* handled since they would otherwise be missed.
|
|
|
241 After execution is resumed, the error is signaled again.")
|
|
|
242
|
|
|
243 (defvar edebug-on-quit t
|
|
|
244 "*Value bound to `debug-on-quit' while Edebug is active.")
|
|
|
245
|
|
|
246 (defvar edebug-global-break-condition nil
|
|
|
247 "*If non-nil, an expression to test for at every stop point.
|
|
|
248 If the result is non-nil, then break. Errors are ignored.")
|
|
|
249
|
|
|
250
|
|
|
251 ;;;; Form spec utilities.
|
|
|
252 ;;; ===============================
|
|
|
253
|
|
|
254 ;;;###autoload
|
|
|
255 (defmacro def-edebug-spec (symbol spec)
|
|
|
256 "Set the edebug-form-spec property of SYMBOL according to SPEC.
|
|
|
257 Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
|
|
|
258 \(naming a function), or a list."
|
|
|
259 (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
|
|
|
260
|
|
|
261 (defmacro def-edebug-form-spec (symbol spec-form)
|
|
|
262 "For compatibility with old version. Use `def-edebug-spec' instead."
|
|
|
263 (message "Obsolete: use def-edebug-spec instead.")
|
|
|
264 (def-edebug-spec symbol (eval spec-form)))
|
|
|
265
|
|
|
266 (defun get-edebug-spec (symbol)
|
|
|
267 ;; Get the spec of symbol resolving all indirection.
|
|
|
268 (let ((edebug-form-spec (get symbol 'edebug-form-spec))
|
|
|
269 indirect)
|
|
|
270 (while (and (symbolp edebug-form-spec)
|
|
|
271 (setq indirect (get edebug-form-spec 'edebug-form-spec)))
|
|
|
272 ;; (edebug-trace "indirection: %s" edebug-form-spec)
|
|
|
273 (setq edebug-form-spec indirect))
|
|
|
274 edebug-form-spec
|
|
|
275 ))
|
|
|
276
|
|
|
277
|
|
|
278 ;;;; Utilities
|
|
|
279 ;;; ===============================
|
|
|
280
|
|
|
281 ;; Define edebug-gensym - from old cl.el
|
|
|
282 (defvar edebug-gensym-index 0
|
|
|
283 "Integer used by `edebug-gensym' to produce new names.")
|
|
|
284
|
|
|
285 (defun edebug-gensym (&optional prefix)
|
|
|
286 "Generate a fresh uninterned symbol.
|
|
|
287 There is an optional argument, PREFIX. PREFIX is the
|
|
|
288 string that begins the new name. Most people take just the default,
|
|
|
289 except when debugging needs suggest otherwise."
|
|
|
290 (if (null prefix)
|
|
|
291 (setq prefix "G"))
|
|
|
292 (let ((newsymbol nil)
|
|
|
293 (newname ""))
|
|
|
294 (while (not newsymbol)
|
|
|
295 (setq newname (concat prefix (int-to-string edebug-gensym-index)))
|
|
|
296 (setq edebug-gensym-index (+ edebug-gensym-index 1))
|
|
|
297 (if (not (intern-soft newname))
|
|
|
298 (setq newsymbol (make-symbol newname))))
|
|
|
299 newsymbol))
|
|
|
300
|
|
|
301 ;; Only used by CL-like code.
|
|
|
302 (defun edebug-keywordp (object)
|
|
|
303 "Return t if OBJECT is a keyword.
|
|
|
304 A keyword is a symbol that starts with `:'."
|
|
|
305 (and (symbolp object)
|
|
|
306 (= ?: (aref (symbol-name object) 0))))
|
|
|
307
|
|
|
308 (defun edebug-lambda-list-keywordp (object)
|
|
|
309 "Return t if OBJECT is a lambda list keyword.
|
|
|
310 A lambda list keyword is a symbol that starts with `&'."
|
|
|
311 (and (symbolp object)
|
|
|
312 (= ?& (aref (symbol-name object) 0))))
|
|
|
313
|
|
|
314
|
|
|
315 (defun edebug-last-sexp ()
|
|
|
316 ;; Return the last sexp before point in current buffer.
|
|
|
317 ;; Assumes Emacs Lisp syntax is active.
|
|
|
318 (car
|
|
|
319 (read-from-string
|
|
|
320 (buffer-substring
|
|
|
321 (save-excursion
|
|
|
322 (forward-sexp -1)
|
|
|
323 (point))
|
|
|
324 (point)))))
|
|
|
325
|
|
|
326 (defun edebug-window-list ()
|
|
|
327 "Return a list of windows, in order of `next-window'."
|
|
|
328 ;; This doesnt work for epoch.
|
|
|
329 (let* ((first-window (selected-window))
|
|
|
330 (window-list (list first-window))
|
|
|
331 (next (next-window first-window)))
|
|
|
332 (while (not (eq next first-window))
|
|
|
333 (setq window-list (cons next window-list))
|
|
|
334 (setq next (next-window next)))
|
|
|
335 (nreverse window-list)))
|
|
|
336
|
|
|
337 (defun edebug-window-live-p (window)
|
|
|
338 "Return non-nil if WINDOW is visible."
|
|
|
339 (let* ((first-window (selected-window))
|
|
|
340 (next (next-window first-window t)))
|
|
|
341 (while (not (or (eq next window)
|
|
|
342 (eq next first-window)))
|
|
|
343 (setq next (next-window next t)))
|
|
|
344 (eq next window)))
|
|
|
345
|
|
|
346 ;; Not used.
|
|
|
347 '(defun edebug-two-window-p ()
|
|
|
348 "Return t if there are two windows."
|
|
|
349 (and (not (one-window-p))
|
|
|
350 (eq (selected-window)
|
|
|
351 (next-window (next-window (selected-window))))))
|
|
|
352
|
|
|
353 (defsubst edebug-lookup-function (object)
|
|
|
354 (while (and (symbolp object) (fboundp object))
|
|
|
355 (setq object (symbol-function object)))
|
|
|
356 object)
|
|
|
357
|
|
|
358 (defun edebug-macrop (object)
|
|
|
359 "Return the macro named by OBJECT, or nil if it is not a macro."
|
|
|
360 (setq object (edebug-lookup-function object))
|
|
|
361 (if (and (listp object)
|
|
|
362 (eq 'macro (car object))
|
|
|
363 (edebug-functionp (cdr object)))
|
|
|
364 object))
|
|
|
365
|
|
|
366 (defun edebug-functionp (object)
|
|
|
367 "Returns the function named by OBJECT, or nil if it is not a function."
|
|
|
368 (setq object (edebug-lookup-function object))
|
|
|
369 (if (or (subrp object)
|
|
|
370 (byte-code-function-p object)
|
|
|
371 (and (listp object)
|
|
|
372 (eq (car object) 'lambda)
|
|
|
373 (listp (car (cdr object)))))
|
|
|
374 object))
|
|
|
375
|
|
|
376 (defun edebug-sort-alist (alist function)
|
|
|
377 ;; Return the ALIST sorted with comparison function FUNCTION.
|
|
|
378 ;; This uses 'sort so the sorting is destructive.
|
|
|
379 (sort alist (function
|
|
|
380 (lambda (e1 e2)
|
|
|
381 (funcall function (car e1) (car e2))))))
|
|
|
382
|
|
|
383 ;;(def-edebug-spec edebug-save-restriction t)
|
|
|
384
|
|
|
385 ;; Not used. If it is used, def-edebug-spec must be defined before use.
|
|
|
386 '(defmacro edebug-save-restriction (&rest body)
|
|
|
387 "Evaluate BODY while saving the current buffers restriction.
|
|
|
388 BODY may change buffer outside of current restriction, unlike
|
|
|
389 save-restriction. BODY may change the current buffer,
|
|
|
390 and the restriction will be restored to the original buffer,
|
|
|
391 and the current buffer remains current.
|
|
|
392 Return the result of the last expression in BODY."
|
|
|
393 (` (let ((edebug:s-r-beg (point-min-marker))
|
|
|
394 (edebug:s-r-end (point-max-marker)))
|
|
|
395 (unwind-protect
|
|
|
396 (progn (,@ body))
|
|
|
397 (save-excursion
|
|
|
398 (set-buffer (marker-buffer edebug:s-r-beg))
|
|
|
399 (narrow-to-region edebug:s-r-beg edebug:s-r-end))))))
|
|
|
400
|
|
|
401 ;;;; Display
|
|
|
402 ;;; ============
|
|
|
403
|
|
|
404 (defconst edebug-trace-buffer "*edebug-trace*"
|
|
|
405 "Name of the buffer to put trace info in.")
|
|
|
406
|
|
|
407 (defun edebug-pop-to-buffer (buffer &optional window)
|
|
|
408 ;; Like pop-to-buffer, but select window where BUFFER was last shown.
|
|
|
409 ;; Select WINDOW if it provided and it still exists. Otherwise,
|
|
|
410 ;; if buffer is currently shown in several windows, choose one.
|
|
|
411 ;; Otherwise, find a new window, possibly splitting one.
|
|
|
412 (setq window (if (and (windowp window) (edebug-window-live-p window)
|
|
|
413 (eq (window-buffer window) buffer))
|
|
|
414 window
|
|
|
415 (if (eq (window-buffer (selected-window)) buffer)
|
|
|
416 (selected-window)
|
|
|
417 (edebug-get-buffer-window buffer))))
|
|
|
418 (if window
|
|
|
419 (select-window window)
|
|
|
420 (if (one-window-p)
|
|
|
421 (split-window))
|
|
|
422 ;; (message "next window: %s" (next-window)) (sit-for 1)
|
|
|
423 (if (eq (get-buffer-window edebug-trace-buffer) (next-window))
|
|
|
424 ;; Dont select trace window
|
|
|
425 nil
|
|
|
426 (select-window (next-window))))
|
|
|
427 (set-window-buffer (selected-window) buffer)
|
|
|
428 (set-window-hscroll (selected-window) 0);; should this be??
|
|
|
429 ;; Selecting the window does not set the buffer until command loop.
|
|
|
430 ;;(set-buffer buffer)
|
|
|
431 )
|
|
|
432
|
|
|
433
|
|
|
434 (defun edebug-get-displayed-buffer-points ()
|
|
|
435 ;; Return a list of buffer point pairs, for all displayed buffers.
|
|
|
436 (save-excursion
|
|
|
437 (let* ((first-window (selected-window))
|
|
|
438 (next (next-window first-window))
|
|
|
439 (buffer-point-list nil)
|
|
|
440 buffer)
|
|
|
441 (while (not (eq next first-window))
|
|
|
442 (set-buffer (setq buffer (window-buffer next)))
|
|
|
443 (setq buffer-point-list
|
|
|
444 (cons (cons buffer (point)) buffer-point-list))
|
|
|
445 (setq next (next-window next)))
|
|
|
446 buffer-point-list)))
|
|
|
447
|
|
|
448
|
|
|
449 (defun edebug-set-buffer-points (buffer-points)
|
|
|
450 ;; Restore the buffer-points created by edebug-get-displayed-buffer-points.
|
|
|
451 (let ((current-buffer (current-buffer)))
|
|
|
452 (mapcar (function (lambda (buf-point)
|
|
|
453 (if (buffer-name (car buf-point)) ; still exists
|
|
|
454 (progn
|
|
|
455 (set-buffer (car buf-point))
|
|
|
456 (goto-char (cdr buf-point))))))
|
|
|
457 buffer-points)
|
|
|
458 (set-buffer current-buffer)))
|
|
|
459
|
|
|
460 (defun edebug-current-windows (which-windows)
|
|
|
461 ;; Get either a full window configuration or some window information.
|
|
|
462 (if (listp which-windows)
|
|
|
463 (mapcar (function (lambda (window)
|
|
|
464 (if (edebug-window-live-p window)
|
|
|
465 (list window
|
|
|
466 (window-buffer window)
|
|
|
467 (window-point window)
|
|
|
468 (window-start window)
|
|
|
469 (window-hscroll window)))))
|
|
|
470 which-windows)
|
|
|
471 (current-window-configuration)))
|
|
|
472
|
|
|
473 (defun edebug-set-windows (window-info)
|
|
|
474 ;; Set either a full window configuration or some window information.
|
|
|
475 (if (listp window-info)
|
|
|
476 (mapcar (function
|
|
|
477 (lambda (one-window-info)
|
|
|
478 (if one-window-info
|
|
|
479 (apply (function
|
|
|
480 (lambda (window buffer point start hscroll)
|
|
|
481 (if (edebug-window-live-p window)
|
|
|
482 (progn
|
|
|
483 (set-window-buffer window buffer)
|
|
|
484 (set-window-point window point)
|
|
|
485 (set-window-start window start)
|
|
|
486 (set-window-hscroll window hscroll)))))
|
|
|
487 one-window-info))))
|
|
|
488 window-info)
|
|
|
489 (set-window-configuration window-info)))
|
|
|
490
|
|
|
491 (defalias 'edebug-get-buffer-window 'get-buffer-window)
|
|
|
492 (defalias 'edebug-sit-for 'sit-for)
|
|
|
493 (defalias 'edebug-input-pending-p 'input-pending-p)
|
|
|
494
|
|
|
495
|
|
|
496 ;;;; Redefine read and eval functions
|
|
|
497 ;;; =================================
|
|
|
498 ;;; read is redefined to maybe instrument forms.
|
|
|
499 ;;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
|
|
|
500
|
|
|
501 ;;; Use the Lisp version of eval-region.
|
|
|
502 (require 'eval-reg "eval-reg")
|
|
|
503
|
|
|
504 ;; Save the original read function
|
|
|
505 (or (fboundp 'edebug-original-read)
|
|
|
506 (defalias 'edebug-original-read (symbol-function 'read)))
|
|
|
507
|
|
|
508 (defun edebug-read (&optional stream)
|
|
|
509 "Read one Lisp expression as text from STREAM, return as Lisp object.
|
|
|
510 If STREAM is nil, use the value of `standard-input' (which see).
|
|
|
511 STREAM or the value of `standard-input' may be:
|
|
|
512 a buffer (read from point and advance it)
|
|
|
513 a marker (read from where it points and advance it)
|
|
|
514 a function (call it with no arguments for each character,
|
|
|
515 call it with a char as argument to push a char back)
|
|
|
516 a string (takes text from string, starting at the beginning)
|
|
|
517 t (read text line using minibuffer and use it).
|
|
|
518
|
|
|
519 This version, from Edebug, maybe instruments the expression. But the
|
|
|
520 STREAM must be the current buffer to do so. Whether it instuments is
|
|
|
521 also dependent on the values of `edebug-all-defs' and
|
|
|
522 `edebug-all-forms'."
|
|
|
523 (or stream (setq stream standard-input))
|
|
|
524 (if (eq stream (current-buffer))
|
|
|
525 (edebug-read-and-maybe-wrap-form)
|
|
|
526 (edebug-original-read stream)))
|
|
|
527
|
|
|
528 (or (fboundp 'edebug-original-eval-defun)
|
|
|
529 (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun)))
|
|
|
530
|
|
|
531 (defun edebug-eval-defun (edebug-it)
|
|
|
532 "Evaluate the top-level form containing point, or after point.
|
|
|
533
|
|
|
534 This version, from Edebug, has the following differences: With a
|
|
|
535 prefix argument instrument the code for Edebug. If `edebug-all-defs' is
|
|
|
536 non-nil, then the code is instrumented *unless* there is a prefix
|
|
|
537 argument. If instrumenting, it prints: `Edebug: FUNCTIONNAME'.
|
|
|
538 Otherwise, it prints in the minibuffer."
|
|
|
539 (interactive "P")
|
|
|
540 (let ((edebugging (not (eq (not edebug-it) (not edebug-all-defs))))
|
|
|
541 (edebug-result))
|
|
|
542 (setq edebug-result
|
|
|
543 (eval
|
|
|
544 (let ((edebug-all-forms edebugging)
|
|
|
545 (edebug-all-defs (eq edebug-all-defs (not edebug-it))))
|
|
|
546 (edebug-read-top-level-form))))
|
|
|
547 (if (not edebugging)
|
|
|
548 (princ edebug-result)
|
|
|
549 edebug-result)))
|
|
|
550
|
|
|
551
|
|
|
552 ;;;###autoload
|
|
|
553 (defalias 'edebug-defun 'edebug-eval-top-level-form)
|
|
|
554
|
|
|
555 ;;;###autoload
|
|
|
556 (defun edebug-eval-top-level-form ()
|
|
|
557 "Evaluate a top level form, such as a defun or defmacro.
|
|
|
558 This is like `eval-defun', but the code is always instrumented for Edebug.
|
|
|
559 Print its name in the minibuffer and leave point where it is,
|
|
|
560 or if an error occurs, leave point after it with mark at the original point."
|
|
|
561 (interactive)
|
|
|
562 (eval
|
|
|
563 ;; Bind edebug-all-forms only while reading, not while evaling
|
|
|
564 ;; but this causes problems while edebugging edebug.
|
|
|
565 (let ((edebug-all-forms t)
|
|
|
566 (edebug-all-defs t))
|
|
|
567 (edebug-read-top-level-form))))
|
|
|
568
|
|
|
569
|
|
|
570 (defun edebug-read-top-level-form ()
|
|
|
571 (let ((starting-point (point)))
|
|
|
572 (end-of-defun)
|
|
|
573 (beginning-of-defun)
|
|
|
574 (prog1
|
|
|
575 (edebug-read-and-maybe-wrap-form)
|
|
|
576 ;; Recover point, but only if no error occurred.
|
|
|
577 (goto-char starting-point))))
|
|
|
578
|
|
|
579
|
|
|
580 ;; Compatibility with old versions.
|
|
|
581 (defalias 'edebug-all-defuns 'edebug-all-defs)
|
|
|
582
|
|
|
583 (defun edebug-all-defs ()
|
|
|
584 "Toggle edebugging of all definitions."
|
|
|
585 (interactive)
|
|
|
586 (setq edebug-all-defs (not edebug-all-defs))
|
|
|
587 (message "Edebugging all definitions is %s."
|
|
|
588 (if edebug-all-defs "on" "off")))
|
|
|
589
|
|
|
590
|
|
|
591 (defun edebug-all-forms ()
|
|
|
592 "Toggle edebugging of all forms."
|
|
|
593 (interactive)
|
|
|
594 (setq edebug-all-forms (not edebug-all-forms))
|
|
|
595 (message "Edebugging all forms is %s."
|
|
|
596 (if edebug-all-forms "on" "off")))
|
|
|
597
|
|
|
598
|
|
|
599 (defun edebug-install-read-eval-functions ()
|
|
|
600 (interactive)
|
|
|
601 ;; Don't install if already installed.
|
|
|
602 (if (eq (symbol-function 'read) 'edebug-read) nil
|
|
|
603 (elisp-eval-region-install)
|
|
|
604 (defalias 'read 'edebug-read)
|
|
|
605 (defalias 'eval-defun 'edebug-eval-defun)))
|
|
|
606
|
|
|
607 (defun edebug-uninstall-read-eval-functions ()
|
|
|
608 (interactive)
|
|
|
609 (elisp-eval-region-uninstall)
|
|
|
610 (defalias 'read (symbol-function 'edebug-original-read))
|
|
|
611 (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun)))
|
|
|
612
|
|
|
613
|
|
|
614 ;;;; Edebug internal data
|
|
|
615 ;;; ===============================
|
|
|
616
|
|
|
617 ;;; The internal data that is needed for edebugging is kept in the
|
|
|
618 ;;; buffer-local variable `edebug-form-data'.
|
|
|
619
|
|
|
620 ;; XEmacs change?
|
|
|
621 (defconst edebug-form-data nil)
|
|
|
622 (make-variable-buffer-local 'edebug-form-data)
|
|
|
623
|
|
|
624 ;; A list of entries associating symbols with buffer regions.
|
|
|
625 ;; This is an automatic buffer local variable. Each entry looks like:
|
|
|
626 ;; @code{(@var{symbol} @var{begin-marker} @var{end-marker}). The markers
|
|
|
627 ;; are at the beginning and end of an entry level form and @var{symbol} is
|
|
|
628 ;; a symbol that holds all edebug related information for the form on its
|
|
|
629 ;; property list.
|
|
|
630
|
|
|
631 ;; In the future, the symbol will be irrelevant and edebug data will
|
|
|
632 ;; be stored in the definitions themselves rather than in the property
|
|
|
633 ;; list of a symbol.
|
|
|
634
|
|
|
635 (defun edebug-make-form-data-entry (symbol begin end)
|
|
|
636 (list symbol begin end))
|
|
|
637
|
|
|
638 (defsubst edebug-form-data-name (entry)
|
|
|
639 (car entry))
|
|
|
640
|
|
|
641 (defsubst edebug-form-data-begin (entry)
|
|
|
642 (nth 1 entry))
|
|
|
643
|
|
|
644 (defsubst edebug-form-data-end (entry)
|
|
|
645 (nth 2 entry))
|
|
|
646
|
|
|
647 (defsubst edebug-set-form-data-entry (entry name begin end)
|
|
|
648 (setcar entry name);; in case name is changed
|
|
|
649 (set-marker (nth 1 entry) begin)
|
|
|
650 (set-marker (nth 2 entry) end))
|
|
|
651
|
|
|
652 (defun edebug-get-form-data-entry (pnt &optional end-point)
|
|
|
653 ;; Find the edebug form data entry which is closest to PNT.
|
|
|
654 ;; If END-POINT is supplied, match must be exact.
|
|
|
655 ;; Return `nil' if none found.
|
|
|
656 (let ((rest edebug-form-data)
|
|
|
657 closest-entry
|
|
|
658 (closest-dist 999999)) ;; need maxint here
|
|
|
659 (while (and rest (< 0 closest-dist))
|
|
|
660 (let* ((entry (car rest))
|
|
|
661 (begin (edebug-form-data-begin entry))
|
|
|
662 (dist (- pnt begin)))
|
|
|
663 (setq rest (cdr rest))
|
|
|
664 (if (and (<= 0 dist)
|
|
|
665 (< dist closest-dist)
|
|
|
666 (or (not end-point)
|
|
|
667 (= end-point (edebug-form-data-end entry)))
|
|
|
668 (<= pnt (edebug-form-data-end entry)))
|
|
|
669 (setq closest-dist dist
|
|
|
670 closest-entry entry))))
|
|
|
671 closest-entry))
|
|
|
672
|
|
|
673 ;; Also need to find all contained entries,
|
|
|
674 ;; and find an entry given a symbol, which should be just assq.
|
|
|
675
|
|
|
676 (defun edebug-form-data-symbol ()
|
|
|
677 ;; Return the edebug data symbol of the form where point is in.
|
|
|
678 ;; If point is not inside a edebuggable form, cause error.
|
|
|
679 (or (edebug-form-data-name (edebug-get-form-data-entry (point)))
|
|
|
680 (error "Not inside instrumented form")))
|
|
|
681
|
|
|
682 (defun edebug-make-top-form-data-entry (new-entry)
|
|
|
683 ;; Make NEW-ENTRY the first element in the `edebug-form-data' list.
|
|
|
684 (edebug-clear-form-data-entry new-entry)
|
|
|
685 (setq edebug-form-data (cons new-entry edebug-form-data)))
|
|
|
686
|
|
|
687 (defun edebug-clear-form-data-entry (entry)
|
|
|
688 ;; If non-nil, clear ENTRY out of the form data.
|
|
|
689 ;; Maybe clear the markers and delete the symbol's edebug property?
|
|
|
690 (if entry
|
|
|
691 (progn
|
|
|
692 ;; Instead of this, we could just find all contained forms.
|
|
|
693 ;; (put (car entry) 'edebug nil) ;
|
|
|
694 ;; (mapcar 'edebug-clear-form-data-entry ; dangerous
|
|
|
695 ;; (get (car entry) 'edebug-dependents))
|
|
|
696 ;; (set-marker (nth 1 entry) nil)
|
|
|
697 ;; (set-marker (nth 2 entry) nil)
|
|
|
698 (setq edebug-form-data (delq entry edebug-form-data)))))
|
|
|
699
|
|
|
700
|
|
|
701 ;;;; Parser utilities
|
|
|
702 ;;; ===============================
|
|
|
703
|
|
|
704
|
|
|
705 (defun edebug-syntax-error (&rest args)
|
|
|
706 ;; Signal an invalid-read-syntax with ARGS.
|
|
|
707 (signal 'invalid-read-syntax args))
|
|
|
708
|
|
|
709
|
|
|
710 (defconst edebug-read-syntax-table
|
|
|
711 ;; Lookup table for significant characters indicating the class of the
|
|
|
712 ;; token that follows. This is not a \"real\" syntax table.
|
|
|
713 (let ((table (make-vector 256 'symbol))
|
|
|
714 (i 0))
|
|
|
715 (while (< i ?!)
|
|
|
716 (aset table i 'space)
|
|
|
717 (setq i (1+ i)))
|
|
|
718 (aset table ?\( 'lparen)
|
|
|
719 (aset table ?\) 'rparen)
|
|
|
720 (aset table ?\' 'quote)
|
|
|
721 (aset table ?\" 'string)
|
|
|
722 (aset table ?\? 'char)
|
|
|
723 (aset table ?\[ 'lbracket)
|
|
|
724 (aset table ?\] 'rbracket)
|
|
|
725 (aset table ?\. 'dot)
|
|
|
726 (aset table ?\# 'hash)
|
|
|
727 ;; We treat numbers as symbols, because of confusion with -, -1, and 1-.
|
|
|
728 ;; We dont care about any other chars since they wont be seen.
|
|
|
729 table))
|
|
|
730
|
|
|
731 (defun edebug-next-token-class ()
|
|
|
732 ;; Move to the next token and return its class. We only care about
|
|
|
733 ;; lparen, rparen, dot, quote, string, char, vector, or symbol.
|
|
|
734 (edebug-skip-whitespace)
|
|
|
735 (aref edebug-read-syntax-table (following-char)))
|
|
|
736
|
|
|
737
|
|
|
738 (defun edebug-skip-whitespace ()
|
|
|
739 ;; Leave point before the next token, skipping white space and comments.
|
|
|
740 (skip-chars-forward " \t\r\n\f")
|
|
|
741 (while (= (following-char) ?\;)
|
|
|
742 ;; \r is counted as a comment terminator to support selective display.
|
|
|
743 (skip-chars-forward "^\n\r") ; skip the comment
|
|
|
744 (skip-chars-forward " \t\r\n\f")))
|
|
|
745
|
|
|
746
|
|
|
747 ;; Mostly obsolete reader; still used in one case.
|
|
|
748
|
|
|
749 (defun edebug-read-sexp ()
|
|
|
750 ;; Read one sexp from the current buffer starting at point.
|
|
|
751 ;; Leave point immediately after it. A sexp can be a list or atom.
|
|
|
752 ;; An atom is a symbol (or number), character, string, or vector.
|
|
|
753 ;; This works for reading anything legitimate, but it
|
|
|
754 ;; is gummed up by parser inconsistencies (bugs?)
|
|
|
755 (let ((class (edebug-next-token-class)))
|
|
|
756 (cond
|
|
|
757 ;; read goes one too far if a (possibly quoted) string or symbol
|
|
|
758 ;; is immediately followed by non-whitespace.
|
|
|
759 ((eq class 'symbol) (prog1
|
|
|
760 (edebug-original-read (current-buffer))
|
|
|
761 (if (not (eq (aref edebug-read-syntax-table
|
|
|
762 (preceding-char)) 'symbol))
|
|
|
763 (forward-char -1))))
|
|
|
764 ((eq class 'string) (prog1
|
|
|
765 (edebug-original-read (current-buffer))
|
|
|
766 (if (/= (preceding-char) ?\")
|
|
|
767 (forward-char -1))))
|
|
|
768 ((eq class 'quote) (forward-char 1)
|
|
|
769 (list 'quote (edebug-read-sexp)))
|
|
|
770 (t ; anything else, just read it.
|
|
|
771 (edebug-original-read (current-buffer))))))
|
|
|
772
|
|
|
773
|
|
|
774 ;;;; Offsets for reader
|
|
|
775 ;;; ==============================
|
|
|
776
|
|
|
777 ;; Define a structure to represent offset positions of expressions.
|
|
|
778 ;; Each offset structure looks like: (before . after) for constituents,
|
|
|
779 ;; or for structures that have elements: (before <subexpressions> . after)
|
|
|
780 ;; where the <subexpressions> are the offset structures for subexpressions
|
|
|
781 ;; including the head of a list.
|
|
|
782 (defconst edebug-offsets nil)
|
|
|
783
|
|
|
784 ;; Stack of offset structures in reverse order of the nesting.
|
|
|
785 ;; This is used to get back to previous levels.
|
|
|
786 (defconst edebug-offsets-stack nil)
|
|
|
787 (defconst edebug-current-offset nil) ; Top of the stack, for convenience.
|
|
|
788
|
|
|
789 ;; We must store whether we just read a list with a dotted form that
|
|
|
790 ;; is itself a list. This structure will be condensed, so the offsets
|
|
|
791 ;; must also be condensed.
|
|
|
792 (defconst edebug-read-dotted-list nil)
|
|
|
793
|
|
|
794 (defsubst edebug-initialize-offsets ()
|
|
|
795 ;; Reinitialize offset recording.
|
|
|
796 (setq edebug-current-offset nil))
|
|
|
797
|
|
|
798 (defun edebug-store-before-offset (point)
|
|
|
799 ;; Add a new offset pair with POINT as the before offset.
|
|
|
800 (let ((new-offset (list point)))
|
|
|
801 (if edebug-current-offset
|
|
|
802 (setcdr edebug-current-offset
|
|
|
803 (cons new-offset (cdr edebug-current-offset)))
|
|
|
804 ;; Otherwise, we are at the top level, so initialize.
|
|
|
805 (setq edebug-offsets new-offset
|
|
|
806 edebug-offsets-stack nil
|
|
|
807 edebug-read-dotted-list nil))
|
|
|
808 ;; Cons the new offset to the front of the stack.
|
|
|
809 (setq edebug-offsets-stack (cons new-offset edebug-offsets-stack)
|
|
|
810 edebug-current-offset new-offset)
|
|
|
811 ))
|
|
|
812
|
|
|
813 (defun edebug-store-after-offset (point)
|
|
|
814 ;; Finalize the current offset struct by reversing it and
|
|
|
815 ;; store POINT as the after offset.
|
|
|
816 (if (not edebug-read-dotted-list)
|
|
|
817 ;; Just reverse the offsets of all subexpressions.
|
|
|
818 (setcdr edebug-current-offset (nreverse (cdr edebug-current-offset)))
|
|
|
819
|
|
|
820 ;; We just read a list after a dot, which will be abbreviated out.
|
|
|
821 (setq edebug-read-dotted-list nil)
|
|
|
822 ;; Drop the corresponding offset pair.
|
|
|
823 ;; That is, nconc the reverse of the rest of the offsets
|
|
|
824 ;; with the cdr of last offset.
|
|
|
825 (setcdr edebug-current-offset
|
|
|
826 (nconc (nreverse (cdr (cdr edebug-current-offset)))
|
|
|
827 (cdr (car (cdr edebug-current-offset))))))
|
|
|
828
|
|
|
829 ;; Now append the point using nconc.
|
|
|
830 (setq edebug-current-offset (nconc edebug-current-offset point))
|
|
|
831 ;; Pop the stack.
|
|
|
832 (setq edebug-offsets-stack (cdr edebug-offsets-stack)
|
|
|
833 edebug-current-offset (car edebug-offsets-stack)))
|
|
|
834
|
|
|
835 (defun edebug-ignore-offset ()
|
|
|
836 ;; Ignore the last created offset pair.
|
|
|
837 (setcdr edebug-current-offset (cdr (cdr edebug-current-offset))))
|
|
|
838
|
|
|
839 (def-edebug-spec edebug-storing-offsets (form body))
|
|
|
840 (put 'edebug-storing-offsets 'lisp-indent-hook 1)
|
|
|
841
|
|
|
842 (defmacro edebug-storing-offsets (point &rest body)
|
|
|
843 (` (unwind-protect
|
|
|
844 (progn
|
|
|
845 (edebug-store-before-offset (, point))
|
|
|
846 (,@ body))
|
|
|
847 (edebug-store-after-offset (point)))))
|
|
|
848
|
|
|
849
|
|
|
850 ;;;; Reader for Emacs Lisp.
|
|
|
851 ;;; ==========================================
|
|
|
852 ;; Uses edebug-next-token-class (and edebug-skip-whitespace) above.
|
|
|
853
|
|
|
854 (defconst edebug-read-alist
|
|
|
855 '((symbol . edebug-read-symbol)
|
|
|
856 (lparen . edebug-read-list)
|
|
|
857 (string . edebug-read-string)
|
|
|
858 (quote . edebug-read-quote)
|
|
|
859 (lbracket . edebug-read-vector)
|
|
|
860 (hash . edebug-read-function)
|
|
|
861 ))
|
|
|
862
|
|
|
863 (defun edebug-read-storing-offsets (stream)
|
|
|
864 (let ((class (edebug-next-token-class))
|
|
|
865 func
|
|
|
866 edebug-read-dotted-list) ; see edebug-store-after-offset
|
|
|
867 (edebug-storing-offsets (point)
|
|
|
868 (if (setq func (assq class edebug-read-alist))
|
|
|
869 (funcall (cdr func) stream)
|
|
|
870 ;; anything else, just read it.
|
|
|
871 (edebug-original-read stream))
|
|
|
872 )))
|
|
|
873
|
|
|
874 (defun edebug-read-symbol (stream)
|
|
|
875 (prog1
|
|
|
876 (edebug-original-read stream)
|
|
|
877 ;; loses for escaped chars
|
|
|
878 (if (not (eq (aref edebug-read-syntax-table
|
|
|
879 (preceding-char)) 'symbol))
|
|
|
880 (forward-char -1))))
|
|
|
881
|
|
|
882 (defun edebug-read-string (stream)
|
|
|
883 (prog1
|
|
|
884 (edebug-original-read stream)
|
|
|
885 (if (/= (preceding-char) ?\")
|
|
|
886 (forward-char -1))))
|
|
|
887
|
|
|
888 (defun edebug-read-quote (stream)
|
|
|
889 ;; Turn 'thing into (quote thing)
|
|
|
890 (forward-char 1)
|
|
|
891 (list
|
|
|
892 (edebug-storing-offsets (point) 'quote)
|
|
|
893 (edebug-read-storing-offsets stream)))
|
|
|
894
|
|
|
895 (defun edebug-read-function (stream)
|
|
|
896 ;; Turn #'thing into (function thing)
|
|
|
897 (forward-char 1)
|
|
|
898 (if (/= ?\' (following-char)) (edebug-syntax-error "Bad char"))
|
|
|
899 (forward-char 1)
|
|
|
900 (list
|
|
|
901 (edebug-storing-offsets (point)
|
|
|
902 (if (featurep 'cl) 'function* 'function))
|
|
|
903 (edebug-read-storing-offsets stream)))
|
|
|
904
|
|
|
905 (defun edebug-read-list (stream)
|
|
|
906 (forward-char 1) ; skip \(
|
|
|
907 (prog1
|
|
|
908 (let ((elements))
|
|
|
909 (while (not (memq (edebug-next-token-class) '(rparen dot)))
|
|
|
910 (setq elements (cons (edebug-read-storing-offsets stream) elements)))
|
|
|
911 (setq elements (nreverse elements))
|
|
|
912 (if (eq 'dot (edebug-next-token-class))
|
|
|
913 (let (dotted-form)
|
|
|
914 (forward-char 1) ; skip \.
|
|
|
915 (setq dotted-form (edebug-read-storing-offsets stream))
|
|
|
916 elements (nconc elements dotted-form)
|
|
|
917 (if (not (eq (edebug-next-token-class) 'rparen))
|
|
|
918 (edebug-syntax-error "Expected `)'"))
|
|
|
919 (setq edebug-read-dotted-list (listp dotted-form))
|
|
|
920 ))
|
|
|
921 elements)
|
|
|
922 (forward-char 1) ; skip \)
|
|
|
923 ))
|
|
|
924
|
|
|
925 (defun edebug-read-vector (stream)
|
|
|
926 (forward-char 1) ; skip \[
|
|
|
927 (prog1
|
|
|
928 (let ((elements))
|
|
|
929 (while (not (eq 'rbracket (edebug-next-token-class)))
|
|
|
930 (setq elements (cons (edebug-read-storing-offsets stream) elements)))
|
|
|
931 (apply 'vector (nreverse elements)))
|
|
|
932 (forward-char 1) ; skip \]
|
|
|
933 ))
|
|
|
934
|
|
|
935
|
|
|
936
|
|
|
937 ;;;; Cursors for traversal of list and vector elements with offsets.
|
|
|
938 ;;;====================================================================
|
|
|
939
|
|
|
940 (defvar edebug-dotted-spec nil)
|
|
|
941
|
|
|
942 (defun edebug-new-cursor (expressions offsets)
|
|
|
943 ;; Return a new cursor for EXPRESSIONS with OFFSETS.
|
|
|
944 (if (vectorp expressions)
|
|
|
945 (setq expressions (append expressions nil)))
|
|
|
946 (cons expressions offsets))
|
|
|
947
|
|
|
948 (defsubst edebug-set-cursor (cursor expressions offsets)
|
|
|
949 ;; Set the CURSOR's EXPRESSIONS and OFFSETS to the given.
|
|
|
950 ;; Return the cursor.
|
|
|
951 (setcar cursor expressions)
|
|
|
952 (setcdr cursor offsets)
|
|
|
953 cursor)
|
|
|
954
|
|
|
955 '(defun edebug-copy-cursor (cursor)
|
|
|
956 ;; Copy the cursor using the same object and offsets.
|
|
|
957 (cons (car cursor) (cdr cursor)))
|
|
|
958
|
|
|
959 (defsubst edebug-cursor-expressions (cursor)
|
|
|
960 (car cursor))
|
|
|
961 (defsubst edebug-cursor-offsets (cursor)
|
|
|
962 (cdr cursor))
|
|
|
963
|
|
|
964 (defsubst edebug-empty-cursor (cursor)
|
|
|
965 ;; Return non-nil if CURSOR is empty - meaning no more elements.
|
|
|
966 (null (car cursor)))
|
|
|
967
|
|
|
968 (defsubst edebug-top-element (cursor)
|
|
|
969 ;; Return the top element at the cursor.
|
|
|
970 ;; Assumes not empty.
|
|
|
971 (car (car cursor)))
|
|
|
972
|
|
|
973 (defun edebug-top-element-required (cursor &rest error)
|
|
|
974 ;; Check if a dotted form is required.
|
|
|
975 (if edebug-dotted-spec (edebug-no-match cursor "Dot expected."))
|
|
|
976 ;; Check if there is at least one more argument.
|
|
|
977 (if (edebug-empty-cursor cursor) (apply 'edebug-no-match cursor error))
|
|
|
978 ;; Return that top element.
|
|
|
979 (edebug-top-element cursor))
|
|
|
980
|
|
|
981 (defsubst edebug-top-offset (cursor)
|
|
|
982 ;; Return the top offset pair corresponding to the top element.
|
|
|
983 (car (cdr cursor)))
|
|
|
984
|
|
|
985 (defun edebug-move-cursor (cursor)
|
|
|
986 ;; Advance and return the cursor to the next element and offset.
|
|
|
987 ;; throw no-match if empty before moving.
|
|
|
988 ;; This is a violation of the cursor encapsulation, but
|
|
|
989 ;; there is plenty of that going on while matching.
|
|
|
990 ;; The following test should always fail.
|
|
|
991 (if (edebug-empty-cursor cursor)
|
|
|
992 (edebug-no-match cursor "Not enough arguments."))
|
|
|
993 (setcar cursor (cdr (car cursor)))
|
|
|
994 (setcdr cursor (cdr (cdr cursor)))
|
|
|
995 cursor)
|
|
|
996
|
|
|
997
|
|
|
998 (defun edebug-before-offset (cursor)
|
|
|
999 ;; Return the before offset of the cursor.
|
|
|
1000 ;; If there is nothing left in the offsets,
|
|
|
1001 ;; return one less than the offset itself,
|
|
|
1002 ;; which is the after offset for a list.
|
|
|
1003 (let ((offset (edebug-cursor-offsets cursor)))
|
|
|
1004 (if (consp offset)
|
|
|
1005 (car (car offset))
|
|
|
1006 (1- offset))))
|
|
|
1007
|
|
|
1008 (defun edebug-after-offset (cursor)
|
|
|
1009 ;; Return the after offset of the cursor object.
|
|
|
1010 (let ((offset (edebug-top-offset cursor)))
|
|
|
1011 (while (consp offset)
|
|
|
1012 (setq offset (cdr offset)))
|
|
|
1013 offset))
|
|
|
1014
|
|
|
1015 ;;;; The Parser
|
|
|
1016 ;;; ===============================
|
|
|
1017
|
|
|
1018 ;;; The top level function for parsing forms is
|
|
|
1019 ;;; edebug-read-and-maybe-wrap-form; it calls all the rest. It checks the
|
|
|
1020 ;;; syntax a bit and leaves point at any error it finds, but otherwise
|
|
|
1021 ;;; should appear to work like eval-defun.
|
|
|
1022
|
|
|
1023 ;;; The basic plan is to surround each expression with a call to
|
|
|
1024 ;;; the edebug debugger together with indexes into a table of positions of
|
|
|
1025 ;;; all expressions. Thus an expression "exp" becomes:
|
|
|
1026
|
|
|
1027 ;;; (edebug-after (edebug-before 1) 2 exp)
|
|
|
1028
|
|
|
1029 ;;; When this is evaluated, first point is moved to the beginning of
|
|
|
1030 ;;; exp at offset 1 of the current function. The expression is
|
|
|
1031 ;;; evaluated, which may cause more edebug calls, and then point is
|
|
|
1032 ;;; moved to offset 2 after the end of exp.
|
|
|
1033
|
|
|
1034 ;;; The highest level expressions of the function are wrapped in a call to
|
|
|
1035 ;;; edebug-enter, which supplies the function name and the actual
|
|
|
1036 ;;; arguments to the function. See functions edebug-enter, edebug-before,
|
|
|
1037 ;;; and edebug-after for more details.
|
|
|
1038
|
|
|
1039 ;; Dynamically bound vars, left unbound, but globally declared.
|
|
|
1040 ;; This is to quiet the byte compiler.
|
|
|
1041
|
|
|
1042 ;; Window data of the highest definition being wrapped.
|
|
|
1043 ;; This data is shared by all embedded definitions.
|
|
|
1044 (defvar edebug-top-window-data)
|
|
|
1045
|
|
|
1046 (defvar edebug-&optional)
|
|
|
1047 (defvar edebug-&rest)
|
|
|
1048 (defvar edebug-gate nil) ;; whether no-match forces an error.
|
|
|
1049
|
|
|
1050 (defconst edebug-def-name nil) ; name of definition, used by interactive-form
|
|
|
1051 (defconst edebug-old-def-name nil) ; previous name of containing definition.
|
|
|
1052
|
|
|
1053 (defconst edebug-error-point nil)
|
|
|
1054 (defconst edebug-best-error nil)
|
|
|
1055
|
|
|
1056
|
|
|
1057 (defun edebug-read-and-maybe-wrap-form ()
|
|
|
1058 ;; Read a form and wrap it with edebug calls, if the conditions are right.
|
|
|
1059 ;; Here we just catch any no-match not caught below and signal an error.
|
|
|
1060
|
|
|
1061 ;; Run the setup hook.
|
|
|
1062 (run-hooks 'edebug-setup-hook)
|
|
|
1063 (setq edebug-setup-hook nil)
|
|
|
1064
|
|
|
1065 (let (result
|
|
|
1066 edebug-top-window-data
|
|
|
1067 edebug-def-name;; make sure it is locally nil
|
|
|
1068 ;; I dont like these here!!
|
|
|
1069 edebug-&optional
|
|
|
1070 edebug-&rest
|
|
|
1071 edebug-gate
|
|
|
1072 edebug-best-error
|
|
|
1073 edebug-error-point
|
|
|
1074 no-match
|
|
|
1075 ;; Do this once here instead of several times.
|
|
|
1076 (max-lisp-eval-depth (+ 800 max-lisp-eval-depth))
|
|
|
1077 (max-specpdl-size (+ 2000 max-specpdl-size)))
|
|
|
1078 (setq no-match
|
|
|
1079 (catch 'no-match
|
|
|
1080 (setq result (edebug-read-and-maybe-wrap-form1))
|
|
|
1081 nil))
|
|
|
1082 (if no-match
|
|
|
1083 (apply 'edebug-syntax-error no-match))
|
|
|
1084 result))
|
|
|
1085
|
|
|
1086
|
|
|
1087 (defun edebug-read-and-maybe-wrap-form1 ()
|
|
|
1088 (let (spec
|
|
|
1089 def-kind
|
|
|
1090 defining-form-p
|
|
|
1091 def-name
|
|
|
1092 ;; These offset things dont belong here, but to support recursive
|
|
|
1093 ;; calls to edebug-read, they need to be here.
|
|
|
1094 edebug-offsets
|
|
|
1095 edebug-offsets-stack
|
|
|
1096 edebug-current-offset ; reset to nil
|
|
|
1097 )
|
|
|
1098 (save-excursion
|
|
|
1099 (if (and (eq 'lparen (edebug-next-token-class))
|
|
|
1100 (eq 'symbol (progn (forward-char 1) (edebug-next-token-class))))
|
|
|
1101 ;; Find out if this is a defining form from first symbol
|
|
|
1102 (setq def-kind (edebug-original-read (current-buffer))
|
|
|
1103 spec (and (symbolp def-kind) (get-edebug-spec def-kind))
|
|
|
1104 defining-form-p (and (listp spec)
|
|
|
1105 (eq '&define (car spec)))
|
|
|
1106 ;; This is incorrect in general!! But OK most of the time.
|
|
|
1107 def-name (if (and defining-form-p
|
|
|
1108 (eq 'name (car (cdr spec)))
|
|
|
1109 (eq 'symbol (edebug-next-token-class)))
|
|
|
1110 (edebug-original-read (current-buffer))))))
|
|
|
1111 ;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms)
|
|
|
1112 (cond
|
|
|
1113 (defining-form-p
|
|
|
1114 (if (or edebug-all-defs edebug-all-forms)
|
|
|
1115 ;; If it is a defining form and we are edebugging defs,
|
|
|
1116 ;; then let edebug-list-form start it.
|
|
|
1117 (let ((cursor (edebug-new-cursor
|
|
|
1118 (list (edebug-read-storing-offsets (current-buffer)))
|
|
|
1119 (list edebug-offsets))))
|
|
|
1120 (car
|
|
|
1121 (edebug-make-form-wrapper
|
|
|
1122 cursor
|
|
|
1123 (edebug-before-offset cursor)
|
|
|
1124 (1- (edebug-after-offset cursor))
|
|
|
1125 (list (cons (symbol-name def-kind) (cdr spec))))))
|
|
|
1126
|
|
|
1127 ;; Not edebugging this form, so reset the symbol's edebug
|
|
|
1128 ;; property to be just a marker at the definition's source code.
|
|
|
1129 ;; This only works for defs with simple names.
|
|
|
1130 (put def-name 'edebug (point-marker))
|
|
|
1131 ;; Also nil out dependent defs.
|
|
|
1132 '(mapcar (function
|
|
|
1133 (lambda (def)
|
|
|
1134 (put def-name 'edebug nil)))
|
|
|
1135 (get def-name 'edebug-dependents))
|
|
|
1136 (edebug-read-sexp)))
|
|
|
1137
|
|
|
1138 ;; If all forms are being edebugged, explicitly wrap it.
|
|
|
1139 (edebug-all-forms
|
|
|
1140 (let ((cursor (edebug-new-cursor
|
|
|
1141 (list (edebug-read-storing-offsets (current-buffer)))
|
|
|
1142 (list edebug-offsets))))
|
|
|
1143 (edebug-make-form-wrapper
|
|
|
1144 cursor
|
|
|
1145 (edebug-before-offset cursor)
|
|
|
1146 (edebug-after-offset cursor)
|
|
|
1147 nil)))
|
|
|
1148
|
|
|
1149 ;; Not a defining form, and not edebugging.
|
|
|
1150 (t (edebug-read-sexp)))
|
|
|
1151 ))
|
|
|
1152
|
|
|
1153
|
|
|
1154 (defvar edebug-def-args) ; args of defining form.
|
|
|
1155 (defvar edebug-def-interactive) ; is it an emacs interactive function?
|
|
|
1156 (defvar edebug-inside-func) ;; whether code is inside function context.
|
|
|
1157 ;; Currently def-form sets this to nil; def-body sets it to t.
|
|
|
1158
|
|
|
1159 (defun edebug-interactive-p-name ()
|
|
|
1160 ;; Return a unique symbol for the variable used to store the
|
|
|
1161 ;; status of interactive-p for this function.
|
|
|
1162 (intern (format "edebug-%s-interactive-p" edebug-def-name)))
|
|
|
1163
|
|
|
1164
|
|
|
1165 (defun edebug-wrap-def-body (forms)
|
|
|
1166 "Wrap the FORMS of a definition body."
|
|
|
1167 (if edebug-def-interactive
|
|
|
1168 (` (let (((, (edebug-interactive-p-name))
|
|
|
1169 (interactive-p)))
|
|
|
1170 (, (edebug-make-enter-wrapper forms))))
|
|
|
1171 (edebug-make-enter-wrapper forms)))
|
|
|
1172
|
|
|
1173
|
|
|
1174 (defun edebug-make-enter-wrapper (forms)
|
|
|
1175 ;; Generate the enter wrapper for some forms of a definition.
|
|
|
1176 ;; This is not to be used for the body of other forms, e.g. `while',
|
|
|
1177 ;; since it wraps the list of forms with a call to `edebug-enter'.
|
|
|
1178 ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
|
|
|
1179 ;; Do this after parsing since that may find a name.
|
|
|
1180 (setq edebug-def-name
|
|
|
1181 (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
|
|
|
1182 (` (edebug-enter
|
|
|
1183 (quote (, edebug-def-name))
|
|
|
1184 (, (if edebug-inside-func
|
|
|
1185 (` (list (,@
|
|
|
1186 ;; Doesnt work with more than one def-body!!
|
|
|
1187 ;; But the list will just be reversed.
|
|
|
1188 (nreverse edebug-def-args))))
|
|
|
1189 'nil))
|
|
|
1190 (function (lambda () (,@ forms)))
|
|
|
1191 )))
|
|
|
1192
|
|
|
1193
|
|
|
1194 (defvar edebug-form-begin-marker) ; the mark for def being instrumented
|
|
|
1195
|
|
|
1196 (defvar edebug-offset-index) ; the next available offset index.
|
|
|
1197 (defvar edebug-offset-list) ; the list of offset positions.
|
|
|
1198
|
|
|
1199 (defun edebug-inc-offset (offset)
|
|
|
1200 ;; modifies edebug-offset-index and edebug-offset-list
|
|
|
1201 ;; accesses edebug-func-marc and buffer point
|
|
|
1202 (prog1
|
|
|
1203 edebug-offset-index
|
|
|
1204 (setq edebug-offset-list (cons (- offset edebug-form-begin-marker)
|
|
|
1205 edebug-offset-list)
|
|
|
1206 edebug-offset-index (1+ edebug-offset-index))))
|
|
|
1207
|
|
|
1208
|
|
|
1209 (defun edebug-make-before-and-after-form (before-index form after-index)
|
|
|
1210 ;; Return the edebug form for the current function at offset BEFORE-INDEX
|
|
|
1211 ;; given FORM. Looks like:
|
|
|
1212 ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM)
|
|
|
1213 ;; Also increment the offset index for subsequent use.
|
|
|
1214 ;; if (not edebug-stop-before-symbols) and form is a symbol,
|
|
|
1215 ;; then dont call edebug-before.
|
|
|
1216 (list 'edebug-after
|
|
|
1217 (list 'edebug-before before-index)
|
|
|
1218 after-index form))
|
|
|
1219
|
|
|
1220 (defun edebug-make-after-form (form after-index)
|
|
|
1221 ;; Like edebug-make-before-and-after-form, but only after.
|
|
|
1222 (list 'edebug-after 0 after-index form))
|
|
|
1223
|
|
|
1224
|
|
|
1225 (defun edebug-unwrap (sexp)
|
|
|
1226 "Return the unwrapped SEXP or return it as is if it is not wrapped.
|
|
|
1227 The SEXP might be the result of wrapping a body, which is a list of
|
|
|
1228 expressions; a `progn' form will be returned enclosing these forms."
|
|
|
1229 (if (consp sexp)
|
|
|
1230 (cond
|
|
|
1231 ((eq 'edebug-after (car sexp))
|
|
|
1232 (nth 3 sexp))
|
|
|
1233 ((eq 'edebug-enter (car sexp))
|
|
|
1234 (let ((forms (nthcdr 2 (nth 1 (nth 3 sexp)))))
|
|
|
1235 (if (> (length forms) 1)
|
|
|
1236 (cons 'progn forms) ;; could return (values forms) instead.
|
|
|
1237 (car forms))))
|
|
|
1238 (t sexp);; otherwise it is not wrapped, so just return it.
|
|
|
1239 )
|
|
|
1240 sexp))
|
|
|
1241
|
|
|
1242 (defun edebug-unwrap* (sexp)
|
|
|
1243 "Return the sexp recursively unwrapped."
|
|
|
1244 (let ((new-sexp (edebug-unwrap sexp)))
|
|
|
1245 (while (not (eq sexp new-sexp))
|
|
|
1246 (setq sexp new-sexp
|
|
|
1247 new-sexp (edebug-unwrap sexp)))
|
|
|
1248 (if (consp new-sexp)
|
|
|
1249 (mapcar 'edebug-unwrap* new-sexp)
|
|
|
1250 new-sexp)))
|
|
|
1251
|
|
|
1252
|
|
|
1253 (defun edebug-defining-form (cursor form-begin form-end speclist)
|
|
|
1254 ;; Process the defining form, starting outside the form.
|
|
|
1255 ;; The speclist is a generated list spec that looks like:
|
|
|
1256 ;; (("def-symbol" defining-form-spec-sans-&define))
|
|
|
1257 ;; Skip the first offset.
|
|
|
1258 (edebug-set-cursor cursor (edebug-cursor-expressions cursor)
|
|
|
1259 (cdr (edebug-cursor-offsets cursor)))
|
|
|
1260 (edebug-make-form-wrapper
|
|
|
1261 cursor
|
|
|
1262 form-begin (1- form-end)
|
|
|
1263 speclist))
|
|
|
1264
|
|
|
1265 (defun edebug-make-form-wrapper (cursor form-begin form-end
|
|
|
1266 &optional speclist)
|
|
|
1267 ;; Wrap a form, usually a defining form, but any evaluated one.
|
|
|
1268 ;; If speclist is non-nil, this is being called by edebug-defining-form.
|
|
|
1269 ;; Otherwise it is being called from edebug-read-and-maybe-wrap-form1.
|
|
|
1270 ;; This is a hack, but I havent figured out a simpler way yet.
|
|
|
1271 (let* ((form-data-entry (edebug-get-form-data-entry form-begin form-end))
|
|
|
1272 ;; Set this marker before parsing.
|
|
|
1273 (edebug-form-begin-marker
|
|
|
1274 (if form-data-entry
|
|
|
1275 (edebug-form-data-begin form-data-entry)
|
|
|
1276 ;; Buffer must be current-buffer for this to work:
|
|
|
1277 (set-marker (make-marker) form-begin))))
|
|
|
1278
|
|
|
1279 (let (edebug-offset-list
|
|
|
1280 (edebug-offset-index 0)
|
|
|
1281 result
|
|
|
1282 ;; For definitions.
|
|
|
1283 ;; (edebug-containing-def-name edebug-def-name)
|
|
|
1284 ;; Get name from form-data, if any.
|
|
|
1285 (edebug-old-def-name (edebug-form-data-name form-data-entry))
|
|
|
1286 edebug-def-name
|
|
|
1287 edebug-def-args
|
|
|
1288 edebug-def-interactive
|
|
|
1289 edebug-inside-func;; whether wrapped code executes inside a function.
|
|
|
1290 )
|
|
|
1291
|
|
|
1292 (setq result
|
|
|
1293 (if speclist
|
|
|
1294 (edebug-match cursor speclist)
|
|
|
1295
|
|
|
1296 ;; else wrap as an enter-form.
|
|
|
1297 (edebug-make-enter-wrapper (list (edebug-form cursor)))))
|
|
|
1298
|
|
|
1299 ;; Set the name here if it was not set by edebug-make-enter-wrapper.
|
|
|
1300 (setq edebug-def-name
|
|
|
1301 (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
|
|
|
1302
|
|
|
1303 ;; Add this def as a dependent of containing def. Buggy.
|
|
|
1304 '(if (and edebug-containing-def-name
|
|
|
1305 (not (get edebug-containing-def-name 'edebug-dependents)))
|
|
|
1306 (put edebug-containing-def-name 'edebug-dependents
|
|
|
1307 (cons edebug-def-name
|
|
|
1308 (get edebug-containing-def-name
|
|
|
1309 'edebug-dependents))))
|
|
|
1310
|
|
|
1311 ;; Create a form-data-entry or modify existing entry's markers.
|
|
|
1312 ;; In the latter case, pointers to the entry remain eq.
|
|
|
1313 (if (not form-data-entry)
|
|
|
1314 (setq form-data-entry
|
|
|
1315 (edebug-make-form-data-entry
|
|
|
1316 edebug-def-name
|
|
|
1317 edebug-form-begin-marker
|
|
|
1318 ;; Buffer must be current-buffer.
|
|
|
1319 (set-marker (make-marker) form-end)
|
|
|
1320 ))
|
|
|
1321 (edebug-set-form-data-entry
|
|
|
1322 form-data-entry edebug-def-name ;; in case name is changed
|
|
|
1323 form-begin form-end))
|
|
|
1324
|
|
|
1325 ;; (message "defining: %s" edebug-def-name) (sit-for 2)
|
|
|
1326 (edebug-make-top-form-data-entry form-data-entry)
|
|
|
1327 (message "Edebug: %s" edebug-def-name)
|
|
|
1328 ;;(debug edebug-def-name)
|
|
|
1329
|
|
|
1330 ;; Destructively reverse edebug-offset-list and make vector from it.
|
|
|
1331 (setq edebug-offset-list (vconcat (nreverse edebug-offset-list)))
|
|
|
1332
|
|
|
1333 ;; Side effects on the property list of edebug-def-name.
|
|
|
1334 (edebug-clear-frequency-count edebug-def-name)
|
|
|
1335 (edebug-clear-coverage edebug-def-name)
|
|
|
1336
|
|
|
1337 ;; Set up the initial window data.
|
|
|
1338 (if (not edebug-top-window-data) ;; if not already set, do it now.
|
|
|
1339 (let ((window ;; Find the best window for this buffer.
|
|
|
1340 (or (get-buffer-window (current-buffer))
|
|
|
1341 (selected-window))))
|
|
|
1342 (setq edebug-top-window-data
|
|
|
1343 (cons window (window-start window)))))
|
|
|
1344
|
|
|
1345 ;; Store the edebug data in symbol's property list.
|
|
|
1346 (put edebug-def-name 'edebug
|
|
|
1347 ;; A struct or vector would be better here!!
|
|
|
1348 (list edebug-form-begin-marker
|
|
|
1349 nil ; clear breakpoints
|
|
|
1350 edebug-offset-list
|
|
|
1351 edebug-top-window-data
|
|
|
1352 ))
|
|
|
1353 result
|
|
|
1354 )))
|
|
|
1355
|
|
|
1356
|
|
|
1357 (defun edebug-clear-frequency-count (name)
|
|
|
1358 ;; Create initial frequency count vector.
|
|
|
1359 ;; For each stop point, the counter is incremented each time it is visited.
|
|
|
1360 (put name 'edebug-freq-count
|
|
|
1361 (make-vector (length edebug-offset-list) 0)))
|
|
|
1362
|
|
|
1363
|
|
|
1364 (defun edebug-clear-coverage (name)
|
|
|
1365 ;; Create initial coverage vector.
|
|
|
1366 ;; Only need one per expression, but it is simpler to use stop points.
|
|
|
1367 (put name 'edebug-coverage
|
|
|
1368 (make-vector (length edebug-offset-list) 'unknown)))
|
|
|
1369
|
|
|
1370
|
|
|
1371 (defun edebug-form (cursor)
|
|
|
1372 ;; Return the instrumented form for the following form.
|
|
|
1373 ;; Add the point offsets to the edebug-offset-list for the form.
|
|
|
1374 (let* ((form (edebug-top-element-required cursor "Expected form"))
|
|
|
1375 (offset (edebug-top-offset cursor)))
|
|
|
1376 (prog1
|
|
|
1377 (cond
|
|
|
1378 ((consp form)
|
|
|
1379 ;; The first offset for a list form is for the list form itself.
|
|
|
1380 (if (eq 'quote (car form))
|
|
|
1381 form
|
|
|
1382 (let* ((head (car form))
|
|
|
1383 (spec (and (symbolp head) (get-edebug-spec head)))
|
|
|
1384 (new-cursor (edebug-new-cursor form offset)))
|
|
|
1385 ;; Find out if this is a defining form from first symbol.
|
|
|
1386 ;; An indirect spec would not work here, yet.
|
|
|
1387 (if (and (consp spec) (eq '&define (car spec)))
|
|
|
1388 (edebug-defining-form
|
|
|
1389 new-cursor
|
|
|
1390 (car offset);; before the form
|
|
|
1391 (edebug-after-offset cursor)
|
|
|
1392 (cons (symbol-name head) (cdr spec)))
|
|
|
1393 ;; Wrap a regular form.
|
|
|
1394 (edebug-make-before-and-after-form
|
|
|
1395 (edebug-inc-offset (car offset))
|
|
|
1396 (edebug-list-form new-cursor)
|
|
|
1397 ;; After processing the list form, the new-cursor is left
|
|
|
1398 ;; with the offset after the form.
|
|
|
1399 (edebug-inc-offset (edebug-cursor-offsets new-cursor))))
|
|
|
1400 )))
|
|
|
1401
|
|
|
1402 ((symbolp form)
|
|
|
1403 (cond
|
|
|
1404 ;; Check for constant symbols that dont get wrapped.
|
|
|
1405 ((or (memq form '(t nil))
|
|
|
1406 (and (fboundp 'edebug-keywordp) (edebug-keywordp form)))
|
|
|
1407 form)
|
|
|
1408
|
|
|
1409 ;; This option may go away.
|
|
|
1410 (edebug-stop-before-symbols
|
|
|
1411 (edebug-make-before-and-after-form
|
|
|
1412 (edebug-inc-offset (car offset))
|
|
|
1413 form
|
|
|
1414 (edebug-inc-offset (cdr offset))
|
|
|
1415 ))
|
|
|
1416
|
|
|
1417 (t ;; just a variable
|
|
|
1418 (edebug-make-after-form form (edebug-inc-offset (cdr offset))))))
|
|
|
1419
|
|
|
1420 ;; Anything else is self-evaluating.
|
|
|
1421 (t form))
|
|
|
1422 (edebug-move-cursor cursor))))
|
|
|
1423
|
|
|
1424
|
|
|
1425 (defsubst edebug-forms (cursor) (edebug-match cursor '(&rest form)))
|
|
|
1426 (defsubst edebug-sexps (cursor) (edebug-match cursor '(&rest sexp)))
|
|
|
1427
|
|
|
1428 (defsubst edebug-list-form-args (head cursor)
|
|
|
1429 ;; Process the arguments of a list form given that head of form is a symbol.
|
|
|
1430 ;; Helper for edebug-list-form
|
|
|
1431 (let ((spec (get-edebug-spec head)))
|
|
|
1432 (cond
|
|
|
1433 (spec
|
|
|
1434 (cond
|
|
|
1435 ((consp spec)
|
|
|
1436 ;; It is a speclist.
|
|
|
1437 (let (edebug-best-error
|
|
|
1438 edebug-error-point);; This may not be needed.
|
|
|
1439 (edebug-match-sublist cursor spec)))
|
|
|
1440 ((eq t spec) (edebug-forms cursor))
|
|
|
1441 ((eq 0 spec) (edebug-sexps cursor))
|
|
|
1442 ((symbolp spec) (funcall spec cursor));; Not used by edebug,
|
|
|
1443 ; but leave it in for compatibility.
|
|
|
1444 ))
|
|
|
1445 ;; No edebug-form-spec provided.
|
|
|
1446 ((edebug-macrop head)
|
|
|
1447 (if edebug-eval-macro-args
|
|
|
1448 (edebug-forms cursor)
|
|
|
1449 (edebug-sexps cursor)))
|
|
|
1450 (t ;; Otherwise it is a function call.
|
|
|
1451 (edebug-forms cursor)))))
|
|
|
1452
|
|
|
1453
|
|
|
1454 (defun edebug-list-form (cursor)
|
|
|
1455 ;; Return an instrumented form built from the list form.
|
|
|
1456 ;; The after offset will be left in the cursor after processing the form.
|
|
|
1457 (let ((head (edebug-top-element-required cursor "Expected elements"))
|
|
|
1458 ;; Prevent backtracking whenever instrumenting.
|
|
|
1459 (edebug-gate t)
|
|
|
1460 ;; A list form is never optional because it matches anything.
|
|
|
1461 (edebug-&optional nil)
|
|
|
1462 (edebug-&rest nil))
|
|
|
1463 ;; Skip the first offset.
|
|
|
1464 (edebug-set-cursor cursor (edebug-cursor-expressions cursor)
|
|
|
1465 (cdr (edebug-cursor-offsets cursor)))
|
|
|
1466 (cond
|
|
|
1467 ((null head) nil) ; () is legal.
|
|
|
1468
|
|
|
1469 ((symbolp head)
|
|
|
1470 (cond
|
|
|
1471 ((null head)
|
|
|
1472 (edebug-syntax-error "nil head"))
|
|
|
1473 ((eq head 'interactive-p)
|
|
|
1474 ;; Special case: replace (interactive-p) with variable
|
|
|
1475 (setq edebug-def-interactive 'check-it)
|
|
|
1476 (edebug-move-cursor cursor)
|
|
|
1477 (edebug-interactive-p-name))
|
|
|
1478 (t
|
|
|
1479 (cons head (edebug-list-form-args
|
|
|
1480 head (edebug-move-cursor cursor))))))
|
|
|
1481
|
|
|
1482 ((consp head)
|
|
|
1483 (if (and (listp head) (eq (car head) ',))
|
|
|
1484 (edebug-match cursor '(("," def-form) body))
|
|
|
1485 ;; Process anonymous function and args.
|
|
|
1486 ;; This assumes no anonymous macros.
|
|
|
1487 (edebug-match-specs cursor '(lambda-expr body) 'edebug-match-specs)))
|
|
|
1488
|
|
|
1489 (t (edebug-syntax-error
|
|
|
1490 "Head of list form must be a symbol or lambda expression.")))
|
|
|
1491 ))
|
|
|
1492
|
|
|
1493
|
|
|
1494 ;;;; Matching of specs.
|
|
|
1495 ;;; ===================
|
|
|
1496
|
|
|
1497 (defvar edebug-after-dotted-spec nil)
|
|
|
1498
|
|
|
1499 (defvar edebug-matching-depth 0) ;; initial value
|
|
|
1500 (defconst edebug-max-depth 150) ;; maximum number of matching recursions.
|
|
|
1501
|
|
|
1502
|
|
|
1503 ;;;; Failure to match
|
|
|
1504 ;;; ==================
|
|
|
1505 ;; This throws to no-match, if there are higher alternatives.
|
|
|
1506 ;; Otherwise it signals an error. The place of the error is found
|
|
|
1507 ;; with the two before- and after-offset functions.
|
|
|
1508
|
|
|
1509 (defun edebug-no-match (cursor &rest edebug-args)
|
|
|
1510 ;; Throw a no-match, or signal an error immediately if gate is active.
|
|
|
1511 ;; Remember this point in case we need to report this error.
|
|
|
1512 (setq edebug-error-point (or edebug-error-point
|
|
|
1513 (edebug-before-offset cursor))
|
|
|
1514 edebug-best-error (or edebug-best-error edebug-args))
|
|
|
1515 (if (and edebug-gate (not edebug-&optional))
|
|
|
1516 (progn
|
|
|
1517 (if edebug-error-point
|
|
|
1518 (goto-char edebug-error-point))
|
|
|
1519 (apply 'edebug-syntax-error edebug-args))
|
|
|
1520 (funcall 'throw 'no-match edebug-args)))
|
|
|
1521
|
|
|
1522
|
|
|
1523 (defun edebug-match (cursor specs)
|
|
|
1524 ;; Top level spec matching function.
|
|
|
1525 ;; Used also at each lower level of specs.
|
|
|
1526 (let (edebug-&optional
|
|
|
1527 edebug-&rest
|
|
|
1528 edebug-best-error
|
|
|
1529 edebug-error-point
|
|
|
1530 (edebug-gate edebug-gate) ;; locally bound to limit effect
|
|
|
1531 )
|
|
|
1532 (edebug-match-specs cursor specs 'edebug-match-specs)))
|
|
|
1533
|
|
|
1534
|
|
|
1535 (defun edebug-match-one-spec (cursor spec)
|
|
|
1536 ;; Match one spec, which is not a keyword &-spec.
|
|
|
1537 (cond
|
|
|
1538 ((symbolp spec) (edebug-match-symbol cursor spec))
|
|
|
1539 ((vectorp spec) (edebug-match cursor (append spec nil)))
|
|
|
1540 ((stringp spec) (edebug-match-string cursor spec))
|
|
|
1541 ((listp spec) (edebug-match-list cursor spec))
|
|
|
1542 ))
|
|
|
1543
|
|
|
1544
|
|
|
1545 (defun edebug-match-specs (cursor specs remainder-handler)
|
|
|
1546 ;; Append results of matching the list of specs.
|
|
|
1547 ;; The first spec is handled and the remainder-handler handles the rest.
|
|
|
1548 (let ((edebug-matching-depth
|
|
|
1549 (if (> edebug-matching-depth edebug-max-depth)
|
|
|
1550 (error "too deep - perhaps infinite loop in spec?")
|
|
|
1551 (1+ edebug-matching-depth))))
|
|
|
1552 (cond
|
|
|
1553 ((null specs) nil)
|
|
|
1554
|
|
|
1555 ;; Is the spec dotted?
|
|
|
1556 ((atom specs)
|
|
|
1557 (let ((edebug-dotted-spec t));; Containing spec list was dotted.
|
|
|
1558 (edebug-match-specs cursor (list specs) remainder-handler)))
|
|
|
1559
|
|
|
1560 ;; Is the form dotted?
|
|
|
1561 ((not (listp (edebug-cursor-expressions cursor)));; allow nil
|
|
|
1562 (if (not edebug-dotted-spec)
|
|
|
1563 (edebug-no-match cursor "Dotted spec required."))
|
|
|
1564 ;; Cancel dotted spec and dotted form.
|
|
|
1565 (let ((edebug-dotted-spec)
|
|
|
1566 (this-form (edebug-cursor-expressions cursor))
|
|
|
1567 (this-offset (edebug-cursor-offsets cursor)))
|
|
|
1568 ;; Wrap the form in a list, (by changing the cursor??)...
|
|
|
1569 (edebug-set-cursor cursor (list this-form) this-offset)
|
|
|
1570 ;; and process normally, then unwrap the result.
|
|
|
1571 (car (edebug-match-specs cursor specs remainder-handler))))
|
|
|
1572
|
|
|
1573 (t;; Process normally.
|
|
|
1574 (let* ((spec (car specs))
|
|
|
1575 (rest)
|
|
|
1576 (first-char (and (symbolp spec) (aref (symbol-name spec) 0))))
|
|
|
1577 ;;(message "spec = %s first char = %s" spec first-char) (sit-for 1)
|
|
|
1578 (nconc
|
|
|
1579 (cond
|
|
|
1580 ((eq ?& first-char);; "&" symbols take all following specs.
|
|
|
1581 (funcall (get-edebug-spec spec) cursor (cdr specs)))
|
|
|
1582 ((eq ?: first-char);; ":" symbols take one following spec.
|
|
|
1583 (setq rest (cdr (cdr specs)))
|
|
|
1584 (funcall (get-edebug-spec spec) cursor (car (cdr specs))))
|
|
|
1585 (t;; Any other normal spec.
|
|
|
1586 (setq rest (cdr specs))
|
|
|
1587 (edebug-match-one-spec cursor spec)))
|
|
|
1588 (funcall remainder-handler cursor rest remainder-handler)))))))
|
|
|
1589
|
|
|
1590
|
|
|
1591 ;; Define specs for all the symbol specs with functions used to process them.
|
|
|
1592 ;; Perhaps we shouldnt be doing this with edebug-form-specs since the
|
|
|
1593 ;; user may want to define macros or functions with the same names.
|
|
|
1594 ;; We could use an internal obarray for these primitive specs.
|
|
|
1595
|
|
|
1596 (mapcar
|
|
|
1597 (function (lambda (pair)
|
|
|
1598 (put (car pair) 'edebug-form-spec (cdr pair))))
|
|
|
1599 '((&optional . edebug-match-&optional)
|
|
|
1600 (&rest . edebug-match-&rest)
|
|
|
1601 (&or . edebug-match-&or)
|
|
|
1602 (form . edebug-match-form)
|
|
|
1603 (sexp . edebug-match-sexp)
|
|
|
1604 (body . edebug-match-body)
|
|
|
1605 (&define . edebug-match-&define)
|
|
|
1606 (name . edebug-match-name)
|
|
|
1607 (:name . edebug-match-colon-name)
|
|
|
1608 (arg . edebug-match-arg)
|
|
|
1609 (def-body . edebug-match-def-body)
|
|
|
1610 (def-form . edebug-match-def-form)
|
|
|
1611 ;; Less frequently used:
|
|
|
1612 ;; (function . edebug-match-function)
|
|
|
1613 (lambda-expr . edebug-match-lambda-expr)
|
|
|
1614 (¬ . edebug-match-¬)
|
|
|
1615 (&key . edebug-match-&key)
|
|
|
1616 (place . edebug-match-place)
|
|
|
1617 (gate . edebug-match-gate)
|
|
|
1618 ;; (nil . edebug-match-nil) not this one - special case it.
|
|
|
1619 ))
|
|
|
1620
|
|
|
1621 (defun edebug-match-symbol (cursor symbol)
|
|
|
1622 ;; Match a symbol spec.
|
|
|
1623 (let* ((spec (get-edebug-spec symbol)))
|
|
|
1624 (cond
|
|
|
1625 (spec
|
|
|
1626 (if (consp spec)
|
|
|
1627 ;; It is an indirect spec.
|
|
|
1628 (edebug-match cursor spec)
|
|
|
1629 ;; Otherwise it should be the symbol name of a function.
|
|
|
1630 ;; There could be a bug here - maybe need to do edebug-match bindings.
|
|
|
1631 (funcall spec cursor)))
|
|
|
1632
|
|
|
1633 ((null symbol) ;; special case this.
|
|
|
1634 (edebug-match-nil cursor))
|
|
|
1635
|
|
|
1636 ((fboundp symbol) ; is it a predicate?
|
|
|
1637 (let ((sexp (edebug-top-element-required cursor "Expected" symbol)))
|
|
|
1638 ;; Special case for edebug-`.
|
|
|
1639 (if (and (listp sexp) (eq (car sexp) ',))
|
|
|
1640 (edebug-match cursor '(("," def-form)))
|
|
|
1641 (if (not (funcall symbol sexp))
|
|
|
1642 (edebug-no-match cursor symbol "failed"))
|
|
|
1643 (edebug-move-cursor cursor)
|
|
|
1644 (list sexp))))
|
|
|
1645 (t (error "%s is not a form-spec or function" symbol))
|
|
|
1646 )))
|
|
|
1647
|
|
|
1648
|
|
|
1649 (defun edebug-match-sexp (cursor)
|
|
|
1650 (list (prog1 (edebug-top-element-required cursor "Expected sexp")
|
|
|
1651 (edebug-move-cursor cursor))))
|
|
|
1652
|
|
|
1653 (defun edebug-match-form (cursor)
|
|
|
1654 (list (edebug-form cursor)))
|
|
|
1655
|
|
|
1656 (defalias 'edebug-match-place 'edebug-match-form)
|
|
|
1657 ;; Currently identical to edebug-match-form.
|
|
|
1658 ;; This is for common lisp setf-style place arguments.
|
|
|
1659
|
|
|
1660 (defsubst edebug-match-body (cursor) (edebug-forms cursor))
|
|
|
1661
|
|
|
1662 (defun edebug-match-&optional (cursor specs)
|
|
|
1663 ;; Keep matching until one spec fails.
|
|
|
1664 (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper))
|
|
|
1665
|
|
|
1666 (defun edebug-&optional-wrapper (cursor specs remainder-handler)
|
|
|
1667 (let (result
|
|
|
1668 (edebug-&optional specs)
|
|
|
1669 (edebug-gate nil)
|
|
|
1670 (this-form (edebug-cursor-expressions cursor))
|
|
|
1671 (this-offset (edebug-cursor-offsets cursor)))
|
|
|
1672 (if (null (catch 'no-match
|
|
|
1673 (setq result
|
|
|
1674 (edebug-match-specs cursor specs remainder-handler))
|
|
|
1675 ;; Returning nil means no no-match was thrown.
|
|
|
1676 nil))
|
|
|
1677 result
|
|
|
1678 ;; no-match, but don't fail; just reset cursor and return nil.
|
|
|
1679 (edebug-set-cursor cursor this-form this-offset)
|
|
|
1680 nil)))
|
|
|
1681
|
|
|
1682
|
|
|
1683 (defun edebug-&rest-wrapper (cursor specs remainder-handler)
|
|
|
1684 (if (null specs) (setq specs edebug-&rest))
|
|
|
1685 ;; Reuse the &optional handler with this as the remainder handler.
|
|
|
1686 (edebug-&optional-wrapper cursor specs remainder-handler))
|
|
|
1687
|
|
|
1688 (defun edebug-match-&rest (cursor specs)
|
|
|
1689 ;; Repeatedly use specs until failure.
|
|
|
1690 (let ((edebug-&rest specs) ;; remember these
|
|
|
1691 edebug-best-error
|
|
|
1692 edebug-error-point)
|
|
|
1693 (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper)))
|
|
|
1694
|
|
|
1695
|
|
|
1696 (defun edebug-match-&or (cursor specs)
|
|
|
1697 ;; Keep matching until one spec succeeds, and return its results.
|
|
|
1698 ;; If none match, fail.
|
|
|
1699 ;; This needs to be optimized since most specs spend time here.
|
|
|
1700 (let ((original-specs specs)
|
|
|
1701 (this-form (edebug-cursor-expressions cursor))
|
|
|
1702 (this-offset (edebug-cursor-offsets cursor)))
|
|
|
1703 (catch 'matched
|
|
|
1704 (while specs
|
|
|
1705 (catch 'no-match
|
|
|
1706 (throw 'matched
|
|
|
1707 (let (edebug-gate ;; only while matching each spec
|
|
|
1708 edebug-best-error
|
|
|
1709 edebug-error-point)
|
|
|
1710 ;; Doesnt support e.g. &or symbolp &rest form
|
|
|
1711 (edebug-match-one-spec cursor (car specs)))))
|
|
|
1712 ;; Match failed, so reset and try again.
|
|
|
1713 (setq specs (cdr specs))
|
|
|
1714 ;; Reset the cursor for the next match.
|
|
|
1715 (edebug-set-cursor cursor this-form this-offset))
|
|
|
1716 ;; All failed.
|
|
|
1717 (apply 'edebug-no-match cursor "Expected one of" original-specs))
|
|
|
1718 ))
|
|
|
1719
|
|
|
1720
|
|
|
1721 (defun edebug-match-¬ (cursor specs)
|
|
|
1722 ;; If any specs match, then fail
|
|
|
1723 (if (null (catch 'no-match
|
|
|
1724 (let ((edebug-gate nil))
|
|
|
1725 (save-excursion
|
|
|
1726 (edebug-match-&or cursor specs)))
|
|
|
1727 nil))
|
|
|
1728 ;; This means something matched, so it is a no match.
|
|
|
1729 (edebug-no-match cursor "Unexpected"))
|
|
|
1730 ;; This means nothing matched, so it is OK.
|
|
|
1731 nil) ;; So, return nothing
|
|
|
1732
|
|
|
1733
|
|
|
1734 (def-edebug-spec &key edebug-match-&key)
|
|
|
1735
|
|
|
1736 (defun edebug-match-&key (cursor specs)
|
|
|
1737 ;; Following specs must look like (<name> <spec>) ...
|
|
|
1738 ;; where <name> is the name of a keyword, and spec is its spec.
|
|
|
1739 ;; This really doesnt save much over the expanded form and takes time.
|
|
|
1740 (edebug-match-&rest
|
|
|
1741 cursor
|
|
|
1742 (cons '&or
|
|
|
1743 (mapcar (function (lambda (pair)
|
|
|
1744 (vector (format ":%s" (car pair))
|
|
|
1745 (car (cdr pair)))))
|
|
|
1746 specs))))
|
|
|
1747
|
|
|
1748
|
|
|
1749 (defun edebug-match-gate (cursor)
|
|
|
1750 ;; Simply set the gate to prevent backtracking at this level.
|
|
|
1751 (setq edebug-gate t)
|
|
|
1752 nil)
|
|
|
1753
|
|
|
1754
|
|
|
1755 (defun edebug-match-list (cursor specs)
|
|
|
1756 ;; The spec is a list, but what kind of list, and what context?
|
|
|
1757 (if edebug-dotted-spec
|
|
|
1758 ;; After dotted spec but form did not contain dot,
|
|
|
1759 ;; so match list spec elements as if spliced in.
|
|
|
1760 (prog1
|
|
|
1761 (let ((edebug-dotted-spec))
|
|
|
1762 (edebug-match-specs cursor specs 'edebug-match-specs))
|
|
|
1763 ;; If it matched, really clear the dotted-spec flag.
|
|
|
1764 (setq edebug-dotted-spec nil))
|
|
|
1765 (let ((spec (car specs))
|
|
|
1766 (form (edebug-top-element-required cursor "Expected" specs)))
|
|
|
1767 (cond
|
|
|
1768 ((eq 'quote spec)
|
|
|
1769 (let ((spec (car (cdr specs))))
|
|
|
1770 (cond
|
|
|
1771 ((symbolp spec)
|
|
|
1772 ;; Special case: spec quotes a symbol to match.
|
|
|
1773 ;; Change in future. Use "..." instead.
|
|
|
1774 (if (not (eq spec form))
|
|
|
1775 (edebug-no-match cursor "Expected" spec))
|
|
|
1776 (edebug-move-cursor cursor)
|
|
|
1777 (setq edebug-gate t)
|
|
|
1778 form)
|
|
|
1779 (t
|
|
|
1780 (error "Bad spec: %s" specs)))))
|
|
|
1781
|
|
|
1782 ((listp form)
|
|
|
1783 (prog1
|
|
|
1784 (list (edebug-match-sublist
|
|
|
1785 ;; First offset is for the list form itself.
|
|
|
1786 ;; Treat nil as empty list.
|
|
|
1787 (edebug-new-cursor form (cdr (edebug-top-offset cursor)))
|
|
|
1788 specs))
|
|
|
1789 (edebug-move-cursor cursor)))
|
|
|
1790
|
|
|
1791 ((and (eq 'vector spec) (vectorp form))
|
|
|
1792 ;; Special case: match a vector with the specs.
|
|
|
1793 (let ((result (edebug-match-sublist
|
|
|
1794 (edebug-new-cursor
|
|
|
1795 form (cdr (edebug-top-offset cursor)))
|
|
|
1796 (cdr specs))))
|
|
|
1797 (edebug-move-cursor cursor)
|
|
|
1798 (list (apply 'vector result))))
|
|
|
1799
|
|
|
1800 (t (edebug-no-match cursor "Expected" specs)))
|
|
|
1801 )))
|
|
|
1802
|
|
|
1803
|
|
|
1804 (defun edebug-match-sublist (cursor specs)
|
|
|
1805 ;; Match a sublist of specs.
|
|
|
1806 (let (edebug-&optional
|
|
|
1807 ;;edebug-best-error
|
|
|
1808 ;;edebug-error-point
|
|
|
1809 )
|
|
|
1810 (prog1
|
|
|
1811 ;; match with edebug-match-specs so edebug-best-error is not bound.
|
|
|
1812 (edebug-match-specs cursor specs 'edebug-match-specs)
|
|
|
1813 (if (not (edebug-empty-cursor cursor))
|
|
|
1814 (if edebug-best-error
|
|
|
1815 (apply 'edebug-no-match cursor edebug-best-error)
|
|
|
1816 ;; A failed &rest or &optional spec may leave some args.
|
|
|
1817 (edebug-no-match cursor "Failed matching" specs)
|
|
|
1818 )))))
|
|
|
1819
|
|
|
1820
|
|
|
1821 (defun edebug-match-string (cursor spec)
|
|
|
1822 (let ((sexp (edebug-top-element-required cursor "Expected" spec)))
|
|
|
1823 (if (not (eq (intern spec) sexp))
|
|
|
1824 (edebug-no-match cursor "Expected" spec)
|
|
|
1825 ;; Since it matched, failure means immediate error, unless &optional.
|
|
|
1826 (setq edebug-gate t)
|
|
|
1827 (edebug-move-cursor cursor)
|
|
|
1828 (list sexp)
|
|
|
1829 )))
|
|
|
1830
|
|
|
1831 (defun edebug-match-nil (cursor)
|
|
|
1832 ;; There must be nothing left to match a nil.
|
|
|
1833 (if (not (edebug-empty-cursor cursor))
|
|
|
1834 (edebug-no-match cursor "Unmatched argument(s)")
|
|
|
1835 nil))
|
|
|
1836
|
|
|
1837
|
|
|
1838 (defun edebug-match-function (cursor)
|
|
|
1839 (error "Use function-form instead of function in edebug spec"))
|
|
|
1840
|
|
|
1841 (defun edebug-match-&define (cursor specs)
|
|
|
1842 ;; Match a defining form.
|
|
|
1843 ;; Normally, &define is interpretted specially other places.
|
|
|
1844 ;; This should only be called inside of a spec list to match the remainder
|
|
|
1845 ;; of the current list. e.g. ("lambda" &define args def-body)
|
|
|
1846 (edebug-make-form-wrapper
|
|
|
1847 cursor
|
|
|
1848 (edebug-before-offset cursor)
|
|
|
1849 ;; Find the last offset in the list.
|
|
|
1850 (let ((offsets (edebug-cursor-offsets cursor)))
|
|
|
1851 (while (consp offsets) (setq offsets (cdr offsets)))
|
|
|
1852 offsets)
|
|
|
1853 specs))
|
|
|
1854
|
|
|
1855 (defun edebug-match-lambda-expr (cursor)
|
|
|
1856 ;; The expression must be a function.
|
|
|
1857 ;; This will match any list form that begins with a symbol
|
|
|
1858 ;; that has an edebug-form-spec beginning with &define. In
|
|
|
1859 ;; practice, only lambda expressions should be used.
|
|
|
1860 ;; I could add a &lambda specification to avoid confusion.
|
|
|
1861 (let* ((sexp (edebug-top-element-required
|
|
|
1862 cursor "Expected lambda expression"))
|
|
|
1863 (offset (edebug-top-offset cursor))
|
|
|
1864 (head (and (consp sexp) (car sexp)))
|
|
|
1865 (spec (and (symbolp head) (get-edebug-spec head)))
|
|
|
1866 (edebug-inside-func nil))
|
|
|
1867 ;; Find out if this is a defining form from first symbol.
|
|
|
1868 (if (and (consp spec) (eq '&define (car spec)))
|
|
|
1869 (prog1
|
|
|
1870 (list
|
|
|
1871 (edebug-defining-form
|
|
|
1872 (edebug-new-cursor sexp offset)
|
|
|
1873 (car offset);; before the sexp
|
|
|
1874 (edebug-after-offset cursor)
|
|
|
1875 (cons (symbol-name head) (cdr spec))))
|
|
|
1876 (edebug-move-cursor cursor))
|
|
|
1877 (edebug-no-match cursor "Expected lambda expression")
|
|
|
1878 )))
|
|
|
1879
|
|
|
1880
|
|
|
1881 (defun edebug-match-name (cursor)
|
|
|
1882 ;; Set the edebug-def-name bound in edebug-defining-form.
|
|
|
1883 (let ((name (edebug-top-element-required cursor "Expected name")))
|
|
|
1884 ;; Maybe strings and numbers could be used.
|
|
|
1885 (if (not (symbolp name))
|
|
|
1886 (edebug-no-match cursor "Symbol expected for name of definition"))
|
|
|
1887 (setq edebug-def-name
|
|
|
1888 (if edebug-def-name
|
|
|
1889 ;; Construct a new name by appending to previous name.
|
|
|
1890 (intern (format "%s@%s" edebug-def-name name))
|
|
|
1891 name))
|
|
|
1892 (edebug-move-cursor cursor)
|
|
|
1893 (list name)))
|
|
|
1894
|
|
|
1895 (defun edebug-match-colon-name (cursor spec)
|
|
|
1896 ;; Set the edebug-def-name to the spec.
|
|
|
1897 (setq edebug-def-name
|
|
|
1898 (if edebug-def-name
|
|
|
1899 ;; Construct a new name by appending to previous name.
|
|
|
1900 (intern (format "%s@%s" edebug-def-name spec))
|
|
|
1901 spec))
|
|
|
1902 nil)
|
|
|
1903
|
|
|
1904 (defun edebug-match-arg (cursor)
|
|
|
1905 ;; set the def-args bound in edebug-defining-form
|
|
|
1906 (let ((edebug-arg (edebug-top-element-required cursor "Expected arg")))
|
|
|
1907 (if (or (not (symbolp edebug-arg))
|
|
|
1908 (edebug-lambda-list-keywordp edebug-arg))
|
|
|
1909 (edebug-no-match cursor "Bad argument:" edebug-arg))
|
|
|
1910 (edebug-move-cursor cursor)
|
|
|
1911 (setq edebug-def-args (cons edebug-arg edebug-def-args))
|
|
|
1912 (list edebug-arg)))
|
|
|
1913
|
|
|
1914 (defun edebug-match-def-form (cursor)
|
|
|
1915 ;; Like form but the form is wrapped in edebug-enter form.
|
|
|
1916 ;; The form is assumed to be executing outside of the function context.
|
|
|
1917 ;; This is a hack for now, since a def-form might execute inside as well.
|
|
|
1918 ;; Not to be used otherwise.
|
|
|
1919 (let ((edebug-inside-func nil))
|
|
|
1920 (list (edebug-make-enter-wrapper (list (edebug-form cursor))))))
|
|
|
1921
|
|
|
1922 (defun edebug-match-def-body (cursor)
|
|
|
1923 ;; Like body but body is wrapped in edebug-enter form.
|
|
|
1924 ;; The body is assumed to be executing inside of the function context.
|
|
|
1925 ;; Not to be used otherwise.
|
|
|
1926 (let ((edebug-inside-func t))
|
|
|
1927 (list (edebug-wrap-def-body (edebug-forms cursor)))))
|
|
|
1928
|
|
|
1929
|
|
|
1930 ;;;; Edebug Form Specs
|
|
|
1931 ;;; ==========================================================
|
|
|
1932 ;;; See cl-specs.el for common lisp specs.
|
|
|
1933
|
|
|
1934 ;;;;* Spec for def-edebug-spec
|
|
|
1935 ;;; Out of date.
|
|
|
1936
|
|
|
1937 (defun edebug-spec-p (object)
|
|
|
1938 "Return non-nil if OBJECT is a symbol with an edebug-form-spec property."
|
|
|
1939 (and (symbolp object)
|
|
|
1940 (get object 'edebug-form-spec)))
|
|
|
1941
|
|
|
1942 (def-edebug-spec def-edebug-spec
|
|
|
1943 ;; Top level is different from lower levels.
|
|
|
1944 (&define :name edebug-spec name
|
|
|
1945 &or "nil" edebug-spec-p "t" "0" (&rest edebug-spec)))
|
|
|
1946
|
|
|
1947 (def-edebug-spec edebug-spec-list
|
|
|
1948 ;; A list must have something in it, or it is nil, a symbolp
|
|
|
1949 ((edebug-spec . [&or nil edebug-spec])))
|
|
|
1950
|
|
|
1951 (def-edebug-spec edebug-spec
|
|
|
1952 (&or
|
|
|
1953 (vector &rest edebug-spec) ; matches a vector
|
|
|
1954 ("vector" &rest edebug-spec) ; matches a vector spec
|
|
|
1955 ("quote" symbolp)
|
|
|
1956 edebug-spec-list
|
|
|
1957 stringp
|
|
|
1958 [edebug-lambda-list-keywordp &rest edebug-spec]
|
|
|
1959 ;; [edebug-keywordp gate edebug-spec] ;; need edebug-keywordp for this.
|
|
|
1960 edebug-spec-p ;; Including all the special ones e.g. form.
|
|
|
1961 symbolp;; a predicate
|
|
|
1962 ))
|
|
|
1963
|
|
|
1964
|
|
|
1965 ;;;;* Emacs special forms and some functions.
|
|
|
1966
|
|
|
1967 ;; quote expects only one argument, although it allows any number.
|
|
|
1968 (def-edebug-spec quote sexp)
|
|
|
1969
|
|
|
1970 ;; The standard defining forms.
|
|
|
1971 (def-edebug-spec defconst defvar)
|
|
|
1972 (def-edebug-spec defvar (symbolp &optional form stringp))
|
|
|
1973
|
|
|
1974 (def-edebug-spec defun
|
|
|
1975 (&define name lambda-list
|
|
|
1976 [&optional stringp]
|
|
|
1977 [&optional ("interactive" interactive)]
|
|
|
1978 def-body))
|
|
|
1979 (def-edebug-spec defmacro
|
|
|
1980 (&define name lambda-list def-body))
|
|
|
1981
|
|
|
1982 (def-edebug-spec arglist lambda-list) ;; denegrated - use lambda-list.
|
|
|
1983
|
|
|
1984 (def-edebug-spec lambda-list
|
|
|
1985 (([&rest arg]
|
|
|
1986 [&optional ["&optional" arg &rest arg]]
|
|
|
1987 &optional ["&rest" arg]
|
|
|
1988 )))
|
|
|
1989
|
|
|
1990 (def-edebug-spec interactive
|
|
|
1991 (&optional &or stringp def-form))
|
|
|
1992
|
|
|
1993 ;; A function-form is for an argument that may be a function or a form.
|
|
|
1994 ;; This specially recognizes anonymous functions quoted with quote.
|
|
|
1995 (def-edebug-spec function-form
|
|
|
1996 ;; form at the end could also handle "function",
|
|
|
1997 ;; but recognize it specially to avoid wrapping function forms.
|
|
|
1998 (&or ([&or "quote" "function"] &or symbolp lambda-expr) form))
|
|
|
1999
|
|
|
2000 ;; function expects a symbol or a lambda or macro expression
|
|
|
2001 ;; A macro is allowed by Emacs.
|
|
|
2002 (def-edebug-spec function (&or symbolp lambda-expr))
|
|
|
2003
|
|
|
2004 ;; lambda is a macro in emacs 19.
|
|
|
2005 (def-edebug-spec lambda (&define lambda-list
|
|
|
2006 [&optional stringp]
|
|
|
2007 [&optional ("interactive" interactive)]
|
|
|
2008 def-body))
|
|
|
2009
|
|
|
2010 ;; A macro expression is a lambda expression with "macro" prepended.
|
|
|
2011 (def-edebug-spec macro (&define "lambda" lambda-list def-body))
|
|
|
2012
|
|
|
2013 ;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro])))
|
|
|
2014
|
|
|
2015 ;; Standard functions that take function-forms arguments.
|
|
|
2016 (def-edebug-spec mapcar (function-form form))
|
|
|
2017 (def-edebug-spec mapconcat (function-form form form))
|
|
|
2018 (def-edebug-spec mapatoms (function-form &optional form))
|
|
|
2019 (def-edebug-spec apply (function-form &rest form))
|
|
|
2020 (def-edebug-spec funcall (function-form &rest form))
|
|
|
2021
|
|
|
2022 (def-edebug-spec let
|
|
|
2023 ((&rest &or (symbolp &optional form) symbolp)
|
|
|
2024 body))
|
|
|
2025
|
|
|
2026 (def-edebug-spec let* let)
|
|
|
2027
|
|
|
2028 (def-edebug-spec setq (&rest symbolp form))
|
|
|
2029 (def-edebug-spec setq-default setq)
|
|
|
2030
|
|
|
2031 (def-edebug-spec cond (&rest (&rest form)))
|
|
|
2032
|
|
|
2033 (def-edebug-spec condition-case
|
|
|
2034 (symbolp
|
|
|
2035 form
|
|
|
2036 &rest (symbolp body)))
|
|
|
2037
|
|
|
2038
|
|
|
2039 (def-edebug-spec \` (backquote-form))
|
|
|
2040
|
|
|
2041 ;; Supports quotes inside backquotes,
|
|
|
2042 ;; but only at the top level inside unquotes.
|
|
|
2043 (def-edebug-spec backquote-form
|
|
|
2044 (&or
|
|
|
2045 ([&or "," ",@"] &or ("quote" backquote-form) form)
|
|
|
2046 (backquote-form &rest backquote-form)
|
|
|
2047 ;; If you use dotted forms in backquotes, replace the previous line
|
|
|
2048 ;; with the following. This takes quite a bit more stack space, however.
|
|
|
2049 ;; (backquote-form . [&or nil backquote-form])
|
|
|
2050 (vector &rest backquote-form)
|
|
|
2051 sexp))
|
|
|
2052
|
|
|
2053 ;; Special version of backquote that instruments backquoted forms
|
|
|
2054 ;; destined to be evaluated, usually as the result of a
|
|
|
2055 ;; macroexpansion. Backquoted code can only have unquotes (, and ,@)
|
|
|
2056 ;; in places where list forms are allowed, and predicates. If the
|
|
|
2057 ;; backquote is used in a macro, unquoted code that come from
|
|
|
2058 ;; arguments must be instrumented, if at all, with def-form not def-body.
|
|
|
2059
|
|
|
2060 ;; We could assume that all forms (not nested in other forms)
|
|
|
2061 ;; in arguments of macros should be def-forms, whether or not the macros
|
|
|
2062 ;; are defined with edebug-` but this would be expensive.
|
|
|
2063
|
|
|
2064 ;; ,@ might have some problems.
|
|
|
2065
|
|
|
2066 (defalias 'edebug-\` '\`) ;; same macro as regular backquote.
|
|
|
2067 (def-edebug-spec edebug-\` (def-form))
|
|
|
2068
|
|
|
2069 ;; Assume immediate quote in unquotes mean backquote at next higher level.
|
|
|
2070 (def-edebug-spec , (&or ("quote" edebug-`) def-form))
|
|
|
2071 (def-edebug-spec ,@ (&define ;; so (,@ form) is never wrapped.
|
|
|
2072 &or ("quote" edebug-`) def-form))
|
|
|
2073
|
|
|
2074 ;; New byte compiler.
|
|
|
2075 (def-edebug-spec defsubst defun)
|
|
|
2076 (def-edebug-spec dont-compile t)
|
|
|
2077 (def-edebug-spec eval-when-compile t)
|
|
|
2078 (def-edebug-spec eval-and-compile t)
|
|
|
2079
|
|
|
2080 ;; Anything else?
|
|
|
2081
|
|
|
2082
|
|
|
2083 ;;====================
|
|
|
2084 ;; Some miscellaneous specs for macros in public packages.
|
|
|
2085 ;; Send me yours.
|
|
|
2086
|
|
|
2087 ;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)
|
|
|
2088
|
|
|
2089 (def-edebug-spec ad-dolist ((symbolp form &optional form) body))
|
|
|
2090 (def-edebug-spec defadvice
|
|
|
2091 (&define name ;; thing being advised.
|
|
|
2092 (name ;; class is [&or "before" "around" "after"
|
|
|
2093 ;; "activation" "deactivation"]
|
|
|
2094 name ;; name of advice
|
|
|
2095 &rest sexp ;; optional position and flags
|
|
|
2096 )
|
|
|
2097 [&optional stringp]
|
|
|
2098 [&optional ("interactive" interactive)]
|
|
|
2099 def-body))
|
|
|
2100
|
|
|
2101
|
|
|
2102 ;;;; The debugger itself
|
|
|
2103 ;;; ===============================
|
|
|
2104
|
|
|
2105 (defvar edebug-active nil) ;; Non-nil when edebug is active
|
|
|
2106
|
|
|
2107 ;;; add minor-mode-alist entry
|
|
|
2108 (or (assq 'edebug-active minor-mode-alist)
|
|
|
2109 (setq minor-mode-alist (cons (list 'edebug-active " *Debugging*")
|
|
|
2110 minor-mode-alist)))
|
|
|
2111
|
|
|
2112 (defvar edebug-stack nil)
|
|
|
2113 ;; Stack of active functions evaluated via edebug.
|
|
|
2114 ;; Should be nil at the top level.
|
|
|
2115
|
|
|
2116 (defvar edebug-stack-depth -1)
|
|
|
2117 ;; Index of last edebug-stack item.
|
|
|
2118
|
|
|
2119 (defvar edebug-offset-indices nil)
|
|
|
2120 ;; Stack of offset indices of visited edebug sexps.
|
|
|
2121 ;; Should be nil at the top level.
|
|
|
2122 ;; Each function adds one cons. Top is modified with setcar.
|
|
|
2123
|
|
|
2124
|
|
|
2125 (defvar edebug-entered nil
|
|
|
2126 ;; Non-nil if edebug has already been entered at this recursive edit level.
|
|
|
2127 ;; This should stay nil at the top level.
|
|
|
2128 )
|
|
|
2129
|
|
|
2130 ;; Should these be options?
|
|
|
2131 (defconst edebug-debugger 'edebug
|
|
|
2132 ;; Name of function to use for debugging when error or quit occurs.
|
|
|
2133 ;; Set this to 'debug if you want to debug edebug.
|
|
|
2134 )
|
|
|
2135
|
|
|
2136
|
|
|
2137 ;; Dynamically bound variables, declared globally but left unbound.
|
|
|
2138 (defvar edebug-function) ; the function being executed. change name!!
|
|
|
2139 (defvar edebug-args) ; the arguments of the function
|
|
|
2140 (defvar edebug-data) ; the edebug data for the function
|
|
|
2141 (defvar edebug-value) ; the result of the expression
|
|
|
2142 (defvar edebug-after-index)
|
|
|
2143 (defvar edebug-def-mark) ; the mark for the definition
|
|
|
2144 (defvar edebug-freq-count) ; the count of expression visits.
|
|
|
2145 (defvar edebug-coverage) ; the coverage results of each expression of function.
|
|
|
2146
|
|
|
2147 (defvar edebug-buffer) ; which buffer the function is in.
|
|
|
2148 (defvar edebug-result) ; the result of the function call returned by body
|
|
|
2149 (defvar edebug-outside-executing-macro)
|
|
|
2150 (defvar edebug-outside-defining-kbd-macro)
|
|
|
2151
|
|
|
2152 (defvar edebug-execution-mode 'step) ; Current edebug mode set by user.
|
|
|
2153 (defvar edebug-next-execution-mode nil) ; Use once instead of initial mode.
|
|
|
2154
|
|
|
2155 (defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside
|
|
|
2156 (defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside
|
|
|
2157
|
|
|
2158 (defvar edebug-outside-pre-command-hook)
|
|
|
2159 (defvar edebug-outside-post-command-hook)
|
|
|
2160 (defvar edebug-outside-post-command-idle-hook)
|
|
|
2161
|
|
|
2162 ;; Emacs 19
|
|
|
2163 (defvar pre-command-hook nil)
|
|
|
2164 (defvar post-command-hook nil)
|
|
|
2165 (defvar post-command-idle-hook nil)
|
|
|
2166
|
|
|
2167 (defvar cl-lexical-debug) ;; Defined in cl.el
|
|
|
2168
|
|
|
2169 ;;; Handling signals
|
|
|
2170 ;;; =================
|
|
|
2171
|
|
|
2172 (if (not (fboundp 'edebug-original-signal))
|
|
|
2173 (defalias 'edebug-original-signal (symbol-function 'signal)))
|
|
|
2174 ;; We should use advise for this!!
|
|
|
2175
|
|
|
2176 (defun edebug-signal (edebug-signal-name edebug-signal-data)
|
|
|
2177 "Signal an error. Args are SIGNAL-NAME, and associated DATA.
|
|
|
2178 A signal name is a symbol with an `error-conditions' property
|
|
|
2179 that is a list of condition names.
|
|
|
2180 A handler for any of those names will get to handle this signal.
|
|
|
2181 The symbol `error' should always be one of them.
|
|
|
2182
|
|
|
2183 DATA should be a list. Its elements are printed as part of the error message.
|
|
|
2184 If the signal is handled, DATA is made available to the handler.
|
|
|
2185 See `condition-case'.
|
|
|
2186
|
|
|
2187 This is the Edebug replacement for the standard `signal'. It should
|
|
|
2188 only be active while Edebug is. It checks `debug-on-error' to see
|
|
|
2189 whether it should call the debugger. When execution is resumed, the
|
|
|
2190 error is signaled again."
|
|
|
2191 (if (and (listp debug-on-error) (memq edebug-signal-name debug-on-error))
|
|
|
2192 (edebug 'error (cons edebug-signal-name edebug-signal-data)))
|
|
|
2193 ;; If we reach here without another non-local exit, then send signal again.
|
|
|
2194 ;; i.e. the signal is not continuable, yet.
|
|
|
2195 (edebug-original-signal edebug-signal-name edebug-signal-data))
|
|
|
2196
|
|
|
2197
|
|
|
2198 ;;; Entering Edebug
|
|
|
2199 ;;; ==================
|
|
|
2200
|
|
|
2201 (defun edebug-enter (edebug-function edebug-args edebug-body)
|
|
|
2202 ;; Entering FUNC. The arguments are ARGS, and the body is BODY.
|
|
|
2203 ;; Setup edebug variables and evaluate BODY. This function is called
|
|
|
2204 ;; when a function evaluated with edebug-eval-top-level-form is entered.
|
|
|
2205 ;; Return the result of BODY.
|
|
|
2206
|
|
|
2207 ;; Is this the first time we are entering edebug since
|
|
|
2208 ;; lower-level recursive-edit command?
|
|
|
2209 ;; More precisely, this tests whether Edebug is currently active.
|
|
|
2210 (if (not edebug-entered)
|
|
|
2211 (let ((edebug-entered t)
|
|
|
2212 ;; Binding max-lisp-eval-depth here is OK,
|
|
|
2213 ;; but not inside an unwind-protect.
|
|
|
2214 ;; Doing it here also keeps it from growing too large.
|
|
|
2215 (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
|
|
|
2216 (max-specpdl-size (+ 200 max-specpdl-size))
|
|
|
2217
|
|
|
2218 (debugger edebug-debugger) ; only while edebug is active.
|
|
|
2219 (edebug-outside-debug-on-error debug-on-error)
|
|
|
2220 (edebug-outside-debug-on-quit debug-on-quit)
|
|
|
2221 ;; Binding these may not be the right thing to do.
|
|
|
2222 ;; We want to allow the global values to be changed.
|
|
|
2223 (debug-on-error (or debug-on-error edebug-on-error))
|
|
|
2224 (debug-on-quit edebug-on-quit)
|
|
|
2225
|
|
|
2226 ;; Lexical bindings must be uncompiled for this to work.
|
|
|
2227 (cl-lexical-debug t)
|
|
|
2228
|
|
|
2229 ;; Save the outside value of executing macro. (here??)
|
|
|
2230 (edebug-outside-executing-macro executing-macro)
|
|
|
2231 (edebug-outside-pre-command-hook pre-command-hook)
|
|
|
2232 (edebug-outside-post-command-hook post-command-hook)
|
|
|
2233 (edebug-outside-post-command-idle-hook post-command-idle-hook))
|
|
|
2234 (unwind-protect
|
|
|
2235 (let (;; Don't keep reading from an executing kbd macro
|
|
|
2236 ;; within edebug unless edebug-continue-kbd-macro is
|
|
|
2237 ;; non-nil. Again, local binding may not be best.
|
|
|
2238 (executing-macro
|
|
|
2239 (if edebug-continue-kbd-macro executing-macro))
|
|
|
2240
|
|
|
2241 ;; Disable command hooks. This is essential when
|
|
|
2242 ;; a hook function is instrumented - to avoid infinite loop.
|
|
|
2243 ;; This may be more than we need, however.
|
|
|
2244 (pre-command-hook nil)
|
|
|
2245 (post-command-hook nil)
|
|
|
2246 (post-command-idle-hook nil))
|
|
|
2247 (setq edebug-execution-mode (or edebug-next-execution-mode
|
|
|
2248 edebug-initial-mode
|
|
|
2249 edebug-execution-mode)
|
|
|
2250 edebug-next-execution-mode nil)
|
|
|
2251 ;; Bind signal to edebug-signal only while Edebug is active.
|
|
|
2252 (fset 'signal 'edebug-signal)
|
|
|
2253 (unwind-protect
|
|
|
2254 (edebug-enter edebug-function edebug-args edebug-body)
|
|
|
2255 (fset 'signal (symbol-function 'edebug-original-signal))))
|
|
|
2256 ;; Reset global variables in case outside value was changed.
|
|
|
2257 (setq executing-macro edebug-outside-executing-macro
|
|
|
2258 pre-command-hook edebug-outside-pre-command-hook
|
|
|
2259 post-command-hook edebug-outside-post-command-hook
|
|
|
2260 post-command-idle-hook edebug-outside-post-command-idle-hook
|
|
|
2261 )))
|
|
|
2262
|
|
|
2263 (let* ((edebug-data (get edebug-function 'edebug))
|
|
|
2264 (edebug-def-mark (car edebug-data)) ; mark at def start
|
|
|
2265 (edebug-freq-count (get edebug-function 'edebug-freq-count))
|
|
|
2266 (edebug-coverage (get edebug-function 'edebug-coverage))
|
|
|
2267 (edebug-buffer (marker-buffer edebug-def-mark))
|
|
|
2268
|
|
|
2269 (edebug-stack (cons edebug-function edebug-stack))
|
|
|
2270 (edebug-offset-indices (cons 0 edebug-offset-indices))
|
|
|
2271 )
|
|
|
2272 (if (get edebug-function 'edebug-on-entry)
|
|
|
2273 (progn
|
|
|
2274 (setq edebug-execution-mode 'step)
|
|
|
2275 (if (eq (get edebug-function 'edebug-on-entry) 'temp)
|
|
|
2276 (put edebug-function 'edebug-on-entry nil))))
|
|
|
2277 (if edebug-trace
|
|
|
2278 (edebug-enter-trace edebug-body)
|
|
|
2279 (funcall edebug-body))
|
|
|
2280 )))
|
|
|
2281
|
|
|
2282
|
|
|
2283 (defun edebug-enter-trace (edebug-body)
|
|
|
2284 (let ((edebug-stack-depth (1+ edebug-stack-depth))
|
|
|
2285 edebug-result)
|
|
|
2286 (edebug-print-trace-before
|
|
|
2287 (format "%s args: %s" edebug-function edebug-args))
|
|
|
2288 (prog1 (setq edebug-result (funcall edebug-body))
|
|
|
2289 (edebug-print-trace-after
|
|
|
2290 (format "%s result: %s" edebug-function edebug-result)))))
|
|
|
2291
|
|
|
2292 (def-edebug-spec edebug-tracing (form body))
|
|
|
2293
|
|
|
2294 (defmacro edebug-tracing (msg &rest body)
|
|
|
2295 "Print MSG in *edebug-trace* before and after evaluating BODY.
|
|
|
2296 The result of BODY is also printed."
|
|
|
2297 (` (let ((edebug-stack-depth (1+ edebug-stack-depth))
|
|
|
2298 edebug-result)
|
|
|
2299 (edebug-print-trace-before (, msg))
|
|
|
2300 (prog1 (setq edebug-result (progn (,@ body)))
|
|
|
2301 (edebug-print-trace-after
|
|
|
2302 (format "%s result: %s" (, msg) edebug-result))))))
|
|
|
2303
|
|
|
2304 (defun edebug-print-trace-before (msg)
|
|
|
2305 "Function called to print trace info before expression evaluation.
|
|
|
2306 MSG is printed after `::::{ '."
|
|
|
2307 (edebug-trace-display
|
|
|
2308 edebug-trace-buffer "%s{ %s" (make-string edebug-stack-depth ?\:) msg))
|
|
|
2309
|
|
|
2310 (defun edebug-print-trace-after (msg)
|
|
|
2311 "Function called to print trace info after expression evaluation.
|
|
|
2312 MSG is printed after `::::} '."
|
|
|
2313 (edebug-trace-display
|
|
|
2314 edebug-trace-buffer "%s} %s" (make-string edebug-stack-depth ?\:) msg))
|
|
|
2315
|
|
|
2316
|
|
|
2317
|
|
|
2318 (defun edebug-slow-before (edebug-before-index)
|
|
|
2319 ;; Debug current function given BEFORE position.
|
|
|
2320 ;; Called from functions compiled with edebug-eval-top-level-form.
|
|
|
2321 ;; Return the before index.
|
|
|
2322 (setcar edebug-offset-indices edebug-before-index)
|
|
|
2323
|
|
|
2324 ;; Increment frequency count
|
|
|
2325 (aset edebug-freq-count edebug-before-index
|
|
|
2326 (1+ (aref edebug-freq-count edebug-before-index)))
|
|
|
2327
|
|
|
2328 (if (or (not (memq edebug-execution-mode '(Go-nonstop next)))
|
|
|
2329 (edebug-input-pending-p))
|
|
|
2330 (edebug-debugger edebug-before-index 'before nil))
|
|
|
2331 edebug-before-index)
|
|
|
2332
|
|
|
2333 (defun edebug-fast-before (edebug-before-index)
|
|
|
2334 ;; Do nothing.
|
|
|
2335 )
|
|
|
2336
|
|
|
2337 (defun edebug-slow-after (edebug-before-index edebug-after-index edebug-value)
|
|
|
2338 ;; Debug current function given AFTER position and VALUE.
|
|
|
2339 ;; Called from functions compiled with edebug-eval-top-level-form.
|
|
|
2340 ;; Return VALUE.
|
|
|
2341 (setcar edebug-offset-indices edebug-after-index)
|
|
|
2342
|
|
|
2343 ;; Increment frequency count
|
|
|
2344 (aset edebug-freq-count edebug-after-index
|
|
|
2345 (1+ (aref edebug-freq-count edebug-after-index)))
|
|
|
2346 (if edebug-test-coverage (edebug-update-coverage))
|
|
|
2347
|
|
|
2348 (if (and (eq edebug-execution-mode 'Go-nonstop)
|
|
|
2349 (not (edebug-input-pending-p)))
|
|
|
2350 ;; Just return result.
|
|
|
2351 edebug-value
|
|
|
2352 (edebug-debugger edebug-after-index 'after edebug-value)
|
|
|
2353 ))
|
|
|
2354
|
|
|
2355 (defun edebug-fast-after (edebug-before-index edebug-after-index edebug-value)
|
|
|
2356 ;; Do nothing but return the value.
|
|
|
2357 edebug-value)
|
|
|
2358
|
|
|
2359 (defun edebug-run-slow ()
|
|
|
2360 (defalias 'edebug-before 'edebug-slow-before)
|
|
|
2361 (defalias 'edebug-after 'edebug-slow-after))
|
|
|
2362
|
|
|
2363 ;; This is not used, yet.
|
|
|
2364 (defun edebug-run-fast ()
|
|
|
2365 (defalias 'edebug-before 'edebug-fast-before)
|
|
|
2366 (defalias 'edebug-after 'edebug-fast-after))
|
|
|
2367
|
|
|
2368 (edebug-run-slow)
|
|
|
2369
|
|
|
2370
|
|
|
2371 (defun edebug-update-coverage ()
|
|
|
2372 (let ((old-result (aref edebug-coverage edebug-after-index)))
|
|
|
2373 (cond
|
|
|
2374 ((eq 'ok-coverage old-result))
|
|
|
2375 ((eq 'unknown old-result)
|
|
|
2376 (aset edebug-coverage edebug-after-index edebug-value))
|
|
|
2377 ;; Test if a different result.
|
|
|
2378 ((not (eq edebug-value old-result))
|
|
|
2379 (aset edebug-coverage edebug-after-index 'ok-coverage)))))
|
|
|
2380
|
|
|
2381
|
|
|
2382 ;; Dynamically declared unbound variables.
|
|
|
2383 (defvar edebug-arg-mode) ; the mode, either before, after, or error
|
|
|
2384 (defvar edebug-breakpoints)
|
|
|
2385 (defvar edebug-break-data) ; break data for current function.
|
|
|
2386 (defvar edebug-break) ; whether a break occurred.
|
|
|
2387 (defvar edebug-global-break) ; whether a global break occurred.
|
|
|
2388 (defvar edebug-break-condition) ; whether the breakpoint is conditional.
|
|
|
2389
|
|
|
2390 (defvar edebug-break-result nil)
|
|
|
2391 (defvar edebug-global-break-result nil)
|
|
|
2392
|
|
|
2393
|
|
|
2394 (defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-value)
|
|
|
2395 ;; Check breakpoints and pending input.
|
|
|
2396 ;; If edebug display should be updated, call edebug-display.
|
|
|
2397 ;; Return edebug-value.
|
|
|
2398 (let* (;; This needs to be here since breakpoints may be changed.
|
|
|
2399 (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints
|
|
|
2400 (edebug-break-data (assq edebug-offset-index edebug-breakpoints))
|
|
|
2401 (edebug-break-condition (car (cdr edebug-break-data)))
|
|
|
2402 (edebug-global-break
|
|
|
2403 (if edebug-global-break-condition
|
|
|
2404 (condition-case nil
|
|
|
2405 (setq edebug-global-break-result
|
|
|
2406 (eval edebug-global-break-condition))
|
|
|
2407 (error nil))))
|
|
|
2408 (edebug-break))
|
|
|
2409
|
|
|
2410 ;;; (edebug-trace "exp: %s" edebug-value)
|
|
|
2411 ;; Test whether we should break.
|
|
|
2412 (setq edebug-break
|
|
|
2413 (or edebug-global-break
|
|
|
2414 (and edebug-break-data
|
|
|
2415 (or (not edebug-break-condition)
|
|
|
2416 (setq edebug-break-result
|
|
|
2417 (eval edebug-break-condition))))))
|
|
|
2418 (if (and edebug-break
|
|
|
2419 (nth 2 edebug-break-data)) ; is it temporary?
|
|
|
2420 ;; Delete the breakpoint.
|
|
|
2421 (setcdr edebug-data
|
|
|
2422 (cons (delq edebug-break-data edebug-breakpoints)
|
|
|
2423 (cdr (cdr edebug-data)))))
|
|
|
2424
|
|
|
2425 ;; Display if mode is not go, continue, or Continue-fast
|
|
|
2426 ;; or break, or input is pending,
|
|
|
2427 (if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))
|
|
|
2428 edebug-break
|
|
|
2429 (edebug-input-pending-p))
|
|
|
2430 (edebug-display)) ; <--------------- display
|
|
|
2431
|
|
|
2432 edebug-value
|
|
|
2433 ))
|
|
|
2434
|
|
|
2435
|
|
|
2436 ;; window-start now stored with each function.
|
|
|
2437 ;;(defvar edebug-window-start nil)
|
|
|
2438 ;; Remember where each buffers' window starts between edebug calls.
|
|
|
2439 ;; This is to avoid spurious recentering.
|
|
|
2440 ;; Does this still need to be buffer-local??
|
|
|
2441 ;;(setq-default edebug-window-start nil)
|
|
|
2442 ;;(make-variable-buffer-local 'edebug-window-start)
|
|
|
2443
|
|
|
2444
|
|
|
2445 ;; Dynamically declared unbound vars
|
|
|
2446 (defvar edebug-point) ; the point in edebug buffer
|
|
|
2447 (defvar edebug-outside-buffer) ; the current-buffer outside of edebug
|
|
|
2448 (defvar edebug-outside-point) ; the point outside of edebug
|
|
|
2449 (defvar edebug-outside-mark) ; the mark outside of edebug
|
|
|
2450 (defvar edebug-window-data) ; window and window-start for current function
|
|
|
2451 (defvar edebug-outside-windows) ; outside window configuration
|
|
|
2452 (defvar edebug-eval-buffer) ; for the evaluation list.
|
|
|
2453 (defvar edebug-outside-o-a-p) ; outside overlay-arrow-position
|
|
|
2454 (defvar edebug-outside-o-a-s) ; outside overlay-arrow-string
|
|
|
2455 (defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area
|
|
|
2456
|
|
|
2457 (defvar edebug-eval-list nil) ;; List of expressions to evaluate.
|
|
|
2458
|
|
|
2459 (defvar edebug-previous-result nil) ;; Last result returned.
|
|
|
2460
|
|
|
2461 ;; Emacs 19 adds an arg to mark and mark-marker.
|
|
|
2462 (defalias 'edebug-mark 'mark)
|
|
|
2463 (defalias 'edebug-mark-marker 'mark-marker)
|
|
|
2464
|
|
|
2465
|
|
|
2466 (defun edebug-display ()
|
|
|
2467 ;; Setup windows for edebug, determine mode, maybe enter recursive-edit.
|
|
|
2468 ;; Uses local variables of edebug-enter, edebug-before, edebug-after
|
|
|
2469 ;; and edebug-debugger.
|
|
|
2470 (let ((edebug-active t) ; for minor mode alist
|
|
|
2471 edebug-stop ; should we enter recursive-edit
|
|
|
2472 (edebug-point (+ edebug-def-mark
|
|
|
2473 (aref (nth 2 edebug-data) edebug-offset-index)))
|
|
|
2474 edebug-buffer-outside-point ; current point in edebug-buffer
|
|
|
2475 ;; window displaying edebug-buffer
|
|
|
2476 (edebug-window-data (nth 3 edebug-data))
|
|
|
2477 (edebug-outside-window (selected-window))
|
|
|
2478 (edebug-outside-buffer (current-buffer))
|
|
|
2479 (edebug-outside-point (point))
|
|
|
2480 (edebug-outside-mark (edebug-mark))
|
|
|
2481 edebug-outside-windows ; window or screen configuration
|
|
|
2482 edebug-buffer-points
|
|
|
2483
|
|
|
2484 edebug-eval-buffer ; declared here so we can kill it below
|
|
|
2485 (edebug-eval-result-list (and edebug-eval-list
|
|
|
2486 (edebug-eval-result-list)))
|
|
|
2487 edebug-trace-window
|
|
|
2488 edebug-trace-window-start
|
|
|
2489
|
|
|
2490 (edebug-outside-o-a-p overlay-arrow-position)
|
|
|
2491 (edebug-outside-o-a-s overlay-arrow-string)
|
|
|
2492 (edebug-outside-c-i-e-a cursor-in-echo-area))
|
|
|
2493 (unwind-protect
|
|
|
2494 (let ((overlay-arrow-position overlay-arrow-position)
|
|
|
2495 (overlay-arrow-string overlay-arrow-string)
|
|
|
2496 (cursor-in-echo-area nil)
|
|
|
2497 ;; any others??
|
|
|
2498 )
|
|
|
2499 (if (not (buffer-name edebug-buffer))
|
|
|
2500 (let ((debug-on-error nil))
|
|
|
2501 (error "Buffer defining %s not found" edebug-function)))
|
|
|
2502
|
|
|
2503 (if (eq 'after edebug-arg-mode)
|
|
|
2504 ;; Compute result string now before windows are modified.
|
|
|
2505 (edebug-compute-previous-result edebug-value))
|
|
|
2506
|
|
|
2507 (if edebug-save-windows
|
|
|
2508 ;; Save windows now before we modify them.
|
|
|
2509 (setq edebug-outside-windows
|
|
|
2510 (edebug-current-windows edebug-save-windows)))
|
|
|
2511
|
|
|
2512 (if edebug-save-displayed-buffer-points
|
|
|
2513 (setq edebug-buffer-points (edebug-get-displayed-buffer-points)))
|
|
|
2514
|
|
|
2515 ;; First move the edebug buffer point to edebug-point
|
|
|
2516 ;; so that window start doesnt get changed when we display it.
|
|
|
2517 ;; I dont know if this is going to help.
|
|
|
2518 ;;(set-buffer edebug-buffer)
|
|
|
2519 ;;(goto-char edebug-point)
|
|
|
2520
|
|
|
2521 ;; If edebug-buffer is not currently displayed,
|
|
|
2522 ;; first find a window for it.
|
|
|
2523 (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))
|
|
|
2524 (setcar edebug-window-data (selected-window))
|
|
|
2525
|
|
|
2526 ;; Now display eval list, if any.
|
|
|
2527 ;; This is done after the pop to edebug-buffer
|
|
|
2528 ;; so that buffer-window correspondence is correct after quitting.
|
|
|
2529 (edebug-eval-display edebug-eval-result-list)
|
|
|
2530 ;; The evaluation list better not have deleted edebug-window-data.
|
|
|
2531 (select-window (car edebug-window-data))
|
|
|
2532 (set-buffer edebug-buffer)
|
|
|
2533
|
|
|
2534 (setq edebug-buffer-outside-point (point))
|
|
|
2535 (goto-char edebug-point)
|
|
|
2536
|
|
|
2537 (if (eq 'before edebug-arg-mode)
|
|
|
2538 ;; Check whether positions are up-to-date.
|
|
|
2539 ;; This assumes point is never before symbol.
|
|
|
2540 (if (not (memq (following-char) '(?\( ?\# ?\` )))
|
|
|
2541 (let ((debug-on-error nil))
|
|
|
2542 (error "Source has changed - reevaluate definition of %s"
|
|
|
2543 edebug-function)
|
|
|
2544 )))
|
|
|
2545
|
|
|
2546 (setcdr edebug-window-data
|
|
|
2547 (edebug-adjust-window (cdr edebug-window-data)))
|
|
|
2548
|
|
|
2549 ;; Test if there is input, not including keyboard macros.
|
|
|
2550 (if (edebug-input-pending-p)
|
|
|
2551 (progn
|
|
|
2552 (setq edebug-execution-mode 'step
|
|
|
2553 edebug-stop t)
|
|
|
2554 (edebug-stop)
|
|
|
2555 ;; (discard-input) ; is this unfriendly??
|
|
|
2556 ))
|
|
|
2557 ;; Now display arrow based on mode.
|
|
|
2558 (edebug-overlay-arrow)
|
|
|
2559
|
|
|
2560 (cond
|
|
|
2561 ((eq 'error edebug-arg-mode)
|
|
|
2562 ;; Display error message
|
|
|
2563 (setq edebug-execution-mode 'step)
|
|
|
2564 (edebug-overlay-arrow)
|
|
|
2565 (beep)
|
|
|
2566 (if (eq 'quit (car edebug-value))
|
|
|
2567 (message "Quit")
|
|
|
2568 (edebug-report-error edebug-value)))
|
|
|
2569 (edebug-break
|
|
|
2570 (cond
|
|
|
2571 (edebug-global-break
|
|
|
2572 (message "Global Break: %s => %s"
|
|
|
2573 edebug-global-break-condition
|
|
|
2574 edebug-global-break-result))
|
|
|
2575 (edebug-break-condition
|
|
|
2576 (message "Break: %s => %s"
|
|
|
2577 edebug-break-condition
|
|
|
2578 edebug-break-result))
|
|
|
2579 ((not (eq edebug-execution-mode 'Continue-fast))
|
|
|
2580 (message "Break"))
|
|
|
2581 (t)))
|
|
|
2582
|
|
|
2583 (t (message "")))
|
|
|
2584
|
|
|
2585 (if (eq 'after edebug-arg-mode)
|
|
|
2586 (progn
|
|
|
2587 ;; Display result of previous evaluation.
|
|
|
2588 (if (and edebug-break
|
|
|
2589 (not (eq edebug-execution-mode 'Continue-fast)))
|
|
|
2590 (sit-for 1)) ; Show break message.
|
|
|
2591 (edebug-previous-result)))
|
|
|
2592
|
|
|
2593 (cond
|
|
|
2594 (edebug-break
|
|
|
2595 (cond
|
|
|
2596 ((eq edebug-execution-mode 'continue) (edebug-sit-for 1))
|
|
|
2597 ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0))
|
|
|
2598 (t (setq edebug-stop t))))
|
|
|
2599 ;; not edebug-break
|
|
|
2600 ((eq edebug-execution-mode 'trace)
|
|
|
2601 (edebug-sit-for 1)) ; Force update and pause.
|
|
|
2602 ((eq edebug-execution-mode 'Trace-fast)
|
|
|
2603 (edebug-sit-for 0)) ; Force update and continue.
|
|
|
2604 )
|
|
|
2605
|
|
|
2606 (unwind-protect
|
|
|
2607 (if (or edebug-stop
|
|
|
2608 (memq edebug-execution-mode '(step next))
|
|
|
2609 (eq edebug-arg-mode 'error))
|
|
|
2610 (progn
|
|
|
2611 ;; (setq edebug-execution-mode 'step)
|
|
|
2612 ;; (edebug-overlay-arrow) ; this doesnt always show up.
|
|
|
2613 (edebug-recursive-edit))) ; <---------- Recursive edit
|
|
|
2614
|
|
|
2615 ;; Reset the edebug-window-data to whatever it is now.
|
|
|
2616 (let ((window (if (eq (window-buffer) edebug-buffer)
|
|
|
2617 (selected-window)
|
|
|
2618 (edebug-get-buffer-window edebug-buffer))))
|
|
|
2619 ;; Remember window-start for edebug-buffer, if still displayed.
|
|
|
2620 (if window
|
|
|
2621 (progn
|
|
|
2622 (setcar edebug-window-data window)
|
|
|
2623 (setcdr edebug-window-data (window-start window)))))
|
|
|
2624
|
|
|
2625 ;; Save trace window point before restoring outside windows.
|
|
|
2626 ;; Could generalize this for other buffers.
|
|
|
2627 (setq edebug-trace-window (get-buffer-window edebug-trace-buffer))
|
|
|
2628 (if edebug-trace-window
|
|
|
2629 (setq edebug-trace-window-start
|
|
|
2630 (and edebug-trace-window
|
|
|
2631 (window-start edebug-trace-window))))
|
|
|
2632
|
|
|
2633 ;; Restore windows before continuing.
|
|
|
2634 (if edebug-save-windows
|
|
|
2635 (progn
|
|
|
2636 (edebug-set-windows edebug-outside-windows)
|
|
|
2637
|
|
|
2638 ;; Restore displayed buffer points.
|
|
|
2639 ;; Needed even if restoring windows because
|
|
|
2640 ;; window-points are not restored. (should they be??)
|
|
|
2641 (if edebug-save-displayed-buffer-points
|
|
|
2642 (edebug-set-buffer-points edebug-buffer-points))
|
|
|
2643
|
|
|
2644 ;; Unrestore trace window's window-point.
|
|
|
2645 (if edebug-trace-window
|
|
|
2646 (set-window-start edebug-trace-window
|
|
|
2647 edebug-trace-window-start))
|
|
|
2648
|
|
|
2649 ;; Unrestore edebug-buffer's window-start, if displayed.
|
|
|
2650 (let ((window (car edebug-window-data)))
|
|
|
2651 (if (and window (edebug-window-live-p window)
|
|
|
2652 (eq (window-buffer) edebug-buffer))
|
|
|
2653 (progn
|
|
|
2654 (set-window-start window (cdr edebug-window-data)
|
|
|
2655 'no-force)
|
|
|
2656 ;; Unrestore edebug-buffer's window-point.
|
|
|
2657 ;; Needed in addition to setting the buffer point
|
|
|
2658 ;; - otherwise quitting doesnt leave point as is.
|
|
|
2659 ;; But this causes point to not be restored at times.
|
|
|
2660 ;; Also, it may not be a visible window.
|
|
|
2661 ;; (set-window-point window edebug-point)
|
|
|
2662 )))
|
|
|
2663
|
|
|
2664 ;; Unrestore edebug-buffer's point. Rerestored below.
|
|
|
2665 ;; (goto-char edebug-point) ;; in edebug-buffer
|
|
|
2666 )
|
|
|
2667 ;; Since we may be in a save-excursion, in case of quit,
|
|
|
2668 ;; reselect the outside window only.
|
|
|
2669 ;; Only needed if we are not recovering windows??
|
|
|
2670 (if (edebug-window-live-p edebug-outside-window)
|
|
|
2671 (select-window edebug-outside-window))
|
|
|
2672 ) ; if edebug-save-windows
|
|
|
2673
|
|
|
2674 ;; Restore current buffer always, in case application needs it.
|
|
|
2675 (set-buffer edebug-outside-buffer)
|
|
|
2676 ;; Restore point, and mark.
|
|
|
2677 ;; Needed even if restoring windows because
|
|
|
2678 ;; that doesnt restore point and mark in the current buffer.
|
|
|
2679 ;; But dont restore point if edebug-buffer is current buffer.
|
|
|
2680 (if (not (eq edebug-buffer edebug-outside-buffer))
|
|
|
2681 (goto-char edebug-outside-point))
|
|
|
2682 (if (marker-buffer (edebug-mark-marker))
|
|
|
2683 ;; Does zmacs-regions need to be nil while doing set-marker?
|
|
|
2684 (set-marker (edebug-mark-marker) edebug-outside-mark))
|
|
|
2685 ) ; unwind-protect
|
|
|
2686 ;; None of the following is done if quit or signal occurs.
|
|
|
2687
|
|
|
2688 ;; Restore edebug-buffer's outside point.
|
|
|
2689 ;; (edebug-trace "restore edebug-buffer point: %s"
|
|
|
2690 ;; edebug-buffer-outside-point)
|
|
|
2691 (let ((current-buffer (current-buffer)))
|
|
|
2692 (set-buffer edebug-buffer)
|
|
|
2693 (goto-char edebug-buffer-outside-point)
|
|
|
2694 (set-buffer current-buffer))
|
|
|
2695 ;; ... nothing more.
|
|
|
2696 )
|
|
|
2697 ;; Reset global variables to outside values in case they were changed.
|
|
|
2698 (setq
|
|
|
2699 overlay-arrow-position edebug-outside-o-a-p
|
|
|
2700 overlay-arrow-string edebug-outside-o-a-s
|
|
|
2701 cursor-in-echo-area edebug-outside-c-i-e-a)
|
|
|
2702 )))
|
|
|
2703
|
|
|
2704
|
|
|
2705 (defvar edebug-number-of-recursions 0)
|
|
|
2706 ;; Number of recursive edits started by edebug.
|
|
|
2707 ;; Should be 0 at the top level.
|
|
|
2708
|
|
|
2709 (defvar edebug-recursion-depth 0)
|
|
|
2710 ;; Value of recursion-depth when edebug was called.
|
|
|
2711
|
|
|
2712 ;; Dynamically declared unbound vars
|
|
|
2713 (defvar edebug-outside-match-data) ; match data outside of edebug
|
|
|
2714 (defvar edebug-backtrace-buffer) ; each recursive edit gets its own
|
|
|
2715 (defvar edebug-inside-windows)
|
|
|
2716 (defvar edebug-interactive-p)
|
|
|
2717
|
|
|
2718 (defvar edebug-outside-map)
|
|
|
2719 (defvar edebug-outside-standard-output)
|
|
|
2720 (defvar edebug-outside-standard-input)
|
|
|
2721 (defvar edebug-outside-last-command-char)
|
|
|
2722 (defvar edebug-outside-last-command)
|
|
|
2723 (defvar edebug-outside-this-command)
|
|
|
2724 (defvar edebug-outside-last-input-char)
|
|
|
2725
|
|
|
2726 ;; Note: here we have defvars for variables that are
|
|
|
2727 ;; built-in in certain versions.
|
|
|
2728 ;; Each defvar makes a difference
|
|
|
2729 ;; in versions where the variable is *not* built-in.
|
|
|
2730
|
|
|
2731 ;; Emacs 18
|
|
|
2732 (defvar edebug-outside-unread-command-char)
|
|
|
2733
|
|
|
2734 ;; XEmacs
|
|
|
2735 (defvar edebug-outside-unread-command-event) ;; like unread-command-events
|
|
|
2736 (defvar unread-command-event nil)
|
|
|
2737
|
|
|
2738 ;; Emacs 19.
|
|
|
2739 (defvar edebug-outside-last-command-event)
|
|
|
2740 (defvar edebug-outside-unread-command-events)
|
|
|
2741 (defvar edebug-outside-last-input-event)
|
|
|
2742 (defvar edebug-outside-last-event-frame)
|
|
|
2743 (defvar edebug-outside-last-nonmenu-event)
|
|
|
2744 (defvar edebug-outside-track-mouse)
|
|
|
2745
|
|
|
2746 ;; Disable byte compiler warnings about unread-command-char and -event
|
|
|
2747 ;; (maybe works with byte-compile-version 2.22 at least)
|
|
|
2748 (defvar edebug-unread-command-char-warning)
|
|
|
2749 (defvar edebug-unread-command-event-warning)
|
|
|
2750 (eval-when-compile
|
|
|
2751 (setq edebug-unread-command-char-warning
|
|
|
2752 (get 'unread-command-char 'byte-obsolete-variable))
|
|
|
2753 (put 'unread-command-char 'byte-obsolete-variable nil)
|
|
|
2754 (setq edebug-unread-command-event-warning
|
|
|
2755 (get 'unread-command-event 'byte-obsolete-variable))
|
|
|
2756 (put 'unread-command-event 'byte-obsolete-variable nil))
|
|
|
2757
|
|
|
2758 (defun edebug-recursive-edit ()
|
|
|
2759 ;; Start up a recursive edit inside of edebug.
|
|
|
2760 ;; The current buffer is the edebug-buffer, which is put into edebug-mode.
|
|
|
2761 ;; Assume that none of the variables below are buffer-local.
|
|
|
2762 (let ((edebug-buffer-read-only buffer-read-only)
|
|
|
2763 ;; match-data must be done in the outside buffer
|
|
|
2764 (edebug-outside-match-data
|
|
|
2765 (save-excursion ; might be unnecessary now??
|
|
|
2766 (set-buffer edebug-outside-buffer) ; in case match buffer different
|
|
|
2767 (match-data)))
|
|
|
2768
|
|
|
2769 ;;(edebug-number-of-recursions (1+ edebug-number-of-recursions))
|
|
|
2770 (edebug-recursion-depth (recursion-depth))
|
|
|
2771 edebug-entered ; bind locally to nil
|
|
|
2772 (edebug-interactive-p nil) ; again non-interactive
|
|
|
2773 edebug-backtrace-buffer ; each recursive edit gets its own
|
|
|
2774 ;; The window configuration may be saved and restored
|
|
|
2775 ;; during a recursive-edit
|
|
|
2776 edebug-inside-windows
|
|
|
2777
|
|
|
2778 (edebug-outside-map (current-local-map))
|
|
|
2779
|
|
|
2780 (edebug-outside-standard-output standard-output)
|
|
|
2781 (edebug-outside-standard-input standard-input)
|
|
|
2782 (edebug-outside-defining-kbd-macro defining-kbd-macro)
|
|
|
2783
|
|
|
2784 (edebug-outside-last-command-char last-command-char)
|
|
|
2785 (edebug-outside-last-command last-command)
|
|
|
2786 (edebug-outside-this-command this-command)
|
|
|
2787 (edebug-outside-last-input-char last-input-char)
|
|
|
2788
|
|
|
2789 ;; XEmacs: added the boundp checks
|
|
|
2790 (edebug-outside-unread-command-char
|
|
|
2791 (and (boundp 'unread-command-char) unread-command-char))
|
|
|
2792
|
|
|
2793 (edebug-outside-last-input-event
|
|
|
2794 (and (boundp 'last-input-event) last-input-event))
|
|
|
2795 (edebug-outside-last-command-event
|
|
|
2796 (and (boundp 'last-command-event) last-command-event))
|
|
|
2797 (edebug-outside-unread-command-event
|
|
|
2798 (and (boundp 'unread-command-event) unread-command-event))
|
|
|
2799 (edebug-outside-unread-command-events
|
|
|
2800 (and (boundp 'unread-command-events) unread-command-events))
|
|
|
2801 (edebug-outside-last-event-frame
|
|
|
2802 (and (boundp 'last-event-frame) last-event-frame))
|
|
|
2803 (edebug-outside-last-nonmenu-event
|
|
|
2804 (and (boundp 'last-nonmenu-event) last-nonmenu-event))
|
|
|
2805 (edebug-outside-track-mouse
|
|
|
2806 (and (boundp 'track-mouse) track-mouse))
|
|
|
2807 )
|
|
|
2808
|
|
|
2809 (unwind-protect
|
|
|
2810 (let (
|
|
|
2811 ;; Declare global values local but using the same global value.
|
|
|
2812 ;; We could set these to the values for previous edebug call.
|
|
|
2813 (last-command-char last-command-char)
|
|
|
2814 (last-command last-command)
|
|
|
2815 (this-command this-command)
|
|
|
2816 (last-input-char last-input-char)
|
|
|
2817
|
|
|
2818 ;; Assume no edebug command sets unread-command-char.
|
|
|
2819 (unread-command-char -1)
|
|
|
2820
|
|
|
2821 ;; More for Emacs 19
|
|
|
2822 (last-input-event nil)
|
|
|
2823 (last-command-event nil)
|
|
|
2824 (unread-command-event nil);; XEmacs
|
|
|
2825 (unread-command-events nil)
|
|
|
2826 (last-event-frame nil)
|
|
|
2827 (last-nonmenu-event nil)
|
|
|
2828 (track-mouse nil)
|
|
|
2829
|
|
|
2830 ;; Bind again to outside values.
|
|
|
2831 (debug-on-error edebug-outside-debug-on-error)
|
|
|
2832 (debug-on-quit edebug-outside-debug-on-quit)
|
|
|
2833
|
|
|
2834 ;; Don't keep defining a kbd macro.
|
|
|
2835 (defining-kbd-macro
|
|
|
2836 (if edebug-continue-kbd-macro defining-kbd-macro))
|
|
|
2837
|
|
|
2838 ;; others??
|
|
|
2839 )
|
|
|
2840
|
|
|
2841 (if (fboundp 'zmacs-deactivate-region);; for XEmacs
|
|
|
2842 (zmacs-deactivate-region))
|
|
|
2843 (if (and (eq edebug-execution-mode 'go)
|
|
|
2844 (not (memq edebug-arg-mode '(after error))))
|
|
|
2845 (message "Break"))
|
|
|
2846
|
|
|
2847 (setq buffer-read-only t)
|
|
|
2848 (fset 'signal (symbol-function 'edebug-original-signal))
|
|
|
2849
|
|
|
2850 (edebug-mode)
|
|
|
2851 (unwind-protect
|
|
|
2852 (recursive-edit) ; <<<<<<<<<< Recursive edit
|
|
|
2853
|
|
|
2854 ;; Do the following, even if quit occurs.
|
|
|
2855 (fset 'signal 'edebug-signal)
|
|
|
2856 (if edebug-backtrace-buffer
|
|
|
2857 (kill-buffer edebug-backtrace-buffer))
|
|
|
2858 ;; Could be an option to keep eval display up.
|
|
|
2859 (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
|
|
|
2860
|
|
|
2861 ;; Remember selected-window after recursive-edit.
|
|
|
2862 ;; (setq edebug-inside-window (selected-window))
|
|
|
2863
|
|
|
2864 (store-match-data edebug-outside-match-data)
|
|
|
2865
|
|
|
2866 ;; Recursive edit may have changed buffers,
|
|
|
2867 ;; so set it back before exiting let.
|
|
|
2868 (if (buffer-name edebug-buffer) ; if it still exists
|
|
|
2869 (progn
|
|
|
2870 (set-buffer edebug-buffer)
|
|
|
2871 (if (memq edebug-execution-mode '(go Go-nonstop))
|
|
|
2872 (edebug-overlay-arrow))
|
|
|
2873 (setq buffer-read-only edebug-buffer-read-only)
|
|
|
2874 (use-local-map edebug-outside-map)
|
|
|
2875 )
|
|
|
2876 ;; gotta have a buffer to let its buffer local variables be set
|
|
|
2877 (get-buffer-create " bogus edebug buffer"))
|
|
|
2878 ));; inner let
|
|
|
2879
|
|
|
2880 ;; Reset global vars to outside values, in case they have been changed.
|
|
|
2881 (setq
|
|
|
2882 last-command-char edebug-outside-last-command-char
|
|
|
2883 last-command-event edebug-outside-last-command-event
|
|
|
2884 last-command edebug-outside-last-command
|
|
|
2885 this-command edebug-outside-this-command
|
|
|
2886 unread-command-char edebug-outside-unread-command-char
|
|
|
2887 unread-command-event edebug-outside-unread-command-event
|
|
|
2888 unread-command-events edebug-outside-unread-command-events
|
|
|
2889 last-input-char edebug-outside-last-input-char
|
|
|
2890 last-input-event edebug-outside-last-input-event
|
|
|
2891 last-event-frame edebug-outside-last-event-frame
|
|
|
2892 last-nonmenu-event edebug-outside-last-nonmenu-event
|
|
|
2893 track-mouse edebug-outside-track-mouse
|
|
|
2894
|
|
|
2895 standard-output edebug-outside-standard-output
|
|
|
2896 standard-input edebug-outside-standard-input
|
|
|
2897 defining-kbd-macro edebug-outside-defining-kbd-macro
|
|
|
2898 ))
|
|
|
2899 ))
|
|
|
2900
|
|
|
2901
|
|
|
2902 ;;; Display related functions
|
|
|
2903 ;;; ===============================
|
|
|
2904
|
|
|
2905 (defun edebug-adjust-window (old-start)
|
|
|
2906 ;; If pos is not visible, adjust current window to fit following context.
|
|
|
2907 ;;; (message "window: %s old-start: %s window-start: %s pos: %s"
|
|
|
2908 ;;; (selected-window) old-start (window-start) (point)) (sit-for 5)
|
|
|
2909 (if (not (pos-visible-in-window-p))
|
|
|
2910 (progn
|
|
|
2911 ;; First try old-start
|
|
|
2912 (if old-start
|
|
|
2913 (set-window-start (selected-window) old-start))
|
|
|
2914 (if (not (pos-visible-in-window-p))
|
|
|
2915 (progn
|
|
|
2916 ;; (message "resetting window start") (sit-for 2)
|
|
|
2917 (set-window-start
|
|
|
2918 (selected-window)
|
|
|
2919 (save-excursion
|
|
|
2920 (forward-line
|
|
|
2921 (if (< (point) (window-start)) -1 ; one line before if in back
|
|
|
2922 (- (/ (window-height) 2)) ; center the line moving forward
|
|
|
2923 ))
|
|
|
2924 (beginning-of-line)
|
|
|
2925 (point)))))))
|
|
|
2926 (window-start))
|
|
|
2927
|
|
|
2928
|
|
|
2929
|
|
|
2930 (defconst edebug-arrow-alist
|
|
|
2931 '((Continue-fast . "=")
|
|
|
2932 (Trace-fast . "-")
|
|
|
2933 (continue . ">")
|
|
|
2934 (trace . "->")
|
|
|
2935 (step . "=>")
|
|
|
2936 (next . "=>")
|
|
|
2937 (go . "<>")
|
|
|
2938 (Go-nonstop . "..") ; not used
|
|
|
2939 )
|
|
|
2940 "Association list of arrows for each edebug mode.")
|
|
|
2941
|
|
|
2942 (defun edebug-overlay-arrow ()
|
|
|
2943 ;; Set up the overlay arrow at beginning-of-line in current buffer.
|
|
|
2944 ;; The arrow string is derived from edebug-arrow-alist and
|
|
|
2945 ;; edebug-execution-mode.
|
|
|
2946 (let ((pos (save-excursion (beginning-of-line) (point))))
|
|
|
2947 (setq overlay-arrow-string
|
|
|
2948 (cdr (assq edebug-execution-mode edebug-arrow-alist)))
|
|
|
2949 (setq overlay-arrow-position (make-marker))
|
|
|
2950 (set-marker overlay-arrow-position pos (current-buffer))))
|
|
|
2951
|
|
|
2952
|
|
|
2953 (defun edebug-toggle-save-all-windows ()
|
|
|
2954 "Toggle the saving and restoring of all windows.
|
|
|
2955 Also, each time you toggle it on, the inside and outside window
|
|
|
2956 configurations become the same as the current configuration."
|
|
|
2957 (interactive)
|
|
|
2958 (setq edebug-save-windows (not edebug-save-windows))
|
|
|
2959 (if edebug-save-windows
|
|
|
2960 (setq edebug-inside-windows
|
|
|
2961 (setq edebug-outside-windows
|
|
|
2962 (edebug-current-windows
|
|
|
2963 edebug-save-windows))))
|
|
|
2964 (message "Window saving is %s for all windows."
|
|
|
2965 (if edebug-save-windows "on" "off")))
|
|
|
2966
|
|
|
2967 (defmacro edebug-changing-windows (&rest body)
|
|
|
2968 (` (let ((window (selected-window)))
|
|
|
2969 (setq edebug-inside-windows (edebug-current-windows t))
|
|
|
2970 (edebug-set-windows edebug-outside-windows)
|
|
|
2971 (,@ body) ;; Code to change edebug-save-windows
|
|
|
2972 (setq edebug-outside-windows (edebug-current-windows
|
|
|
2973 edebug-save-windows))
|
|
|
2974 ;; Problem: what about outside windows that are deleted inside?
|
|
|
2975 (edebug-set-windows edebug-inside-windows))))
|
|
|
2976
|
|
|
2977 (defun edebug-toggle-save-selected-window ()
|
|
|
2978 "Toggle the saving and restoring of the selected window.
|
|
|
2979 Also, each time you toggle it on, the inside and outside window
|
|
|
2980 configurations become the same as the current configuration."
|
|
|
2981 (interactive)
|
|
|
2982 (cond
|
|
|
2983 ((eq t edebug-save-windows)
|
|
|
2984 ;; Save all outside windows except the selected one.
|
|
|
2985 ;; Remove (selected-window) from outside-windows.
|
|
|
2986 (edebug-changing-windows
|
|
|
2987 (setq edebug-save-windows (delq window (edebug-window-list)))))
|
|
|
2988
|
|
|
2989 ((memq (selected-window) edebug-save-windows)
|
|
|
2990 (setq edebug-outside-windows
|
|
|
2991 (delq (assq (selected-window) edebug-outside-windows)
|
|
|
2992 edebug-outside-windows))
|
|
|
2993 (setq edebug-save-windows
|
|
|
2994 (delq (selected-window) edebug-save-windows)))
|
|
|
2995 (t ; Save a new window.
|
|
|
2996 (edebug-changing-windows
|
|
|
2997 (setq edebug-save-windows (cons window edebug-save-windows)))))
|
|
|
2998
|
|
|
2999 (message "Window saving is %s for %s."
|
|
|
3000 (if (memq (selected-window) edebug-save-windows)
|
|
|
3001 "on" "off")
|
|
|
3002 (selected-window)))
|
|
|
3003
|
|
|
3004 (defun edebug-toggle-save-windows (arg)
|
|
|
3005 "Toggle the saving and restoring of windows.
|
|
|
3006 With prefix, toggle for just the selected window.
|
|
|
3007 Otherwise, toggle for all windows."
|
|
|
3008 (interactive "P")
|
|
|
3009 (if arg
|
|
|
3010 (edebug-toggle-save-selected-window)
|
|
|
3011 (edebug-toggle-save-all-windows)))
|
|
|
3012
|
|
|
3013
|
|
|
3014 (defun edebug-where ()
|
|
|
3015 "Show the debug windows and where we stopped in the program."
|
|
|
3016 (interactive)
|
|
|
3017 (if (not edebug-active)
|
|
|
3018 (error "Edebug is not active"))
|
|
|
3019 ;; Restore the window configuration to what it last was inside.
|
|
|
3020 ;; But it is not always set. - experiment
|
|
|
3021 ;;(if edebug-inside-windows
|
|
|
3022 ;; (edebug-set-windows edebug-inside-windows))
|
|
|
3023 (edebug-pop-to-buffer edebug-buffer)
|
|
|
3024 (goto-char edebug-point))
|
|
|
3025
|
|
|
3026 (defun edebug-view-outside ()
|
|
|
3027 "Change to the outside window configuration."
|
|
|
3028 (interactive)
|
|
|
3029 (if (not edebug-active)
|
|
|
3030 (error "Edebug is not active"))
|
|
|
3031 (setq edebug-inside-windows
|
|
|
3032 (edebug-current-windows edebug-save-windows))
|
|
|
3033 (edebug-set-windows edebug-outside-windows)
|
|
|
3034 (goto-char edebug-outside-point)
|
|
|
3035 (message "Window configuration outside of Edebug. Return with %s"
|
|
|
3036 (substitute-command-keys "\\<global-map>\\[edebug-where]")))
|
|
|
3037
|
|
|
3038
|
|
|
3039 (defun edebug-bounce-point (arg)
|
|
|
3040 "Bounce the point in the outside current buffer.
|
|
|
3041 If prefix arg is supplied, sit for that many seconds before returning.
|
|
|
3042 The default is one second."
|
|
|
3043 (interactive "p")
|
|
|
3044 (if (not edebug-active)
|
|
|
3045 (error "Edebug is not active"))
|
|
|
3046 (save-excursion
|
|
|
3047 ;; If the buffer's currently displayed, avoid set-window-configuration.
|
|
|
3048 (save-window-excursion
|
|
|
3049 (edebug-pop-to-buffer edebug-outside-buffer)
|
|
|
3050 (goto-char edebug-outside-point)
|
|
|
3051 (message "Current buffer: %s Point: %s Mark: %s"
|
|
|
3052 (current-buffer) (point)
|
|
|
3053 (if (marker-buffer (edebug-mark-marker))
|
|
|
3054 (marker-position (edebug-mark-marker)) "<not set>"))
|
|
|
3055 (edebug-sit-for arg)
|
|
|
3056 (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
|
|
|
3057
|
|
|
3058
|
|
|
3059 ;; Joe Wells, here is a start at your idea of adding a buffer to the internal
|
|
|
3060 ;; display list. Still need to use this list in edebug-display.
|
|
|
3061
|
|
|
3062 '(defvar edebug-display-buffer-list nil
|
|
|
3063 "List of buffers that edebug will display when it is active.")
|
|
|
3064
|
|
|
3065 '(defun edebug-display-buffer (buffer)
|
|
|
3066 "Toggle display of a buffer inside of edebug."
|
|
|
3067 (interactive "bBuffer: ")
|
|
|
3068 (let ((already-displaying (memq buffer edebug-display-buffer-list)))
|
|
|
3069 (setq edebug-display-buffer-list
|
|
|
3070 (if already-displaying
|
|
|
3071 (delq buffer edebug-display-buffer-list)
|
|
|
3072 (cons buffer edebug-display-buffer-list)))
|
|
|
3073 (message "Displaying %s %s" buffer
|
|
|
3074 (if already-displaying "off" "on"))))
|
|
|
3075
|
|
|
3076
|
|
|
3077 ;;; Breakpoint related functions
|
|
|
3078 ;;; ===============================
|
|
|
3079
|
|
|
3080 (defun edebug-find-stop-point ()
|
|
|
3081 ;; Return (function . index) of the nearest edebug stop point.
|
|
|
3082 (let* ((edebug-def-name (edebug-form-data-symbol))
|
|
|
3083 (edebug-data
|
|
|
3084 (let ((data (get edebug-def-name 'edebug)))
|
|
|
3085 (if (or (null data) (markerp data))
|
|
|
3086 (error "%s is not instrumented for Edebug" edebug-def-name))
|
|
|
3087 data)) ; we could do it automatically, if data is a marker.
|
|
|
3088 ;; pull out parts of edebug-data.
|
|
|
3089 (edebug-def-mark (car edebug-data))
|
|
|
3090 ;; (edebug-breakpoints (car (cdr edebug-data)))
|
|
|
3091
|
|
|
3092 (offset-vector (nth 2 edebug-data))
|
|
|
3093 (offset (- (save-excursion
|
|
|
3094 (if (looking-at "[ \t]")
|
|
|
3095 ;; skip backwards until non-whitespace, or bol
|
|
|
3096 (skip-chars-backward " \t"))
|
|
|
3097 (point))
|
|
|
3098 edebug-def-mark))
|
|
|
3099 len i)
|
|
|
3100 ;; the offsets are in order so we can do a linear search
|
|
|
3101 (setq len (length offset-vector))
|
|
|
3102 (setq i 0)
|
|
|
3103 (while (and (< i len) (> offset (aref offset-vector i)))
|
|
|
3104 (setq i (1+ i)))
|
|
|
3105 (if (and (< i len)
|
|
|
3106 (<= offset (aref offset-vector i)))
|
|
|
3107 ;; return the relevant info
|
|
|
3108 (cons edebug-def-name i)
|
|
|
3109 (message "Point is not on an expression in %s."
|
|
|
3110 edebug-def-name)
|
|
|
3111 )))
|
|
|
3112
|
|
|
3113
|
|
|
3114 (defun edebug-next-breakpoint ()
|
|
|
3115 "Move point to the next breakpoint, or first if none past point."
|
|
|
3116 (interactive)
|
|
|
3117 (let ((edebug-stop-point (edebug-find-stop-point)))
|
|
|
3118 (if edebug-stop-point
|
|
|
3119 (let* ((edebug-def-name (car edebug-stop-point))
|
|
|
3120 (index (cdr edebug-stop-point))
|
|
|
3121 (edebug-data (get edebug-def-name 'edebug))
|
|
|
3122
|
|
|
3123 ;; pull out parts of edebug-data
|
|
|
3124 (edebug-def-mark (car edebug-data))
|
|
|
3125 (edebug-breakpoints (car (cdr edebug-data)))
|
|
|
3126 (offset-vector (nth 2 edebug-data))
|
|
|
3127 breakpoint)
|
|
|
3128 (if (not edebug-breakpoints)
|
|
|
3129 (message "No breakpoints in this function.")
|
|
|
3130 (let ((breaks edebug-breakpoints))
|
|
|
3131 (while (and breaks
|
|
|
3132 (<= (car (car breaks)) index))
|
|
|
3133 (setq breaks (cdr breaks)))
|
|
|
3134 (setq breakpoint
|
|
|
3135 (if breaks
|
|
|
3136 (car breaks)
|
|
|
3137 ;; goto the first breakpoint
|
|
|
3138 (car edebug-breakpoints)))
|
|
|
3139 (goto-char (+ edebug-def-mark
|
|
|
3140 (aref offset-vector (car breakpoint))))
|
|
|
3141
|
|
|
3142 (message (concat (if (nth 2 breakpoint)
|
|
|
3143 "Temporary " "")
|
|
|
3144 (if (car (cdr breakpoint))
|
|
|
3145 (format "Condition: %s"
|
|
|
3146 (edebug-safe-prin1-to-string
|
|
|
3147 (car (cdr breakpoint))))
|
|
|
3148 "")))
|
|
|
3149 ))))))
|
|
|
3150
|
|
|
3151
|
|
|
3152 (defun edebug-modify-breakpoint (flag &optional condition temporary)
|
|
|
3153 "Modify the breakpoint for the form at point or after it according
|
|
|
3154 to FLAG: set if t, clear if nil. Then move to that point.
|
|
|
3155 If CONDITION or TEMPORARY are non-nil, add those attributes to
|
|
|
3156 the breakpoint. "
|
|
|
3157 (let ((edebug-stop-point (edebug-find-stop-point)))
|
|
|
3158 (if edebug-stop-point
|
|
|
3159 (let* ((edebug-def-name (car edebug-stop-point))
|
|
|
3160 (index (cdr edebug-stop-point))
|
|
|
3161 (edebug-data (get edebug-def-name 'edebug))
|
|
|
3162
|
|
|
3163 ;; pull out parts of edebug-data
|
|
|
3164 (edebug-def-mark (car edebug-data))
|
|
|
3165 (edebug-breakpoints (car (cdr edebug-data)))
|
|
|
3166 (offset-vector (nth 2 edebug-data))
|
|
|
3167 present)
|
|
|
3168 ;; delete it either way
|
|
|
3169 (setq present (assq index edebug-breakpoints))
|
|
|
3170 (setq edebug-breakpoints (delq present edebug-breakpoints))
|
|
|
3171 (if flag
|
|
|
3172 (progn
|
|
|
3173 ;; add it to the list and resort
|
|
|
3174 (setq edebug-breakpoints
|
|
|
3175 (edebug-sort-alist
|
|
|
3176 (cons
|
|
|
3177 (list index condition temporary)
|
|
|
3178 edebug-breakpoints) '<))
|
|
|
3179 (if condition
|
|
|
3180 (message "Breakpoint set in %s with condition: %s"
|
|
|
3181 edebug-def-name condition)
|
|
|
3182 (message "Breakpoint set in %s" edebug-def-name)))
|
|
|
3183 (if present
|
|
|
3184 (message "Breakpoint unset in %s" edebug-def-name)
|
|
|
3185 (message "No breakpoint here")))
|
|
|
3186
|
|
|
3187 (setcar (cdr edebug-data) edebug-breakpoints)
|
|
|
3188 (goto-char (+ edebug-def-mark (aref offset-vector index)))
|
|
|
3189 ))))
|
|
|
3190
|
|
|
3191 (defun edebug-set-breakpoint (arg)
|
|
|
3192 "Set the breakpoint of nearest sexp.
|
|
|
3193 With prefix argument, make it a temporary breakpoint."
|
|
|
3194 (interactive "P")
|
|
|
3195 (edebug-modify-breakpoint t nil arg))
|
|
|
3196
|
|
|
3197 (defun edebug-unset-breakpoint ()
|
|
|
3198 "Clear the breakpoint of nearest sexp."
|
|
|
3199 (interactive)
|
|
|
3200 (edebug-modify-breakpoint nil))
|
|
|
3201
|
|
|
3202
|
|
|
3203 ;; For emacs 18, no read-expression-history
|
|
|
3204 (defun edebug-set-conditional-breakpoint (arg condition)
|
|
|
3205 "Set a conditional breakpoint at nearest sexp.
|
|
|
3206 The condition is evaluated in the outside context.
|
|
|
3207 With prefix argument, make it a temporary breakpoint."
|
|
|
3208 ;; (interactive "P\nxCondition: ")
|
|
|
3209 (interactive
|
|
|
3210 (list
|
|
|
3211 current-prefix-arg
|
|
|
3212 ;; Edit previous condition as follows, but it is cumbersome:
|
|
|
3213 (let ((edebug-stop-point (edebug-find-stop-point)))
|
|
|
3214 (if edebug-stop-point
|
|
|
3215 (let* ((edebug-def-name (car edebug-stop-point))
|
|
|
3216 (index (cdr edebug-stop-point))
|
|
|
3217 (edebug-data (get edebug-def-name 'edebug))
|
|
|
3218 (edebug-breakpoints (car (cdr edebug-data)))
|
|
|
3219 (edebug-break-data (assq index edebug-breakpoints))
|
|
|
3220 (edebug-break-condition (car (cdr edebug-break-data))))
|
|
|
3221 (read-minibuffer
|
|
|
3222 (format "Condition in %s: " edebug-def-name)
|
|
|
3223 (if edebug-break-condition
|
|
|
3224 (format "%s" edebug-break-condition)
|
|
|
3225 (format ""))))))))
|
|
|
3226 (edebug-modify-breakpoint t condition arg))
|
|
|
3227
|
|
|
3228
|
|
|
3229 (defun edebug-set-global-break-condition (expression)
|
|
|
3230 (interactive (list (read-minibuffer
|
|
|
3231 "Global Condition: "
|
|
|
3232 (format "%s" edebug-global-break-condition))))
|
|
|
3233 (setq edebug-global-break-condition expression))
|
|
|
3234
|
|
|
3235
|
|
|
3236 ;;; Mode switching functions
|
|
|
3237 ;;; ===============================
|
|
|
3238
|
|
|
3239 (defun edebug-set-mode (mode shortmsg msg)
|
|
|
3240 ;; Set the edebug mode to MODE.
|
|
|
3241 ;; Display SHORTMSG, or MSG if not within edebug.
|
|
|
3242 (if (eq (1+ edebug-recursion-depth) (recursion-depth))
|
|
|
3243 (progn
|
|
|
3244 (setq edebug-execution-mode mode)
|
|
|
3245 (message shortmsg)
|
|
|
3246 ;; Continue execution
|
|
|
3247 (exit-recursive-edit))
|
|
|
3248 ;; This is not terribly useful!!
|
|
|
3249 (setq edebug-next-execution-mode mode)
|
|
|
3250 (message msg)))
|
|
|
3251
|
|
|
3252
|
|
|
3253 (defalias 'edebug-step-through-mode 'edebug-step-mode)
|
|
|
3254
|
|
|
3255 (defun edebug-step-mode ()
|
|
|
3256 "Proceed to next stop point."
|
|
|
3257 (interactive)
|
|
|
3258 (edebug-set-mode 'step "" "Edebug will stop at next stop point."))
|
|
|
3259
|
|
|
3260 (defun edebug-next-mode ()
|
|
|
3261 "Proceed to next `after' stop point."
|
|
|
3262 (interactive)
|
|
|
3263 (edebug-set-mode 'next "" "Edebug will stop after next eval."))
|
|
|
3264
|
|
|
3265 (defun edebug-go-mode (arg)
|
|
|
3266 "Go, evaluating until break.
|
|
|
3267 With prefix ARG, set temporary break at current point and go."
|
|
|
3268 (interactive "P")
|
|
|
3269 (if arg
|
|
|
3270 (edebug-set-breakpoint t))
|
|
|
3271 (edebug-set-mode 'go "Go..." "Edebug will go until break."))
|
|
|
3272
|
|
|
3273 (defun edebug-Go-nonstop-mode ()
|
|
|
3274 "Go, evaluating without debugging."
|
|
|
3275 (interactive)
|
|
|
3276 (edebug-set-mode 'Go-nonstop "Go-Nonstop..."
|
|
|
3277 "Edebug will not stop at breaks."))
|
|
|
3278
|
|
|
3279
|
|
|
3280 (defun edebug-trace-mode ()
|
|
|
3281 "Begin trace mode."
|
|
|
3282 (interactive)
|
|
|
3283 (edebug-set-mode 'trace "Tracing..." "Edebug will trace with pause."))
|
|
|
3284
|
|
|
3285 (defun edebug-Trace-fast-mode ()
|
|
|
3286 "Trace with no wait at each step."
|
|
|
3287 (interactive)
|
|
|
3288 (edebug-set-mode 'Trace-fast
|
|
|
3289 "Trace fast..." "Edebug will trace without pause."))
|
|
|
3290
|
|
|
3291 (defun edebug-continue-mode ()
|
|
|
3292 "Begin continue mode."
|
|
|
3293 (interactive)
|
|
|
3294 (edebug-set-mode 'continue "Continue..."
|
|
|
3295 "Edebug will pause at breakpoints."))
|
|
|
3296
|
|
|
3297 (defun edebug-Continue-fast-mode ()
|
|
|
3298 "Trace with no wait at each step."
|
|
|
3299 (interactive)
|
|
|
3300 (edebug-set-mode 'Continue-fast "Continue fast..."
|
|
|
3301 "Edebug will stop and go at breakpoints."))
|
|
|
3302
|
|
|
3303 ;; ------------------------------------------------------------
|
|
|
3304 ;; The following use the mode changing commands and breakpoints.
|
|
|
3305
|
|
|
3306
|
|
|
3307 (defun edebug-goto-here ()
|
|
|
3308 "Proceed to this stop point."
|
|
|
3309 (interactive)
|
|
|
3310 (edebug-go-mode t))
|
|
|
3311
|
|
|
3312
|
|
|
3313 (defun edebug-stop ()
|
|
|
3314 "Stop execution and do not continue.
|
|
|
3315 Useful for exiting from trace or continue loop."
|
|
|
3316 (interactive)
|
|
|
3317 (message "Stop"))
|
|
|
3318
|
|
|
3319
|
|
|
3320 '(defun edebug-forward ()
|
|
|
3321 "Proceed to the exit of the next expression to be evaluated."
|
|
|
3322 (interactive)
|
|
|
3323 (edebug-set-mode
|
|
|
3324 'forward "Forward"
|
|
|
3325 "Edebug will stop after exiting the next expression."))
|
|
|
3326
|
|
|
3327
|
|
|
3328 (defun edebug-forward-sexp (arg)
|
|
|
3329 "Proceed from the current point to the end of the ARGth sexp ahead.
|
|
|
3330 If there are not ARG sexps ahead, then do edebug-step-out."
|
|
|
3331 (interactive "p")
|
|
|
3332 (condition-case nil
|
|
|
3333 (let ((parse-sexp-ignore-comments t))
|
|
|
3334 ;; Call forward-sexp repeatedly until done or failure.
|
|
|
3335 (forward-sexp arg)
|
|
|
3336 (edebug-go-mode t))
|
|
|
3337 (error
|
|
|
3338 (edebug-step-out)
|
|
|
3339 )))
|
|
|
3340
|
|
|
3341 (defun edebug-step-out ()
|
|
|
3342 "Proceed from the current point to the end of the containing sexp.
|
|
|
3343 If there is no containing sexp that is not the top level defun,
|
|
|
3344 go to the end of the last sexp, or if that is the same point, then step."
|
|
|
3345 (interactive)
|
|
|
3346 (condition-case nil
|
|
|
3347 (let ((parse-sexp-ignore-comments t))
|
|
|
3348 (up-list 1)
|
|
|
3349 (save-excursion
|
|
|
3350 ;; Is there still a containing expression?
|
|
|
3351 (up-list 1))
|
|
|
3352 (edebug-go-mode t))
|
|
|
3353 (error
|
|
|
3354 ;; At top level - 1, so first check if there are more sexps at this level.
|
|
|
3355 (let ((start-point (point)))
|
|
|
3356 ;; (up-list 1)
|
|
|
3357 (down-list -1)
|
|
|
3358 (if (= (point) start-point)
|
|
|
3359 (edebug-step-mode) ; No more at this level, so step.
|
|
|
3360 (edebug-go-mode t)
|
|
|
3361 )))))
|
|
|
3362
|
|
|
3363 (defun edebug-instrument-function (func)
|
|
|
3364 ;; Func should be a function symbol.
|
|
|
3365 ;; Return the function symbol, or nil if not instrumented.
|
|
|
3366 (let ((func-marker))
|
|
|
3367 (setq func-marker (get func 'edebug))
|
|
|
3368 (cond
|
|
|
3369 ((markerp func-marker)
|
|
|
3370 ;; It is uninstrumented, so instrument it.
|
|
|
3371 (save-excursion
|
|
|
3372 (set-buffer (marker-buffer func-marker))
|
|
|
3373 (goto-char func-marker)
|
|
|
3374 (edebug-eval-top-level-form)
|
|
|
3375 func))
|
|
|
3376 ((consp func-marker)
|
|
|
3377 (message "%s is already instrumented." func)
|
|
|
3378 func)
|
|
|
3379 (t
|
|
|
3380 ;; We could try harder, e.g. do a tags search.
|
|
|
3381 (error "Don't know where %s is defined" func)
|
|
|
3382 nil))))
|
|
|
3383
|
|
|
3384 (defun edebug-instrument-callee ()
|
|
|
3385 "Instrument the definition of the function or macro about to be called.
|
|
|
3386 Do this when stopped before the form or it will be too late.
|
|
|
3387 One side effect of using this command is that the next time the
|
|
|
3388 function or macro is called, Edebug will be called there as well."
|
|
|
3389 (interactive)
|
|
|
3390 (if (not (looking-at "\("))
|
|
|
3391 (error "You must be before a list form")
|
|
|
3392 (let ((func
|
|
|
3393 (save-excursion
|
|
|
3394 (down-list 1)
|
|
|
3395 (if (looking-at "\(")
|
|
|
3396 (edebug-form-data-name
|
|
|
3397 (edebug-get-form-data-entry (point)))
|
|
|
3398 (edebug-original-read (current-buffer))))))
|
|
|
3399 (edebug-instrument-function func))))
|
|
|
3400
|
|
|
3401
|
|
|
3402 (defun edebug-step-in ()
|
|
|
3403 "Step into the definition of the function or macro about to be called.
|
|
|
3404 This first does `edebug-instrument-callee' to ensure that it is
|
|
|
3405 instrumented. Then it does `edebug-on-entry' and switches to `go' mode."
|
|
|
3406 (interactive)
|
|
|
3407 (let ((func (edebug-instrument-callee)))
|
|
|
3408 (if func
|
|
|
3409 (progn
|
|
|
3410 (edebug-on-entry func 'temp)
|
|
|
3411 (edebug-go-mode nil)))))
|
|
|
3412
|
|
|
3413 (defun edebug-on-entry (function &optional flag)
|
|
|
3414 "Cause Edebug to stop when FUNCTION is called.
|
|
|
3415 With prefix argument, make this temporary so it is automatically
|
|
|
3416 cancelled the first time the function is entered."
|
|
|
3417 (interactive "aEdebug on entry to: \nP")
|
|
|
3418 ;; Could store this in the edebug data instead.
|
|
|
3419 (put function 'edebug-on-entry (if flag 'temp t)))
|
|
|
3420
|
|
|
3421 (defun cancel-edebug-on-entry (function)
|
|
|
3422 (interactive "aEdebug on entry to: ")
|
|
|
3423 (put function 'edebug-on-entry nil))
|
|
|
3424
|
|
|
3425
|
|
|
3426 (if (not (fboundp 'edebug-original-debug-on-entry))
|
|
|
3427 (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))
|
|
|
3428 '(fset 'debug-on-entry 'edebug-debug-on-entry) ;; Should we do this?
|
|
|
3429 ;; Also need edebug-cancel-debug-on-entry
|
|
|
3430
|
|
|
3431 '(defun edebug-debug-on-entry (function)
|
|
|
3432 "Request FUNCTION to invoke debugger each time it is called.
|
|
|
3433 If the user continues, FUNCTION's execution proceeds.
|
|
|
3434 Works by modifying the definition of FUNCTION,
|
|
|
3435 which must be written in Lisp, not predefined.
|
|
|
3436 Use `cancel-debug-on-entry' to cancel the effect of this command.
|
|
|
3437 Redefining FUNCTION also does that.
|
|
|
3438
|
|
|
3439 This version is from Edebug. If the function is instrumented for
|
|
|
3440 Edebug, it calls `edebug-on-entry'"
|
|
|
3441 (interactive "aDebug on entry (to function): ")
|
|
|
3442 (let ((func-data (get function 'edebug)))
|
|
|
3443 (if (or (null func-data) (markerp func-data))
|
|
|
3444 (edebug-original-debug-on-entry function)
|
|
|
3445 (edebug-on-entry function))))
|
|
|
3446
|
|
|
3447
|
|
|
3448 (defun edebug-top-level-nonstop ()
|
|
|
3449 "Set mode to Go-nonstop, and exit to top-level.
|
|
|
3450 This is useful for exiting even if unwind-protect code may be executed."
|
|
|
3451 (interactive)
|
|
|
3452 (setq edebug-execution-mode 'Go-nonstop)
|
|
|
3453 (top-level))
|
|
|
3454
|
|
|
3455
|
|
|
3456 ;;(defun edebug-exit-out ()
|
|
|
3457 ;; "Go until the current function exits."
|
|
|
3458 ;; (interactive)
|
|
|
3459 ;; (edebug-set-mode 'exiting "Exit..."))
|
|
|
3460
|
|
|
3461
|
|
|
3462 ;;; -----------------------------------------------------------------
|
|
|
3463 ;;; The following initial mode setting definitions are not used yet.
|
|
|
3464
|
|
|
3465 '(defconst edebug-initial-mode-alist
|
|
|
3466 '((edebug-Continue-fast . Continue-fast)
|
|
|
3467 (edebug-Trace-fast . Trace-fast)
|
|
|
3468 (edebug-continue . continue)
|
|
|
3469 (edebug-trace . trace)
|
|
|
3470 (edebug-go . go)
|
|
|
3471 (edebug-step-through . step)
|
|
|
3472 (edebug-Go-nonstop . Go-nonstop)
|
|
|
3473 )
|
|
|
3474 "Association list between commands and the modes they set.")
|
|
|
3475
|
|
|
3476
|
|
|
3477 '(defun edebug-set-initial-mode ()
|
|
|
3478 "Ask for the initial mode of the enclosing function.
|
|
|
3479 The mode is requested via the key that would be used to set the mode in
|
|
|
3480 edebug-mode."
|
|
|
3481 (interactive)
|
|
|
3482 (let* ((this-function (edebug-which-function))
|
|
|
3483 (keymap (if (eq edebug-mode-map (current-local-map))
|
|
|
3484 edebug-mode-map))
|
|
|
3485 (old-mode (or (get this-function 'edebug-initial-mode)
|
|
|
3486 edebug-initial-mode))
|
|
|
3487 (key (read-key-sequence
|
|
|
3488 (format
|
|
|
3489 "Change initial edebug mode for %s from %s (%s) to (enter key): "
|
|
|
3490 this-function
|
|
|
3491 old-mode
|
|
|
3492 (where-is-internal
|
|
|
3493 (car (rassq old-mode edebug-initial-mode-alist))
|
|
|
3494 keymap 'firstonly
|
|
|
3495 ))))
|
|
|
3496 (mode (cdr (assq (key-binding key) edebug-initial-mode-alist)))
|
|
|
3497 )
|
|
|
3498 (if (and mode
|
|
|
3499 (or (get this-function 'edebug-initial-mode)
|
|
|
3500 (not (eq mode edebug-initial-mode))))
|
|
|
3501 (progn
|
|
|
3502 (put this-function 'edebug-initial-mode mode)
|
|
|
3503 (message "Initial mode for %s is now: %s"
|
|
|
3504 this-function mode))
|
|
|
3505 (error "Key must map to one of the mode changing commands")
|
|
|
3506 )))
|
|
|
3507
|
|
|
3508
|
|
|
3509 ;;; Evaluation of expressions
|
|
|
3510 ;;; ===============================
|
|
|
3511
|
|
|
3512 (def-edebug-spec edebug-outside-excursion t)
|
|
|
3513
|
|
|
3514 (defmacro edebug-outside-excursion (&rest body)
|
|
|
3515 "Evaluate an expression list in the outside context.
|
|
|
3516 Return the result of the last expression."
|
|
|
3517 (` (save-excursion ; of current-buffer
|
|
|
3518 (if edebug-save-windows
|
|
|
3519 (progn
|
|
|
3520 ;; After excursion, we will
|
|
|
3521 ;; restore to current window configuration.
|
|
|
3522 (setq edebug-inside-windows
|
|
|
3523 (edebug-current-windows edebug-save-windows))
|
|
|
3524 ;; Restore outside windows.
|
|
|
3525 (edebug-set-windows edebug-outside-windows)))
|
|
|
3526
|
|
|
3527 (set-buffer edebug-buffer) ; why?
|
|
|
3528 ;; (use-local-map edebug-outside-map)
|
|
|
3529 (store-match-data edebug-outside-match-data)
|
|
|
3530 ;; Restore outside context.
|
|
|
3531 (let (;; (edebug-inside-map (current-local-map)) ;; restore map??
|
|
|
3532 (last-command-char edebug-outside-last-command-char)
|
|
|
3533 (last-command-event edebug-outside-last-command-event)
|
|
|
3534 (last-command edebug-outside-last-command)
|
|
|
3535 (this-command edebug-outside-this-command)
|
|
|
3536 (unread-command-char edebug-outside-unread-command-char)
|
|
|
3537 (unread-command-event edebug-outside-unread-command-event)
|
|
|
3538 (unread-command-events edebug-outside-unread-command-events)
|
|
|
3539 (last-input-char edebug-outside-last-input-char)
|
|
|
3540 (last-input-event edebug-outside-last-input-event)
|
|
|
3541 (last-event-frame edebug-outside-last-event-frame)
|
|
|
3542 (last-nonmenu-event edebug-outside-last-nonmenu-event)
|
|
|
3543 (track-mouse edebug-outside-track-mouse)
|
|
|
3544 (standard-output edebug-outside-standard-output)
|
|
|
3545 (standard-input edebug-outside-standard-input)
|
|
|
3546
|
|
|
3547 (executing-macro edebug-outside-executing-macro)
|
|
|
3548 (defining-kbd-macro edebug-outside-defining-kbd-macro)
|
|
|
3549 (pre-command-hook edebug-outside-pre-command-hook)
|
|
|
3550 (post-command-hook edebug-outside-post-command-hook)
|
|
|
3551 (post-command-idle-hook edebug-outside-post-command-idle-hook)
|
|
|
3552
|
|
|
3553 ;; See edebug-display
|
|
|
3554 (overlay-arrow-position edebug-outside-o-a-p)
|
|
|
3555 (overlay-arrow-string edebug-outside-o-a-s)
|
|
|
3556 (cursor-in-echo-area edebug-outside-c-i-e-a)
|
|
|
3557 )
|
|
|
3558 (unwind-protect
|
|
|
3559 (save-excursion ; of edebug-buffer
|
|
|
3560 (set-buffer edebug-outside-buffer)
|
|
|
3561 (goto-char edebug-outside-point)
|
|
|
3562 (if (marker-buffer (edebug-mark-marker))
|
|
|
3563 (set-marker (edebug-mark-marker) edebug-outside-mark))
|
|
|
3564 (,@ body))
|
|
|
3565
|
|
|
3566 ;; Back to edebug-buffer. Restore rest of inside context.
|
|
|
3567 ;; (use-local-map edebug-inside-map)
|
|
|
3568 (if edebug-save-windows
|
|
|
3569 ;; Restore inside windows.
|
|
|
3570 (edebug-set-windows edebug-inside-windows))
|
|
|
3571
|
|
|
3572 ;; Save values that may have been changed.
|
|
|
3573 (setq
|
|
|
3574 edebug-outside-last-command-char last-command-char
|
|
|
3575 edebug-outside-last-command-event last-command-event
|
|
|
3576 edebug-outside-last-command last-command
|
|
|
3577 edebug-outside-this-command this-command
|
|
|
3578 edebug-outside-unread-command-char unread-command-char
|
|
|
3579 edebug-outside-unread-command-event unread-command-event
|
|
|
3580 edebug-outside-unread-command-events unread-command-events
|
|
|
3581 edebug-outside-last-input-char last-input-char
|
|
|
3582 edebug-outside-last-input-event last-input-event
|
|
|
3583 edebug-outside-last-event-frame last-event-frame
|
|
|
3584 edebug-outside-last-nonmenu-event last-nonmenu-event
|
|
|
3585 edebug-outside-track-mouse track-mouse
|
|
|
3586 edebug-outside-standard-output standard-output
|
|
|
3587 edebug-outside-standard-input standard-input
|
|
|
3588
|
|
|
3589 edebug-outside-executing-macro executing-macro
|
|
|
3590 edebug-outside-defining-kbd-macro defining-kbd-macro
|
|
|
3591 edebug-outside-pre-command-hook pre-command-hook
|
|
|
3592 edebug-outside-post-command-hook post-command-hook
|
|
|
3593 edebug-outside-post-command-idle-hook post-command-idle-hook
|
|
|
3594
|
|
|
3595 edebug-outside-o-a-p overlay-arrow-position
|
|
|
3596 edebug-outside-o-a-s overlay-arrow-string
|
|
|
3597 edebug-outside-c-i-e-a cursor-in-echo-area
|
|
|
3598 ))) ; let
|
|
|
3599 )))
|
|
|
3600
|
|
|
3601 (defvar cl-debug-env nil) ;; defined in cl; non-nil when lexical env used.
|
|
|
3602
|
|
|
3603 (defun edebug-eval (edebug-expr)
|
|
|
3604 ;; Are there cl lexical variables active?
|
|
|
3605 (if cl-debug-env
|
|
|
3606 (eval (cl-macroexpand-all edebug-expr cl-debug-env))
|
|
|
3607 (eval edebug-expr)))
|
|
|
3608
|
|
|
3609 (defun edebug-safe-eval (edebug-expr)
|
|
|
3610 ;; Evaluate EXPR safely.
|
|
|
3611 ;; If there is an error, a string is returned describing the error.
|
|
|
3612 (condition-case edebug-err
|
|
|
3613 (edebug-eval edebug-expr)
|
|
|
3614 (error (edebug-format "%s: %s" ;; could
|
|
|
3615 (get (car edebug-err) 'error-message)
|
|
|
3616 (car (cdr edebug-err))))))
|
|
|
3617
|
|
|
3618 ;;;; Printing
|
|
|
3619 ;;; =========
|
|
|
3620 ;; Replace printing functions.
|
|
|
3621
|
|
|
3622 ;; obsolete names
|
|
|
3623 (defalias 'edebug-install-custom-print-funcs 'edebug-install-custom-print)
|
|
|
3624 (defalias 'edebug-reset-print-funcs 'edebug-uninstall-custom-print)
|
|
|
3625 (defalias 'edebug-uninstall-custom-print-funcs 'edebug-uninstall-custom-print)
|
|
|
3626
|
|
|
3627 (defun edebug-install-custom-print ()
|
|
|
3628 "Replace print functions used by Edebug with custom versions."
|
|
|
3629 ;; Modifying the custom print functions, or changing print-length,
|
|
|
3630 ;; print-level, print-circle, custom-print-list or custom-print-vector
|
|
|
3631 ;; have immediate effect.
|
|
|
3632 (interactive)
|
|
|
3633 (require 'cust-print)
|
|
|
3634 (defalias 'edebug-prin1 'custom-prin1)
|
|
|
3635 (defalias 'edebug-print 'custom-print)
|
|
|
3636 (defalias 'edebug-prin1-to-string 'custom-prin1-to-string)
|
|
|
3637 (defalias 'edebug-format 'custom-format)
|
|
|
3638 (defalias 'edebug-message 'custom-message)
|
|
|
3639 "Installed")
|
|
|
3640
|
|
|
3641 (eval-and-compile
|
|
|
3642 (defun edebug-uninstall-custom-print ()
|
|
|
3643 "Replace edebug custom print functions with internal versions."
|
|
|
3644 (interactive)
|
|
|
3645 (defalias 'edebug-prin1 'prin1)
|
|
|
3646 (defalias 'edebug-print 'print)
|
|
|
3647 (defalias 'edebug-prin1-to-string 'prin1-to-string)
|
|
|
3648 (defalias 'edebug-format 'format)
|
|
|
3649 (defalias 'edebug-message 'message)
|
|
|
3650 "Uninstalled")
|
|
|
3651
|
|
|
3652 ;; Default print functions are the same as Emacs'.
|
|
|
3653 (edebug-uninstall-custom-print))
|
|
|
3654
|
|
|
3655
|
|
|
3656 (defun edebug-report-error (edebug-value)
|
|
|
3657 ;; Print an error message like command level does.
|
|
|
3658 ;; This also prints the error name if it has no error-message.
|
|
|
3659 (message "%s: %s"
|
|
|
3660 (or (get (car edebug-value) 'error-message)
|
|
|
3661 (format "peculiar error (%s)" (car edebug-value)))
|
|
|
3662 (mapconcat (function (lambda (edebug-arg)
|
|
|
3663 ;; continuing after an error may
|
|
|
3664 ;; complain about edebug-arg. why??
|
|
|
3665 (prin1-to-string edebug-arg)))
|
|
|
3666 (cdr edebug-value) ", ")))
|
|
|
3667
|
|
|
3668 ;; Define here in case they are not already defined.
|
|
|
3669 (defvar print-level nil)
|
|
|
3670 (defvar print-circle nil)
|
|
|
3671 (defvar print-readably) ;; defined by XEmacs
|
|
|
3672 ;; Alternatively, we could change the definition of
|
|
|
3673 ;; edebug-safe-prin1-to-string to only use these if defined.
|
|
|
3674
|
|
|
3675 (defun edebug-safe-prin1-to-string (value)
|
|
|
3676 (let ((print-escape-newlines t)
|
|
|
3677 (print-length (or edebug-print-length print-length))
|
|
|
3678 (print-level (or edebug-print-level print-level))
|
|
|
3679 (print-circle (or edebug-print-circle print-circle))
|
|
|
3680 (print-readably nil)) ;; XEmacs uses this.
|
|
|
3681 (edebug-prin1-to-string value)))
|
|
|
3682
|
|
|
3683 (defun edebug-compute-previous-result (edebug-previous-value)
|
|
|
3684 (setq edebug-previous-result
|
|
|
3685 (if (and (numberp edebug-previous-value)
|
|
|
3686 (< edebug-previous-value 256)
|
|
|
3687 (>= edebug-previous-value 0))
|
|
|
3688 (format "Result: %s = %s" edebug-previous-value
|
|
|
3689 (single-key-description edebug-previous-value))
|
|
|
3690 (if edebug-unwrap-results
|
|
|
3691 (setq edebug-previous-value
|
|
|
3692 (edebug-unwrap* edebug-previous-value)))
|
|
|
3693 (concat "Result: "
|
|
|
3694 (edebug-safe-prin1-to-string edebug-previous-value)))))
|
|
|
3695
|
|
|
3696 (defun edebug-previous-result ()
|
|
|
3697 "Print the previous result."
|
|
|
3698 (interactive)
|
|
|
3699 (message "%s" edebug-previous-result))
|
|
|
3700
|
|
|
3701 ;;;; Read, Eval and Print
|
|
|
3702 ;;; =====================
|
|
|
3703
|
|
|
3704 (defun edebug-eval-expression (edebug-expr)
|
|
|
3705 "Evaluate an expression in the outside environment.
|
|
|
3706 If interactive, prompt for the expression.
|
|
|
3707 Print result in minibuffer."
|
|
|
3708 (interactive "xEval: ")
|
|
|
3709 (princ
|
|
|
3710 (edebug-outside-excursion
|
|
|
3711 (setq values (cons (edebug-eval edebug-expr) values))
|
|
|
3712 (edebug-safe-prin1-to-string (car values)))))
|
|
|
3713
|
|
|
3714 (defun edebug-eval-last-sexp ()
|
|
|
3715 "Evaluate sexp before point in the outside environment;
|
|
|
3716 print value in minibuffer."
|
|
|
3717 (interactive)
|
|
|
3718 (edebug-eval-expression (edebug-last-sexp)))
|
|
|
3719
|
|
|
3720 (defun edebug-eval-print-last-sexp ()
|
|
|
3721 "Evaluate sexp before point in the outside environment;
|
|
|
3722 print value into current buffer."
|
|
|
3723 (interactive)
|
|
|
3724 (let* ((edebug-form (edebug-last-sexp))
|
|
|
3725 (edebug-result-string
|
|
|
3726 (edebug-outside-excursion
|
|
|
3727 (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))
|
|
|
3728 (standard-output (current-buffer)))
|
|
|
3729 (princ "\n")
|
|
|
3730 ;; princ the string to get rid of quotes.
|
|
|
3731 (princ edebug-result-string)
|
|
|
3732 (princ "\n")
|
|
|
3733 ))
|
|
|
3734
|
|
|
3735
|
|
|
3736 ;;;; Edebug Minor Mode
|
|
|
3737 ;;; ===============================
|
|
|
3738
|
|
|
3739 ;; Global GUD bindings for all emacs-lisp-mode buffers.
|
|
|
3740 (define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
|
|
|
3741 (define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
|
|
|
3742 (define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
|
|
|
3743 (define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)
|
|
|
3744
|
|
|
3745
|
|
|
3746 (defvar edebug-mode-map nil)
|
|
|
3747 (if edebug-mode-map
|
|
|
3748 nil
|
|
|
3749 (progn
|
|
|
3750 (setq edebug-mode-map (copy-keymap emacs-lisp-mode-map))
|
|
|
3751 ;; control
|
|
|
3752 (define-key edebug-mode-map " " 'edebug-step-mode)
|
|
|
3753 (define-key edebug-mode-map "n" 'edebug-next-mode)
|
|
|
3754 (define-key edebug-mode-map "g" 'edebug-go-mode)
|
|
|
3755 (define-key edebug-mode-map "G" 'edebug-Go-nonstop-mode)
|
|
|
3756 (define-key edebug-mode-map "t" 'edebug-trace-mode)
|
|
|
3757 (define-key edebug-mode-map "T" 'edebug-Trace-fast-mode)
|
|
|
3758 (define-key edebug-mode-map "c" 'edebug-continue-mode)
|
|
|
3759 (define-key edebug-mode-map "C" 'edebug-Continue-fast-mode)
|
|
|
3760
|
|
|
3761 ;;(define-key edebug-mode-map "f" 'edebug-forward) not implemented
|
|
|
3762 (define-key edebug-mode-map "f" 'edebug-forward-sexp)
|
|
|
3763 (define-key edebug-mode-map "h" 'edebug-goto-here)
|
|
|
3764
|
|
|
3765 (define-key edebug-mode-map "I" 'edebug-instrument-callee)
|
|
|
3766 (define-key edebug-mode-map "i" 'edebug-step-in)
|
|
|
3767 (define-key edebug-mode-map "o" 'edebug-step-out)
|
|
|
3768
|
|
|
3769 ;; quitting and stopping
|
|
|
3770 (define-key edebug-mode-map "q" 'top-level)
|
|
|
3771 (define-key edebug-mode-map "Q" 'edebug-top-level-nonstop)
|
|
|
3772 (define-key edebug-mode-map "a" 'abort-recursive-edit)
|
|
|
3773 (define-key edebug-mode-map "S" 'edebug-stop)
|
|
|
3774
|
|
|
3775 ;; breakpoints
|
|
|
3776 (define-key edebug-mode-map "b" 'edebug-set-breakpoint)
|
|
|
3777 (define-key edebug-mode-map "u" 'edebug-unset-breakpoint)
|
|
|
3778 (define-key edebug-mode-map "B" 'edebug-next-breakpoint)
|
|
|
3779 (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint)
|
|
|
3780 (define-key edebug-mode-map "X" 'edebug-set-global-break-condition)
|
|
|
3781
|
|
|
3782 ;; evaluation
|
|
|
3783 (define-key edebug-mode-map "r" 'edebug-previous-result)
|
|
|
3784 (define-key edebug-mode-map "e" 'edebug-eval-expression)
|
|
|
3785 (define-key edebug-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
|
|
|
3786 (define-key edebug-mode-map "E" 'edebug-visit-eval-list)
|
|
|
3787
|
|
|
3788 ;; views
|
|
|
3789 (define-key edebug-mode-map "w" 'edebug-where)
|
|
|
3790 (define-key edebug-mode-map "v" 'edebug-view-outside) ;; maybe obsolete??
|
|
|
3791 (define-key edebug-mode-map "p" 'edebug-bounce-point)
|
|
|
3792 (define-key edebug-mode-map "P" 'edebug-view-outside) ;; same as v
|
|
|
3793 (define-key edebug-mode-map "W" 'edebug-toggle-save-windows)
|
|
|
3794
|
|
|
3795 ;; misc
|
|
|
3796 (define-key edebug-mode-map "?" 'edebug-help)
|
|
|
3797 (define-key edebug-mode-map "d" 'edebug-backtrace)
|
|
|
3798
|
|
|
3799 (define-key edebug-mode-map "-" 'negative-argument)
|
|
|
3800
|
|
|
3801 ;; statistics
|
|
|
3802 (define-key edebug-mode-map "=" 'edebug-temp-display-freq-count)
|
|
|
3803
|
|
|
3804 ;; GUD bindings
|
|
|
3805 (define-key edebug-mode-map "\C-c\C-s" 'edebug-step-mode)
|
|
|
3806 (define-key edebug-mode-map "\C-c\C-n" 'edebug-next-mode)
|
|
|
3807 (define-key edebug-mode-map "\C-c\C-c" 'edebug-go-mode)
|
|
|
3808
|
|
|
3809 (define-key edebug-mode-map "\C-x " 'edebug-set-breakpoint)
|
|
|
3810 (define-key edebug-mode-map "\C-c\C-d" 'edebug-unset-breakpoint)
|
|
|
3811 (define-key edebug-mode-map "\C-c\C-t"
|
|
|
3812 (function (lambda () (edebug-set-breakpoint t))))
|
|
|
3813 (define-key edebug-mode-map "\C-c\C-l" 'edebug-where)
|
|
|
3814 ))
|
|
|
3815
|
|
|
3816 ;; Autoloading these global bindings doesn't make sense because
|
|
|
3817 ;; they cannot be used anyway unless Edebug is already loaded and active.
|
|
|
3818
|
|
|
3819 (defvar global-edebug-prefix "\^XX"
|
|
|
3820 "Prefix key for global edebug commands, available from any buffer.")
|
|
|
3821
|
|
|
3822 (defvar global-edebug-map nil
|
|
|
3823 "Global map of edebug commands, available from any buffer.")
|
|
|
3824
|
|
|
3825 (if global-edebug-map
|
|
|
3826 nil
|
|
|
3827 (setq global-edebug-map (make-sparse-keymap))
|
|
|
3828
|
|
|
3829 (global-unset-key global-edebug-prefix)
|
|
|
3830 (global-set-key global-edebug-prefix global-edebug-map)
|
|
|
3831
|
|
|
3832 (define-key global-edebug-map " " 'edebug-step-mode)
|
|
|
3833 (define-key global-edebug-map "g" 'edebug-go-mode)
|
|
|
3834 (define-key global-edebug-map "G" 'edebug-Go-nonstop-mode)
|
|
|
3835 (define-key global-edebug-map "t" 'edebug-trace-mode)
|
|
|
3836 (define-key global-edebug-map "T" 'edebug-Trace-fast-mode)
|
|
|
3837 (define-key global-edebug-map "c" 'edebug-continue-mode)
|
|
|
3838 (define-key global-edebug-map "C" 'edebug-Continue-fast-mode)
|
|
|
3839
|
|
|
3840 ;; breakpoints
|
|
|
3841 (define-key global-edebug-map "b" 'edebug-set-breakpoint)
|
|
|
3842 (define-key global-edebug-map "u" 'edebug-unset-breakpoint)
|
|
|
3843 (define-key global-edebug-map "x" 'edebug-set-conditional-breakpoint)
|
|
|
3844 (define-key global-edebug-map "X" 'edebug-set-global-break-condition)
|
|
|
3845
|
|
|
3846 ;; views
|
|
|
3847 (define-key global-edebug-map "w" 'edebug-where)
|
|
|
3848 (define-key global-edebug-map "W" 'edebug-toggle-save-windows)
|
|
|
3849
|
|
|
3850 ;; quitting
|
|
|
3851 (define-key global-edebug-map "q" 'top-level)
|
|
|
3852 (define-key global-edebug-map "Q" 'edebug-top-level-nonstop)
|
|
|
3853 (define-key global-edebug-map "a" 'abort-recursive-edit)
|
|
|
3854
|
|
|
3855 ;; statistics
|
|
|
3856 (define-key global-edebug-map "=" 'edebug-display-freq-count)
|
|
|
3857 )
|
|
|
3858
|
|
|
3859 (defun edebug-help ()
|
|
|
3860 (interactive)
|
|
|
3861 (describe-function 'edebug-mode))
|
|
|
3862
|
|
|
3863 (defun edebug-mode ()
|
|
|
3864 "Mode for Emacs Lisp buffers while in Edebug.
|
|
|
3865
|
|
|
3866 In addition to all Emacs Lisp commands (except those that modify the
|
|
|
3867 buffer) there are local and global key bindings to several Edebug
|
|
|
3868 specific commands. E.g. `edebug-step-mode' is bound to \\[edebug-step-mode]
|
|
|
3869 in the Edebug buffer and \\<global-map>\\[edebug-step-mode] in any buffer.
|
|
|
3870
|
|
|
3871 Also see bindings for the eval list buffer, *edebug*.
|
|
|
3872
|
|
|
3873 The edebug buffer commands:
|
|
|
3874 \\{edebug-mode-map}
|
|
|
3875
|
|
|
3876 Global commands prefixed by `global-edebug-prefix':
|
|
|
3877 \\{global-edebug-map}
|
|
|
3878
|
|
|
3879 Options:
|
|
|
3880 edebug-setup-hook
|
|
|
3881 edebug-all-defs
|
|
|
3882 edebug-all-forms
|
|
|
3883 edebug-save-windows
|
|
|
3884 edebug-save-displayed-buffer-points
|
|
|
3885 edebug-initial-mode
|
|
|
3886 edebug-trace
|
|
|
3887 edebug-test-coverage
|
|
|
3888 edebug-continue-kbd-macro
|
|
|
3889 edebug-print-length
|
|
|
3890 edebug-print-level
|
|
|
3891 edebug-print-circle
|
|
|
3892 edebug-on-error
|
|
|
3893 edebug-on-quit
|
|
|
3894 edebug-on-signal
|
|
|
3895 edebug-unwrap-results
|
|
|
3896 edebug-global-break-condition
|
|
|
3897 "
|
|
|
3898 (use-local-map edebug-mode-map))
|
|
|
3899
|
|
|
3900
|
|
|
3901 ;;;; edebug eval list mode
|
|
|
3902 ;;; ===============================================
|
|
|
3903 ;; A list of expressions and their evaluations is displayed in *edebug*.
|
|
|
3904
|
|
|
3905 (defun edebug-eval-result-list ()
|
|
|
3906 "Return a list of evaluations of edebug-eval-list"
|
|
|
3907 ;; Assumes in outside environment.
|
|
|
3908 ;; Don't do any edebug things now.
|
|
|
3909 (let ((edebug-execution-mode 'Go-nonstop)
|
|
|
3910 (edebug-trace nil))
|
|
|
3911 (mapcar 'edebug-safe-eval edebug-eval-list)))
|
|
|
3912
|
|
|
3913 (defun edebug-eval-display-list (edebug-eval-result-list)
|
|
|
3914 ;; Assumes edebug-eval-buffer exists.
|
|
|
3915 (let ((edebug-eval-list-temp edebug-eval-list)
|
|
|
3916 (standard-output edebug-eval-buffer)
|
|
|
3917 (edebug-comment-line
|
|
|
3918 (format ";%s\n" (make-string (- (window-width) 2) ?-))))
|
|
|
3919 (set-buffer edebug-eval-buffer)
|
|
|
3920 (erase-buffer)
|
|
|
3921 (while edebug-eval-list-temp
|
|
|
3922 (prin1 (car edebug-eval-list-temp)) (terpri)
|
|
|
3923 (prin1 (car edebug-eval-result-list)) (terpri)
|
|
|
3924 (princ edebug-comment-line)
|
|
|
3925 (setq edebug-eval-list-temp (cdr edebug-eval-list-temp))
|
|
|
3926 (setq edebug-eval-result-list (cdr edebug-eval-result-list)))
|
|
|
3927 (edebug-pop-to-buffer edebug-eval-buffer)
|
|
|
3928 ))
|
|
|
3929
|
|
|
3930 (defun edebug-create-eval-buffer ()
|
|
|
3931 (if (not (and edebug-eval-buffer (buffer-name edebug-eval-buffer)))
|
|
|
3932 (progn
|
|
|
3933 (set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*")))
|
|
|
3934 (edebug-eval-mode))))
|
|
|
3935
|
|
|
3936 ;; Should generalize this to be callable outside of edebug
|
|
|
3937 ;; with calls in user functions, e.g. (edebug-eval-display)
|
|
|
3938
|
|
|
3939 (defun edebug-eval-display (edebug-eval-result-list)
|
|
|
3940 "Display expressions and evaluations in EVAL-LIST.
|
|
|
3941 It modifies the context by popping up the eval display."
|
|
|
3942 (if edebug-eval-result-list
|
|
|
3943 (progn
|
|
|
3944 (edebug-create-eval-buffer)
|
|
|
3945 (edebug-eval-display-list edebug-eval-result-list)
|
|
|
3946 )))
|
|
|
3947
|
|
|
3948 (defun edebug-eval-redisplay ()
|
|
|
3949 "Redisplay eval list in outside environment.
|
|
|
3950 May only be called from within edebug-recursive-edit."
|
|
|
3951 (edebug-create-eval-buffer)
|
|
|
3952 (edebug-outside-excursion
|
|
|
3953 (edebug-eval-display-list (edebug-eval-result-list))
|
|
|
3954 ))
|
|
|
3955
|
|
|
3956 (defun edebug-visit-eval-list ()
|
|
|
3957 (interactive)
|
|
|
3958 (edebug-eval-redisplay)
|
|
|
3959 (edebug-pop-to-buffer edebug-eval-buffer))
|
|
|
3960
|
|
|
3961
|
|
|
3962 (defun edebug-update-eval-list ()
|
|
|
3963 "Replace the evaluation list with the sexps now in the eval buffer."
|
|
|
3964 (interactive)
|
|
|
3965 (let ((starting-point (point))
|
|
|
3966 new-list)
|
|
|
3967 (goto-char (point-min))
|
|
|
3968 ;; get the first expression
|
|
|
3969 (edebug-skip-whitespace)
|
|
|
3970 (if (not (eobp))
|
|
|
3971 (progn
|
|
|
3972 (forward-sexp 1)
|
|
|
3973 (setq new-list (cons (edebug-last-sexp) new-list))))
|
|
|
3974
|
|
|
3975 (while (re-search-forward "^;" nil t)
|
|
|
3976 (forward-line 1)
|
|
|
3977 (skip-chars-forward " \t\n\r")
|
|
|
3978 (if (and (/= ?\; (following-char))
|
|
|
3979 (not (eobp)))
|
|
|
3980 (progn
|
|
|
3981 (forward-sexp 1)
|
|
|
3982 (setq new-list (cons (edebug-last-sexp) new-list)))))
|
|
|
3983
|
|
|
3984 (setq edebug-eval-list (nreverse new-list))
|
|
|
3985 (edebug-eval-redisplay)
|
|
|
3986 (goto-char starting-point)))
|
|
|
3987
|
|
|
3988
|
|
|
3989 (defun edebug-delete-eval-item ()
|
|
|
3990 "Delete the item under point and redisplay."
|
|
|
3991 ;; could add arg to do repeatedly
|
|
|
3992 (interactive)
|
|
|
3993 (if (re-search-backward "^;" nil 'nofail)
|
|
|
3994 (forward-line 1))
|
|
|
3995 (delete-region
|
|
|
3996 (point) (progn (re-search-forward "^;" nil 'nofail)
|
|
|
3997 (beginning-of-line)
|
|
|
3998 (point)))
|
|
|
3999 (edebug-update-eval-list))
|
|
|
4000
|
|
|
4001
|
|
|
4002
|
|
|
4003 (defvar edebug-eval-mode-map nil
|
|
|
4004 "Keymap for edebug-eval-mode. Superset of lisp-interaction-mode.")
|
|
|
4005
|
|
|
4006 (if edebug-eval-mode-map
|
|
|
4007 nil
|
|
|
4008 (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map))
|
|
|
4009
|
|
|
4010 (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)
|
|
|
4011 (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item)
|
|
|
4012 (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list)
|
|
|
4013 (define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
|
|
|
4014 (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp)
|
|
|
4015 )
|
|
|
4016
|
|
|
4017
|
|
|
4018 (defun edebug-eval-mode ()
|
|
|
4019 "Mode for evaluation list buffer while in Edebug.
|
|
|
4020
|
|
|
4021 In addition to all Interactive Emacs Lisp commands there are local and
|
|
|
4022 global key bindings to several Edebug specific commands. E.g.
|
|
|
4023 `edebug-step-mode' is bound to \\[edebug-step-mode] in the Edebug
|
|
|
4024 buffer and \\<global-map>\\[edebug-step-mode] in any buffer.
|
|
|
4025
|
|
|
4026 Eval list buffer commands:
|
|
|
4027 \\{edebug-eval-mode-map}
|
|
|
4028
|
|
|
4029 Global commands prefixed by global-edebug-prefix:
|
|
|
4030 \\{global-edebug-map}
|
|
|
4031 "
|
|
|
4032 (lisp-interaction-mode)
|
|
|
4033 (setq major-mode 'edebug-eval-mode)
|
|
|
4034 (setq mode-name "Edebug-Eval")
|
|
|
4035 (use-local-map edebug-eval-mode-map))
|
|
|
4036
|
|
|
4037
|
|
|
4038 ;;;; Interface with standard debugger.
|
|
|
4039 ;;; ========================================
|
|
|
4040
|
|
|
4041 ;; (setq debugger 'edebug) ; to use the edebug debugger
|
|
|
4042 ;; (setq debugger 'debug) ; use the standard debugger
|
|
|
4043
|
|
|
4044 ;; Note that debug and its utilities must be byte-compiled to work,
|
|
|
4045 ;; since they depend on the backtrace looking a certain way. But
|
|
|
4046 ;; edebug is not dependent on this, yet.
|
|
|
4047
|
|
|
4048 (defun edebug (&optional edebug-arg-mode &rest debugger-args)
|
|
|
4049 "Replacement for debug.
|
|
|
4050 If we are running an edebugged function,
|
|
|
4051 show where we last were. Otherwise call debug normally."
|
|
|
4052 ;; (message "entered: %s depth: %s edebug-recursion-depth: %s"
|
|
|
4053 ;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1)
|
|
|
4054 (if (and edebug-entered ; anything active?
|
|
|
4055 (eq (recursion-depth) edebug-recursion-depth))
|
|
|
4056 (let (;; Where were we before the error occurred?
|
|
|
4057 (edebug-offset-index (car edebug-offset-indices))
|
|
|
4058 ;; Bind variables required by edebug-display
|
|
|
4059 (edebug-value (car debugger-args))
|
|
|
4060 edebug-breakpoints
|
|
|
4061 edebug-break-data
|
|
|
4062 edebug-break-condition
|
|
|
4063 edebug-global-break
|
|
|
4064 (edebug-break (null edebug-arg-mode)) ;; if called explicitly
|
|
|
4065 )
|
|
|
4066 (edebug-display)
|
|
|
4067 (if (eq edebug-arg-mode 'error)
|
|
|
4068 nil
|
|
|
4069 edebug-value))
|
|
|
4070
|
|
|
4071 ;; Otherwise call debug normally.
|
|
|
4072 ;; Still need to remove extraneous edebug calls from stack.
|
|
|
4073 (apply 'debug edebug-arg-mode debugger-args)
|
|
|
4074 ))
|
|
|
4075
|
|
|
4076
|
|
|
4077 (defun edebug-backtrace ()
|
|
|
4078 "Display a non-working backtrace. Better than nothing..."
|
|
|
4079 (interactive)
|
|
|
4080 (if (or (not edebug-backtrace-buffer)
|
|
|
4081 (null (buffer-name edebug-backtrace-buffer)))
|
|
|
4082 (setq edebug-backtrace-buffer
|
|
|
4083 (generate-new-buffer "*Backtrace*"))
|
|
|
4084 ;; else, could just display edebug-backtrace-buffer
|
|
|
4085 )
|
|
|
4086 (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer)
|
|
|
4087 (setq edebug-backtrace-buffer standard-output)
|
|
|
4088 (let ((print-escape-newlines t)
|
|
|
4089 (print-length 50)
|
|
|
4090 last-ok-point)
|
|
|
4091 (backtrace)
|
|
|
4092
|
|
|
4093 ;; Clean up the backtrace.
|
|
|
4094 ;; Not quite right for current edebug scheme.
|
|
|
4095 (set-buffer edebug-backtrace-buffer)
|
|
|
4096 (setq truncate-lines t)
|
|
|
4097 (goto-char (point-min))
|
|
|
4098 (setq last-ok-point (point))
|
|
|
4099 (if t (progn
|
|
|
4100
|
|
|
4101 ;; Delete interspersed edebug internals.
|
|
|
4102 (while (re-search-forward "^ \(?edebug" nil t)
|
|
|
4103 (beginning-of-line)
|
|
|
4104 (cond
|
|
|
4105 ((looking-at "^ \(edebug-after")
|
|
|
4106 ;; Previous lines may contain code, so just delete this line
|
|
|
4107 (setq last-ok-point (point))
|
|
|
4108 (forward-line 1)
|
|
|
4109 (delete-region last-ok-point (point)))
|
|
|
4110
|
|
|
4111 ((looking-at "^ edebug")
|
|
|
4112 (forward-line 1)
|
|
|
4113 (delete-region last-ok-point (point))
|
|
|
4114 )))
|
|
|
4115 )))))
|
|
|
4116
|
|
|
4117
|
|
|
4118 ;;;; Trace display
|
|
|
4119 ;; ===============================
|
|
|
4120
|
|
|
4121 (defun edebug-trace-display (buf-name fmt &rest args)
|
|
|
4122 "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible.
|
|
|
4123 The buffer is created if it does not exist.
|
|
|
4124 You must include newlines in FMT to break lines, but one newline is appended."
|
|
|
4125 ;; e.g.
|
|
|
4126 ;; (edebug-trace-display "*trace-point*"
|
|
|
4127 ;; "saving: point = %s window-start = %s"
|
|
|
4128 ;; (point) (window-start))
|
|
|
4129 (let* ((selected-window (selected-window))
|
|
|
4130 (buffer (get-buffer-create buf-name))
|
|
|
4131 buf-window)
|
|
|
4132 ;; (message "before pop-to-buffer") (sit-for 1)
|
|
|
4133 (edebug-pop-to-buffer buffer)
|
|
|
4134 (setq truncate-lines t)
|
|
|
4135 (setq buf-window (selected-window))
|
|
|
4136 (goto-char (point-max))
|
|
|
4137 (insert (apply 'edebug-format fmt args) "\n")
|
|
|
4138 ;; Make it visible.
|
|
|
4139 (vertical-motion (- 1 (window-height)))
|
|
|
4140 (set-window-start buf-window (point))
|
|
|
4141 (goto-char (point-max))
|
|
|
4142 ;; (set-window-point buf-window (point))
|
|
|
4143 ;; (edebug-sit-for 0)
|
|
|
4144 (bury-buffer buffer)
|
|
|
4145 (select-window selected-window))
|
|
|
4146 buf-name)
|
|
|
4147
|
|
|
4148
|
|
|
4149 (defun edebug-trace (fmt &rest args)
|
|
|
4150 "Convenience call to edebug-trace-display using edebug-trace-buffer"
|
|
|
4151 (apply 'edebug-trace-display edebug-trace-buffer fmt args))
|
|
|
4152
|
|
|
4153
|
|
|
4154 ;;;; Frequency count and coverage
|
|
|
4155 ;;; ==============================
|
|
|
4156
|
|
|
4157 (defun edebug-display-freq-count ()
|
|
|
4158 "Display the frequency count data for each line of the current
|
|
|
4159 definition. The frequency counts are inserted as comment lines after
|
|
|
4160 each line, and you can undo all insertions with one `undo' command.
|
|
|
4161
|
|
|
4162 The counts are inserted starting under the `(' before an expression
|
|
|
4163 or the `)' after an expression, or on the last char of a symbol.
|
|
|
4164 The counts are only displayed when they differ from previous counts on
|
|
|
4165 the same line.
|
|
|
4166
|
|
|
4167 If coverage is being tested, whenever all known results of an expression
|
|
|
4168 are `eq', the char `=' will be appended after the count
|
|
|
4169 for that expression. Note that this is always the case for an
|
|
|
4170 expression only evaluated once.
|
|
|
4171
|
|
|
4172 To clear the frequency count and coverage data for a definition,
|
|
|
4173 reinstrument it."
|
|
|
4174 (interactive)
|
|
|
4175 (let* ((function (edebug-form-data-symbol))
|
|
|
4176 (counts (get function 'edebug-freq-count))
|
|
|
4177 (coverages (get function 'edebug-coverage))
|
|
|
4178 (data (get function 'edebug))
|
|
|
4179 (def-mark (car data)) ; mark at def start
|
|
|
4180 (edebug-points (nth 2 data))
|
|
|
4181 (i (1- (length edebug-points)))
|
|
|
4182 (last-index)
|
|
|
4183 (first-index)
|
|
|
4184 (start-of-line)
|
|
|
4185 (start-of-count-line)
|
|
|
4186 (last-count)
|
|
|
4187 )
|
|
|
4188 (save-excursion
|
|
|
4189 ;; Traverse in reverse order so offsets are correct.
|
|
|
4190 (while (<= 0 i)
|
|
|
4191 ;; Start at last expression in line.
|
|
|
4192 (goto-char (+ def-mark (aref edebug-points i)))
|
|
|
4193 (beginning-of-line)
|
|
|
4194 (setq start-of-line (- (point) def-mark)
|
|
|
4195 last-index i)
|
|
|
4196
|
|
|
4197 ;; Find all indexes on same line.
|
|
|
4198 (while (and (<= 0 (setq i (1- i)))
|
|
|
4199 (<= start-of-line (aref edebug-points i))))
|
|
|
4200 ;; Insert all the indices for this line.
|
|
|
4201 (forward-line 1)
|
|
|
4202 (setq start-of-count-line (point)
|
|
|
4203 first-index i ; really last index for line above this one.
|
|
|
4204 last-count -1) ; cause first count to always appear.
|
|
|
4205 (insert ";#")
|
|
|
4206 ;; i == first-index still
|
|
|
4207 (while (<= (setq i (1+ i)) last-index)
|
|
|
4208 (let ((count (aref counts i))
|
|
|
4209 (coverage (aref coverages i))
|
|
|
4210 (col (save-excursion
|
|
|
4211 (goto-char (+ (aref edebug-points i) def-mark))
|
|
|
4212 (- (current-column)
|
|
|
4213 (if (= ?\( (following-char)) 0 1)))))
|
|
|
4214 (insert (make-string
|
|
|
4215 (max 0 (- col (- (point) start-of-count-line))) ?\ )
|
|
|
4216 (if (and (< 0 count)
|
|
|
4217 (not (memq coverage
|
|
|
4218 '(unknown ok-coverage))))
|
|
|
4219 "=" "")
|
|
|
4220 (if (= count last-count) "" (int-to-string count))
|
|
|
4221 " ")
|
|
|
4222 (setq last-count count)))
|
|
|
4223 (insert "\n")
|
|
|
4224 (setq i first-index)))))
|
|
|
4225
|
|
|
4226 (defun edebug-temp-display-freq-count ()
|
|
|
4227 "Temporarily display the frequency count data for the current definition.
|
|
|
4228 It is removed when you hit any char."
|
|
|
4229 ;; This seems not to work with Emacs 18.59. It undoes too far.
|
|
|
4230 (interactive)
|
|
|
4231 (let ((buffer-read-only nil))
|
|
|
4232 (undo-boundary)
|
|
|
4233 (edebug-display-freq-count)
|
|
|
4234 (setq unread-command-char (read-char))
|
|
|
4235 (undo)))
|
|
|
4236
|
|
|
4237
|
|
|
4238 ;;;; Menus
|
|
|
4239 ;;;=========
|
|
|
4240
|
|
|
4241 (defun edebug-toggle (variable)
|
|
|
4242 (set variable (not (eval variable)))
|
|
|
4243 (message "%s: %s" variable (eval variable)))
|
|
|
4244
|
|
|
4245 ;; We have to require easymenu (even for Emacs 18) just so
|
|
|
4246 ;; the easy-menu-define macro call is compiled correctly.
|
|
|
4247 (require 'easymenu)
|
|
|
4248
|
|
|
4249 (defconst edebug-mode-menus
|
|
|
4250 '("Edebug"
|
|
|
4251 "----"
|
|
|
4252 ["Stop" edebug-stop t]
|
|
|
4253 ["Step" edebug-step-mode t]
|
|
|
4254 ["Next" edebug-next-mode t]
|
|
|
4255 ["Trace" edebug-trace-mode t]
|
|
|
4256 ["Trace Fast" edebug-Trace-fast-mode t]
|
|
|
4257 ["Continue" edebug-continue-mode t]
|
|
|
4258 ["Continue Fast" edebug-Continue-fast-mode t]
|
|
|
4259 ["Go" edebug-go-mode t]
|
|
|
4260 ["Go Nonstop" edebug-Go-nonstop-mode t]
|
|
|
4261 "----"
|
|
|
4262 ["Help" edebug-help t]
|
|
|
4263 ["Abort" abort-recursive-edit t]
|
|
|
4264 ["Quit to Top Level" top-level t]
|
|
|
4265 ["Quit Nonstop" edebug-top-level-nonstop t]
|
|
|
4266 "----"
|
|
|
4267 ("Jumps"
|
|
|
4268 ["Forward Sexp" edebug-forward-sexp t]
|
|
|
4269 ["Step In" edebug-step-in t]
|
|
|
4270 ["Step Out" edebug-step-out t]
|
|
|
4271 ["Goto Here" edebug-goto-here t])
|
|
|
4272
|
|
|
4273 ("Breaks"
|
|
|
4274 ["Set Breakpoint" edebug-set-breakpoint t]
|
|
|
4275 ["Unset Breakpoint" edebug-unset-breakpoint t]
|
|
|
4276 ["Set Conditional Breakpoint" edebug-set-conditional-breakpoint t]
|
|
|
4277 ["Set Global Break Condition" edebug-set-global-break-condition t]
|
|
|
4278 ["Show Next Breakpoint" edebug-next-breakpoint t])
|
|
|
4279
|
|
|
4280 ("Views"
|
|
|
4281 ["Where am I?" edebug-where t]
|
|
|
4282 ["Bounce to Current Point" edebug-bounce-point t]
|
|
|
4283 ["View Outside Windows" edebug-view-outside t]
|
|
|
4284 ["Previous Result" edebug-previous-result t]
|
|
|
4285 ["Show Backtrace" edebug-backtrace t]
|
|
|
4286 ["Display Freq Count" edebug-display-freq-count t])
|
|
|
4287
|
|
|
4288 ("Eval"
|
|
|
4289 ["Expression" edebug-eval-expression t]
|
|
|
4290 ["Last Sexp" edebug-eval-last-sexp t]
|
|
|
4291 ["Visit Eval List" edebug-visit-eval-list t])
|
|
|
4292
|
|
|
4293 ("Options"
|
|
|
4294 ["Edebug All Defs" edebug-all-defs t]
|
|
|
4295 ["Edebug All Forms" edebug-all-forms t]
|
|
|
4296 "----"
|
|
|
4297 ["Toggle Tracing" (edebug-toggle 'edebug-trace) t]
|
|
|
4298 ["Toggle Coverage Testing" (edebug-toggle 'edebug-test-coverage) t]
|
|
|
4299 ["Toggle Window Saving" edebug-toggle-save-windows t]
|
|
|
4300 ["Toggle Point Saving"
|
|
|
4301 (edebug-toggle 'edebug-save-displayed-buffer-points) t]
|
|
|
4302 ))
|
|
|
4303 "XEmacs style menus for Edebug.")
|
|
|
4304
|
|
|
4305
|
|
|
4306 ;;;; Emacs version specific code
|
|
|
4307 ;;;=============================
|
|
|
4308 ;;; The default for all above is Emacs 18, because it is easier to compile
|
|
|
4309 ;;; Emacs 18 code in Emacs 19 than vice versa. This default will
|
|
|
4310 ;;; change once most people are using Emacs 19 or derivatives.
|
|
|
4311
|
|
|
4312 ;; Epoch specific code is in a separate file: edebug-epoch.el.
|
|
|
4313
|
|
|
4314 ;; The byte-compiler will complain about changes in number of arguments
|
|
|
4315 ;; to functions like mark and read-from-minibuffer. These warnings
|
|
|
4316 ;; may be ignored because the right call should always be made.
|
|
|
4317
|
|
|
4318 (defun edebug-emacs-19-specific ()
|
|
|
4319
|
|
|
4320 (defalias 'edebug-window-live-p 'window-live-p)
|
|
|
4321
|
|
|
4322 ;; Mark takes an argument in Emacs 19.
|
|
|
4323 (defun edebug-mark ()
|
|
|
4324 (mark t));; Does this work for XEmacs too?
|
|
|
4325
|
|
|
4326 ;; Use minibuffer-history when reading expressions.
|
|
|
4327 (defvar read-expression-history) ;; hush bytecomp
|
|
|
4328 (defvar read-expression-map)
|
|
|
4329
|
|
|
4330 (defun edebug-set-conditional-breakpoint (arg condition)
|
|
|
4331 "Set a conditional breakpoint at nearest sexp.
|
|
|
4332 The condition is evaluated in the outside context.
|
|
|
4333 With prefix argument, make it a temporary breakpoint."
|
|
|
4334 ;; (interactive "P\nxCondition: ")
|
|
|
4335 (interactive
|
|
|
4336 (list
|
|
|
4337 current-prefix-arg
|
|
|
4338 ;; Read condition as follows; getting previous condition is cumbersome:
|
|
|
4339 (let ((edebug-stop-point (edebug-find-stop-point)))
|
|
|
4340 (if edebug-stop-point
|
|
|
4341 (let* ((edebug-def-name (car edebug-stop-point))
|
|
|
4342 (index (cdr edebug-stop-point))
|
|
|
4343 (edebug-data (get edebug-def-name 'edebug))
|
|
|
4344 (edebug-breakpoints (car (cdr edebug-data)))
|
|
|
4345 (edebug-break-data (assq index edebug-breakpoints))
|
|
|
4346 (edebug-break-condition (car (cdr edebug-break-data)))
|
|
|
4347 (edebug-expression-history
|
|
|
4348 ;; Prepend the current condition, if any.
|
|
|
4349 (if edebug-break-condition
|
|
|
4350 (cons edebug-break-condition read-expression-history)
|
|
|
4351 read-expression-history)))
|
|
|
4352 (prog1
|
|
|
4353 (read-from-minibuffer
|
|
|
4354 "Condition: " nil read-expression-map t
|
|
|
4355 'edebug-expression-history)
|
|
|
4356 (setq read-expression-history edebug-expression-history)
|
|
|
4357 ))))))
|
|
|
4358 (edebug-modify-breakpoint t condition arg))
|
|
|
4359
|
|
|
4360 (defun edebug-eval-expression (edebug-expr)
|
|
|
4361 "Evaluate an expression in the outside environment.
|
|
|
4362 If interactive, prompt for the expression.
|
|
|
4363 Print result in minibuffer."
|
|
|
4364 (interactive (list (read-from-minibuffer
|
|
|
4365 "Eval: " nil read-expression-map t
|
|
|
4366 'read-expression-history)))
|
|
|
4367 (princ
|
|
|
4368 (edebug-outside-excursion
|
|
|
4369 (setq values (cons (edebug-eval edebug-expr) values))
|
|
|
4370 (edebug-safe-prin1-to-string (car values)))))
|
|
|
4371
|
|
|
4372 (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
|
|
|
4373 (if window-system
|
|
|
4374 (x-popup-menu nil (lookup-key edebug-mode-map [menu-bar Edebug])))
|
|
|
4375 )
|
|
|
4376
|
|
|
4377
|
|
|
4378 (defun edebug-xemacs-specific ()
|
|
|
4379
|
|
|
4380 ;; We need to bind zmacs-regions to nil around all calls to `mark' and
|
|
|
4381 ;; `mark-marker' but don't bind it to nil before entering a recursive edit,
|
|
|
4382 ;; that is, don't interfere with the binding the user might see while
|
|
|
4383 ;; executing a command.
|
|
|
4384
|
|
|
4385 (defvar zmacs-regions)
|
|
|
4386
|
|
|
4387 (defun edebug-mark ()
|
|
|
4388 (let ((zmacs-regions nil))
|
|
|
4389 (mark)))
|
|
|
4390
|
|
|
4391 (defun edebug-mark-marker ()
|
|
|
4392 (let ((zmacs-regions nil));; for XEmacs
|
|
|
4393 (mark-marker)))
|
|
|
4394
|
|
|
4395
|
|
|
4396 (defun edebug-mode-menu (event)
|
|
|
4397 (interactive "@event")
|
|
|
4398 (popup-menu edebug-mode-menus))
|
|
|
4399
|
|
|
4400 (define-key edebug-mode-map 'button3 'edebug-mode-menu)
|
|
|
4401 )
|
|
|
4402
|
|
|
4403 (defun edebug-emacs-version-specific ()
|
|
|
4404 (cond
|
|
|
4405 ((string-match "XEmacs" emacs-version);; XEmacs
|
|
|
4406 (edebug-xemacs-specific))
|
|
|
4407
|
|
|
4408 ((and (boundp 'epoch::version) epoch::version)
|
|
|
4409 (require 'edebug-epoch))
|
|
|
4410
|
|
|
4411 ((not (string-match "^18" emacs-version))
|
|
|
4412 (edebug-emacs-19-specific))))
|
|
|
4413
|
|
|
4414 (edebug-emacs-version-specific)
|
|
|
4415
|
|
|
4416
|
|
|
4417 ;;;; Byte-compiler
|
|
|
4418 ;;; ====================
|
|
|
4419 ;; Extension for bytecomp to resolve undefined function references.
|
|
|
4420 ;; Requires new byte compiler.
|
|
|
4421
|
|
|
4422 ;; Reenable byte compiler warnings about unread-command-char and -event.
|
|
|
4423 ;; Disabled before edebug-recursive-edit.
|
|
|
4424 (eval-when-compile
|
|
|
4425 (if edebug-unread-command-char-warning
|
|
|
4426 (put 'unread-command-char 'byte-obsolete-variable
|
|
|
4427 edebug-unread-command-char-warning))
|
|
|
4428 (if edebug-unread-command-event-warning
|
|
|
4429 (put 'unread-command-event 'byte-obsolete-variable
|
|
|
4430 edebug-unread-command-event-warning)))
|
|
|
4431
|
|
|
4432 (eval-when-compile
|
|
|
4433 ;; The body of eval-when-compile seems to get evaluated with eval-defun.
|
|
|
4434 ;; We only want to evaluate when actually byte compiling.
|
|
|
4435 ;; But it is OK to evaluate as long as byte-compiler has been loaded.
|
|
|
4436 (if (featurep 'byte-compile) (progn
|
|
|
4437
|
|
|
4438 (defun byte-compile-resolve-functions (funcs)
|
|
|
4439 "Say it is OK for the named functions to be unresolved."
|
|
|
4440 (mapcar
|
|
|
4441 (function
|
|
|
4442 (lambda (func)
|
|
|
4443 (setq byte-compile-unresolved-functions
|
|
|
4444 (delq (assq func byte-compile-unresolved-functions)
|
|
|
4445 byte-compile-unresolved-functions))))
|
|
|
4446 funcs)
|
|
|
4447 nil)
|
|
|
4448
|
|
|
4449 '(defun byte-compile-resolve-free-references (vars)
|
|
|
4450 "Say it is OK for the named variables to be referenced."
|
|
|
4451 (mapcar
|
|
|
4452 (function
|
|
|
4453 (lambda (var)
|
|
|
4454 (setq byte-compile-free-references
|
|
|
4455 (delq var byte-compile-free-references))))
|
|
|
4456 vars)
|
|
|
4457 nil)
|
|
|
4458
|
|
|
4459 '(defun byte-compile-resolve-free-assignments (vars)
|
|
|
4460 "Say it is OK for the named variables to be assigned."
|
|
|
4461 (mapcar
|
|
|
4462 (function
|
|
|
4463 (lambda (var)
|
|
|
4464 (setq byte-compile-free-assignments
|
|
|
4465 (delq var byte-compile-free-assignments))))
|
|
|
4466 vars)
|
|
|
4467 nil)
|
|
|
4468
|
|
|
4469 (byte-compile-resolve-functions
|
|
|
4470 '(reporter-submit-bug-report
|
|
|
4471 edebug-gensym ;; also in cl.el
|
|
|
4472 ;; Interfaces to standard functions.
|
|
|
4473 edebug-original-eval-defun
|
|
|
4474 edebug-original-read
|
|
|
4475 edebug-get-buffer-window
|
|
|
4476 edebug-mark
|
|
|
4477 edebug-mark-marker
|
|
|
4478 edebug-input-pending-p
|
|
|
4479 edebug-sit-for
|
|
|
4480 edebug-prin1-to-string
|
|
|
4481 edebug-format
|
|
|
4482 edebug-original-signal
|
|
|
4483 ;; XEmacs
|
|
|
4484 zmacs-deactivate-region
|
|
|
4485 popup-menu
|
|
|
4486 ;; CL
|
|
|
4487 cl-macroexpand-all
|
|
|
4488 ;; And believe it or not, the byte compiler doesnt know about:
|
|
|
4489 byte-compile-resolve-functions
|
|
|
4490 ))
|
|
|
4491
|
|
|
4492 '(byte-compile-resolve-free-references
|
|
|
4493 '(read-expression-history
|
|
|
4494 read-expression-map))
|
|
|
4495
|
|
|
4496 '(byte-compile-resolve-free-assignments
|
|
|
4497 '(read-expression-history))
|
|
|
4498
|
|
|
4499 )))
|
|
|
4500
|
|
|
4501
|
|
|
4502 ;;;; Autoloading of Edebug accessories
|
|
|
4503 ;;;===================================
|
|
|
4504
|
|
|
4505 (if (featurep 'cl)
|
|
|
4506 (add-hook 'edebug-setup-hook
|
|
|
4507 (function (lambda () (require 'cl-specs))))
|
|
|
4508 ;; The following causes cl-specs to be loaded if you load cl.el.
|
|
|
4509 (add-hook 'cl-load-hook
|
|
|
4510 (function (lambda () (require 'cl-specs)))))
|
|
|
4511
|
|
|
4512 ;;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
|
|
|
4513 (if (featurep 'cl-read)
|
|
|
4514 (add-hook 'edebug-setup-hook
|
|
|
4515 (function (lambda () (require 'edebug-cl-read))))
|
|
|
4516 ;; The following causes edebug-cl-read to be loaded when you load cl-read.el.
|
|
|
4517 (add-hook 'cl-read-load-hooks
|
|
|
4518 (function (lambda () (require 'edebug-cl-read)))))
|
|
|
4519
|
|
|
4520
|
|
|
4521 ;;;; Finalize Loading
|
|
|
4522 ;;;===================
|
|
|
4523
|
|
|
4524 ;;; Finally, hook edebug into the rest of Emacs.
|
|
|
4525 ;;; There are probably some other things that could go here.
|
|
|
4526
|
|
|
4527 ;; Install edebug read and eval functions.
|
|
|
4528 (edebug-install-read-eval-functions)
|
|
|
4529
|
|
|
4530 (provide 'edebug)
|
|
|
4531
|
|
|
4532 ;;; edebug.el ends here
|
|
|
4533
|
|
|
4534
|
