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