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