(timer-until): Fix syntax error.
[bpt/emacs.git] / lisp / emacs-lisp / edebug.el
CommitLineData
f7359658 1;;; edebug.el --- a source-level debugger for Emacs Lisp
84fc2cfa 2
c5292bc8
RS
3;; Copyright (C) 1988,'89,'90,'91,'92,'93,'94,'95,'97
4;; Free Software Foundation, Inc
84fc2cfa 5
3a801d0c 6;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
e9571d2a 7;; Keywords: lisp, tools, maint
3a801d0c 8
1fe3d507
DL
9;; LCD Archive Entry:
10;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu
11;; |A source level debugger for Emacs Lisp.
c5292bc8 12;; |$Date: 1996/12/26 20:46:51 $|$Revision: 3.13 $|~/modes/edebug.el|
e41b2db1 13
84fc2cfa
ER
14;; This file is part of GNU Emacs.
15
1fe3d507
DL
16;; GNU Emacs is free software; you can redistribute it and/or modify
17;; it under the terms of the GNU General Public License as published by
18;; the Free Software Foundation; either version 2, or (at your option)
19;; any later version.
20
84fc2cfa 21;; GNU Emacs is distributed in the hope that it will be useful,
1fe3d507
DL
22;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24;; GNU General Public License for more details.
25
26;; You should have received a copy of the GNU General Public License
f7359658
RS
27;; along with GNU Emacs; see the file COPYING. If not, write to the
28;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
29;; Boston, MA 02111-1307, USA.
30
31;;; Commentary:
32
33;; This minor mode allows programmers to step through Emacs Lisp
34;; source code while executing functions. You can also set
35;; breakpoints, trace (stopping at each expression), evaluate
36;; expressions as if outside Edebug, reevaluate and display a list of
37;; expressions, trap errors normally caught by debug, and display a
38;; debug style backtrace.
39
40;;; Installation
41;; =============
42
43;; Put edebug.el in some directory in your load-path and
44;; byte-compile it. Also read the beginning of edebug-epoch.el,
45;; cl-specs.el, and edebug-cl-read.el if they apply to you.
46
47;; Unless you are using Emacs 19 which is already set up to use Edebug,
48;; put the following forms in your .emacs file.
49;; (define-key emacs-lisp-mode-map "\C-xx" 'edebug-eval-top-level-form)
50;; (autoload 'edebug-eval-top-level-form "edebug")
51
52;; If you wish to change the default edebug global command prefix, change:
53;; (setq edebug-global-prefix "\C-xX")
54
55;; Other options, are described in the manual.
56
57;; In previous versions of Edebug, users were directed to set
58;; `debugger' to `edebug-debug'. This is no longer necessary
59;; since Edebug automatically sets it whenever Edebug is active.
60
61;;; Minimal Instructions
62;; =====================
63
64;; First evaluate a defun with C-xx, then run the function. Step
65;; through the code with SPC, mark breakpoints with b, go until a
66;; breakpoint is reached with g, and quit execution with q. Use the
67;; "?" command in edebug to describe other commands. See edebug.tex
68;; or the Emacs 19 Lisp Reference Manual for more instructions.
69
70;; Send me your enhancements, ideas, bugs, or fixes.
71;; For bugs, you can call edebug-submit-bug-report if you have reporter.el.
72;; There is an edebug mailing list if you want to keep up
73;; with the latest developments. Requests to: edebug-request@cs.uiuc.edu
74
75;; Daniel LaLiberte 217-398-4114
76;; University of Illinois, Urbana-Champaign
77;; Department of Computer Science
78;; 1304 W Springfield
79;; Urbana, IL 61801
80
81;; uiucdcs!liberte
82;; liberte@cs.uiuc.edu
83
84;; For the early revision history, see edebug-history.
85
86;;; Code:
1fe3d507
DL
87
88(defconst edebug-version
c5292bc8 89 (let ((raw-version "$Revision: 3.13 $"))
1576fe1d 90 (substring raw-version (string-match "[0-9.]*" raw-version)
1fe3d507
DL
91 (match-end 0))))
92
93(require 'backquote)
94
f7359658 95;; Emacs 18 doesn't have defalias.
1fe3d507
DL
96(eval-and-compile
97 (or (fboundp 'defalias) (fset 'defalias 'fset)))
84fc2cfa 98
84fc2cfa 99
f7359658 100;;; Bug reporting
84fc2cfa 101
1fe3d507 102(defconst edebug-maintainer-address "liberte@cs.uiuc.edu")
84fc2cfa 103
1fe3d507
DL
104(defun edebug-submit-bug-report ()
105 "Submit, via mail, a bug report on edebug."
106 (interactive)
107 (require 'reporter)
108 (and (y-or-n-p "Do you really want to submit a report on edebug? ")
109 (reporter-submit-bug-report
110 edebug-maintainer-address
111 (concat "edebug.el " edebug-version)
112 (list 'edebug-setup-hook
113 'edebug-all-defs
114 'edebug-all-forms
115 'edebug-eval-macro-args
116 'edebug-stop-before-symbols
117 'edebug-save-windows
118 'edebug-save-displayed-buffer-points
119 'edebug-initial-mode
120 'edebug-trace
121 'edebug-test-coverage
122 'edebug-continue-kbd-macro
123 'edebug-print-length
124 'edebug-print-level
125 'edebug-print-circle
126 ))))
127
f7359658 128;;; Options
1fe3d507 129
c5292bc8
RS
130(defgroup edebug nil
131 "A source-level debugger for Emacs Lisp"
132 :group 'lisp)
133
134
135(defcustom edebug-setup-hook nil
1fe3d507 136 "*Functions to call before edebug is used.
a50d4326
DL
137Each time it is set to a new value, Edebug will call those functions
138once and then `edebug-setup-hook' is reset to nil. You could use this
139to load up Edebug specifications associated with a package you are
c5292bc8
RS
140using but only when you also use Edebug."
141 :type 'hook
142 :group 'edebug)
1fe3d507 143
c5292bc8 144(defcustom edebug-all-defs nil
a50d4326
DL
145 "*If non-nil, evaluation of any defining forms will instrument for Edebug.
146This applies to `eval-defun', `eval-region', `eval-buffer', and
147`eval-current-buffer'. `eval-region' is also called by
1fe3d507
DL
148`eval-last-sexp', and `eval-print-last-sexp'.
149
150You can use the command `edebug-all-defs' to toggle the value of this
a50d4326 151variable. You may wish to make it local to each buffer with
f7359658 152\(make-local-variable 'edebug-all-defs) in your
c5292bc8
RS
153`emacs-lisp-mode-hook'."
154 :type 'boolean
155 :group 'edebug)
1fe3d507 156
c5292bc8 157(defcustom edebug-all-forms nil
a50d4326 158 "*Non-nil evaluation of all forms will instrument for Edebug.
1fe3d507 159This doesn't apply to loading or evaluations in the minibuffer.
c5292bc8
RS
160Use the command `edebug-all-forms' to toggle the value of this option."
161 :type 'boolean
162 :group 'edebug)
84fc2cfa 163
c5292bc8 164(defcustom edebug-eval-macro-args nil
1fe3d507 165 "*Non-nil means all macro call arguments may be evaluated.
f7359658 166If this variable is nil, the default, Edebug will *not* wrap
1fe3d507 167macro call arguments as if they will be evaluated.
f7359658 168For each macro, a `edebug-form-spec' overrides this option.
1fe3d507 169So to specify exceptions for macros that have some arguments evaluated
f7359658 170and some not, you should specify an `edebug-form-spec'.
1fe3d507 171
c5292bc8
RS
172This option is going away soon."
173 :type 'boolean
174 :group 'edebug)
84fc2cfa 175
c5292bc8 176(defcustom edebug-stop-before-symbols nil
a50d4326
DL
177 "*Non-nil causes Edebug to stop before symbols as well as after.
178In any case, a breakpoint or interrupt may stop before a symbol.
179
c5292bc8
RS
180This option is going away soon."
181 :type 'boolean
182 :group 'edebug)
84fc2cfa 183
c5292bc8 184(defcustom edebug-save-windows t
a50d4326
DL
185 "*If non-nil, Edebug saves and restores the window configuration.
186That takes some time, so if your program does not care what happens to
187the window configurations, it is better to set this variable to nil.
1fe3d507
DL
188
189If the value is a list, only the listed windows are saved and
190restored.
84fc2cfa 191
c5292bc8
RS
192`edebug-toggle-save-windows' may be used to change this variable."
193 :type '(choice boolean (repeat string))
194 :group 'edebug)
84fc2cfa 195
c5292bc8 196(defcustom edebug-save-displayed-buffer-points nil
a50d4326 197 "*If non-nil, save and restore point in all displayed buffers.
84fc2cfa 198
a50d4326
DL
199Saving and restoring point in other buffers is necessary if you are
200debugging code that changes the point of a buffer which is displayed
201in a non-selected window. If Edebug or the user then selects the
84fc2cfa
ER
202window, the buffer's point will be changed to the window's point.
203
a50d4326
DL
204Saving and restoring point in all buffers is expensive, since it
205requires selecting each window twice, so enable this only if you need
c5292bc8
RS
206it."
207 :type 'boolean
208 :group 'edebug)
84fc2cfa 209
c5292bc8 210(defcustom edebug-initial-mode 'step
a50d4326
DL
211 "*Initial execution mode for Edebug, if non-nil. If this variable
212is non-@code{nil}, it specifies the initial execution mode for Edebug
213when it is first activated. Possible values are step, next, go,
c5292bc8
RS
214Go-nonstop, trace, Trace-fast, continue, and Continue-fast."
215 :type '(choice (const step) (const next) (const go)
216 (const Go-nonstop) (const trace)
217 (const Trace-fast) (const continue)
218 (const continue-fast))
219 :group 'edebug)
220
221(defcustom edebug-trace nil
a50d4326
DL
222 "*Non-nil means display a trace of function entry and exit.
223Tracing output is displayed in a buffer named `*edebug-trace*', one
224function entry or exit per line, indented by the recursion level.
225
226You can customize by replacing functions `edebug-print-trace-before'
c5292bc8
RS
227and `edebug-print-trace-after'."
228 :type 'boolean
229 :group 'edebug)
84fc2cfa 230
c5292bc8 231(defcustom edebug-test-coverage nil
1fe3d507
DL
232 "*If non-nil, Edebug tests coverage of all expressions debugged.
233This is done by comparing the result of each expression
234with the previous result. Coverage is considered OK if two different
a50d4326 235results are found.
84fc2cfa 236
1fe3d507 237Use `edebug-display-freq-count' to display the frequency count and
c5292bc8
RS
238coverage information for a definition."
239 :type 'boolean
240 :group 'edebug)
1fe3d507 241
c5292bc8 242(defcustom edebug-continue-kbd-macro nil
a50d4326 243 "*If non-nil, continue defining or executing any keyboard macro.
c5292bc8
RS
244Use this with caution since it is not debugged."
245 :type 'boolean
246 :group 'edebug)
247
248
249(defcustom edebug-print-length 50
250 "*Default value of `print-length' to use while printing results in Edebug."
251 :type 'integer
252 :group 'edebug)
253(defcustom edebug-print-level 50
254 "*Default value of `print-level' to use while printing results in Edebug."
255 :type 'integer
256 :group 'edebug)
257(defcustom edebug-print-circle t
258 "*Default value of `print-circle' to use while printing results in Edebug."
259 :type 'boolean
260 :group 'edebug)
261
262(defcustom edebug-unwrap-results nil
1fe3d507
DL
263 "*Non-nil if Edebug should unwrap results of expressions.
264This is useful when debugging macros where the results of expressions
265are instrumented expressions. But don't do this when results might be
c5292bc8
RS
266circular or an infinite loop will result."
267 :type 'boolean
268 :group 'edebug)
1fe3d507 269
c5292bc8 270(defcustom edebug-on-error t
1fe3d507
DL
271 "*Value bound to `debug-on-error' while Edebug is active.
272
273If `debug-on-error' is non-nil, that value is still used.
274
275If the value is a list of signal names, Edebug will stop when any of
276these errors are signaled from Lisp code whether or not the signal is
277handled by a `condition-case'. This option is useful for debugging
278signals that *are* handled since they would otherwise be missed.
c5292bc8
RS
279After execution is resumed, the error is signaled again."
280 :type '(choice boolean (repeat string))
281 :group 'edebug)
1fe3d507 282
c5292bc8
RS
283(defcustom edebug-on-quit t
284 "*Value bound to `debug-on-quit' while Edebug is active."
285 :type 'boolean
286 :group 'edebug)
1fe3d507 287
c5292bc8 288(defcustom edebug-global-break-condition nil
a50d4326 289 "*If non-nil, an expression to test for at every stop point.
c5292bc8
RS
290If the result is non-nil, then break. Errors are ignored."
291 :type 'sexp
292 :group 'edebug)
a50d4326 293
f7359658 294;;; Form spec utilities.
1fe3d507
DL
295
296;;;###autoload
297(defmacro def-edebug-spec (symbol spec)
298 "Set the edebug-form-spec property of SYMBOL according to SPEC.
299Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
f7359658 300\(naming a function), or a list."
1fe3d507
DL
301 (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
302
303(defmacro def-edebug-form-spec (symbol spec-form)
f7359658 304 "For compatibility with old version. Use `def-edebug-spec' instead."
1fe3d507
DL
305 (message "Obsolete: use def-edebug-spec instead.")
306 (def-edebug-spec symbol (eval spec-form)))
307
308(defun get-edebug-spec (symbol)
309 ;; Get the spec of symbol resolving all indirection.
310 (let ((edebug-form-spec (get symbol 'edebug-form-spec))
311 indirect)
312 (while (and (symbolp edebug-form-spec)
313 (setq indirect (get edebug-form-spec 'edebug-form-spec)))
314 ;; (edebug-trace "indirection: %s" edebug-form-spec)
315 (setq edebug-form-spec indirect))
316 edebug-form-spec
317 ))
318
f7359658 319;;; Utilities
1fe3d507 320
f7359658
RS
321;; Define edebug-gensym - from old cl.el
322(defvar edebug-gensym-index 0
323 "Integer used by `edebug-gensym' to produce new names.")
1fe3d507 324
f7359658 325(defun edebug-gensym (&optional prefix)
1fe3d507
DL
326 "Generate a fresh uninterned symbol.
327There is an optional argument, PREFIX. PREFIX is the
328string that begins the new name. Most people take just the default,
329except when debugging needs suggest otherwise."
330 (if (null prefix)
331 (setq prefix "G"))
332 (let ((newsymbol nil)
333 (newname ""))
334 (while (not newsymbol)
f7359658
RS
335 (setq newname (concat prefix (int-to-string edebug-gensym-index)))
336 (setq edebug-gensym-index (+ edebug-gensym-index 1))
1fe3d507
DL
337 (if (not (intern-soft newname))
338 (setq newsymbol (make-symbol newname))))
339 newsymbol))
1fe3d507 340
a50d4326 341;; Only used by CL-like code.
f7359658
RS
342(defun edebug-keywordp (object)
343 "Return t if OBJECT is a keyword.
344A keyword is a symbol that starts with `:'."
345 (and (symbolp object)
346 (= ?: (aref (symbol-name object) 0))))
347
348(defun edebug-lambda-list-keywordp (object)
1fe3d507 349 "Return t if OBJECT is a lambda list keyword.
f7359658 350A lambda list keyword is a symbol that starts with `&'."
1fe3d507
DL
351 (and (symbolp object)
352 (= ?& (aref (symbol-name object) 0))))
84fc2cfa 353
84fc2cfa
ER
354
355(defun edebug-last-sexp ()
1fe3d507 356 ;; Return the last sexp before point in current buffer.
f7359658 357 ;; Assumes Emacs Lisp syntax is active.
84fc2cfa
ER
358 (car
359 (read-from-string
360 (buffer-substring
361 (save-excursion
362 (forward-sexp -1)
363 (point))
364 (point)))))
365
366(defun edebug-window-list ()
f7359658
RS
367 "Return a list of windows, in order of `next-window'."
368 ;; This doesn't work for epoch.
84fc2cfa
ER
369 (let* ((first-window (selected-window))
370 (window-list (list first-window))
371 (next (next-window first-window)))
372 (while (not (eq next first-window))
373 (setq window-list (cons next window-list))
374 (setq next (next-window next)))
375 (nreverse window-list)))
376
1fe3d507
DL
377(defun edebug-window-live-p (window)
378 "Return non-nil if WINDOW is visible."
379 (let* ((first-window (selected-window))
380 (next (next-window first-window t)))
381 (while (not (or (eq next window)
382 (eq next first-window)))
383 (setq next (next-window next t)))
384 (eq next window)))
385
386;; Not used.
387'(defun edebug-two-window-p ()
84fc2cfa
ER
388 "Return t if there are two windows."
389 (and (not (one-window-p))
390 (eq (selected-window)
391 (next-window (next-window (selected-window))))))
392
1fe3d507 393(defsubst edebug-lookup-function (object)
84fc2cfa
ER
394 (while (and (symbolp object) (fboundp object))
395 (setq object (symbol-function object)))
1fe3d507
DL
396 object)
397
398(defun edebug-macrop (object)
399 "Return the macro named by OBJECT, or nil if it is not a macro."
400 (setq object (edebug-lookup-function object))
84fc2cfa
ER
401 (if (and (listp object)
402 (eq 'macro (car object))
403 (edebug-functionp (cdr object)))
404 object))
405
406(defun edebug-functionp (object)
407 "Returns the function named by OBJECT, or nil if it is not a function."
1fe3d507 408 (setq object (edebug-lookup-function object))
84fc2cfa 409 (if (or (subrp object)
f7359658 410 (byte-code-function-p object)
84fc2cfa
ER
411 (and (listp object)
412 (eq (car object) 'lambda)
413 (listp (car (cdr object)))))
414 object))
415
416(defun edebug-sort-alist (alist function)
1fe3d507
DL
417 ;; Return the ALIST sorted with comparison function FUNCTION.
418 ;; This uses 'sort so the sorting is destructive.
84fc2cfa
ER
419 (sort alist (function
420 (lambda (e1 e2)
421 (funcall function (car e1) (car e2))))))
422
1fe3d507 423;;(def-edebug-spec edebug-save-restriction t)
84fc2cfa 424
1fe3d507
DL
425;; Not used. If it is used, def-edebug-spec must be defined before use.
426'(defmacro edebug-save-restriction (&rest body)
84fc2cfa
ER
427 "Evaluate BODY while saving the current buffers restriction.
428BODY may change buffer outside of current restriction, unlike
429save-restriction. BODY may change the current buffer,
430and the restriction will be restored to the original buffer,
431and the current buffer remains current.
432Return the result of the last expression in BODY."
433 (` (let ((edebug:s-r-beg (point-min-marker))
434 (edebug:s-r-end (point-max-marker)))
435 (unwind-protect
436 (progn (,@ body))
437 (save-excursion
438 (set-buffer (marker-buffer edebug:s-r-beg))
439 (narrow-to-region edebug:s-r-beg edebug:s-r-end))))))
440
f7359658 441;;; Display
1fe3d507
DL
442
443(defconst edebug-trace-buffer "*edebug-trace*"
444 "Name of the buffer to put trace info in.")
445
446(defun edebug-pop-to-buffer (buffer &optional window)
447 ;; Like pop-to-buffer, but select window where BUFFER was last shown.
448 ;; Select WINDOW if it provided and it still exists. Otherwise,
449 ;; if buffer is currently shown in several windows, choose one.
450 ;; Otherwise, find a new window, possibly splitting one.
451 (setq window (if (and (windowp window) (edebug-window-live-p window)
452 (eq (window-buffer window) buffer))
453 window
454 (if (eq (window-buffer (selected-window)) buffer)
455 (selected-window)
456 (edebug-get-buffer-window buffer))))
457 (if window
458 (select-window window)
459 (if (one-window-p)
460 (split-window))
461 ;; (message "next window: %s" (next-window)) (sit-for 1)
462 (if (eq (get-buffer-window edebug-trace-buffer) (next-window))
f7359658 463 ;; Don't select trace window
1fe3d507
DL
464 nil
465 (select-window (next-window))))
466 (set-window-buffer (selected-window) buffer)
467 (set-window-hscroll (selected-window) 0);; should this be??
468 ;; Selecting the window does not set the buffer until command loop.
469 ;;(set-buffer buffer)
470 )
84fc2cfa 471
1fe3d507
DL
472
473(defun edebug-get-displayed-buffer-points ()
474 ;; Return a list of buffer point pairs, for all displayed buffers.
475 (save-excursion
476 (let* ((first-window (selected-window))
477 (next (next-window first-window))
478 (buffer-point-list nil)
479 buffer)
480 (while (not (eq next first-window))
481 (set-buffer (setq buffer (window-buffer next)))
482 (setq buffer-point-list
483 (cons (cons buffer (point)) buffer-point-list))
484 (setq next (next-window next)))
485 buffer-point-list)))
486
487
488(defun edebug-set-buffer-points (buffer-points)
489 ;; Restore the buffer-points created by edebug-get-displayed-buffer-points.
490 (let ((current-buffer (current-buffer)))
491 (mapcar (function (lambda (buf-point)
492 (if (buffer-name (car buf-point)) ; still exists
493 (progn
494 (set-buffer (car buf-point))
495 (goto-char (cdr buf-point))))))
496 buffer-points)
497 (set-buffer current-buffer)))
498
499(defun edebug-current-windows (which-windows)
500 ;; Get either a full window configuration or some window information.
501 (if (listp which-windows)
502 (mapcar (function (lambda (window)
503 (if (edebug-window-live-p window)
504 (list window
505 (window-buffer window)
506 (window-point window)
507 (window-start window)
508 (window-hscroll window)))))
509 which-windows)
510 (current-window-configuration)))
511
512(defun edebug-set-windows (window-info)
513 ;; Set either a full window configuration or some window information.
514 (if (listp window-info)
515 (mapcar (function
516 (lambda (one-window-info)
517 (if one-window-info
518 (apply (function
519 (lambda (window buffer point start hscroll)
520 (if (edebug-window-live-p window)
521 (progn
522 (set-window-buffer window buffer)
523 (set-window-point window point)
524 (set-window-start window start)
525 (set-window-hscroll window hscroll)))))
526 one-window-info))))
527 window-info)
528 (set-window-configuration window-info)))
529
530(defalias 'edebug-get-buffer-window 'get-buffer-window)
531(defalias 'edebug-sit-for 'sit-for)
532(defalias 'edebug-input-pending-p 'input-pending-p)
533
534
f7359658
RS
535;;; Redefine read and eval functions
536;; read is redefined to maybe instrument forms.
537;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
1fe3d507 538
f7359658
RS
539;; Use the Lisp version of eval-region.
540(require 'eval-reg "eval-reg")
1fe3d507
DL
541
542;; Save the original read function
543(or (fboundp 'edebug-original-read)
544 (defalias 'edebug-original-read (symbol-function 'read)))
545
88668147
DL
546(defun edebug-read (&optional stream)
547 "Read one Lisp expression as text from STREAM, return as Lisp object.
548If STREAM is nil, use the value of `standard-input' (which see).
549STREAM or the value of `standard-input' may be:
550 a buffer (read from point and advance it)
551 a marker (read from where it points and advance it)
552 a function (call it with no arguments for each character,
553 call it with a char as argument to push a char back)
554 a string (takes text from string, starting at the beginning)
555 t (read text line using minibuffer and use it).
556
557This version, from Edebug, maybe instruments the expression. But the
f7359658 558STREAM must be the current buffer to do so. Whether it instruments is
88668147 559also dependent on the values of `edebug-all-defs' and
1fe3d507 560`edebug-all-forms'."
88668147
DL
561 (or stream (setq stream standard-input))
562 (if (eq stream (current-buffer))
1fe3d507
DL
563 (edebug-read-and-maybe-wrap-form)
564 (edebug-original-read stream)))
565
1fe3d507
DL
566(or (fboundp 'edebug-original-eval-defun)
567 (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun)))
568
f7359658
RS
569;; We should somehow arrange to be able to do this
570;; without actually replacing the eval-defun command.
1fe3d507
DL
571(defun edebug-eval-defun (edebug-it)
572 "Evaluate the top-level form containing point, or after point.
573
574This version, from Edebug, has the following differences: With a
88668147 575prefix argument instrument the code for Edebug. If `edebug-all-defs' is
1fe3d507 576non-nil, then the code is instrumented *unless* there is a prefix
f7359658 577argument. If instrumenting, it prints: `Edebug: FUNCTIONNAME'.
1fe3d507
DL
578Otherwise, it prints in the minibuffer."
579 (interactive "P")
f7359658
RS
580 (let* ((edebugging (not (eq (not edebug-it) (not edebug-all-defs))))
581 (edebug-result)
582 (form
583 (let ((edebug-all-forms edebugging)
584 (edebug-all-defs (eq edebug-all-defs (not edebug-it))))
585 (edebug-read-top-level-form))))
586 (if (and (eq (car form) 'defvar)
587 (cdr-safe (cdr-safe form)))
588 (setq form (cons 'defconst (cdr form))))
589 (setq edebug-result (eval form))
1fe3d507
DL
590 (if (not edebugging)
591 (princ edebug-result)
592 edebug-result)))
593
594
595;;;###autoload
596(defalias 'edebug-defun 'edebug-eval-top-level-form)
597
598;;;###autoload
599(defun edebug-eval-top-level-form ()
600 "Evaluate a top level form, such as a defun or defmacro.
601This is like `eval-defun', but the code is always instrumented for Edebug.
602Print its name in the minibuffer and leave point where it is,
f7359658 603or if an error occurs, leave point after it with mark at the original point."
84fc2cfa 604 (interactive)
1fe3d507 605 (eval
f7359658 606 ;; Bind edebug-all-forms only while reading, not while evalling
1fe3d507 607 ;; but this causes problems while edebugging edebug.
88668147
DL
608 (let ((edebug-all-forms t)
609 (edebug-all-defs t))
1fe3d507 610 (edebug-read-top-level-form))))
84fc2cfa
ER
611
612
1fe3d507
DL
613(defun edebug-read-top-level-form ()
614 (let ((starting-point (point)))
615 (end-of-defun)
616 (beginning-of-defun)
617 (prog1
618 (edebug-read-and-maybe-wrap-form)
619 ;; Recover point, but only if no error occurred.
620 (goto-char starting-point))))
84fc2cfa 621
84fc2cfa 622
1fe3d507
DL
623;; Compatibility with old versions.
624(defalias 'edebug-all-defuns 'edebug-all-defs)
84fc2cfa 625
1fe3d507
DL
626(defun edebug-all-defs ()
627 "Toggle edebugging of all definitions."
628 (interactive)
629 (setq edebug-all-defs (not edebug-all-defs))
630 (message "Edebugging all definitions is %s."
631 (if edebug-all-defs "on" "off")))
84fc2cfa 632
84fc2cfa 633
1fe3d507
DL
634(defun edebug-all-forms ()
635 "Toggle edebugging of all forms."
636 (interactive)
637 (setq edebug-all-forms (not edebug-all-forms))
638 (message "Edebugging all forms is %s."
639 (if edebug-all-forms "on" "off")))
84fc2cfa
ER
640
641
1fe3d507 642(defun edebug-install-read-eval-functions ()
1c222bca 643 (interactive)
88668147 644 ;; Don't install if already installed.
f7359658 645 (if (eq (symbol-function 'read) 'edebug-read) nil
88668147
DL
646 (elisp-eval-region-install)
647 (defalias 'read 'edebug-read)
648 (defalias 'eval-defun 'edebug-eval-defun)))
daa37602 649
1fe3d507
DL
650(defun edebug-uninstall-read-eval-functions ()
651 (interactive)
88668147
DL
652 (elisp-eval-region-uninstall)
653 (defalias 'read (symbol-function 'edebug-original-read))
654 (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun)))
1fe3d507
DL
655
656
f7359658 657;;; Edebug internal data
1fe3d507 658
f7359658
RS
659;; The internal data that is needed for edebugging is kept in the
660;; buffer-local variable `edebug-form-data'.
1fe3d507
DL
661
662(make-variable-buffer-local 'edebug-form-data)
663
664(defconst edebug-form-data nil)
665;; A list of entries associating symbols with buffer regions.
666;; This is an automatic buffer local variable. Each entry looks like:
667;; @code{(@var{symbol} @var{begin-marker} @var{end-marker}). The markers
668;; are at the beginning and end of an entry level form and @var{symbol} is
669;; a symbol that holds all edebug related information for the form on its
670;; property list.
671
672;; In the future, the symbol will be irrelevant and edebug data will
673;; be stored in the definitions themselves rather than in the property
674;; list of a symbol.
675
676(defun edebug-make-form-data-entry (symbol begin end)
677 (list symbol begin end))
678
679(defsubst edebug-form-data-name (entry)
680 (car entry))
681
682(defsubst edebug-form-data-begin (entry)
683 (nth 1 entry))
684
685(defsubst edebug-form-data-end (entry)
686 (nth 2 entry))
687
688(defsubst edebug-set-form-data-entry (entry name begin end)
689 (setcar entry name);; in case name is changed
690 (set-marker (nth 1 entry) begin)
691 (set-marker (nth 2 entry) end))
692
693(defun edebug-get-form-data-entry (pnt &optional end-point)
694 ;; Find the edebug form data entry which is closest to PNT.
695 ;; If END-POINT is supplied, match must be exact.
696 ;; Return `nil' if none found.
697 (let ((rest edebug-form-data)
698 closest-entry
699 (closest-dist 999999)) ;; need maxint here
700 (while (and rest (< 0 closest-dist))
701 (let* ((entry (car rest))
702 (begin (edebug-form-data-begin entry))
703 (dist (- pnt begin)))
704 (setq rest (cdr rest))
705 (if (and (<= 0 dist)
706 (< dist closest-dist)
707 (or (not end-point)
708 (= end-point (edebug-form-data-end entry)))
709 (<= pnt (edebug-form-data-end entry)))
710 (setq closest-dist dist
711 closest-entry entry))))
712 closest-entry))
713
714;; Also need to find all contained entries,
715;; and find an entry given a symbol, which should be just assq.
716
717(defun edebug-form-data-symbol ()
718;; Return the edebug data symbol of the form where point is in.
719;; If point is not inside a edebuggable form, cause error.
720 (or (edebug-form-data-name (edebug-get-form-data-entry (point)))
721 (error "Not inside instrumented form")))
722
723(defun edebug-make-top-form-data-entry (new-entry)
724 ;; Make NEW-ENTRY the first element in the `edebug-form-data' list.
725 (edebug-clear-form-data-entry new-entry)
726 (setq edebug-form-data (cons new-entry edebug-form-data)))
727
728(defun edebug-clear-form-data-entry (entry)
729;; If non-nil, clear ENTRY out of the form data.
730;; Maybe clear the markers and delete the symbol's edebug property?
731 (if entry
732 (progn
733 ;; Instead of this, we could just find all contained forms.
734 ;; (put (car entry) 'edebug nil) ;
735 ;; (mapcar 'edebug-clear-form-data-entry ; dangerous
736 ;; (get (car entry) 'edebug-dependents))
737 ;; (set-marker (nth 1 entry) nil)
738 ;; (set-marker (nth 2 entry) nil)
739 (setq edebug-form-data (delq entry edebug-form-data)))))
daa37602 740
f7359658 741;;; Parser utilities
1fe3d507
DL
742
743(defun edebug-syntax-error (&rest args)
744 ;; Signal an invalid-read-syntax with ARGS.
745 (signal 'invalid-read-syntax args))
746
84fc2cfa 747
1fe3d507
DL
748(defconst edebug-read-syntax-table
749 ;; Lookup table for significant characters indicating the class of the
750 ;; token that follows. This is not a \"real\" syntax table.
751 (let ((table (make-vector 256 'symbol))
752 (i 0))
753 (while (< i ?!)
754 (aset table i 'space)
755 (setq i (1+ i)))
756 (aset table ?\( 'lparen)
757 (aset table ?\) 'rparen)
758 (aset table ?\' 'quote)
f7359658
RS
759 (aset table ?\` 'backquote)
760 (aset table ?\, 'comma)
1fe3d507
DL
761 (aset table ?\" 'string)
762 (aset table ?\? 'char)
763 (aset table ?\[ 'lbracket)
764 (aset table ?\] 'rbracket)
765 (aset table ?\. 'dot)
766 (aset table ?\# 'hash)
767 ;; We treat numbers as symbols, because of confusion with -, -1, and 1-.
f7359658 768 ;; We don't care about any other chars since they won't be seen.
1fe3d507 769 table))
84fc2cfa 770
1fe3d507
DL
771(defun edebug-next-token-class ()
772 ;; Move to the next token and return its class. We only care about
f7359658
RS
773 ;; lparen, rparen, dot, quote, backquote, comma, string, char, vector,
774 ;; or symbol.
1fe3d507
DL
775 (edebug-skip-whitespace)
776 (aref edebug-read-syntax-table (following-char)))
84fc2cfa 777
84fc2cfa 778
1fe3d507
DL
779(defun edebug-skip-whitespace ()
780 ;; Leave point before the next token, skipping white space and comments.
781 (skip-chars-forward " \t\r\n\f")
782 (while (= (following-char) ?\;)
783 ;; \r is counted as a comment terminator to support selective display.
784 (skip-chars-forward "^\n\r") ; skip the comment
785 (skip-chars-forward " \t\r\n\f")))
84fc2cfa 786
84fc2cfa 787
1fe3d507 788;; Mostly obsolete reader; still used in one case.
84fc2cfa 789
1fe3d507
DL
790(defun edebug-read-sexp ()
791 ;; Read one sexp from the current buffer starting at point.
792 ;; Leave point immediately after it. A sexp can be a list or atom.
793 ;; An atom is a symbol (or number), character, string, or vector.
794 ;; This works for reading anything legitimate, but it
795 ;; is gummed up by parser inconsistencies (bugs?)
796 (let ((class (edebug-next-token-class)))
797 (cond
798 ;; read goes one too far if a (possibly quoted) string or symbol
799 ;; is immediately followed by non-whitespace.
f4897e40
RS
800 ((eq class 'symbol) (edebug-original-read (current-buffer)))
801 ((eq class 'string) (edebug-original-read (current-buffer)))
1fe3d507
DL
802 ((eq class 'quote) (forward-char 1)
803 (list 'quote (edebug-read-sexp)))
f7359658
RS
804 ((eq class 'backquote)
805 (list '\` (edebug-read-sexp)))
806 ((eq class 'comma)
807 (list '\, (edebug-read-sexp)))
1fe3d507
DL
808 (t ; anything else, just read it.
809 (edebug-original-read (current-buffer))))))
810
f7359658 811;;; Offsets for reader
1fe3d507
DL
812
813;; Define a structure to represent offset positions of expressions.
814;; Each offset structure looks like: (before . after) for constituents,
815;; or for structures that have elements: (before <subexpressions> . after)
816;; where the <subexpressions> are the offset structures for subexpressions
817;; including the head of a list.
818(defconst edebug-offsets nil)
819
820;; Stack of offset structures in reverse order of the nesting.
821;; This is used to get back to previous levels.
822(defconst edebug-offsets-stack nil)
823(defconst edebug-current-offset nil) ; Top of the stack, for convenience.
824
825;; We must store whether we just read a list with a dotted form that
826;; is itself a list. This structure will be condensed, so the offsets
827;; must also be condensed.
828(defconst edebug-read-dotted-list nil)
829
830(defsubst edebug-initialize-offsets ()
831 ;; Reinitialize offset recording.
832 (setq edebug-current-offset nil))
833
834(defun edebug-store-before-offset (point)
835 ;; Add a new offset pair with POINT as the before offset.
836 (let ((new-offset (list point)))
837 (if edebug-current-offset
838 (setcdr edebug-current-offset
839 (cons new-offset (cdr edebug-current-offset)))
840 ;; Otherwise, we are at the top level, so initialize.
841 (setq edebug-offsets new-offset
842 edebug-offsets-stack nil
843 edebug-read-dotted-list nil))
844 ;; Cons the new offset to the front of the stack.
845 (setq edebug-offsets-stack (cons new-offset edebug-offsets-stack)
846 edebug-current-offset new-offset)
84fc2cfa
ER
847 ))
848
1fe3d507
DL
849(defun edebug-store-after-offset (point)
850 ;; Finalize the current offset struct by reversing it and
851 ;; store POINT as the after offset.
852 (if (not edebug-read-dotted-list)
853 ;; Just reverse the offsets of all subexpressions.
854 (setcdr edebug-current-offset (nreverse (cdr edebug-current-offset)))
855
856 ;; We just read a list after a dot, which will be abbreviated out.
857 (setq edebug-read-dotted-list nil)
858 ;; Drop the corresponding offset pair.
859 ;; That is, nconc the reverse of the rest of the offsets
860 ;; with the cdr of last offset.
861 (setcdr edebug-current-offset
862 (nconc (nreverse (cdr (cdr edebug-current-offset)))
863 (cdr (car (cdr edebug-current-offset))))))
864
865 ;; Now append the point using nconc.
866 (setq edebug-current-offset (nconc edebug-current-offset point))
867 ;; Pop the stack.
868 (setq edebug-offsets-stack (cdr edebug-offsets-stack)
869 edebug-current-offset (car edebug-offsets-stack)))
870
871(defun edebug-ignore-offset ()
872 ;; Ignore the last created offset pair.
873 (setcdr edebug-current-offset (cdr (cdr edebug-current-offset))))
874
875(def-edebug-spec edebug-storing-offsets (form body))
876(put 'edebug-storing-offsets 'lisp-indent-hook 1)
877
878(defmacro edebug-storing-offsets (point &rest body)
879 (` (unwind-protect
880 (progn
881 (edebug-store-before-offset (, point))
882 (,@ body))
883 (edebug-store-after-offset (point)))))
884
885
f7359658
RS
886;;; Reader for Emacs Lisp.
887
1fe3d507
DL
888;; Uses edebug-next-token-class (and edebug-skip-whitespace) above.
889
890(defconst edebug-read-alist
891 '((symbol . edebug-read-symbol)
892 (lparen . edebug-read-list)
893 (string . edebug-read-string)
894 (quote . edebug-read-quote)
f7359658
RS
895 (backquote . edebug-read-backquote)
896 (comma . edebug-read-comma)
1fe3d507
DL
897 (lbracket . edebug-read-vector)
898 (hash . edebug-read-function)
899 ))
84fc2cfa 900
1fe3d507
DL
901(defun edebug-read-storing-offsets (stream)
902 (let ((class (edebug-next-token-class))
903 func
904 edebug-read-dotted-list) ; see edebug-store-after-offset
905 (edebug-storing-offsets (point)
906 (if (setq func (assq class edebug-read-alist))
907 (funcall (cdr func) stream)
908 ;; anything else, just read it.
909 (edebug-original-read stream))
910 )))
84fc2cfa 911
1fe3d507 912(defun edebug-read-symbol (stream)
f4897e40 913 (edebug-original-read stream))
84fc2cfa 914
1fe3d507 915(defun edebug-read-string (stream)
f4897e40 916 (edebug-original-read stream))
84fc2cfa 917
1fe3d507
DL
918(defun edebug-read-quote (stream)
919 ;; Turn 'thing into (quote thing)
920 (forward-char 1)
921 (list
922 (edebug-storing-offsets (point) 'quote)
923 (edebug-read-storing-offsets stream)))
924
f7359658
RS
925(defun edebug-read-backquote (stream)
926 ;; Turn `thing into (\` thing)
927 (let ((opoint (point)))
928 (forward-char 1)
929 ;; Generate the same structure of offsets we would have
930 ;; if the resulting list appeared verbatim in the input text.
931 (edebug-storing-offsets opoint
932 (list
933 (edebug-storing-offsets opoint '\`)
934 (edebug-read-storing-offsets stream)))))
935
936(defvar edebug-read-backquote-new nil
937 "Non-nil if reading the inside of a new-style backquote with no parens around it.
938Value of nil means reading the inside of an old-style backquote construct
939which is surrounded by an extra set of parentheses.
940This controls how we read comma constructs.")
941
942(defun edebug-read-comma (stream)
943 ;; Turn ,thing into (\, thing). Handle ,@ and ,. also.
944 (let ((opoint (point)))
945 (forward-char 1)
946 (let ((symbol '\,))
947 (cond ((eq (following-char) ?\.)
948 (setq symbol '\,\.)
949 (forward-char 1))
950 ((eq (following-char) ?\@)
951 (setq symbol '\,@)
952 (forward-char 1)))
953 ;; Generate the same structure of offsets we would have
954 ;; if the resulting list appeared verbatim in the input text.
955 (if edebug-read-backquote-new
956 (list
957 (edebug-storing-offsets opoint symbol)
958 (edebug-read-storing-offsets stream))
959 (edebug-storing-offsets opoint symbol)))))
960
1fe3d507
DL
961(defun edebug-read-function (stream)
962 ;; Turn #'thing into (function thing)
963 (forward-char 1)
964 (if (/= ?\' (following-char)) (edebug-syntax-error "Bad char"))
965 (forward-char 1)
966 (list
967 (edebug-storing-offsets (point)
968 (if (featurep 'cl) 'function* 'function))
969 (edebug-read-storing-offsets stream)))
970
971(defun edebug-read-list (stream)
972 (forward-char 1) ; skip \(
973 (prog1
974 (let ((elements))
975 (while (not (memq (edebug-next-token-class) '(rparen dot)))
f7359658
RS
976 (if (eq (edebug-next-token-class) 'backquote)
977 (let ((edebug-read-backquote-new (not (null elements)))
978 (opoint (point)))
979 (if edebug-read-backquote-new
980 (setq elements (cons (edebug-read-backquote stream) elements))
981 (forward-char 1) ; Skip backquote.
982 ;; Call edebug-storing-offsets here so that we
983 ;; produce the same offsets we would have had
984 ;; if the backquote were an ordinary symbol.
985 (setq elements (cons (edebug-storing-offsets opoint '\`)
986 elements))))
987 (setq elements (cons (edebug-read-storing-offsets stream) elements))))
1fe3d507
DL
988 (setq elements (nreverse elements))
989 (if (eq 'dot (edebug-next-token-class))
990 (let (dotted-form)
991 (forward-char 1) ; skip \.
992 (setq dotted-form (edebug-read-storing-offsets stream))
993 elements (nconc elements dotted-form)
994 (if (not (eq (edebug-next-token-class) 'rparen))
995 (edebug-syntax-error "Expected `)'"))
996 (setq edebug-read-dotted-list (listp dotted-form))
997 ))
998 elements)
999 (forward-char 1) ; skip \)
1000 ))
84fc2cfa 1001
1fe3d507
DL
1002(defun edebug-read-vector (stream)
1003 (forward-char 1) ; skip \[
1004 (prog1
1005 (let ((elements))
1006 (while (not (eq 'rbracket (edebug-next-token-class)))
1007 (setq elements (cons (edebug-read-storing-offsets stream) elements)))
1008 (apply 'vector (nreverse elements)))
1009 (forward-char 1) ; skip \]
84fc2cfa
ER
1010 ))
1011
f7359658 1012;;; Cursors for traversal of list and vector elements with offsets.
1fe3d507
DL
1013
1014(defvar edebug-dotted-spec nil)
1015
1016(defun edebug-new-cursor (expressions offsets)
1017 ;; Return a new cursor for EXPRESSIONS with OFFSETS.
1018 (if (vectorp expressions)
1019 (setq expressions (append expressions nil)))
1020 (cons expressions offsets))
1021
1022(defsubst edebug-set-cursor (cursor expressions offsets)
1023 ;; Set the CURSOR's EXPRESSIONS and OFFSETS to the given.
1024 ;; Return the cursor.
1025 (setcar cursor expressions)
1026 (setcdr cursor offsets)
1027 cursor)
1028
1029'(defun edebug-copy-cursor (cursor)
1030 ;; Copy the cursor using the same object and offsets.
1031 (cons (car cursor) (cdr cursor)))
1032
1033(defsubst edebug-cursor-expressions (cursor)
1034 (car cursor))
1035(defsubst edebug-cursor-offsets (cursor)
1036 (cdr cursor))
1037
1038(defsubst edebug-empty-cursor (cursor)
1039 ;; Return non-nil if CURSOR is empty - meaning no more elements.
1040 (null (car cursor)))
1041
1042(defsubst edebug-top-element (cursor)
1043 ;; Return the top element at the cursor.
1044 ;; Assumes not empty.
1045 (car (car cursor)))
1046
1047(defun edebug-top-element-required (cursor &rest error)
1048 ;; Check if a dotted form is required.
1049 (if edebug-dotted-spec (edebug-no-match cursor "Dot expected."))
1050 ;; Check if there is at least one more argument.
1051 (if (edebug-empty-cursor cursor) (apply 'edebug-no-match cursor error))
1052 ;; Return that top element.
1053 (edebug-top-element cursor))
1054
1055(defsubst edebug-top-offset (cursor)
1056 ;; Return the top offset pair corresponding to the top element.
1057 (car (cdr cursor)))
1058
1059(defun edebug-move-cursor (cursor)
1060 ;; Advance and return the cursor to the next element and offset.
1061 ;; throw no-match if empty before moving.
1062 ;; This is a violation of the cursor encapsulation, but
1063 ;; there is plenty of that going on while matching.
1064 ;; The following test should always fail.
1065 (if (edebug-empty-cursor cursor)
1066 (edebug-no-match cursor "Not enough arguments."))
1067 (setcar cursor (cdr (car cursor)))
1068 (setcdr cursor (cdr (cdr cursor)))
1069 cursor)
1070
1071
1072(defun edebug-before-offset (cursor)
1073 ;; Return the before offset of the cursor.
1074 ;; If there is nothing left in the offsets,
1075 ;; return one less than the offset itself,
1076 ;; which is the after offset for a list.
1077 (let ((offset (edebug-cursor-offsets cursor)))
1078 (if (consp offset)
1079 (car (car offset))
1080 (1- offset))))
1081
1082(defun edebug-after-offset (cursor)
1083 ;; Return the after offset of the cursor object.
1084 (let ((offset (edebug-top-offset cursor)))
1085 (while (consp offset)
1086 (setq offset (cdr offset)))
1087 offset))
1088
f7359658 1089;;; The Parser
1fe3d507 1090
f7359658
RS
1091;; The top level function for parsing forms is
1092;; edebug-read-and-maybe-wrap-form; it calls all the rest. It checks the
1093;; syntax a bit and leaves point at any error it finds, but otherwise
1094;; should appear to work like eval-defun.
1fe3d507 1095
f7359658
RS
1096;; The basic plan is to surround each expression with a call to
1097;; the edebug debugger together with indexes into a table of positions of
1098;; all expressions. Thus an expression "exp" becomes:
1fe3d507 1099
f7359658 1100;; (edebug-after (edebug-before 1) 2 exp)
1fe3d507 1101
f7359658
RS
1102;; When this is evaluated, first point is moved to the beginning of
1103;; exp at offset 1 of the current function. The expression is
1104;; evaluated, which may cause more edebug calls, and then point is
1105;; moved to offset 2 after the end of exp.
1fe3d507 1106
f7359658
RS
1107;; The highest level expressions of the function are wrapped in a call to
1108;; edebug-enter, which supplies the function name and the actual
1109;; arguments to the function. See functions edebug-enter, edebug-before,
1110;; and edebug-after for more details.
1fe3d507
DL
1111
1112;; Dynamically bound vars, left unbound, but globally declared.
1113;; This is to quiet the byte compiler.
1114
1115;; Window data of the highest definition being wrapped.
1116;; This data is shared by all embedded definitions.
1117(defvar edebug-top-window-data)
1118
1119(defvar edebug-&optional)
1120(defvar edebug-&rest)
1121(defvar edebug-gate nil) ;; whether no-match forces an error.
1122
1123(defconst edebug-def-name nil) ; name of definition, used by interactive-form
1124(defconst edebug-old-def-name nil) ; previous name of containing definition.
1125
1126(defconst edebug-error-point nil)
1127(defconst edebug-best-error nil)
1128
1129
1130(defun edebug-read-and-maybe-wrap-form ()
1131 ;; Read a form and wrap it with edebug calls, if the conditions are right.
1132 ;; Here we just catch any no-match not caught below and signal an error.
1133
1134 ;; Run the setup hook.
1135 (run-hooks 'edebug-setup-hook)
1136 (setq edebug-setup-hook nil)
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
2107 &rest (symbolp body)))
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
88668147
DL
2235(defvar edebug-outside-pre-command-hook)
2236(defvar edebug-outside-post-command-hook)
88668147
DL
2237
2238(defvar cl-lexical-debug) ;; Defined in cl.el
2239
1fe3d507 2240;;; Handling signals
1fe3d507 2241
1fe3d507
DL
2242(defun edebug-signal (edebug-signal-name edebug-signal-data)
2243 "Signal an error. Args are SIGNAL-NAME, and associated DATA.
2244A signal name is a symbol with an `error-conditions' property
2245that is a list of condition names.
2246A handler for any of those names will get to handle this signal.
2247The symbol `error' should always be one of them.
2248
2249DATA should be a list. Its elements are printed as part of the error message.
2250If the signal is handled, DATA is made available to the handler.
2251See `condition-case'.
2252
2253This is the Edebug replacement for the standard `signal'. It should
2254only be active while Edebug is. It checks `debug-on-error' to see
2255whether it should call the debugger. When execution is resumed, the
2256error is signaled again."
2257 (if (and (listp debug-on-error) (memq edebug-signal-name debug-on-error))
2258 (edebug 'error (cons edebug-signal-name edebug-signal-data)))
2259 ;; If we reach here without another non-local exit, then send signal again.
2260 ;; i.e. the signal is not continuable, yet.
1e3ab67b 2261 (signal edebug-signal-name edebug-signal-data))
1fe3d507
DL
2262
2263;;; Entering Edebug
84fc2cfa 2264
1fe3d507
DL
2265(defun edebug-enter (edebug-function edebug-args edebug-body)
2266 ;; Entering FUNC. The arguments are ARGS, and the body is BODY.
2267 ;; Setup edebug variables and evaluate BODY. This function is called
2268 ;; when a function evaluated with edebug-eval-top-level-form is entered.
2269 ;; Return the result of BODY.
84fc2cfa
ER
2270
2271 ;; Is this the first time we are entering edebug since
2272 ;; lower-level recursive-edit command?
1fe3d507
DL
2273 ;; More precisely, this tests whether Edebug is currently active.
2274 (if (not edebug-entered)
2275 (let ((edebug-entered t)
2276 ;; Binding max-lisp-eval-depth here is OK,
88668147
DL
2277 ;; but not inside an unwind-protect.
2278 ;; Doing it here also keeps it from growing too large.
1fe3d507
DL
2279 (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
2280 (max-specpdl-size (+ 200 max-specpdl-size))
2281
2282 (debugger edebug-debugger) ; only while edebug is active.
2283 (edebug-outside-debug-on-error debug-on-error)
2284 (edebug-outside-debug-on-quit debug-on-quit)
2285 ;; Binding these may not be the right thing to do.
2286 ;; We want to allow the global values to be changed.
2287 (debug-on-error (or debug-on-error edebug-on-error))
2288 (debug-on-quit edebug-on-quit)
2289
88668147
DL
2290 ;; Lexical bindings must be uncompiled for this to work.
2291 (cl-lexical-debug t)
2292
1fe3d507 2293 ;; Save the outside value of executing macro. (here??)
efcf38c7 2294 (edebug-outside-executing-macro executing-kbd-macro)
88668147 2295 (edebug-outside-pre-command-hook pre-command-hook)
ba88fc3a 2296 (edebug-outside-post-command-hook post-command-hook))
1fe3d507 2297 (unwind-protect
88668147
DL
2298 (let (;; Don't keep reading from an executing kbd macro
2299 ;; within edebug unless edebug-continue-kbd-macro is
2300 ;; non-nil. Again, local binding may not be best.
efcf38c7
KH
2301 (executing-kbd-macro
2302 (if edebug-continue-kbd-macro executing-kbd-macro))
88668147 2303
1e3ab67b
RS
2304 (signal-hook-function 'edebug-signal)
2305
88668147
DL
2306 ;; Disable command hooks. This is essential when
2307 ;; a hook function is instrumented - to avoid infinite loop.
2308 ;; This may be more than we need, however.
2309 (pre-command-hook nil)
ba88fc3a 2310 (post-command-hook nil))
88668147
DL
2311 (setq edebug-execution-mode (or edebug-next-execution-mode
2312 edebug-initial-mode
2313 edebug-execution-mode)
2314 edebug-next-execution-mode nil)
1e3ab67b 2315 (edebug-enter edebug-function edebug-args edebug-body))
88668147 2316 ;; Reset global variables in case outside value was changed.
efcf38c7 2317 (setq executing-kbd-macro edebug-outside-executing-macro
f7359658
RS
2318 pre-command-hook edebug-outside-pre-command-hook
2319 post-command-hook edebug-outside-post-command-hook
88668147 2320 )))
1fe3d507
DL
2321
2322 (let* ((edebug-data (get edebug-function 'edebug))
2323 (edebug-def-mark (car edebug-data)) ; mark at def start
2324 (edebug-freq-count (get edebug-function 'edebug-freq-count))
2325 (edebug-coverage (get edebug-function 'edebug-coverage))
2326 (edebug-buffer (marker-buffer edebug-def-mark))
2327
2328 (edebug-stack (cons edebug-function edebug-stack))
2329 (edebug-offset-indices (cons 0 edebug-offset-indices))
2330 )
2331 (if (get edebug-function 'edebug-on-entry)
2332 (progn
2333 (setq edebug-execution-mode 'step)
2334 (if (eq (get edebug-function 'edebug-on-entry) 'temp)
2335 (put edebug-function 'edebug-on-entry nil))))
2336 (if edebug-trace
2337 (edebug-enter-trace edebug-body)
2338 (funcall edebug-body))
84fc2cfa
ER
2339 )))
2340
84fc2cfa 2341
1fe3d507
DL
2342(defun edebug-enter-trace (edebug-body)
2343 (let ((edebug-stack-depth (1+ edebug-stack-depth))
2344 edebug-result)
2345 (edebug-print-trace-before
2346 (format "%s args: %s" edebug-function edebug-args))
2347 (prog1 (setq edebug-result (funcall edebug-body))
2348 (edebug-print-trace-after
2349 (format "%s result: %s" edebug-function edebug-result)))))
2350
2351(def-edebug-spec edebug-tracing (form body))
2352
2353(defmacro edebug-tracing (msg &rest body)
2354 "Print MSG in *edebug-trace* before and after evaluating BODY.
2355The result of BODY is also printed."
2356 (` (let ((edebug-stack-depth (1+ edebug-stack-depth))
2357 edebug-result)
2358 (edebug-print-trace-before (, msg))
2359 (prog1 (setq edebug-result (progn (,@ body)))
2360 (edebug-print-trace-after
2361 (format "%s result: %s" (, msg) edebug-result))))))
2362
2363(defun edebug-print-trace-before (msg)
2364 "Function called to print trace info before expression evaluation.
2365MSG is printed after `::::{ '."
84fc2cfa 2366 (edebug-trace-display
1fe3d507 2367 edebug-trace-buffer "%s{ %s" (make-string edebug-stack-depth ?\:) msg))
84fc2cfa 2368
1fe3d507
DL
2369(defun edebug-print-trace-after (msg)
2370 "Function called to print trace info after expression evaluation.
2371MSG is printed after `::::} '."
84fc2cfa 2372 (edebug-trace-display
1fe3d507
DL
2373 edebug-trace-buffer "%s} %s" (make-string edebug-stack-depth ?\:) msg))
2374
2375
84fc2cfa 2376
1fe3d507
DL
2377(defun edebug-slow-before (edebug-before-index)
2378 ;; Debug current function given BEFORE position.
2379 ;; Called from functions compiled with edebug-eval-top-level-form.
2380 ;; Return the before index.
2381 (setcar edebug-offset-indices edebug-before-index)
84fc2cfa 2382
1fe3d507
DL
2383 ;; Increment frequency count
2384 (aset edebug-freq-count edebug-before-index
2385 (1+ (aref edebug-freq-count edebug-before-index)))
2386
2387 (if (or (not (memq edebug-execution-mode '(Go-nonstop next)))
2388 (edebug-input-pending-p))
2389 (edebug-debugger edebug-before-index 'before nil))
2390 edebug-before-index)
2391
2392(defun edebug-fast-before (edebug-before-index)
2393 ;; Do nothing.
2394 )
2395
2396(defun edebug-slow-after (edebug-before-index edebug-after-index edebug-value)
2397 ;; Debug current function given AFTER position and VALUE.
2398 ;; Called from functions compiled with edebug-eval-top-level-form.
2399 ;; Return VALUE.
2400 (setcar edebug-offset-indices edebug-after-index)
2401
2402 ;; Increment frequency count
2403 (aset edebug-freq-count edebug-after-index
2404 (1+ (aref edebug-freq-count edebug-after-index)))
2405 (if edebug-test-coverage (edebug-update-coverage))
2406
2407 (if (and (eq edebug-execution-mode 'Go-nonstop)
2408 (not (edebug-input-pending-p)))
2409 ;; Just return result.
2410 edebug-value
2411 (edebug-debugger edebug-after-index 'after edebug-value)
2412 ))
2413
2414(defun edebug-fast-after (edebug-before-index edebug-after-index edebug-value)
2415 ;; Do nothing but return the value.
2416 edebug-value)
2417
2418(defun edebug-run-slow ()
2419 (defalias 'edebug-before 'edebug-slow-before)
2420 (defalias 'edebug-after 'edebug-slow-after))
2421
2422;; This is not used, yet.
2423(defun edebug-run-fast ()
2424 (defalias 'edebug-before 'edebug-fast-before)
2425 (defalias 'edebug-after 'edebug-fast-after))
2426
2427(edebug-run-slow)
2428
2429
2430(defun edebug-update-coverage ()
2431 (let ((old-result (aref edebug-coverage edebug-after-index)))
2432 (cond
2433 ((eq 'ok-coverage old-result))
2434 ((eq 'unknown old-result)
2435 (aset edebug-coverage edebug-after-index edebug-value))
2436 ;; Test if a different result.
2437 ((not (eq edebug-value old-result))
2438 (aset edebug-coverage edebug-after-index 'ok-coverage)))))
2439
2440
2441;; Dynamically declared unbound variables.
2442(defvar edebug-arg-mode) ; the mode, either before, after, or error
2443(defvar edebug-breakpoints)
2444(defvar edebug-break-data) ; break data for current function.
2445(defvar edebug-break) ; whether a break occurred.
2446(defvar edebug-global-break) ; whether a global break occurred.
2447(defvar edebug-break-condition) ; whether the breakpoint is conditional.
2448
2449(defvar edebug-break-result nil)
2450(defvar edebug-global-break-result nil)
2451
2452
2453(defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-value)
2454 ;; Check breakpoints and pending input.
2455 ;; If edebug display should be updated, call edebug-display.
2456 ;; Return edebug-value.
2457 (let* (;; This needs to be here since breakpoints may be changed.
84fc2cfa
ER
2458 (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints
2459 (edebug-break-data (assq edebug-offset-index edebug-breakpoints))
1fe3d507
DL
2460 (edebug-break-condition (car (cdr edebug-break-data)))
2461 (edebug-global-break
2462 (if edebug-global-break-condition
2463 (condition-case nil
2464 (setq edebug-global-break-result
2465 (eval edebug-global-break-condition))
2466 (error nil))))
2467 (edebug-break))
2468
2469;;; (edebug-trace "exp: %s" edebug-value)
2470 ;; Test whether we should break.
2471 (setq edebug-break
2472 (or edebug-global-break
2473 (and edebug-break-data
2474 (or (not edebug-break-condition)
2475 (setq edebug-break-result
2476 (eval edebug-break-condition))))))
84fc2cfa 2477 (if (and edebug-break
1fe3d507 2478 (nth 2 edebug-break-data)) ; is it temporary?
84fc2cfa
ER
2479 ;; Delete the breakpoint.
2480 (setcdr edebug-data
2481 (cons (delq edebug-break-data edebug-breakpoints)
2482 (cdr (cdr edebug-data)))))
1fe3d507
DL
2483
2484 ;; Display if mode is not go, continue, or Continue-fast
2485 ;; or break, or input is pending,
2486 (if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))
2487 edebug-break
2488 (edebug-input-pending-p))
2489 (edebug-display)) ; <--------------- display
84fc2cfa 2490
1fe3d507 2491 edebug-value
84fc2cfa
ER
2492 ))
2493
2494
1fe3d507
DL
2495;; window-start now stored with each function.
2496;;(defvar edebug-window-start nil)
2497;; Remember where each buffers' window starts between edebug calls.
2498;; This is to avoid spurious recentering.
2499;; Does this still need to be buffer-local??
2500;;(setq-default edebug-window-start nil)
2501;;(make-variable-buffer-local 'edebug-window-start)
2502
2503
2504;; Dynamically declared unbound vars
2505(defvar edebug-point) ; the point in edebug buffer
2506(defvar edebug-outside-buffer) ; the current-buffer outside of edebug
2507(defvar edebug-outside-point) ; the point outside of edebug
2508(defvar edebug-outside-mark) ; the mark outside of edebug
2509(defvar edebug-window-data) ; window and window-start for current function
2510(defvar edebug-outside-windows) ; outside window configuration
2511(defvar edebug-eval-buffer) ; for the evaluation list.
2512(defvar edebug-outside-o-a-p) ; outside overlay-arrow-position
2513(defvar edebug-outside-o-a-s) ; outside overlay-arrow-string
2514(defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area
2515
2516(defvar edebug-eval-list nil) ;; List of expressions to evaluate.
2517
2518(defvar edebug-previous-result nil) ;; Last result returned.
2519
88668147 2520;; Emacs 19 adds an arg to mark and mark-marker.
1fe3d507
DL
2521(defalias 'edebug-mark 'mark)
2522(defalias 'edebug-mark-marker 'mark-marker)
84fc2cfa 2523
84fc2cfa
ER
2524
2525(defun edebug-display ()
1fe3d507
DL
2526 ;; Setup windows for edebug, determine mode, maybe enter recursive-edit.
2527 ;; Uses local variables of edebug-enter, edebug-before, edebug-after
2528 ;; and edebug-debugger.
84fc2cfa
ER
2529 (let ((edebug-active t) ; for minor mode alist
2530 edebug-stop ; should we enter recursive-edit
1fe3d507
DL
2531 (edebug-point (+ edebug-def-mark
2532 (aref (nth 2 edebug-data) edebug-offset-index)))
2533 edebug-buffer-outside-point ; current point in edebug-buffer
2534 ;; window displaying edebug-buffer
2535 (edebug-window-data (nth 3 edebug-data))
84fc2cfa
ER
2536 (edebug-outside-window (selected-window))
2537 (edebug-outside-buffer (current-buffer))
2538 (edebug-outside-point (point))
1fe3d507 2539 (edebug-outside-mark (edebug-mark))
84fc2cfa 2540 edebug-outside-windows ; window or screen configuration
1fe3d507 2541 edebug-buffer-points
84fc2cfa
ER
2542
2543 edebug-eval-buffer ; declared here so we can kill it below
2544 (edebug-eval-result-list (and edebug-eval-list
2545 (edebug-eval-result-list)))
1fe3d507
DL
2546 edebug-trace-window
2547 edebug-trace-window-start
88668147
DL
2548
2549 (edebug-outside-o-a-p overlay-arrow-position)
2550 (edebug-outside-o-a-s overlay-arrow-string)
2551 (edebug-outside-c-i-e-a cursor-in-echo-area))
2552 (unwind-protect
2553 (let ((overlay-arrow-position overlay-arrow-position)
2554 (overlay-arrow-string overlay-arrow-string)
2555 (cursor-in-echo-area nil)
2556 ;; any others??
2557 )
2558 (if (not (buffer-name edebug-buffer))
2559 (let ((debug-on-error nil))
2560 (error "Buffer defining %s not found" edebug-function)))
84fc2cfa 2561
88668147
DL
2562 (if (eq 'after edebug-arg-mode)
2563 ;; Compute result string now before windows are modified.
2564 (edebug-compute-previous-result edebug-value))
2565
2566 (if edebug-save-windows
2567 ;; Save windows now before we modify them.
2568 (setq edebug-outside-windows
2569 (edebug-current-windows edebug-save-windows)))
84fc2cfa 2570
88668147
DL
2571 (if edebug-save-displayed-buffer-points
2572 (setq edebug-buffer-points (edebug-get-displayed-buffer-points)))
2573
2574 ;; First move the edebug buffer point to edebug-point
f7359658
RS
2575 ;; so that window start doesn't get changed when we display it.
2576 ;; I don't know if this is going to help.
88668147
DL
2577 ;;(set-buffer edebug-buffer)
2578 ;;(goto-char edebug-point)
2579
2580 ;; If edebug-buffer is not currently displayed,
2581 ;; first find a window for it.
2582 (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))
2583 (setcar edebug-window-data (selected-window))
2584
2585 ;; Now display eval list, if any.
2586 ;; This is done after the pop to edebug-buffer
2587 ;; so that buffer-window correspondence is correct after quitting.
2588 (edebug-eval-display edebug-eval-result-list)
2589 ;; The evaluation list better not have deleted edebug-window-data.
2590 (select-window (car edebug-window-data))
2591 (set-buffer edebug-buffer)
2592
2593 (setq edebug-buffer-outside-point (point))
2594 (goto-char edebug-point)
84fc2cfa 2595
88668147
DL
2596 (if (eq 'before edebug-arg-mode)
2597 ;; Check whether positions are up-to-date.
2598 ;; This assumes point is never before symbol.
2599 (if (not (memq (following-char) '(?\( ?\# ?\` )))
2600 (let ((debug-on-error nil))
2601 (error "Source has changed - reevaluate definition of %s"
2602 edebug-function)
2603 )))
1fe3d507 2604
88668147
DL
2605 (setcdr edebug-window-data
2606 (edebug-adjust-window (cdr edebug-window-data)))
84fc2cfa 2607
88668147
DL
2608 ;; Test if there is input, not including keyboard macros.
2609 (if (edebug-input-pending-p)
2610 (progn
2611 (setq edebug-execution-mode 'step
2612 edebug-stop t)
2613 (edebug-stop)
2614 ;; (discard-input) ; is this unfriendly??
2615 ))
2616 ;; Now display arrow based on mode.
2617 (edebug-overlay-arrow)
84fc2cfa 2618
88668147
DL
2619 (cond
2620 ((eq 'error edebug-arg-mode)
2621 ;; Display error message
2622 (setq edebug-execution-mode 'step)
2623 (edebug-overlay-arrow)
2624 (beep)
2625 (if (eq 'quit (car edebug-value))
2626 (message "Quit")
2627 (edebug-report-error edebug-value)))
2628 (edebug-break
2629 (cond
2630 (edebug-global-break
2631 (message "Global Break: %s => %s"
2632 edebug-global-break-condition
2633 edebug-global-break-result))
2634 (edebug-break-condition
2635 (message "Break: %s => %s"
2636 edebug-break-condition
2637 edebug-break-result))
2638 ((not (eq edebug-execution-mode 'Continue-fast))
2639 (message "Break"))
2640 (t)))
2641
2642 (t (message "")))
2643
2644 (if (eq 'after edebug-arg-mode)
2645 (progn
2646 ;; Display result of previous evaluation.
2647 (if (and edebug-break
2648 (not (eq edebug-execution-mode 'Continue-fast)))
2649 (sit-for 1)) ; Show break message.
2650 (edebug-previous-result)))
1fe3d507 2651
88668147
DL
2652 (cond
2653 (edebug-break
2654 (cond
2655 ((eq edebug-execution-mode 'continue) (edebug-sit-for 1))
2656 ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0))
2657 (t (setq edebug-stop t))))
2658 ;; not edebug-break
2659 ((eq edebug-execution-mode 'trace)
2660 (edebug-sit-for 1)) ; Force update and pause.
2661 ((eq edebug-execution-mode 'Trace-fast)
2662 (edebug-sit-for 0)) ; Force update and continue.
2663 )
1fe3d507 2664
88668147
DL
2665 (unwind-protect
2666 (if (or edebug-stop
2667 (memq edebug-execution-mode '(step next))
2668 (eq edebug-arg-mode 'error))
2669 (progn
2670 ;; (setq edebug-execution-mode 'step)
f7359658 2671 ;; (edebug-overlay-arrow) ; This doesn't always show up.
88668147
DL
2672 (edebug-recursive-edit))) ; <---------- Recursive edit
2673
2674 ;; Reset the edebug-window-data to whatever it is now.
2675 (let ((window (if (eq (window-buffer) edebug-buffer)
2676 (selected-window)
2677 (edebug-get-buffer-window edebug-buffer))))
2678 ;; Remember window-start for edebug-buffer, if still displayed.
2679 (if window
2680 (progn
2681 (setcar edebug-window-data window)
2682 (setcdr edebug-window-data (window-start window)))))
1fe3d507 2683
88668147
DL
2684 ;; Save trace window point before restoring outside windows.
2685 ;; Could generalize this for other buffers.
2686 (setq edebug-trace-window (get-buffer-window edebug-trace-buffer))
2687 (if edebug-trace-window
2688 (setq edebug-trace-window-start
2689 (and edebug-trace-window
2690 (window-start edebug-trace-window))))
2691
2692 ;; Restore windows before continuing.
2693 (if edebug-save-windows
2694 (progn
2695 (edebug-set-windows edebug-outside-windows)
2696
2697 ;; Restore displayed buffer points.
2698 ;; Needed even if restoring windows because
2699 ;; window-points are not restored. (should they be??)
2700 (if edebug-save-displayed-buffer-points
2701 (edebug-set-buffer-points edebug-buffer-points))
2702
2703 ;; Unrestore trace window's window-point.
2704 (if edebug-trace-window
2705 (set-window-start edebug-trace-window
2706 edebug-trace-window-start))
2707
2708 ;; Unrestore edebug-buffer's window-start, if displayed.
2709 (let ((window (car edebug-window-data)))
2710 (if (and window (edebug-window-live-p window)
2711 (eq (window-buffer) edebug-buffer))
2712 (progn
2713 (set-window-start window (cdr edebug-window-data)
2714 'no-force)
2715 ;; Unrestore edebug-buffer's window-point.
2716 ;; Needed in addition to setting the buffer point
f7359658 2717 ;; - otherwise quitting doesn't leave point as is.
88668147
DL
2718 ;; But this causes point to not be restored at times.
2719 ;; Also, it may not be a visible window.
2720 ;; (set-window-point window edebug-point)
2721 )))
2722
2723 ;; Unrestore edebug-buffer's point. Rerestored below.
2724 ;; (goto-char edebug-point) ;; in edebug-buffer
2725 )
2726 ;; Since we may be in a save-excursion, in case of quit,
2727 ;; reselect the outside window only.
2728 ;; Only needed if we are not recovering windows??
2729 (if (edebug-window-live-p edebug-outside-window)
2730 (select-window edebug-outside-window))
2731 ) ; if edebug-save-windows
2732
2733 ;; Restore current buffer always, in case application needs it.
2734 (set-buffer edebug-outside-buffer)
2735 ;; Restore point, and mark.
1fe3d507 2736 ;; Needed even if restoring windows because
f7359658
RS
2737 ;; that doesn't restore point and mark in the current buffer.
2738 ;; But don't restore point if edebug-buffer is current buffer.
88668147
DL
2739 (if (not (eq edebug-buffer edebug-outside-buffer))
2740 (goto-char edebug-outside-point))
2741 (if (marker-buffer (edebug-mark-marker))
2742 ;; Does zmacs-regions need to be nil while doing set-marker?
2743 (set-marker (edebug-mark-marker) edebug-outside-mark))
2744 ) ; unwind-protect
2745 ;; None of the following is done if quit or signal occurs.
2746
2747 ;; Restore edebug-buffer's outside point.
2748 ;; (edebug-trace "restore edebug-buffer point: %s"
2749 ;; edebug-buffer-outside-point)
2750 (let ((current-buffer (current-buffer)))
2751 (set-buffer edebug-buffer)
2752 (goto-char edebug-buffer-outside-point)
2753 (set-buffer current-buffer))
2754 ;; ... nothing more.
2755 )
2756 ;; Reset global variables to outside values in case they were changed.
2757 (setq
2758 overlay-arrow-position edebug-outside-o-a-p
2759 overlay-arrow-string edebug-outside-o-a-s
2760 cursor-in-echo-area edebug-outside-c-i-e-a)
2761 )))
1fe3d507 2762
84fc2cfa 2763
1fe3d507
DL
2764(defvar edebug-number-of-recursions 0)
2765;; Number of recursive edits started by edebug.
2766;; Should be 0 at the top level.
2767
2768(defvar edebug-recursion-depth 0)
2769;; Value of recursion-depth when edebug was called.
2770
2771;; Dynamically declared unbound vars
2772(defvar edebug-outside-match-data) ; match data outside of edebug
2773(defvar edebug-backtrace-buffer) ; each recursive edit gets its own
2774(defvar edebug-inside-windows)
2775(defvar edebug-interactive-p)
2776
2777(defvar edebug-outside-map)
2778(defvar edebug-outside-standard-output)
2779(defvar edebug-outside-standard-input)
2780(defvar edebug-outside-last-command-char)
2781(defvar edebug-outside-last-command)
2782(defvar edebug-outside-this-command)
2783(defvar edebug-outside-last-input-char)
2784
100aa77c
RS
2785;; Note: here we have defvars for variables that are
2786;; built-in in certain versions.
2787;; Each defvar makes a difference
2788;; in versions where the variable is *not* built-in.
2789
1fe3d507
DL
2790;; Emacs 18
2791(defvar edebug-outside-unread-command-char)
1fe3d507
DL
2792
2793;; Lucid Emacs
2794(defvar edebug-outside-unread-command-event) ;; like unread-command-events
2795(defvar unread-command-event nil)
2796
2797;; Emacs 19.
2798(defvar edebug-outside-last-command-event)
2799(defvar edebug-outside-unread-command-events)
2800(defvar edebug-outside-last-input-event)
2801(defvar edebug-outside-last-event-frame)
2802(defvar edebug-outside-last-nonmenu-event)
2803(defvar edebug-outside-track-mouse)
2804
1fe3d507
DL
2805;; Disable byte compiler warnings about unread-command-char and -event
2806;; (maybe works with byte-compile-version 2.22 at least)
2807(defvar edebug-unread-command-char-warning)
2808(defvar edebug-unread-command-event-warning)
2809(eval-when-compile
2810 (setq edebug-unread-command-char-warning
2811 (get 'unread-command-char 'byte-obsolete-variable))
2812 (put 'unread-command-char 'byte-obsolete-variable nil)
2813 (setq edebug-unread-command-event-warning
2814 (get 'unread-command-event 'byte-obsolete-variable))
2815 (put 'unread-command-event 'byte-obsolete-variable nil))
84fc2cfa
ER
2816
2817(defun edebug-recursive-edit ()
1fe3d507 2818 ;; Start up a recursive edit inside of edebug.
84fc2cfa 2819 ;; The current buffer is the edebug-buffer, which is put into edebug-mode.
1fe3d507 2820 ;; Assume that none of the variables below are buffer-local.
84fc2cfa
ER
2821 (let ((edebug-buffer-read-only buffer-read-only)
2822 ;; match-data must be done in the outside buffer
2823 (edebug-outside-match-data
1fe3d507
DL
2824 (save-excursion ; might be unnecessary now??
2825 (set-buffer edebug-outside-buffer) ; in case match buffer different
84fc2cfa
ER
2826 (match-data)))
2827
1fe3d507 2828 ;;(edebug-number-of-recursions (1+ edebug-number-of-recursions))
84fc2cfa
ER
2829 (edebug-recursion-depth (recursion-depth))
2830 edebug-entered ; bind locally to nil
1fe3d507 2831 (edebug-interactive-p nil) ; again non-interactive
84fc2cfa
ER
2832 edebug-backtrace-buffer ; each recursive edit gets its own
2833 ;; The window configuration may be saved and restored
2834 ;; during a recursive-edit
2835 edebug-inside-windows
2836
2837 (edebug-outside-map (current-local-map))
88668147 2838
84fc2cfa
ER
2839 (edebug-outside-standard-output standard-output)
2840 (edebug-outside-standard-input standard-input)
88668147 2841 (edebug-outside-defining-kbd-macro defining-kbd-macro)
84fc2cfa
ER
2842
2843 (edebug-outside-last-command-char last-command-char)
2844 (edebug-outside-last-command last-command)
2845 (edebug-outside-this-command this-command)
2846 (edebug-outside-last-input-char last-input-char)
1fe3d507
DL
2847
2848 (edebug-outside-unread-command-char unread-command-char)
2849
2850 (edebug-outside-last-input-event last-input-event)
2851 (edebug-outside-last-command-event last-command-event)
2852 (edebug-outside-unread-command-event unread-command-event)
2853 (edebug-outside-unread-command-events unread-command-events)
2854 (edebug-outside-last-event-frame last-event-frame)
2855 (edebug-outside-last-nonmenu-event last-nonmenu-event)
2856 (edebug-outside-track-mouse track-mouse)
84fc2cfa
ER
2857 )
2858
84fc2cfa 2859 (unwind-protect
88668147
DL
2860 (let (
2861 ;; Declare global values local but using the same global value.
2862 ;; We could set these to the values for previous edebug call.
2863 (last-command-char last-command-char)
2864 (last-command last-command)
2865 (this-command this-command)
2866 (last-input-char last-input-char)
2867
2868 ;; Assume no edebug command sets unread-command-char.
2869 (unread-command-char -1)
2870
2871 ;; More for Emacs 19
2872 (last-input-event nil)
2873 (last-command-event nil)
2874 (unread-command-event nil);; lemacs
2875 (unread-command-events nil)
2876 (last-event-frame nil)
2877 (last-nonmenu-event nil)
2878 (track-mouse nil)
2879
2880 ;; Bind again to outside values.
2881 (debug-on-error edebug-outside-debug-on-error)
2882 (debug-on-quit edebug-outside-debug-on-quit)
2883
2884 ;; Don't keep defining a kbd macro.
2885 (defining-kbd-macro
2886 (if edebug-continue-kbd-macro defining-kbd-macro))
2887
2888 ;; others??
2889 )
2890
2891 (if (fboundp 'zmacs-deactivate-region);; for lemacs
2892 (zmacs-deactivate-region))
2893 (if (and (eq edebug-execution-mode 'go)
2894 (not (memq edebug-arg-mode '(after error))))
2895 (message "Break"))
2896
2897 (setq buffer-read-only t)
1e3ab67b 2898 (setq signal-hook-function nil)
88668147
DL
2899
2900 (edebug-mode)
2901 (unwind-protect
2902 (recursive-edit) ; <<<<<<<<<< Recursive edit
2903
2904 ;; Do the following, even if quit occurs.
1e3ab67b 2905 (setq signal-hook-function 'edebug-signal)
88668147
DL
2906 (if edebug-backtrace-buffer
2907 (kill-buffer edebug-backtrace-buffer))
2908 ;; Could be an option to keep eval display up.
2909 (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
2910
2911 ;; Remember selected-window after recursive-edit.
2912 ;; (setq edebug-inside-window (selected-window))
2913
2914 (store-match-data edebug-outside-match-data)
2915
2916 ;; Recursive edit may have changed buffers,
2917 ;; so set it back before exiting let.
2918 (if (buffer-name edebug-buffer) ; if it still exists
2919 (progn
2920 (set-buffer edebug-buffer)
2921 (if (memq edebug-execution-mode '(go Go-nonstop))
2922 (edebug-overlay-arrow))
2923 (setq buffer-read-only edebug-buffer-read-only)
2924 (use-local-map edebug-outside-map)
2925 )
2926 ;; gotta have a buffer to let its buffer local variables be set
2927 (get-buffer-create " bogus edebug buffer"))
2928 ));; inner let
2929
2930 ;; Reset global vars to outside values, in case they have been changed.
2931 (setq
2932 last-command-char edebug-outside-last-command-char
2933 last-command-event edebug-outside-last-command-event
2934 last-command edebug-outside-last-command
2935 this-command edebug-outside-this-command
2936 unread-command-char edebug-outside-unread-command-char
2937 unread-command-event edebug-outside-unread-command-event
2938 unread-command-events edebug-outside-unread-command-events
2939 last-input-char edebug-outside-last-input-char
2940 last-input-event edebug-outside-last-input-event
2941 last-event-frame edebug-outside-last-event-frame
2942 last-nonmenu-event edebug-outside-last-nonmenu-event
2943 track-mouse edebug-outside-track-mouse
2944
2945 standard-output edebug-outside-standard-output
2946 standard-input edebug-outside-standard-input
2947 defining-kbd-macro edebug-outside-defining-kbd-macro
2948 ))
2949 ))
84fc2cfa 2950
1fe3d507
DL
2951
2952;;; Display related functions
84fc2cfa
ER
2953
2954(defun edebug-adjust-window (old-start)
1fe3d507
DL
2955 ;; If pos is not visible, adjust current window to fit following context.
2956;;; (message "window: %s old-start: %s window-start: %s pos: %s"
2957;;; (selected-window) old-start (window-start) (point)) (sit-for 5)
84fc2cfa
ER
2958 (if (not (pos-visible-in-window-p))
2959 (progn
1fe3d507
DL
2960 ;; First try old-start
2961 (if old-start
2962 (set-window-start (selected-window) old-start))
84fc2cfa 2963 (if (not (pos-visible-in-window-p))
1fe3d507
DL
2964 (progn
2965;; (message "resetting window start") (sit-for 2)
2966 (set-window-start
2967 (selected-window)
2968 (save-excursion
2969 (forward-line
2970 (if (< (point) (window-start)) -1 ; one line before if in back
2971 (- (/ (window-height) 2)) ; center the line moving forward
2972 ))
2973 (beginning-of-line)
2974 (point)))))))
84fc2cfa 2975 (window-start))
1fe3d507 2976
84fc2cfa
ER
2977
2978
1fe3d507
DL
2979(defconst edebug-arrow-alist
2980 '((Continue-fast . "=")
2981 (Trace-fast . "-")
2982 (continue . ">")
2983 (trace . "->")
2984 (step . "=>")
2985 (next . "=>")
2986 (go . "<>")
2987 (Go-nonstop . "..") ; not used
2988 )
2989 "Association list of arrows for each edebug mode.")
2990
2991(defun edebug-overlay-arrow ()
2992 ;; Set up the overlay arrow at beginning-of-line in current buffer.
2993 ;; The arrow string is derived from edebug-arrow-alist and
2994 ;; edebug-execution-mode.
88668147 2995 (let ((pos (save-excursion (beginning-of-line) (point))))
1fe3d507
DL
2996 (setq overlay-arrow-string
2997 (cdr (assq edebug-execution-mode edebug-arrow-alist)))
2998 (setq overlay-arrow-position (make-marker))
2999 (set-marker overlay-arrow-position pos (current-buffer))))
84fc2cfa 3000
1fe3d507
DL
3001
3002(defun edebug-toggle-save-all-windows ()
3003 "Toggle the saving and restoring of all windows.
3004Also, each time you toggle it on, the inside and outside window
3005configurations become the same as the current configuration."
84fc2cfa 3006 (interactive)
1fe3d507
DL
3007 (setq edebug-save-windows (not edebug-save-windows))
3008 (if edebug-save-windows
84fc2cfa
ER
3009 (setq edebug-inside-windows
3010 (setq edebug-outside-windows
1fe3d507
DL
3011 (edebug-current-windows
3012 edebug-save-windows))))
3013 (message "Window saving is %s for all windows."
84fc2cfa
ER
3014 (if edebug-save-windows "on" "off")))
3015
1fe3d507
DL
3016(defmacro edebug-changing-windows (&rest body)
3017 (` (let ((window (selected-window)))
3018 (setq edebug-inside-windows (edebug-current-windows t))
3019 (edebug-set-windows edebug-outside-windows)
3020 (,@ body) ;; Code to change edebug-save-windows
3021 (setq edebug-outside-windows (edebug-current-windows
3022 edebug-save-windows))
3023 ;; Problem: what about outside windows that are deleted inside?
3024 (edebug-set-windows edebug-inside-windows))))
3025
3026(defun edebug-toggle-save-selected-window ()
3027 "Toggle the saving and restoring of the selected window.
3028Also, each time you toggle it on, the inside and outside window
3029configurations become the same as the current configuration."
3030 (interactive)
3031 (cond
3032 ((eq t edebug-save-windows)
3033 ;; Save all outside windows except the selected one.
3034 ;; Remove (selected-window) from outside-windows.
3035 (edebug-changing-windows
3036 (setq edebug-save-windows (delq window (edebug-window-list)))))
3037
3038 ((memq (selected-window) edebug-save-windows)
3039 (setq edebug-outside-windows
3040 (delq (assq (selected-window) edebug-outside-windows)
3041 edebug-outside-windows))
3042 (setq edebug-save-windows
3043 (delq (selected-window) edebug-save-windows)))
3044 (t ; Save a new window.
3045 (edebug-changing-windows
3046 (setq edebug-save-windows (cons window edebug-save-windows)))))
3047
3048 (message "Window saving is %s for %s."
3049 (if (memq (selected-window) edebug-save-windows)
3050 "on" "off")
3051 (selected-window)))
3052
3053(defun edebug-toggle-save-windows (arg)
3054 "Toggle the saving and restoring of windows.
3055With prefix, toggle for just the selected window.
3056Otherwise, toggle for all windows."
3057 (interactive "P")
3058 (if arg
3059 (edebug-toggle-save-selected-window)
3060 (edebug-toggle-save-all-windows)))
3061
84fc2cfa
ER
3062
3063(defun edebug-where ()
3064 "Show the debug windows and where we stopped in the program."
3065 (interactive)
3066 (if (not edebug-active)
1fe3d507
DL
3067 (error "Edebug is not active"))
3068 ;; Restore the window configuration to what it last was inside.
3069 ;; But it is not always set. - experiment
3070 ;;(if edebug-inside-windows
3071 ;; (edebug-set-windows edebug-inside-windows))
84fc2cfa 3072 (edebug-pop-to-buffer edebug-buffer)
1fe3d507 3073 (goto-char edebug-point))
84fc2cfa
ER
3074
3075(defun edebug-view-outside ()
3076 "Change to the outside window configuration."
3077 (interactive)
3078 (if (not edebug-active)
1fe3d507
DL
3079 (error "Edebug is not active"))
3080 (setq edebug-inside-windows
3081 (edebug-current-windows edebug-save-windows))
3082 (edebug-set-windows edebug-outside-windows)
84fc2cfa 3083 (goto-char edebug-outside-point)
1fe3d507 3084 (message "Window configuration outside of Edebug. Return with %s"
84fc2cfa
ER
3085 (substitute-command-keys "\\<global-map>\\[edebug-where]")))
3086
3087
1fe3d507
DL
3088(defun edebug-bounce-point (arg)
3089 "Bounce the point in the outside current buffer.
3090If prefix arg is supplied, sit for that many seconds before returning.
3091The default is one second."
3092 (interactive "p")
84fc2cfa 3093 (if (not edebug-active)
1fe3d507 3094 (error "Edebug is not active"))
84fc2cfa 3095 (save-excursion
1fe3d507 3096 ;; If the buffer's currently displayed, avoid set-window-configuration.
84fc2cfa
ER
3097 (save-window-excursion
3098 (edebug-pop-to-buffer edebug-outside-buffer)
84fc2cfa 3099 (goto-char edebug-outside-point)
1fe3d507
DL
3100 (message "Current buffer: %s Point: %s Mark: %s"
3101 (current-buffer) (point)
3102 (if (marker-buffer (edebug-mark-marker))
3103 (marker-position (edebug-mark-marker)) "<not set>"))
3104 (edebug-sit-for arg)
3105 (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
84fc2cfa 3106
84fc2cfa 3107
1fe3d507
DL
3108;; Joe Wells, here is a start at your idea of adding a buffer to the internal
3109;; display list. Still need to use this list in edebug-display.
84fc2cfa 3110
1fe3d507
DL
3111'(defvar edebug-display-buffer-list nil
3112 "List of buffers that edebug will display when it is active.")
84fc2cfa 3113
1fe3d507
DL
3114'(defun edebug-display-buffer (buffer)
3115 "Toggle display of a buffer inside of edebug."
3116 (interactive "bBuffer: ")
3117 (let ((already-displaying (memq buffer edebug-display-buffer-list)))
3118 (setq edebug-display-buffer-list
3119 (if already-displaying
3120 (delq buffer edebug-display-buffer-list)
3121 (cons buffer edebug-display-buffer-list)))
3122 (message "Displaying %s %s" buffer
3123 (if already-displaying "off" "on"))))
84fc2cfa 3124
1fe3d507 3125;;; Breakpoint related functions
84fc2cfa
ER
3126
3127(defun edebug-find-stop-point ()
1fe3d507
DL
3128 ;; Return (function . index) of the nearest edebug stop point.
3129 (let* ((edebug-def-name (edebug-form-data-symbol))
84fc2cfa 3130 (edebug-data
1fe3d507
DL
3131 (let ((data (get edebug-def-name 'edebug)))
3132 (if (or (null data) (markerp data))
3133 (error "%s is not instrumented for Edebug" edebug-def-name))
3134 data)) ; we could do it automatically, if data is a marker.
84fc2cfa 3135 ;; pull out parts of edebug-data.
1fe3d507
DL
3136 (edebug-def-mark (car edebug-data))
3137 ;; (edebug-breakpoints (car (cdr edebug-data)))
84fc2cfa 3138
1fe3d507 3139 (offset-vector (nth 2 edebug-data))
84fc2cfa
ER
3140 (offset (- (save-excursion
3141 (if (looking-at "[ \t]")
3142 ;; skip backwards until non-whitespace, or bol
3143 (skip-chars-backward " \t"))
3144 (point))
1fe3d507 3145 edebug-def-mark))
84fc2cfa
ER
3146 len i)
3147 ;; the offsets are in order so we can do a linear search
3148 (setq len (length offset-vector))
3149 (setq i 0)
3150 (while (and (< i len) (> offset (aref offset-vector i)))
3151 (setq i (1+ i)))
3152 (if (and (< i len)
3153 (<= offset (aref offset-vector i)))
3154 ;; return the relevant info
1fe3d507 3155 (cons edebug-def-name i)
84fc2cfa 3156 (message "Point is not on an expression in %s."
1fe3d507 3157 edebug-def-name)
84fc2cfa
ER
3158 )))
3159
3160
3161(defun edebug-next-breakpoint ()
3162 "Move point to the next breakpoint, or first if none past point."
3163 (interactive)
3164 (let ((edebug-stop-point (edebug-find-stop-point)))
3165 (if edebug-stop-point
1fe3d507 3166 (let* ((edebug-def-name (car edebug-stop-point))
84fc2cfa 3167 (index (cdr edebug-stop-point))
1fe3d507 3168 (edebug-data (get edebug-def-name 'edebug))
84fc2cfa
ER
3169
3170 ;; pull out parts of edebug-data
1fe3d507 3171 (edebug-def-mark (car edebug-data))
84fc2cfa 3172 (edebug-breakpoints (car (cdr edebug-data)))
1fe3d507 3173 (offset-vector (nth 2 edebug-data))
84fc2cfa
ER
3174 breakpoint)
3175 (if (not edebug-breakpoints)
3176 (message "No breakpoints in this function.")
3177 (let ((breaks edebug-breakpoints))
3178 (while (and breaks
3179 (<= (car (car breaks)) index))
3180 (setq breaks (cdr breaks)))
3181 (setq breakpoint
3182 (if breaks
3183 (car breaks)
3184 ;; goto the first breakpoint
3185 (car edebug-breakpoints)))
1fe3d507 3186 (goto-char (+ edebug-def-mark
84fc2cfa
ER
3187 (aref offset-vector (car breakpoint))))
3188
f7359658
RS
3189 (message "%s"
3190 (concat (if (nth 2 breakpoint)
84fc2cfa
ER
3191 "Temporary " "")
3192 (if (car (cdr breakpoint))
3193 (format "Condition: %s"
1fe3d507 3194 (edebug-safe-prin1-to-string
84fc2cfa
ER
3195 (car (cdr breakpoint))))
3196 "")))
3197 ))))))
3198
3199
3200(defun edebug-modify-breakpoint (flag &optional condition temporary)
3201 "Modify the breakpoint for the form at point or after it according
3202to FLAG: set if t, clear if nil. Then move to that point.
3203If CONDITION or TEMPORARY are non-nil, add those attributes to
3204the breakpoint. "
3205 (let ((edebug-stop-point (edebug-find-stop-point)))
3206 (if edebug-stop-point
1fe3d507 3207 (let* ((edebug-def-name (car edebug-stop-point))
84fc2cfa 3208 (index (cdr edebug-stop-point))
1fe3d507 3209 (edebug-data (get edebug-def-name 'edebug))
84fc2cfa
ER
3210
3211 ;; pull out parts of edebug-data
1fe3d507 3212 (edebug-def-mark (car edebug-data))
84fc2cfa 3213 (edebug-breakpoints (car (cdr edebug-data)))
1fe3d507 3214 (offset-vector (nth 2 edebug-data))
84fc2cfa
ER
3215 present)
3216 ;; delete it either way
3217 (setq present (assq index edebug-breakpoints))
3218 (setq edebug-breakpoints (delq present edebug-breakpoints))
3219 (if flag
3220 (progn
3221 ;; add it to the list and resort
3222 (setq edebug-breakpoints
3223 (edebug-sort-alist
3224 (cons
3225 (list index condition temporary)
3226 edebug-breakpoints) '<))
1fe3d507
DL
3227 (if condition
3228 (message "Breakpoint set in %s with condition: %s"
3229 edebug-def-name condition)
3230 (message "Breakpoint set in %s" edebug-def-name)))
84fc2cfa 3231 (if present
1fe3d507
DL
3232 (message "Breakpoint unset in %s" edebug-def-name)
3233 (message "No breakpoint here")))
84fc2cfa 3234
1fe3d507
DL
3235 (setcar (cdr edebug-data) edebug-breakpoints)
3236 (goto-char (+ edebug-def-mark (aref offset-vector index)))
84fc2cfa
ER
3237 ))))
3238
3239(defun edebug-set-breakpoint (arg)
3240 "Set the breakpoint of nearest sexp.
3241With prefix argument, make it a temporary breakpoint."
3242 (interactive "P")
3243 (edebug-modify-breakpoint t nil arg))
3244
3245(defun edebug-unset-breakpoint ()
3246 "Clear the breakpoint of nearest sexp."
3247 (interactive)
3248 (edebug-modify-breakpoint nil))
3249
1fe3d507
DL
3250
3251;; For emacs 18, no read-expression-history
84fc2cfa
ER
3252(defun edebug-set-conditional-breakpoint (arg condition)
3253 "Set a conditional breakpoint at nearest sexp.
3254The condition is evaluated in the outside context.
3255With prefix argument, make it a temporary breakpoint."
1fe3d507
DL
3256 ;; (interactive "P\nxCondition: ")
3257 (interactive
3258 (list
3259 current-prefix-arg
3260 ;; Edit previous condition as follows, but it is cumbersome:
3261 (let ((edebug-stop-point (edebug-find-stop-point)))
3262 (if edebug-stop-point
3263 (let* ((edebug-def-name (car edebug-stop-point))
3264 (index (cdr edebug-stop-point))
3265 (edebug-data (get edebug-def-name 'edebug))
3266 (edebug-breakpoints (car (cdr edebug-data)))
3267 (edebug-break-data (assq index edebug-breakpoints))
3268 (edebug-break-condition (car (cdr edebug-break-data))))
3269 (read-minibuffer
3270 (format "Condition in %s: " edebug-def-name)
3271 (if edebug-break-condition
3272 (format "%s" edebug-break-condition)
3273 (format ""))))))))
84fc2cfa
ER
3274 (edebug-modify-breakpoint t condition arg))
3275
1fe3d507
DL
3276
3277(defun edebug-set-global-break-condition (expression)
3278 (interactive (list (read-minibuffer
3279 "Global Condition: "
3280 (format "%s" edebug-global-break-condition))))
3281 (setq edebug-global-break-condition expression))
3282
3283
3284;;; Mode switching functions
84fc2cfa
ER
3285
3286(defun edebug-set-mode (mode shortmsg msg)
1fe3d507
DL
3287 ;; Set the edebug mode to MODE.
3288 ;; Display SHORTMSG, or MSG if not within edebug.
3289 (if (eq (1+ edebug-recursion-depth) (recursion-depth))
3290 (progn
3291 (setq edebug-execution-mode mode)
3292 (message shortmsg)
3293 ;; Continue execution
3294 (exit-recursive-edit))
3295 ;; This is not terribly useful!!
3296 (setq edebug-next-execution-mode mode)
84fc2cfa
ER
3297 (message msg)))
3298
3299
1fe3d507
DL
3300(defalias 'edebug-step-through-mode 'edebug-step-mode)
3301
3302(defun edebug-step-mode ()
3303 "Proceed to next stop point."
3304 (interactive)
3305 (edebug-set-mode 'step "" "Edebug will stop at next stop point."))
3306
3307(defun edebug-next-mode ()
3308 "Proceed to next `after' stop point."
84fc2cfa 3309 (interactive)
1fe3d507 3310 (edebug-set-mode 'next "" "Edebug will stop after next eval."))
84fc2cfa 3311
1fe3d507 3312(defun edebug-go-mode (arg)
84fc2cfa 3313 "Go, evaluating until break.
1fe3d507 3314With prefix ARG, set temporary break at current point and go."
84fc2cfa
ER
3315 (interactive "P")
3316 (if arg
3317 (edebug-set-breakpoint t))
1fe3d507 3318 (edebug-set-mode 'go "Go..." "Edebug will go until break."))
84fc2cfa 3319
1fe3d507 3320(defun edebug-Go-nonstop-mode ()
84fc2cfa
ER
3321 "Go, evaluating without debugging."
3322 (interactive)
3323 (edebug-set-mode 'Go-nonstop "Go-Nonstop..."
1fe3d507
DL
3324 "Edebug will not stop at breaks."))
3325
3326
3327(defun edebug-trace-mode ()
3328 "Begin trace mode."
3329 (interactive)
3330 (edebug-set-mode 'trace "Tracing..." "Edebug will trace with pause."))
3331
3332(defun edebug-Trace-fast-mode ()
3333 "Trace with no wait at each step."
3334 (interactive)
3335 (edebug-set-mode 'Trace-fast
3336 "Trace fast..." "Edebug will trace without pause."))
3337
3338(defun edebug-continue-mode ()
3339 "Begin continue mode."
3340 (interactive)
3341 (edebug-set-mode 'continue "Continue..."
3342 "Edebug will pause at breakpoints."))
3343
3344(defun edebug-Continue-fast-mode ()
3345 "Trace with no wait at each step."
3346 (interactive)
3347 (edebug-set-mode 'Continue-fast "Continue fast..."
3348 "Edebug will stop and go at breakpoints."))
3349
3350;; ------------------------------------------------------------
3351;; The following use the mode changing commands and breakpoints.
3352
3353
3354(defun edebug-goto-here ()
3355 "Proceed to this stop point."
3356 (interactive)
3357 (edebug-go-mode t))
3358
3359
3360(defun edebug-stop ()
3361 "Stop execution and do not continue.
3362Useful for exiting from trace or continue loop."
3363 (interactive)
3364 (message "Stop"))
3365
3366
3367'(defun edebug-forward ()
3368 "Proceed to the exit of the next expression to be evaluated."
3369 (interactive)
3370 (edebug-set-mode
3371 'forward "Forward"
3372 "Edebug will stop after exiting the next expression."))
3373
84fc2cfa
ER
3374
3375(defun edebug-forward-sexp (arg)
3376 "Proceed from the current point to the end of the ARGth sexp ahead.
3377If there are not ARG sexps ahead, then do edebug-step-out."
3378 (interactive "p")
1fe3d507 3379 (condition-case nil
84fc2cfa
ER
3380 (let ((parse-sexp-ignore-comments t))
3381 ;; Call forward-sexp repeatedly until done or failure.
3382 (forward-sexp arg)
1fe3d507 3383 (edebug-go-mode t))
84fc2cfa
ER
3384 (error
3385 (edebug-step-out)
3386 )))
3387
3388(defun edebug-step-out ()
3389 "Proceed from the current point to the end of the containing sexp.
3390If there is no containing sexp that is not the top level defun,
3391go to the end of the last sexp, or if that is the same point, then step."
3392 (interactive)
1fe3d507 3393 (condition-case nil
84fc2cfa
ER
3394 (let ((parse-sexp-ignore-comments t))
3395 (up-list 1)
3396 (save-excursion
3397 ;; Is there still a containing expression?
3398 (up-list 1))
1fe3d507 3399 (edebug-go-mode t))
84fc2cfa
ER
3400 (error
3401 ;; At top level - 1, so first check if there are more sexps at this level.
3402 (let ((start-point (point)))
3403;; (up-list 1)
3404 (down-list -1)
3405 (if (= (point) start-point)
1fe3d507
DL
3406 (edebug-step-mode) ; No more at this level, so step.
3407 (edebug-go-mode t)
84fc2cfa
ER
3408 )))))
3409
1fe3d507
DL
3410(defun edebug-instrument-function (func)
3411 ;; Func should be a function symbol.
3412 ;; Return the function symbol, or nil if not instrumented.
3413 (let ((func-marker))
3414 (setq func-marker (get func 'edebug))
3415 (cond
3416 ((markerp func-marker)
3417 ;; It is uninstrumented, so instrument it.
3418 (save-excursion
3419 (set-buffer (marker-buffer func-marker))
3420 (goto-char func-marker)
3421 (edebug-eval-top-level-form)
3422 func))
3423 ((consp func-marker)
3424 (message "%s is already instrumented." func)
3425 func)
3426 (t
3427 ;; We could try harder, e.g. do a tags search.
3428 (error "Don't know where %s is defined" func)
3429 nil))))
3430
3431(defun edebug-instrument-callee ()
3432 "Instrument the definition of the function or macro about to be called.
3433Do this when stopped before the form or it will be too late.
3434One side effect of using this command is that the next time the
3435function or macro is called, Edebug will be called there as well."
84fc2cfa 3436 (interactive)
1fe3d507
DL
3437 (if (not (looking-at "\("))
3438 (error "You must be before a list form")
3439 (let ((func
3440 (save-excursion
3441 (down-list 1)
3442 (if (looking-at "\(")
3443 (edebug-form-data-name
3444 (edebug-get-form-data-entry (point)))
88668147 3445 (edebug-original-read (current-buffer))))))
1fe3d507 3446 (edebug-instrument-function func))))
84fc2cfa 3447
84fc2cfa 3448
1fe3d507
DL
3449(defun edebug-step-in ()
3450 "Step into the definition of the function or macro about to be called.
3451This first does `edebug-instrument-callee' to ensure that it is
3452instrumented. Then it does `edebug-on-entry' and switches to `go' mode."
84fc2cfa 3453 (interactive)
1fe3d507
DL
3454 (let ((func (edebug-instrument-callee)))
3455 (if func
3456 (progn
3457 (edebug-on-entry func 'temp)
3458 (edebug-go-mode nil)))))
84fc2cfa 3459
1fe3d507
DL
3460(defun edebug-on-entry (function &optional flag)
3461 "Cause Edebug to stop when FUNCTION is called.
3462With prefix argument, make this temporary so it is automatically
3463cancelled the first time the function is entered."
3464 (interactive "aEdebug on entry to: \nP")
3465 ;; Could store this in the edebug data instead.
3466 (put function 'edebug-on-entry (if flag 'temp t)))
84fc2cfa 3467
1fe3d507
DL
3468(defun cancel-edebug-on-entry (function)
3469 (interactive "aEdebug on entry to: ")
3470 (put function 'edebug-on-entry nil))
84fc2cfa 3471
1fe3d507 3472
88668147
DL
3473(if (not (fboundp 'edebug-original-debug-on-entry))
3474 (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))
1fe3d507
DL
3475'(fset 'debug-on-entry 'edebug-debug-on-entry) ;; Should we do this?
3476;; Also need edebug-cancel-debug-on-entry
3477
3478'(defun edebug-debug-on-entry (function)
3479 "Request FUNCTION to invoke debugger each time it is called.
3480If the user continues, FUNCTION's execution proceeds.
3481Works by modifying the definition of FUNCTION,
3482which must be written in Lisp, not predefined.
3483Use `cancel-debug-on-entry' to cancel the effect of this command.
3484Redefining FUNCTION also does that.
3485
3486This version is from Edebug. If the function is instrumented for
3487Edebug, it calls `edebug-on-entry'"
3488 (interactive "aDebug on entry (to function): ")
3489 (let ((func-data (get function 'edebug)))
3490 (if (or (null func-data) (markerp func-data))
88668147 3491 (edebug-original-debug-on-entry function)
1fe3d507
DL
3492 (edebug-on-entry function))))
3493
3494
3495(defun edebug-top-level-nonstop ()
3496 "Set mode to Go-nonstop, and exit to top-level.
3497This is useful for exiting even if unwind-protect code may be executed."
84fc2cfa 3498 (interactive)
1fe3d507
DL
3499 (setq edebug-execution-mode 'Go-nonstop)
3500 (top-level))
84fc2cfa
ER
3501
3502
3503;;(defun edebug-exit-out ()
3504;; "Go until the current function exits."
3505;; (interactive)
3506;; (edebug-set-mode 'exiting "Exit..."))
3507
3508
84fc2cfa
ER
3509;;; The following initial mode setting definitions are not used yet.
3510
1fe3d507 3511'(defconst edebug-initial-mode-alist
84fc2cfa
ER
3512 '((edebug-Continue-fast . Continue-fast)
3513 (edebug-Trace-fast . Trace-fast)
3514 (edebug-continue . continue)
3515 (edebug-trace . trace)
3516 (edebug-go . go)
3517 (edebug-step-through . step)
3518 (edebug-Go-nonstop . Go-nonstop)
3519 )
3520 "Association list between commands and the modes they set.")
3521
3522
1fe3d507 3523'(defun edebug-set-initial-mode ()
84fc2cfa
ER
3524 "Ask for the initial mode of the enclosing function.
3525The mode is requested via the key that would be used to set the mode in
3526edebug-mode."
3527 (interactive)
3528 (let* ((this-function (edebug-which-function))
3529 (keymap (if (eq edebug-mode-map (current-local-map))
3530 edebug-mode-map))
3531 (old-mode (or (get this-function 'edebug-initial-mode)
3532 edebug-initial-mode))
3533 (key (read-key-sequence
3534 (format
3535 "Change initial edebug mode for %s from %s (%s) to (enter key): "
3536 this-function
3537 old-mode
3538 (where-is-internal
3539 (car (rassq old-mode edebug-initial-mode-alist))
3540 keymap 'firstonly
3541 ))))
3542 (mode (cdr (assq (key-binding key) edebug-initial-mode-alist)))
3543 )
3544 (if (and mode
3545 (or (get this-function 'edebug-initial-mode)
3546 (not (eq mode edebug-initial-mode))))
3547 (progn
3548 (put this-function 'edebug-initial-mode mode)
3549 (message "Initial mode for %s is now: %s"
3550 this-function mode))
4897b0a0 3551 (error "Key must map to one of the mode changing commands")
84fc2cfa
ER
3552 )))
3553
1fe3d507 3554;;; Evaluation of expressions
84fc2cfa 3555
1fe3d507 3556(def-edebug-spec edebug-outside-excursion t)
84fc2cfa 3557
1fe3d507
DL
3558(defmacro edebug-outside-excursion (&rest body)
3559 "Evaluate an expression list in the outside context.
3560Return the result of the last expression."
3561 (` (save-excursion ; of current-buffer
3562 (if edebug-save-windows
3563 (progn
3564 ;; After excursion, we will
3565 ;; restore to current window configuration.
3566 (setq edebug-inside-windows
3567 (edebug-current-windows edebug-save-windows))
3568 ;; Restore outside windows.
3569 (edebug-set-windows edebug-outside-windows)))
3570
3571 (set-buffer edebug-buffer) ; why?
3572 ;; (use-local-map edebug-outside-map)
3573 (store-match-data edebug-outside-match-data)
3574 ;; Restore outside context.
3575 (let (;; (edebug-inside-map (current-local-map)) ;; restore map??
3576 (last-command-char edebug-outside-last-command-char)
3577 (last-command-event edebug-outside-last-command-event)
3578 (last-command edebug-outside-last-command)
3579 (this-command edebug-outside-this-command)
3580 (unread-command-char edebug-outside-unread-command-char)
3581 (unread-command-event edebug-outside-unread-command-event)
3582 (unread-command-events edebug-outside-unread-command-events)
3583 (last-input-char edebug-outside-last-input-char)
3584 (last-input-event edebug-outside-last-input-event)
3585 (last-event-frame edebug-outside-last-event-frame)
3586 (last-nonmenu-event edebug-outside-last-nonmenu-event)
3587 (track-mouse edebug-outside-track-mouse)
1fe3d507
DL
3588 (standard-output edebug-outside-standard-output)
3589 (standard-input edebug-outside-standard-input)
88668147 3590
efcf38c7 3591 (executing-kbd-macro edebug-outside-executing-macro)
1fe3d507 3592 (defining-kbd-macro edebug-outside-defining-kbd-macro)
88668147
DL
3593 (pre-command-hook edebug-outside-pre-command-hook)
3594 (post-command-hook edebug-outside-post-command-hook)
3595
3596 ;; See edebug-display
3597 (overlay-arrow-position edebug-outside-o-a-p)
3598 (overlay-arrow-string edebug-outside-o-a-s)
3599 (cursor-in-echo-area edebug-outside-c-i-e-a)
1fe3d507
DL
3600 )
3601 (unwind-protect
3602 (save-excursion ; of edebug-buffer
3603 (set-buffer edebug-outside-buffer)
3604 (goto-char edebug-outside-point)
3605 (if (marker-buffer (edebug-mark-marker))
3606 (set-marker (edebug-mark-marker) edebug-outside-mark))
3607 (,@ body))
3608
3609 ;; Back to edebug-buffer. Restore rest of inside context.
3610 ;; (use-local-map edebug-inside-map)
3611 (if edebug-save-windows
3612 ;; Restore inside windows.
3613 (edebug-set-windows edebug-inside-windows))
88668147
DL
3614
3615 ;; Save values that may have been changed.
3616 (setq
3617 edebug-outside-last-command-char last-command-char
3618 edebug-outside-last-command-event last-command-event
3619 edebug-outside-last-command last-command
3620 edebug-outside-this-command this-command
3621 edebug-outside-unread-command-char unread-command-char
3622 edebug-outside-unread-command-event unread-command-event
3623 edebug-outside-unread-command-events unread-command-events
3624 edebug-outside-last-input-char last-input-char
3625 edebug-outside-last-input-event last-input-event
3626 edebug-outside-last-event-frame last-event-frame
3627 edebug-outside-last-nonmenu-event last-nonmenu-event
3628 edebug-outside-track-mouse track-mouse
3629 edebug-outside-standard-output standard-output
3630 edebug-outside-standard-input standard-input
3631
efcf38c7 3632 edebug-outside-executing-macro executing-kbd-macro
88668147
DL
3633 edebug-outside-defining-kbd-macro defining-kbd-macro
3634 edebug-outside-pre-command-hook pre-command-hook
3635 edebug-outside-post-command-hook post-command-hook
3636
3637 edebug-outside-o-a-p overlay-arrow-position
3638 edebug-outside-o-a-s overlay-arrow-string
3639 edebug-outside-c-i-e-a cursor-in-echo-area
3640 ))) ; let
1fe3d507
DL
3641 )))
3642
3643(defvar cl-debug-env nil) ;; defined in cl; non-nil when lexical env used.
3644
3645(defun edebug-eval (edebug-expr)
3646 ;; Are there cl lexical variables active?
3647 (if cl-debug-env
3648 (eval (cl-macroexpand-all edebug-expr cl-debug-env))
3649 (eval edebug-expr)))
3650
3651(defun edebug-safe-eval (edebug-expr)
3652 ;; Evaluate EXPR safely.
3653 ;; If there is an error, a string is returned describing the error.
3654 (condition-case edebug-err
3655 (edebug-eval edebug-expr)
3656 (error (edebug-format "%s: %s" ;; could
3657 (get (car edebug-err) 'error-message)
3658 (car (cdr edebug-err))))))
3659
f7359658
RS
3660;;; Printing
3661
1fe3d507
DL
3662;; Replace printing functions.
3663
3664;; obsolete names
3665(defalias 'edebug-install-custom-print-funcs 'edebug-install-custom-print)
3666(defalias 'edebug-reset-print-funcs 'edebug-uninstall-custom-print)
3667(defalias 'edebug-uninstall-custom-print-funcs 'edebug-uninstall-custom-print)
3668
3669(defun edebug-install-custom-print ()
3670 "Replace print functions used by Edebug with custom versions."
3671 ;; Modifying the custom print functions, or changing print-length,
3672 ;; print-level, print-circle, custom-print-list or custom-print-vector
3673 ;; have immediate effect.
84fc2cfa 3674 (interactive)
1fe3d507
DL
3675 (require 'cust-print)
3676 (defalias 'edebug-prin1 'custom-prin1)
3677 (defalias 'edebug-print 'custom-print)
3678 (defalias 'edebug-prin1-to-string 'custom-prin1-to-string)
3679 (defalias 'edebug-format 'custom-format)
3680 (defalias 'edebug-message 'custom-message)
3681 "Installed")
3682
3683(eval-and-compile
3684 (defun edebug-uninstall-custom-print ()
3685 "Replace edebug custom print functions with internal versions."
3686 (interactive)
3687 (defalias 'edebug-prin1 'prin1)
3688 (defalias 'edebug-print 'print)
3689 (defalias 'edebug-prin1-to-string 'prin1-to-string)
3690 (defalias 'edebug-format 'format)
3691 (defalias 'edebug-message 'message)
3692 "Uninstalled")
3693
3694 ;; Default print functions are the same as Emacs'.
3695 (edebug-uninstall-custom-print))
3696
3697
3698(defun edebug-report-error (edebug-value)
3699 ;; Print an error message like command level does.
3700 ;; This also prints the error name if it has no error-message.
3701 (message "%s: %s"
3702 (or (get (car edebug-value) 'error-message)
3703 (format "peculiar error (%s)" (car edebug-value)))
3704 (mapconcat (function (lambda (edebug-arg)
3705 ;; continuing after an error may
3706 ;; complain about edebug-arg. why??
3707 (prin1-to-string edebug-arg)))
3708 (cdr edebug-value) ", ")))
3709
3710;; Define here in case they are not already defined.
3711(defvar print-level nil)
3712(defvar print-circle nil)
3713(defvar print-readably) ;; defined by lemacs
3714;; Alternatively, we could change the definition of
88668147 3715;; edebug-safe-prin1-to-string to only use these if defined.
1fe3d507
DL
3716
3717(defun edebug-safe-prin1-to-string (value)
84fc2cfa 3718 (let ((print-escape-newlines t)
1fe3d507
DL
3719 (print-length (or edebug-print-length print-length))
3720 (print-level (or edebug-print-level print-level))
3721 (print-circle (or edebug-print-circle print-circle))
3722 (print-readably nil)) ;; lemacs uses this.
3723 (edebug-prin1-to-string value)))
3724
3725(defun edebug-compute-previous-result (edebug-previous-value)
3726 (setq edebug-previous-result
3727 (if (and (numberp edebug-previous-value)
3728 (< edebug-previous-value 256)
3729 (>= edebug-previous-value 0))
3730 (format "Result: %s = %s" edebug-previous-value
3731 (single-key-description edebug-previous-value))
3732 (if edebug-unwrap-results
3733 (setq edebug-previous-value
3734 (edebug-unwrap* edebug-previous-value)))
3735 (concat "Result: "
3736 (edebug-safe-prin1-to-string edebug-previous-value)))))
84fc2cfa 3737
1fe3d507
DL
3738(defun edebug-previous-result ()
3739 "Print the previous result."
3740 (interactive)
3741 (message "%s" edebug-previous-result))
84fc2cfa 3742
f7359658 3743;;; Read, Eval and Print
84fc2cfa 3744
1fe3d507
DL
3745(defun edebug-eval-expression (edebug-expr)
3746 "Evaluate an expression in the outside environment.
3747If interactive, prompt for the expression.
84fc2cfa
ER
3748Print result in minibuffer."
3749 (interactive "xEval: ")
1fe3d507
DL
3750 (princ
3751 (edebug-outside-excursion
3752 (setq values (cons (edebug-eval edebug-expr) values))
3753 (edebug-safe-prin1-to-string (car values)))))
84fc2cfa
ER
3754
3755(defun edebug-eval-last-sexp ()
3756 "Evaluate sexp before point in the outside environment;
3757print value in minibuffer."
3758 (interactive)
1fe3d507 3759 (edebug-eval-expression (edebug-last-sexp)))
84fc2cfa
ER
3760
3761(defun edebug-eval-print-last-sexp ()
3762 "Evaluate sexp before point in the outside environment;
3763print value into current buffer."
3764 (interactive)
1fe3d507
DL
3765 (let* ((edebug-form (edebug-last-sexp))
3766 (edebug-result-string
3767 (edebug-outside-excursion
3768 (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))
3769 (standard-output (current-buffer)))
3770 (princ "\n")
3771 ;; princ the string to get rid of quotes.
3772 (princ edebug-result-string)
3773 (princ "\n")
3774 ))
3775
f7359658 3776;;; Edebug Minor Mode
84fc2cfa 3777
1fe3d507
DL
3778;; Global GUD bindings for all emacs-lisp-mode buffers.
3779(define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
3780(define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
3781(define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
3782(define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)
3783
84fc2cfa
ER
3784
3785(defvar edebug-mode-map nil)
3786(if edebug-mode-map
3787 nil
3788 (progn
3789 (setq edebug-mode-map (copy-keymap emacs-lisp-mode-map))
3790 ;; control
1fe3d507
DL
3791 (define-key edebug-mode-map " " 'edebug-step-mode)
3792 (define-key edebug-mode-map "n" 'edebug-next-mode)
3793 (define-key edebug-mode-map "g" 'edebug-go-mode)
3794 (define-key edebug-mode-map "G" 'edebug-Go-nonstop-mode)
3795 (define-key edebug-mode-map "t" 'edebug-trace-mode)
3796 (define-key edebug-mode-map "T" 'edebug-Trace-fast-mode)
3797 (define-key edebug-mode-map "c" 'edebug-continue-mode)
3798 (define-key edebug-mode-map "C" 'edebug-Continue-fast-mode)
3799
3800 ;;(define-key edebug-mode-map "f" 'edebug-forward) not implemented
84fc2cfa
ER
3801 (define-key edebug-mode-map "f" 'edebug-forward-sexp)
3802 (define-key edebug-mode-map "h" 'edebug-goto-here)
3803
1fe3d507 3804 (define-key edebug-mode-map "I" 'edebug-instrument-callee)
84fc2cfa
ER
3805 (define-key edebug-mode-map "i" 'edebug-step-in)
3806 (define-key edebug-mode-map "o" 'edebug-step-out)
3807
1fe3d507 3808 ;; quitting and stopping
84fc2cfa 3809 (define-key edebug-mode-map "q" 'top-level)
1fe3d507 3810 (define-key edebug-mode-map "Q" 'edebug-top-level-nonstop)
84fc2cfa
ER
3811 (define-key edebug-mode-map "a" 'abort-recursive-edit)
3812 (define-key edebug-mode-map "S" 'edebug-stop)
3813
3814 ;; breakpoints
3815 (define-key edebug-mode-map "b" 'edebug-set-breakpoint)
3816 (define-key edebug-mode-map "u" 'edebug-unset-breakpoint)
3817 (define-key edebug-mode-map "B" 'edebug-next-breakpoint)
3818 (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint)
1fe3d507 3819 (define-key edebug-mode-map "X" 'edebug-set-global-break-condition)
84fc2cfa
ER
3820
3821 ;; evaluation
1fe3d507 3822 (define-key edebug-mode-map "r" 'edebug-previous-result)
84fc2cfa
ER
3823 (define-key edebug-mode-map "e" 'edebug-eval-expression)
3824 (define-key edebug-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
3825 (define-key edebug-mode-map "E" 'edebug-visit-eval-list)
3826
3827 ;; views
3828 (define-key edebug-mode-map "w" 'edebug-where)
1fe3d507 3829 (define-key edebug-mode-map "v" 'edebug-view-outside) ;; maybe obsolete??
84fc2cfa 3830 (define-key edebug-mode-map "p" 'edebug-bounce-point)
1fe3d507 3831 (define-key edebug-mode-map "P" 'edebug-view-outside) ;; same as v
84fc2cfa 3832 (define-key edebug-mode-map "W" 'edebug-toggle-save-windows)
1fe3d507 3833
84fc2cfa
ER
3834 ;; misc
3835 (define-key edebug-mode-map "?" 'edebug-help)
3836 (define-key edebug-mode-map "d" 'edebug-backtrace)
3837
3838 (define-key edebug-mode-map "-" 'negative-argument)
1fe3d507
DL
3839
3840 ;; statistics
3841 (define-key edebug-mode-map "=" 'edebug-temp-display-freq-count)
3842
3843 ;; GUD bindings
3844 (define-key edebug-mode-map "\C-c\C-s" 'edebug-step-mode)
3845 (define-key edebug-mode-map "\C-c\C-n" 'edebug-next-mode)
3846 (define-key edebug-mode-map "\C-c\C-c" 'edebug-go-mode)
3847
3848 (define-key edebug-mode-map "\C-x " 'edebug-set-breakpoint)
3849 (define-key edebug-mode-map "\C-c\C-d" 'edebug-unset-breakpoint)
3850 (define-key edebug-mode-map "\C-c\C-t"
3851 (function (lambda () (edebug-set-breakpoint t))))
3852 (define-key edebug-mode-map "\C-c\C-l" 'edebug-where)
84fc2cfa
ER
3853 ))
3854
1fe3d507
DL
3855;; Autoloading these global bindings doesn't make sense because
3856;; they cannot be used anyway unless Edebug is already loaded and active.
3857
84fc2cfa
ER
3858(defvar global-edebug-prefix "\^XX"
3859 "Prefix key for global edebug commands, available from any buffer.")
3860
3861(defvar global-edebug-map nil
3862 "Global map of edebug commands, available from any buffer.")
3863
3864(if global-edebug-map
3865 nil
3866 (setq global-edebug-map (make-sparse-keymap))
3867
3868 (global-unset-key global-edebug-prefix)
3869 (global-set-key global-edebug-prefix global-edebug-map)
3870
1fe3d507
DL
3871 (define-key global-edebug-map " " 'edebug-step-mode)
3872 (define-key global-edebug-map "g" 'edebug-go-mode)
3873 (define-key global-edebug-map "G" 'edebug-Go-nonstop-mode)
3874 (define-key global-edebug-map "t" 'edebug-trace-mode)
3875 (define-key global-edebug-map "T" 'edebug-Trace-fast-mode)
3876 (define-key global-edebug-map "c" 'edebug-continue-mode)
3877 (define-key global-edebug-map "C" 'edebug-Continue-fast-mode)
3878
3879 ;; breakpoints
84fc2cfa 3880 (define-key global-edebug-map "b" 'edebug-set-breakpoint)
84fc2cfa 3881 (define-key global-edebug-map "u" 'edebug-unset-breakpoint)
1fe3d507
DL
3882 (define-key global-edebug-map "x" 'edebug-set-conditional-breakpoint)
3883 (define-key global-edebug-map "X" 'edebug-set-global-break-condition)
3884
3885 ;; views
84fc2cfa 3886 (define-key global-edebug-map "w" 'edebug-where)
1fe3d507
DL
3887 (define-key global-edebug-map "W" 'edebug-toggle-save-windows)
3888
3889 ;; quitting
84fc2cfa 3890 (define-key global-edebug-map "q" 'top-level)
1fe3d507
DL
3891 (define-key global-edebug-map "Q" 'edebug-top-level-nonstop)
3892 (define-key global-edebug-map "a" 'abort-recursive-edit)
84fc2cfa 3893
1fe3d507
DL
3894 ;; statistics
3895 (define-key global-edebug-map "=" 'edebug-display-freq-count)
3896 )
84fc2cfa
ER
3897
3898(defun edebug-help ()
3899 (interactive)
3900 (describe-function 'edebug-mode))
3901
84fc2cfa 3902(defun edebug-mode ()
1fe3d507
DL
3903 "Mode for Emacs Lisp buffers while in Edebug.
3904
3905In addition to all Emacs Lisp commands (except those that modify the
3906buffer) there are local and global key bindings to several Edebug
3907specific commands. E.g. `edebug-step-mode' is bound to \\[edebug-step-mode]
3908in the Edebug buffer and \\<global-map>\\[edebug-step-mode] in any buffer.
84fc2cfa 3909
1fe3d507 3910Also see bindings for the eval list buffer, *edebug*.
84fc2cfa 3911
1fe3d507 3912The edebug buffer commands:
84fc2cfa
ER
3913\\{edebug-mode-map}
3914
1fe3d507 3915Global commands prefixed by `global-edebug-prefix':
84fc2cfa
ER
3916\\{global-edebug-map}
3917
3918Options:
1fe3d507
DL
3919edebug-setup-hook
3920edebug-all-defs
3921edebug-all-forms
84fc2cfa 3922edebug-save-windows
1fe3d507 3923edebug-save-displayed-buffer-points
84fc2cfa
ER
3924edebug-initial-mode
3925edebug-trace
1fe3d507
DL
3926edebug-test-coverage
3927edebug-continue-kbd-macro
3928edebug-print-length
3929edebug-print-level
3930edebug-print-circle
3931edebug-on-error
3932edebug-on-quit
3933edebug-on-signal
3934edebug-unwrap-results
3935edebug-global-break-condition
84fc2cfa
ER
3936"
3937 (use-local-map edebug-mode-map))
3938
f7359658 3939;;; edebug eval list mode
84fc2cfa 3940
1fe3d507 3941;; A list of expressions and their evaluations is displayed in *edebug*.
84fc2cfa
ER
3942
3943(defun edebug-eval-result-list ()
3944 "Return a list of evaluations of edebug-eval-list"
3945 ;; Assumes in outside environment.
88668147
DL
3946 ;; Don't do any edebug things now.
3947 (let ((edebug-execution-mode 'Go-nonstop)
3948 (edebug-trace nil))
3949 (mapcar 'edebug-safe-eval edebug-eval-list)))
84fc2cfa
ER
3950
3951(defun edebug-eval-display-list (edebug-eval-result-list)
3952 ;; Assumes edebug-eval-buffer exists.
3953 (let ((edebug-eval-list-temp edebug-eval-list)
3954 (standard-output edebug-eval-buffer)
1fe3d507 3955 (edebug-comment-line
84fc2cfa 3956 (format ";%s\n" (make-string (- (window-width) 2) ?-))))
1fe3d507 3957 (set-buffer edebug-eval-buffer)
84fc2cfa
ER
3958 (erase-buffer)
3959 (while edebug-eval-list-temp
3960 (prin1 (car edebug-eval-list-temp)) (terpri)
3961 (prin1 (car edebug-eval-result-list)) (terpri)
1fe3d507 3962 (princ edebug-comment-line)
84fc2cfa
ER
3963 (setq edebug-eval-list-temp (cdr edebug-eval-list-temp))
3964 (setq edebug-eval-result-list (cdr edebug-eval-result-list)))
1fe3d507 3965 (edebug-pop-to-buffer edebug-eval-buffer)
84fc2cfa
ER
3966 ))
3967
3968(defun edebug-create-eval-buffer ()
3969 (if (not (and edebug-eval-buffer (buffer-name edebug-eval-buffer)))
3970 (progn
3971 (set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*")))
3972 (edebug-eval-mode))))
3973
3974;; Should generalize this to be callable outside of edebug
3975;; with calls in user functions, e.g. (edebug-eval-display)
3976
3977(defun edebug-eval-display (edebug-eval-result-list)
3978 "Display expressions and evaluations in EVAL-LIST.
3979It modifies the context by popping up the eval display."
3980 (if edebug-eval-result-list
3981 (progn
3982 (edebug-create-eval-buffer)
84fc2cfa
ER
3983 (edebug-eval-display-list edebug-eval-result-list)
3984 )))
3985
3986(defun edebug-eval-redisplay ()
3987 "Redisplay eval list in outside environment.
3988May only be called from within edebug-recursive-edit."
3989 (edebug-create-eval-buffer)
84fc2cfa
ER
3990 (edebug-outside-excursion
3991 (edebug-eval-display-list (edebug-eval-result-list))
3992 ))
3993
3994(defun edebug-visit-eval-list ()
3995 (interactive)
3996 (edebug-eval-redisplay)
3997 (edebug-pop-to-buffer edebug-eval-buffer))
3998
3999
4000(defun edebug-update-eval-list ()
4001 "Replace the evaluation list with the sexps now in the eval buffer."
4002 (interactive)
4003 (let ((starting-point (point))
4004 new-list)
4005 (goto-char (point-min))
4006 ;; get the first expression
4007 (edebug-skip-whitespace)
4008 (if (not (eobp))
4009 (progn
4010 (forward-sexp 1)
4011 (setq new-list (cons (edebug-last-sexp) new-list))))
4012
4013 (while (re-search-forward "^;" nil t)
4014 (forward-line 1)
4015 (skip-chars-forward " \t\n\r")
4016 (if (and (/= ?\; (following-char))
4017 (not (eobp)))
4018 (progn
4019 (forward-sexp 1)
4020 (setq new-list (cons (edebug-last-sexp) new-list)))))
4021
4022 (setq edebug-eval-list (nreverse new-list))
4023 (edebug-eval-redisplay)
4024 (goto-char starting-point)))
4025
4026
4027(defun edebug-delete-eval-item ()
4028 "Delete the item under point and redisplay."
4029 ;; could add arg to do repeatedly
4030 (interactive)
4031 (if (re-search-backward "^;" nil 'nofail)
4032 (forward-line 1))
4033 (delete-region
4034 (point) (progn (re-search-forward "^;" nil 'nofail)
4035 (beginning-of-line)
4036 (point)))
4037 (edebug-update-eval-list))
4038
4039
4040
4041(defvar edebug-eval-mode-map nil
4042 "Keymap for edebug-eval-mode. Superset of lisp-interaction-mode.")
4043
4044(if edebug-eval-mode-map
4045 nil
4046 (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map))
4047
4048 (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)
4049 (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item)
4050 (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list)
4051 (define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
4052 (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp)
4053 )
4054
4055
4056(defun edebug-eval-mode ()
1fe3d507
DL
4057 "Mode for evaluation list buffer while in Edebug.
4058
4059In addition to all Interactive Emacs Lisp commands there are local and
4060global key bindings to several Edebug specific commands. E.g.
4061`edebug-step-mode' is bound to \\[edebug-step-mode] in the Edebug
4062buffer and \\<global-map>\\[edebug-step-mode] in any buffer.
84fc2cfa
ER
4063
4064Eval list buffer commands:
4065\\{edebug-eval-mode-map}
4066
1fe3d507 4067Global commands prefixed by global-edebug-prefix:
84fc2cfa
ER
4068\\{global-edebug-map}
4069"
4070 (lisp-interaction-mode)
4071 (setq major-mode 'edebug-eval-mode)
4072 (setq mode-name "Edebug-Eval")
4073 (use-local-map edebug-eval-mode-map))
4074
f7359658 4075;;; Interface with standard debugger.
84fc2cfa 4076
1fe3d507
DL
4077;; (setq debugger 'edebug) ; to use the edebug debugger
4078;; (setq debugger 'debug) ; use the standard debugger
84fc2cfa 4079
1fe3d507
DL
4080;; Note that debug and its utilities must be byte-compiled to work,
4081;; since they depend on the backtrace looking a certain way. But
4082;; edebug is not dependent on this, yet.
84fc2cfa 4083
1fe3d507 4084(defun edebug (&optional edebug-arg-mode &rest debugger-args)
84fc2cfa 4085 "Replacement for debug.
1fe3d507 4086If we are running an edebugged function,
84fc2cfa 4087show where we last were. Otherwise call debug normally."
1fe3d507
DL
4088;; (message "entered: %s depth: %s edebug-recursion-depth: %s"
4089;; edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1)
4090 (if (and edebug-entered ; anything active?
4091 (eq (recursion-depth) edebug-recursion-depth))
4092 (let (;; Where were we before the error occurred?
4093 (edebug-offset-index (car edebug-offset-indices))
4094 ;; Bind variables required by edebug-display
4095 (edebug-value (car debugger-args))
4096 edebug-breakpoints
4097 edebug-break-data
4098 edebug-break-condition
4099 edebug-global-break
4100 (edebug-break (null edebug-arg-mode)) ;; if called explicitly
4101 )
84fc2cfa 4102 (edebug-display)
1fe3d507
DL
4103 (if (eq edebug-arg-mode 'error)
4104 nil
4105 edebug-value))
84fc2cfa
ER
4106
4107 ;; Otherwise call debug normally.
4108 ;; Still need to remove extraneous edebug calls from stack.
1fe3d507 4109 (apply 'debug edebug-arg-mode debugger-args)
84fc2cfa
ER
4110 ))
4111
4112
4113(defun edebug-backtrace ()
4114 "Display a non-working backtrace. Better than nothing..."
4115 (interactive)
1fe3d507
DL
4116 (if (or (not edebug-backtrace-buffer)
4117 (null (buffer-name edebug-backtrace-buffer)))
4118 (setq edebug-backtrace-buffer
4119 (generate-new-buffer "*Backtrace*"))
4120 ;; else, could just display edebug-backtrace-buffer
4121 )
4122 (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer)
4123 (setq edebug-backtrace-buffer standard-output)
4124 (let ((print-escape-newlines t)
84fc2cfa 4125 (print-length 50)
1fe3d507 4126 last-ok-point)
84fc2cfa
ER
4127 (backtrace)
4128
1fe3d507
DL
4129 ;; Clean up the backtrace.
4130 ;; Not quite right for current edebug scheme.
4131 (set-buffer edebug-backtrace-buffer)
4132 (setq truncate-lines t)
84fc2cfa 4133 (goto-char (point-min))
84fc2cfa 4134 (setq last-ok-point (point))
1fe3d507 4135 (if t (progn
84fc2cfa
ER
4136
4137 ;; Delete interspersed edebug internals.
1fe3d507
DL
4138 (while (re-search-forward "^ \(?edebug" nil t)
4139 (beginning-of-line)
4140 (cond
4141 ((looking-at "^ \(edebug-after")
4142 ;; Previous lines may contain code, so just delete this line
4143 (setq last-ok-point (point))
4144 (forward-line 1)
4145 (delete-region last-ok-point (point)))
4146
4147 ((looking-at "^ edebug")
4148 (forward-line 1)
4149 (delete-region last-ok-point (point))
4150 )))
4151 )))))
84fc2cfa
ER
4152
4153\f
f7359658 4154;;; Trace display
84fc2cfa
ER
4155
4156(defun edebug-trace-display (buf-name fmt &rest args)
4157 "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible.
4158The buffer is created if it does not exist.
1fe3d507
DL
4159You must include newlines in FMT to break lines, but one newline is appended."
4160;; e.g.
4161;; (edebug-trace-display "*trace-point*"
4162;; "saving: point = %s window-start = %s"
4163;; (point) (window-start))
dc0e03f3
RS
4164 (let* ((oldbuf (current-buffer))
4165 (selected-window (selected-window))
84fc2cfa 4166 (buffer (get-buffer-create buf-name))
1fe3d507
DL
4167 buf-window)
4168;; (message "before pop-to-buffer") (sit-for 1)
84fc2cfa 4169 (edebug-pop-to-buffer buffer)
1fe3d507
DL
4170 (setq truncate-lines t)
4171 (setq buf-window (selected-window))
4172 (goto-char (point-max))
4173 (insert (apply 'edebug-format fmt args) "\n")
4174 ;; Make it visible.
4175 (vertical-motion (- 1 (window-height)))
4176 (set-window-start buf-window (point))
4177 (goto-char (point-max))
4178;; (set-window-point buf-window (point))
4179;; (edebug-sit-for 0)
4180 (bury-buffer buffer)
dc0e03f3
RS
4181 (select-window selected-window)
4182 (set-buffer oldbuf))
1fe3d507
DL
4183 buf-name)
4184
4185
4186(defun edebug-trace (fmt &rest args)
4187 "Convenience call to edebug-trace-display using edebug-trace-buffer"
4188 (apply 'edebug-trace-display edebug-trace-buffer fmt args))
4189
4190\f
f7359658 4191;;; Frequency count and coverage
1fe3d507
DL
4192
4193(defun edebug-display-freq-count ()
4194 "Display the frequency count data for each line of the current
4195definition. The frequency counts are inserted as comment lines after
4196each line, and you can undo all insertions with one `undo' command.
4197
4198The counts are inserted starting under the `(' before an expression
4199or the `)' after an expression, or on the last char of a symbol.
4200The counts are only displayed when they differ from previous counts on
4201the same line.
4202
4203If coverage is being tested, whenever all known results of an expression
4204are `eq', the char `=' will be appended after the count
4205for that expression. Note that this is always the case for an
4206expression only evaluated once.
4207
4208To clear the frequency count and coverage data for a definition,
4209reinstrument it."
4210 (interactive)
4211 (let* ((function (edebug-form-data-symbol))
4212 (counts (get function 'edebug-freq-count))
4213 (coverages (get function 'edebug-coverage))
4214 (data (get function 'edebug))
4215 (def-mark (car data)) ; mark at def start
4216 (edebug-points (nth 2 data))
4217 (i (1- (length edebug-points)))
4218 (last-index)
4219 (first-index)
4220 (start-of-line)
4221 (start-of-count-line)
4222 (last-count)
4223 )
84fc2cfa 4224 (save-excursion
1fe3d507
DL
4225 ;; Traverse in reverse order so offsets are correct.
4226 (while (<= 0 i)
4227 ;; Start at last expression in line.
4228 (goto-char (+ def-mark (aref edebug-points i)))
4229 (beginning-of-line)
4230 (setq start-of-line (- (point) def-mark)
4231 last-index i)
4232
4233 ;; Find all indexes on same line.
4234 (while (and (<= 0 (setq i (1- i)))
4235 (<= start-of-line (aref edebug-points i))))
4236 ;; Insert all the indices for this line.
4237 (forward-line 1)
4238 (setq start-of-count-line (point)
4239 first-index i ; really last index for line above this one.
4240 last-count -1) ; cause first count to always appear.
4241 (insert ";#")
4242 ;; i == first-index still
4243 (while (<= (setq i (1+ i)) last-index)
4244 (let ((count (aref counts i))
4245 (coverage (aref coverages i))
4246 (col (save-excursion
4247 (goto-char (+ (aref edebug-points i) def-mark))
4248 (- (current-column)
4249 (if (= ?\( (following-char)) 0 1)))))
4250 (insert (make-string
4251 (max 0 (- col (- (point) start-of-count-line))) ?\ )
4252 (if (and (< 0 count)
4253 (not (memq coverage
4254 '(unknown ok-coverage))))
4255 "=" "")
4256 (if (= count last-count) "" (int-to-string count))
4257 " ")
4258 (setq last-count count)))
4259 (insert "\n")
4260 (setq i first-index)))))
4261
4262(defun edebug-temp-display-freq-count ()
4263 "Temporarily display the frequency count data for the current definition.
4264It is removed when you hit any char."
4265 ;; This seems not to work with Emacs 18.59. It undoes too far.
4266 (interactive)
4267 (let ((buffer-read-only nil))
4268 (undo-boundary)
4269 (edebug-display-freq-count)
4270 (setq unread-command-char (read-char))
4271 (undo)))
4272
4273\f
f7359658 4274;;; Menus
1fe3d507
DL
4275
4276(defun edebug-toggle (variable)
4277 (set variable (not (eval variable)))
4278 (message "%s: %s" variable (eval variable)))
4279
4280;; We have to require easymenu (even for Emacs 18) just so
4281;; the easy-menu-define macro call is compiled correctly.
4282(require 'easymenu)
4283
4284(defconst edebug-mode-menus
4285 '("Edebug"
4286 "----"
4287 ["Stop" edebug-stop t]
4288 ["Step" edebug-step-mode t]
4289 ["Next" edebug-next-mode t]
4290 ["Trace" edebug-trace-mode t]
4291 ["Trace Fast" edebug-Trace-fast-mode t]
4292 ["Continue" edebug-continue-mode t]
4293 ["Continue Fast" edebug-Continue-fast-mode t]
4294 ["Go" edebug-go-mode t]
4295 ["Go Nonstop" edebug-Go-nonstop-mode t]
4296 "----"
4297 ["Help" edebug-help t]
4298 ["Abort" abort-recursive-edit t]
4299 ["Quit to Top Level" top-level t]
4300 ["Quit Nonstop" edebug-top-level-nonstop t]
4301 "----"
4302 ("Jumps"
4303 ["Forward Sexp" edebug-forward-sexp t]
4304 ["Step In" edebug-step-in t]
4305 ["Step Out" edebug-step-out t]
4306 ["Goto Here" edebug-goto-here t])
4307
4308 ("Breaks"
4309 ["Set Breakpoint" edebug-set-breakpoint t]
4310 ["Unset Breakpoint" edebug-unset-breakpoint t]
4311 ["Set Conditional Breakpoint" edebug-set-conditional-breakpoint t]
4312 ["Set Global Break Condition" edebug-set-global-break-condition t]
4313 ["Show Next Breakpoint" edebug-next-breakpoint t])
4314
4315 ("Views"
4316 ["Where am I?" edebug-where t]
4317 ["Bounce to Current Point" edebug-bounce-point t]
4318 ["View Outside Windows" edebug-view-outside t]
4319 ["Previous Result" edebug-previous-result t]
4320 ["Show Backtrace" edebug-backtrace t]
4321 ["Display Freq Count" edebug-display-freq-count t])
4322
4323 ("Eval"
4324 ["Expression" edebug-eval-expression t]
4325 ["Last Sexp" edebug-eval-last-sexp t]
4326 ["Visit Eval List" edebug-visit-eval-list t])
4327
4328 ("Options"
4329 ["Edebug All Defs" edebug-all-defs t]
4330 ["Edebug All Forms" edebug-all-forms t]
4331 "----"
4332 ["Toggle Tracing" (edebug-toggle 'edebug-trace) t]
4333 ["Toggle Coverage Testing" (edebug-toggle 'edebug-test-coverage) t]
4334 ["Toggle Window Saving" edebug-toggle-save-windows t]
4335 ["Toggle Point Saving"
4336 (edebug-toggle 'edebug-save-displayed-buffer-points) t]
4337 ))
4338 "Lemacs style menus for Edebug.")
4339
4340\f
f7359658
RS
4341;;; Emacs version specific code
4342
1fe3d507
DL
4343;;; The default for all above is Emacs 18, because it is easier to compile
4344;;; Emacs 18 code in Emacs 19 than vice versa. This default will
4345;;; change once most people are using Emacs 19 or derivatives.
4346
4347;; Epoch specific code is in a separate file: edebug-epoch.el.
4348
4349;; The byte-compiler will complain about changes in number of arguments
4350;; to functions like mark and read-from-minibuffer. These warnings
4351;; may be ignored because the right call should always be made.
4352
100aa77c 4353(defun edebug-emacs-19-specific ()
1fe3d507
DL
4354
4355 (defalias 'edebug-window-live-p 'window-live-p)
4356
4357 ;; Mark takes an argument in Emacs 19.
4358 (defun edebug-mark ()
4359 (mark t));; Does this work for lemacs too?
4360
1fe3d507
DL
4361 (defun edebug-set-conditional-breakpoint (arg condition)
4362 "Set a conditional breakpoint at nearest sexp.
4363The condition is evaluated in the outside context.
4364With prefix argument, make it a temporary breakpoint."
4365 ;; (interactive "P\nxCondition: ")
4366 (interactive
4367 (list
4368 current-prefix-arg
4369 ;; Read condition as follows; getting previous condition is cumbersome:
4370 (let ((edebug-stop-point (edebug-find-stop-point)))
4371 (if edebug-stop-point
4372 (let* ((edebug-def-name (car edebug-stop-point))
4373 (index (cdr edebug-stop-point))
4374 (edebug-data (get edebug-def-name 'edebug))
4375 (edebug-breakpoints (car (cdr edebug-data)))
4376 (edebug-break-data (assq index edebug-breakpoints))
4377 (edebug-break-condition (car (cdr edebug-break-data)))
4378 (edebug-expression-history
4379 ;; Prepend the current condition, if any.
4380 (if edebug-break-condition
4381 (cons edebug-break-condition read-expression-history)
4382 read-expression-history)))
4383 (prog1
4384 (read-from-minibuffer
4385 "Condition: " nil read-expression-map t
4386 'edebug-expression-history)
4387 (setq read-expression-history edebug-expression-history)
4388 ))))))
4389 (edebug-modify-breakpoint t condition arg))
4390
4391 (defun edebug-eval-expression (edebug-expr)
4392 "Evaluate an expression in the outside environment.
4393If interactive, prompt for the expression.
4394Print result in minibuffer."
4395 (interactive (list (read-from-minibuffer
4396 "Eval: " nil read-expression-map t
4397 'read-expression-history)))
4398 (princ
4399 (edebug-outside-excursion
4400 (setq values (cons (edebug-eval edebug-expr) values))
4401 (edebug-safe-prin1-to-string (car values)))))
4402
f7359658
RS
4403 (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
4404 (if window-system
4405 (x-popup-menu nil (lookup-key edebug-mode-map [menu-bar Edebug])))
1fe3d507
DL
4406 )
4407
4408
4409(defun edebug-lemacs-specific ()
4410
4411 ;; We need to bind zmacs-regions to nil around all calls to `mark' and
4412 ;; `mark-marker' but don't bind it to nil before entering a recursive edit,
4413 ;; that is, don't interfere with the binding the user might see while
4414 ;; executing a command.
4415
4416 (defvar zmacs-regions)
4417
4418 (defun edebug-mark ()
4419 (let ((zmacs-regions nil))
4420 (mark)))
4421
4422 (defun edebug-mark-marker ()
4423 (let ((zmacs-regions nil));; for lemacs
4424 (mark-marker)))
4425
4426
4427 (defun edebug-mode-menu (event)
4428 (interactive "@event")
4429 (popup-menu edebug-mode-menus))
4430
4431 (define-key edebug-mode-map 'button3 'edebug-mode-menu)
4432 )
4433
4434(defun edebug-emacs-version-specific ()
4435 (cond
100aa77c 4436 ((string-match "Lucid" emacs-version);; Lucid Emacs
1fe3d507
DL
4437 (edebug-lemacs-specific))
4438
1fe3d507 4439 ((and (boundp 'epoch::version) epoch::version)
100aa77c
RS
4440 (require 'edebug-epoch))
4441
4442 ((not (string-match "^18" emacs-version))
4443 (edebug-emacs-19-specific))))
1fe3d507
DL
4444
4445(edebug-emacs-version-specific)
4446
4447\f
f7359658
RS
4448;;; Byte-compiler
4449
1fe3d507
DL
4450;; Extension for bytecomp to resolve undefined function references.
4451;; Requires new byte compiler.
4452
4453;; Reenable byte compiler warnings about unread-command-char and -event.
4454;; Disabled before edebug-recursive-edit.
4455(eval-when-compile
4456 (if edebug-unread-command-char-warning
4457 (put 'unread-command-char 'byte-obsolete-variable
4458 edebug-unread-command-char-warning))
4459 (if edebug-unread-command-event-warning
4460 (put 'unread-command-event 'byte-obsolete-variable
4461 edebug-unread-command-event-warning)))
4462
4463(eval-when-compile
4464 ;; The body of eval-when-compile seems to get evaluated with eval-defun.
4465 ;; We only want to evaluate when actually byte compiling.
4466 ;; But it is OK to evaluate as long as byte-compiler has been loaded.
4467 (if (featurep 'byte-compile) (progn
4468
4469 (defun byte-compile-resolve-functions (funcs)
4470 "Say it is OK for the named functions to be unresolved."
4471 (mapcar
4472 (function
4473 (lambda (func)
4474 (setq byte-compile-unresolved-functions
4475 (delq (assq func byte-compile-unresolved-functions)
4476 byte-compile-unresolved-functions))))
4477 funcs)
4478 nil)
4479
4480 '(defun byte-compile-resolve-free-references (vars)
4481 "Say it is OK for the named variables to be referenced."
4482 (mapcar
4483 (function
4484 (lambda (var)
4485 (setq byte-compile-free-references
4486 (delq var byte-compile-free-references))))
4487 vars)
4488 nil)
4489
4490 '(defun byte-compile-resolve-free-assignments (vars)
4491 "Say it is OK for the named variables to be assigned."
4492 (mapcar
4493 (function
4494 (lambda (var)
4495 (setq byte-compile-free-assignments
4496 (delq var byte-compile-free-assignments))))
4497 vars)
4498 nil)
4499
4500 (byte-compile-resolve-functions
4501 '(reporter-submit-bug-report
f7359658 4502 edebug-gensym ;; also in cl.el
1fe3d507
DL
4503 ;; Interfaces to standard functions.
4504 edebug-original-eval-defun
4505 edebug-original-read
4506 edebug-get-buffer-window
4507 edebug-mark
4508 edebug-mark-marker
4509 edebug-input-pending-p
4510 edebug-sit-for
4511 edebug-prin1-to-string
4512 edebug-format
1fe3d507
DL
4513 ;; lemacs
4514 zmacs-deactivate-region
4515 popup-menu
4516 ;; CL
4517 cl-macroexpand-all
f7359658 4518 ;; And believe it or not, the byte compiler doesn't know about:
1fe3d507
DL
4519 byte-compile-resolve-functions
4520 ))
4521
4522 '(byte-compile-resolve-free-references
4523 '(read-expression-history
4524 read-expression-map))
4525
4526 '(byte-compile-resolve-free-assignments
4527 '(read-expression-history))
4528
4529 )))
4530
4531\f
f7359658 4532;;; Autoloading of Edebug accessories
1fe3d507
DL
4533
4534(if (featurep 'cl)
4535 (add-hook 'edebug-setup-hook
4536 (function (lambda () (require 'cl-specs))))
4537 ;; The following causes cl-specs to be loaded if you load cl.el.
4538 (add-hook 'cl-load-hook
4539 (function (lambda () (require 'cl-specs)))))
4540
f7359658 4541;;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu
1fe3d507
DL
4542(if (featurep 'cl-read)
4543 (add-hook 'edebug-setup-hook
4544 (function (lambda () (require 'edebug-cl-read))))
4545 ;; The following causes edebug-cl-read to be loaded when you load cl-read.el.
4546 (add-hook 'cl-read-load-hooks
4547 (function (lambda () (require 'edebug-cl-read)))))
4548
4549\f
f7359658 4550;;; Finalize Loading
1fe3d507
DL
4551
4552;;; Finally, hook edebug into the rest of Emacs.
4553;;; There are probably some other things that could go here.
4554
4555;; Install edebug read and eval functions.
4556(edebug-install-read-eval-functions)
84fc2cfa 4557
e8544af2
RS
4558(provide 'edebug)
4559
84fc2cfa 4560;;; edebug.el ends here