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