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