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