root/trunk/lisp/emacs-lisp/edebug.el

;;; edebug.el --- a source-level debugger for Emacs Lisp

;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997, 1999,
;;   2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.

;; Author: Daniel LaLiberte <liberte@holonexus.org>
;; Maintainer: FSF
;; Keywords: lisp, tools, maint

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; This minor mode allows programmers to step through Emacs Lisp
;; source code while executing functions.  You can also set
;; breakpoints, trace (stopping at each expression), evaluate
;; expressions as if outside Edebug, reevaluate and display a list of
;; expressions, trap errors normally caught by debug, and display a
;; debug style backtrace.

;;; Minimal Instructions
;; =====================

;; First evaluate a defun with C-M-x, then run the function.  Step
;; through the code with SPC, mark breakpoints with b, go until a
;; breakpoint is reached with g, and quit execution with q.  Use the
;; "?" command in edebug to describe other commands.
;; See the Emacs Lisp Reference Manual for more details.

;; If you wish to change the default edebug global command prefix, change:
;; (setq edebug-global-prefix "\C-xX")

;; Edebug was written by
;; Daniel LaLiberte
;; GTE Labs
;; 40 Sylvan Rd
;; Waltham, MA  02254
;; liberte@holonexus.org

;;; Code:

;;; Bug reporting

(defalias 'edebug-submit-bug-report 'report-emacs-bug)

;;; Options

(defgroup edebug nil
  "A source-level debugger for Emacs Lisp."
  :group 'lisp)


(defcustom edebug-setup-hook nil
  "*Functions to call before edebug is used.
Each time it is set to a new value, Edebug will call those functions
once and then `edebug-setup-hook' is reset to nil.  You could use this
to load up Edebug specifications associated with a package you are
using but only when you also use Edebug."
  :type 'hook
  :group 'edebug)

;; edebug-all-defs and edebug-all-forms need to be autoloaded
;; because the byte compiler binds them; as a result, if edebug
;; is first loaded for a require in a compilation, they will be left unbound.

;;;###autoload
(defcustom edebug-all-defs nil
  "*If non-nil, evaluating defining forms instruments for Edebug.
This applies to `eval-defun', `eval-region', `eval-buffer', and
`eval-current-buffer'.  `eval-region' is also called by
`eval-last-sexp', and `eval-print-last-sexp'.

You can use the command `edebug-all-defs' to toggle the value of this
variable.  You may wish to make it local to each buffer with
\(make-local-variable 'edebug-all-defs) in your
`emacs-lisp-mode-hook'."
  :type 'boolean
  :group 'edebug)

;; edebug-all-defs and edebug-all-forms need to be autoloaded
;; because the byte compiler binds them; as a result, if edebug
;; is first loaded for a require in a compilation, they will be left unbound.

;;;###autoload
(defcustom edebug-all-forms nil
  "*Non-nil evaluation of all forms will instrument for Edebug.
This doesn't apply to loading or evaluations in the minibuffer.
Use the command `edebug-all-forms' to toggle the value of this option."
  :type 'boolean
  :group 'edebug)

(defcustom edebug-eval-macro-args nil
  "*Non-nil means all macro call arguments may be evaluated.
If this variable is nil, the default, Edebug will *not* wrap
macro call arguments as if they will be evaluated.
For each macro, a `edebug-form-spec' overrides this option.
So to specify exceptions for macros that have some arguments evaluated
and some not, you should specify an `edebug-form-spec'."
  :type 'boolean
  :group 'edebug)

(defcustom edebug-save-windows t
  "*If non-nil, Edebug saves and restores the window configuration.
That takes some time, so if your program does not care what happens to
the window configurations, it is better to set this variable to nil.

If the value is a list, only the listed windows are saved and
restored.

`edebug-toggle-save-windows' may be used to change this variable."
  :type '(choice boolean (repeat string))
  :group 'edebug)

(defcustom edebug-save-displayed-buffer-points nil
  "*If non-nil, save and restore point in all displayed buffers.

Saving and restoring point in other buffers is necessary if you are
debugging code that changes the point of a buffer which is displayed
in a non-selected window.  If Edebug or the user then selects the
window, the buffer's point will be changed to the window's point.

Saving and restoring point in all buffers is expensive, since it
requires selecting each window twice, so enable this only if you need
it."
  :type 'boolean
  :group 'edebug)

(defcustom edebug-initial-mode 'step
  "*Initial execution mode for Edebug, if non-nil.
If this variable is non-nil, it specifies the initial execution mode
for Edebug when it is first activated.  Possible values are step, next,
go, Go-nonstop, trace, Trace-fast, continue, and Continue-fast."
  :type '(choice (const step) (const next) (const go)
                 (const Go-nonstop) (const trace)
                 (const Trace-fast) (const continue)
                 (const Continue-fast))
  :group 'edebug)

(defcustom edebug-trace nil
  "*Non-nil means display a trace of function entry and exit.
Tracing output is displayed in a buffer named `*edebug-trace*', one
function entry or exit per line, indented by the recursion level.

You can customize by replacing functions `edebug-print-trace-before'
and `edebug-print-trace-after'."
  :type 'boolean
  :group 'edebug)

(defcustom edebug-test-coverage nil
  "*If non-nil, Edebug tests coverage of all expressions debugged.
This is done by comparing the result of each expression
with the previous result. Coverage is considered OK if two different
results are found.

Use `edebug-display-freq-count' to display the frequency count and
coverage information for a definition."
  :type 'boolean
  :group 'edebug)

(defcustom edebug-continue-kbd-macro nil
  "*If non-nil, continue defining or executing any keyboard macro.
Use this with caution since it is not debugged."
  :type 'boolean
  :group 'edebug)


(defcustom edebug-print-length 50
  "*Default value of `print-length' for printing results in Edebug."
  :type 'integer
  :group 'edebug)
(defcustom edebug-print-level 50
  "*Default value of `print-level' for printing results in Edebug."
  :type 'integer
  :group 'edebug)
(defcustom edebug-print-circle t
  "*Default value of `print-circle' for printing results in Edebug."
  :type 'boolean
  :group 'edebug)

(defcustom edebug-unwrap-results nil
  "*Non-nil if Edebug should unwrap results of expressions.
This is useful when debugging macros where the results of expressions
are instrumented expressions.  But don't do this when results might be
circular or an infinite loop will result."
  :type 'boolean
  :group 'edebug)

(defcustom edebug-on-error t
  "*Value bound to `debug-on-error' while Edebug is active.

If `debug-on-error' is non-nil, that value is still used.

If the value is a list of signal names, Edebug will stop when any of
these errors are signaled from Lisp code whether or not the signal is
handled by a `condition-case'.  This option is useful for debugging
signals that *are* handled since they would otherwise be missed.
After execution is resumed, the error is signaled again."
  :type '(choice (const :tag "off")
                 (repeat :menu-tag "When"
                         :value (nil)
                         (symbol :format "%v"))
                 (const :tag "always" t))
  :group 'edebug)

(defcustom edebug-on-quit t
  "*Value bound to `debug-on-quit' while Edebug is active."
  :type 'boolean
  :group 'edebug)

(defcustom edebug-global-break-condition nil
  "*If non-nil, an expression to test for at every stop point.
If the result is non-nil, then break.  Errors are ignored."
  :type 'sexp
  :group 'edebug)

(defcustom edebug-sit-for-seconds 1
  "*Number of seconds to pause when execution mode is `trace'."
  :type 'number
  :group 'edebug)

;;; Form spec utilities.

(defmacro def-edebug-form-spec (symbol spec-form)
  "For compatibility with old version."
  (def-edebug-spec symbol (eval spec-form)))
(make-obsolete 'def-edebug-form-spec 'def-edebug-spec "22.1")

(defun get-edebug-spec (symbol)
  ;; Get the spec of symbol resolving all indirection.
  (let ((edebug-form-spec (get symbol 'edebug-form-spec))
        indirect)
    (while (and (symbolp edebug-form-spec)
                (setq indirect (get edebug-form-spec 'edebug-form-spec)))
      ;; (edebug-trace "indirection: %s" edebug-form-spec)
      (setq edebug-form-spec indirect))
    edebug-form-spec
    ))

;;;###autoload
(defun edebug-basic-spec (spec)
  "Return t if SPEC uses only extant spec symbols.
An extant spec symbol is a symbol that is not a function and has a
`edebug-form-spec' property."
  (cond ((listp spec)
         (catch 'basic
           (while spec
             (unless (edebug-basic-spec (car spec)) (throw 'basic nil))
             (setq spec (cdr spec)))
           t))
        ((symbolp spec)
         (unless (functionp spec) (get spec 'edebug-form-spec)))))

;;; Utilities

;; Define edebug-gensym - from old cl.el
(defvar edebug-gensym-index 0
  "Integer used by `edebug-gensym' to produce new names.")

(defun edebug-gensym (&optional prefix)
  "Generate a fresh uninterned symbol.
There is an  optional argument, PREFIX.  PREFIX is the
string that begins the new name. Most people take just the default,
except when debugging needs suggest otherwise."
  (if (null prefix)
      (setq prefix "G"))
  (let ((newsymbol nil)
        (newname   ""))
    (while (not newsymbol)
      (setq newname (concat prefix (int-to-string edebug-gensym-index)))
      (setq edebug-gensym-index (+ edebug-gensym-index 1))
      (if (not (intern-soft newname))
          (setq newsymbol (make-symbol newname))))
    newsymbol))

(defun edebug-lambda-list-keywordp (object)
  "Return t if OBJECT is a lambda list keyword.
A lambda list keyword is a symbol that starts with `&'."
  (and (symbolp object)
       (= ?& (aref (symbol-name object) 0))))


(defun edebug-last-sexp ()
  ;; Return the last sexp before point in current buffer.
  ;; Assumes Emacs Lisp syntax is active.
  (car
   (read-from-string
    (buffer-substring
     (save-excursion
       (forward-sexp -1)
       (point))
     (point)))))

(defun edebug-window-list ()
  "Return a list of windows, in order of `next-window'."
  ;; This doesn't work for epoch.
  (let (window-list)
    (walk-windows (lambda (w) (push w window-list)))
    (nreverse window-list)))

;; Not used.
'(defun edebug-two-window-p ()
  "Return t if there are two windows."
  (and (not (one-window-p))
       (eq (selected-window)
           (next-window (next-window (selected-window))))))

(defsubst edebug-lookup-function (object)
  (while (and (symbolp object) (fboundp object))
    (setq object (symbol-function object)))
  object)

(defun edebug-macrop (object)
  "Return the macro named by OBJECT, or nil if it is not a macro."
  (setq object (edebug-lookup-function object))
  (if (and (listp object)
           (eq 'macro (car object))
           (functionp (cdr object)))
      object))

(defun edebug-sort-alist (alist function)
  ;; Return the ALIST sorted with comparison function FUNCTION.
  ;; This uses 'sort so the sorting is destructive.
  (sort alist (function
               (lambda (e1 e2)
                 (funcall function (car e1) (car e2))))))

;;(def-edebug-spec edebug-save-restriction t)

;; Not used.  If it is used, def-edebug-spec must be defined before use.
'(defmacro edebug-save-restriction (&rest body)
  "Evaluate BODY while saving the current buffers restriction.
BODY may change buffer outside of current restriction, unlike
save-restriction.  BODY may change the current buffer,
and the restriction will be restored to the original buffer,
and the current buffer remains current.
Return the result of the last expression in BODY."
  `(let ((edebug:s-r-beg (point-min-marker))
         (edebug:s-r-end (point-max-marker)))
     (unwind-protect
         (progn ,@body)
       (save-excursion
         (set-buffer (marker-buffer edebug:s-r-beg))
         (narrow-to-region edebug:s-r-beg edebug:s-r-end)))))

;;; Display

(defconst edebug-trace-buffer "*edebug-trace*"
  "Name of the buffer to put trace info in.")

(defun edebug-pop-to-buffer (buffer &optional window)
  ;; Like pop-to-buffer, but select window where BUFFER was last shown.
  ;; Select WINDOW if it is provided and still exists.  Otherwise,
  ;; if buffer is currently shown in several windows, choose one.
  ;; Otherwise, find a new window, possibly splitting one.
  (setq window
        (cond
         ((and (windowp window) (edebug-window-live-p window)
               (eq (window-buffer window) buffer))
          window)
         ((eq (window-buffer (selected-window)) buffer)
          ;; Selected window already displays BUFFER.
          (selected-window))
         ((edebug-get-buffer-window buffer))
         ((one-window-p 'nomini)
          ;; When there's one window only, split it.
          (split-window))
         ((let ((trace-window (get-buffer-window edebug-trace-buffer)))
            (catch 'found
              (dolist (elt (window-list nil 'nomini))
                (unless (or (eq elt (selected-window)) (eq elt trace-window)
                            (window-dedicated-p elt))
                  ;; Found a non-dedicated window not showing
                  ;; `edebug-trace-buffer', use it.
                  (throw 'found elt))))))
         ;; All windows are dedicated or show `edebug-trace-buffer', split
         ;; selected one.
         (t (split-window))))
  (select-window window)
  (set-window-buffer window buffer)
  (set-window-hscroll window 0);; should this be??
  ;; Selecting the window does not set the buffer until command loop.
  ;;(set-buffer buffer)
  )

(defun edebug-get-displayed-buffer-points ()
  ;; Return a list of buffer point pairs, for all displayed buffers.
  (let (list)
    (walk-windows (lambda (w)
                    (unless (eq w (selected-window))
                      (push (cons (window-buffer w)
                                  (window-point w))
                            list))))
    list))


(defun edebug-set-buffer-points (buffer-points)
  ;; Restore the buffer-points created by edebug-get-displayed-buffer-points.
  (save-current-buffer
    (mapcar (lambda (buf-point)
              (when (buffer-live-p (car buf-point))
                (set-buffer (car buf-point))
                (goto-char (cdr buf-point))))
            buffer-points)))

(defun edebug-current-windows (which-windows)
  ;; Get either a full window configuration or some window information.
  (if (listp which-windows)
      (mapcar (function (lambda (window)
                          (if (edebug-window-live-p window)
                              (list window
                                    (window-buffer window)
                                    (window-point window)
                                    (window-start window)
                                    (window-hscroll window)))))
              which-windows)
    (current-window-configuration)))

(defun edebug-set-windows (window-info)
  ;; Set either a full window configuration or some window information.
  (if (listp window-info)
      (mapcar (function
               (lambda (one-window-info)
                 (if one-window-info
                     (apply (function
                             (lambda (window buffer point start hscroll)
                               (if (edebug-window-live-p window)
                                   (progn
                                     (set-window-buffer window buffer)
                                     (set-window-point window point)
                                     (set-window-start window start)
                                     (set-window-hscroll window hscroll)))))
                            one-window-info))))
              window-info)
    (set-window-configuration window-info)))

(defalias 'edebug-get-buffer-window 'get-buffer-window)
(defalias 'edebug-sit-for 'sit-for)
(defalias 'edebug-input-pending-p 'input-pending-p)


;;; Redefine read and eval functions
;; read is redefined to maybe instrument forms.
;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.

;; Save the original read function
(or (fboundp 'edebug-original-read)
    (defalias 'edebug-original-read  (symbol-function 'read)))

(defun edebug-read (&optional stream)
  "Read one Lisp expression as text from STREAM, return as Lisp object.
If STREAM is nil, use the value of `standard-input' (which see).
STREAM or the value of `standard-input' may be:
 a buffer (read from point and advance it)
 a marker (read from where it points and advance it)
 a function (call it with no arguments for each character,
     call it with a char as argument to push a char back)
 a string (takes text from string, starting at the beginning)
 t (read text line using minibuffer and use it).

This version, from Edebug, maybe instruments the expression. But the
STREAM must be the current buffer to do so.  Whether it instruments is
also dependent on the values of `edebug-all-defs' and
`edebug-all-forms'."
  (or stream (setq stream standard-input))
  (if (eq stream (current-buffer))
      (edebug-read-and-maybe-wrap-form)
    (edebug-original-read stream)))

(or (fboundp 'edebug-original-eval-defun)
    (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun)))

;; We should somehow arrange to be able to do this
;; without actually replacing the eval-defun command.
(defun edebug-eval-defun (edebug-it)
  "Evaluate the top-level form containing point, or after point.

If the current defun is actually a call to `defvar', then reset the
variable using its initial value expression even if the variable
already has some other value.  (Normally `defvar' does not change the
variable's value if it already has a value.)  Treat `defcustom'
similarly.  Reinitialize the face according to `defface' specification.

With a prefix argument, instrument the code for Edebug.

Setting `edebug-all-defs' to a non-nil value reverses the meaning of
the prefix argument.  Code is then instrumented when this function is
invoked without a prefix argument

If acting on a `defun' for FUNCTION, and the function was
instrumented, `Edebug: FUNCTION' is printed in the minibuffer.  If not
instrumented, just FUNCTION is printed.

If not acting on a `defun', the result of evaluation is displayed in
the minibuffer."
  (interactive "P")
  (let* ((edebugging (not (eq (not edebug-it) (not edebug-all-defs))))
         (edebug-result)
         (form
          (let ((edebug-all-forms edebugging)
                (edebug-all-defs (eq edebug-all-defs (not edebug-it))))
            (edebug-read-top-level-form))))
    ;; This should be consistent with `eval-defun-1', but not the
    ;; same, since that gets a macroexpanded form.
    (cond ((and (eq (car form) 'defvar)
                (cdr-safe (cdr-safe form)))
           ;; Force variable to be bound.
           (makunbound (nth 1 form)))
          ((and (eq (car form) 'defcustom)
                (default-boundp (nth 1 form)))
           ;; Force variable to be bound.
           (set-default (nth 1 form) (eval (nth 2 form))))
          ((eq (car form) 'defface)
           ;; Reset the face.
           (setq face-new-frame-defaults
                 (assq-delete-all (nth 1 form) face-new-frame-defaults))
           (put (nth 1 form) 'face-defface-spec nil)
           ;; See comments in `eval-defun-1' for purpose of code below
           (setq form (prog1 `(prog1 ,form
                                (put ',(nth 1 form) 'saved-face
                                     ',(get (nth 1 form) 'saved-face))
                                (put ',(nth 1 form) 'customized-face
                                     ,(nth 2 form)))
                        (put (nth 1 form) 'saved-face nil)))))
    (setq edebug-result (eval form))
    (if (not edebugging)
        (princ edebug-result)
      edebug-result)))


;;;###autoload
(defalias 'edebug-defun 'edebug-eval-top-level-form)

;;;###autoload
(defun edebug-eval-top-level-form ()
  "Evaluate the top level form point is in, stepping through with Edebug.
This is like `eval-defun' except that it steps the code for Edebug
before evaluating it.  It displays the value in the echo area
using `eval-expression' (which see).

If you do this on a function definition
such as a defun or defmacro, it defines the function and instruments
its definition for Edebug, so it will do Edebug stepping when called
later.  It displays `Edebug: FUNCTION' in the echo area to indicate
that FUNCTION is now instrumented for Edebug.

If the current defun is actually a call to `defvar' or `defcustom',
evaluating it this way resets the variable using its initial value
expression even if the variable already has some other value.
\(Normally `defvar' and `defcustom' do not alter the value if there
already is one.)"
  (interactive)
  (eval-expression
   ;; Bind edebug-all-forms only while reading, not while evalling
   ;; but this causes problems while edebugging edebug.
   (let ((edebug-all-forms t)
         (edebug-all-defs t))
     (edebug-read-top-level-form))))


(defun edebug-read-top-level-form ()
  (let ((starting-point (point)))
    (end-of-defun)
    (beginning-of-defun)
    (prog1
        (edebug-read-and-maybe-wrap-form)
      ;; Recover point, but only if no error occurred.
      (goto-char starting-point))))


;; Compatibility with old versions.
(defalias 'edebug-all-defuns 'edebug-all-defs)

;;;###autoload
(defun edebug-all-defs ()
  "Toggle edebugging of all definitions."
  (interactive)
  (setq edebug-all-defs (not edebug-all-defs))
  (message "Edebugging all definitions is %s."
           (if edebug-all-defs "on" "off")))


;;;###autoload
(defun edebug-all-forms ()
  "Toggle edebugging of all forms."
  (interactive)
  (setq edebug-all-forms (not edebug-all-forms))
  (message "Edebugging all forms is %s."
           (if edebug-all-forms "on" "off")))


(defun edebug-install-read-eval-functions ()
  (interactive)
  ;; Don't install if already installed.
  (unless load-read-function
    (setq load-read-function 'edebug-read)
    (defalias 'eval-defun 'edebug-eval-defun)))

(defun edebug-uninstall-read-eval-functions ()
  (interactive)
  (setq load-read-function nil)
  (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun)))


;;; Edebug internal data

;; The internal data that is needed for edebugging is kept in the
;; buffer-local variable `edebug-form-data'.

(make-variable-buffer-local 'edebug-form-data)

(defvar edebug-form-data nil)
;; A list of entries associating symbols with buffer regions.
;; This is an automatic buffer local variable.  Each entry looks like:
;; @code{(@var{symbol} @var{begin-marker} @var{end-marker}).  The markers
;; are at the beginning and end of an entry level form and @var{symbol} is
;; a symbol that holds all edebug related information for the form on its
;; property list.

;; In the future, the symbol will be irrelevant and edebug data will
;; be stored in the definitions themselves rather than in the property
;; list of a symbol.

(defun edebug-make-form-data-entry (symbol begin end)
  (list symbol begin end))

(defsubst edebug-form-data-name (entry)
  (car entry))

(defsubst edebug-form-data-begin (entry)
  (nth 1 entry))

(defsubst edebug-form-data-end (entry)
  (nth 2 entry))

(defsubst edebug-set-form-data-entry (entry name begin end)
  (setcar entry name);; in case name is changed
  (set-marker (nth 1 entry) begin)
  (set-marker (nth 2 entry) end))

(defun edebug-get-form-data-entry (pnt &optional end-point)
  ;; Find the edebug form data entry which is closest to PNT.
  ;; If END-POINT is supplied, match must be exact.
  ;; Return `nil' if none found.
  (let ((rest edebug-form-data)
        closest-entry
        (closest-dist 999999))  ;; need maxint here
    (while (and rest (< 0 closest-dist))
      (let* ((entry (car rest))
             (begin (edebug-form-data-begin entry))
             (dist (- pnt begin)))
        (setq rest (cdr rest))
        (if (and (<= 0 dist)
                 (< dist closest-dist)
                 (or (not end-point)
                     (= end-point (edebug-form-data-end entry)))
                 (<= pnt (edebug-form-data-end entry)))
            (setq closest-dist dist
                  closest-entry entry))))
    closest-entry))

;; Also need to find all contained entries,
;; and find an entry given a symbol, which should be just assq.

(defun edebug-form-data-symbol ()
;; Return the edebug data symbol of the form where point is in.
;; If point is not inside a edebuggable form, cause error.
  (or (edebug-form-data-name (edebug-get-form-data-entry (point)))
      (error "Not inside instrumented form")))

(defun edebug-make-top-form-data-entry (new-entry)
  ;; Make NEW-ENTRY the first element in the `edebug-form-data' list.
  (edebug-clear-form-data-entry new-entry)
  (setq edebug-form-data (cons new-entry edebug-form-data)))

(defun edebug-clear-form-data-entry (entry)
;; If non-nil, clear ENTRY out of the form data.
;; Maybe clear the markers and delete the symbol's edebug property?
  (if entry
      (progn
        ;; Instead of this, we could just find all contained forms.
        ;; (put (car entry) 'edebug nil)   ;
        ;; (mapcar 'edebug-clear-form-data-entry   ; dangerous
        ;;   (get (car entry) 'edebug-dependents))
        ;; (set-marker (nth 1 entry) nil)
        ;; (set-marker (nth 2 entry) nil)
        (setq edebug-form-data (delq entry edebug-form-data)))))

;;; Parser utilities

(defun edebug-syntax-error (&rest args)
  ;; Signal an invalid-read-syntax with ARGS.
  (signal 'invalid-read-syntax args))


(defconst edebug-read-syntax-table
  ;; Lookup table for significant characters indicating the class of the
  ;; token that follows.  This is not a \"real\" syntax table.
  (let ((table (make-char-table 'syntax-table 'symbol))
        (i 0))
    (while (< i ?!)
      (aset table i 'space)
      (setq i (1+ i)))
    (aset table ?\( 'lparen)
    (aset table ?\) 'rparen)
    (aset table ?\' 'quote)
    (aset table ?\` 'backquote)
    (aset table ?\, 'comma)
    (aset table ?\" 'string)
    (aset table ?\? 'char)
    (aset table ?\[ 'lbracket)
    (aset table ?\] 'rbracket)
    (aset table ?\. 'dot)
    (aset table ?\# 'hash)
    ;; We treat numbers as symbols, because of confusion with -, -1, and 1-.
    ;; We don't care about any other chars since they won't be seen.
    table))

(defun edebug-next-token-class ()
  ;; Move to the next token and return its class.  We only care about
  ;; lparen, rparen, dot, quote, backquote, comma, string, char, vector,
  ;; or symbol.
  (edebug-skip-whitespace)
  (if (and (eq (following-char) ?.)
           (save-excursion
             (forward-char 1)
             (or (and (eq (aref edebug-read-syntax-table (following-char))
                          'symbol)
                      (not (= (following-char) ?\;)))
                 (memq (following-char) '(?\, ?\.)))))
      'symbol
    (aref edebug-read-syntax-table (following-char))))


(defun edebug-skip-whitespace ()
  ;; Leave point before the next token, skipping white space and comments.
  (skip-chars-forward " \t\r\n\f")
  (while (= (following-char) ?\;)
    (skip-chars-forward "^\n")  ; skip the comment
    (skip-chars-forward " \t\r\n\f")))


;; Mostly obsolete reader; still used in one case.

(defun edebug-read-sexp ()
  ;; Read one sexp from the current buffer starting at point.
  ;; Leave point immediately after it.  A sexp can be a list or atom.
  ;; An atom is a symbol (or number), character, string, or vector.
  ;; This works for reading anything legitimate, but it
  ;; is gummed up by parser inconsistencies (bugs?)
  (let ((class (edebug-next-token-class)))
    (cond
     ;; read goes one too far if a (possibly quoted) string or symbol
     ;; is immediately followed by non-whitespace.
     ((eq class 'symbol) (edebug-original-read (current-buffer)))
     ((eq class 'string) (edebug-original-read (current-buffer)))
     ((eq class 'quote) (forward-char 1)
      (list 'quote (edebug-read-sexp)))
     ((eq class 'backquote)
      (list '\` (edebug-read-sexp)))
     ((eq class 'comma)
      (list '\, (edebug-read-sexp)))
     (t ; anything else, just read it.
      (edebug-original-read (current-buffer))))))

;;; Offsets for reader

;; Define a structure to represent offset positions of expressions.
;; Each offset structure looks like: (before . after) for constituents,
;; or for structures that have elements: (before <subexpressions> . after)
;; where the <subexpressions> are the offset structures for subexpressions
;; including the head of a list.
(defvar edebug-offsets nil)

;; Stack of offset structures in reverse order of the nesting.
;; This is used to get back to previous levels.
(defvar edebug-offsets-stack nil)
(defvar edebug-current-offset nil) ; Top of the stack, for convenience.

;; We must store whether we just read a list with a dotted form that
;; is itself a list.  This structure will be condensed, so the offsets
;; must also be condensed.
(defvar edebug-read-dotted-list nil)

(defsubst edebug-initialize-offsets ()
  ;; Reinitialize offset recording.
  (setq edebug-current-offset nil))

(defun edebug-store-before-offset (point)
  ;; Add a new offset pair with POINT as the before offset.
  (let ((new-offset (list point)))
    (if edebug-current-offset
        (setcdr edebug-current-offset
                (cons new-offset (cdr edebug-current-offset)))
      ;; Otherwise, we are at the top level, so initialize.
      (setq edebug-offsets new-offset
            edebug-offsets-stack nil
            edebug-read-dotted-list nil))
    ;; Cons the new offset to the front of the stack.
    (setq edebug-offsets-stack (cons new-offset edebug-offsets-stack)
          edebug-current-offset new-offset)
    ))

(defun edebug-store-after-offset (point)
  ;; Finalize the current offset struct by reversing it and
  ;; store POINT as the after offset.
  (if (not edebug-read-dotted-list)
      ;; Just reverse the offsets of all subexpressions.
      (setcdr edebug-current-offset (nreverse (cdr edebug-current-offset)))

    ;; We just read a list after a dot, which will be abbreviated out.
    (setq edebug-read-dotted-list nil)
    ;; Drop the corresponding offset pair.
    ;; That is, nconc the reverse of the rest of the offsets
    ;; with the cdr of last offset.
    (setcdr edebug-current-offset
            (nconc (nreverse (cdr (cdr edebug-current-offset)))
                   (cdr (car (cdr edebug-current-offset))))))

  ;; Now append the point using nconc.
  (setq edebug-current-offset (nconc edebug-current-offset point))
  ;; Pop the stack.
  (setq edebug-offsets-stack (cdr edebug-offsets-stack)
        edebug-current-offset (car edebug-offsets-stack)))

(defun edebug-ignore-offset ()
  ;; Ignore the last created offset pair.
  (setcdr edebug-current-offset (cdr (cdr edebug-current-offset))))

(defmacro edebug-storing-offsets (point &rest body)
  (declare (debug (form body)) (indent 1))
  `(unwind-protect
       (progn
         (edebug-store-before-offset ,point)
         ,@body)
     (edebug-store-after-offset (point))))


;;; Reader for Emacs Lisp.

;; Uses edebug-next-token-class (and edebug-skip-whitespace) above.

(defconst edebug-read-alist
  '((symbol . edebug-read-symbol)
    (lparen . edebug-read-list)